- Shiro: <dictionary>は(1) (キー,値)のタプルの集合であり、かつ (2) キーから値が素早く引ける、というものです。
連想配列(れんそうはいれつ)とは、コンピュータプログラミングにおいて、添え字にスカラー数値以外のデータ型(文字列型等)も使用できる配列である。抽象データ型のひとつ。連想リスト、連想コンテナ、辞書、ハッシュとも呼ばれる。
歴史的には、最初に LISP の連想リストとして広く認知された。その後、SNOBOL で table として、AWK で連想配列として実装したことで、その潜在能力がさらに広く知られるようになった。現在、Ruby など一部の言語では、添え字にはどのようなデータでも使えるものもある。
In computer science, an associative array, map, or dictionary is an abstract data type composed of a collection of pairs, such that each possible key appears at most once in the collection.
Operations associated with this data type allow:
- the addition of pairs to the collection
- the removal of pairs from the collection
- the modification of the values of existing pairs
- the lookup of the value associated with a particular key
The dictionary problem is the task of designing a data structure that implements an associative array. A standard solution to the dictionary problem is a hash table; in some cases it is also possible to solve the problem using directly addressed arrays, binary search trees, or other more specialized structures.
Many programming languages include associative arrays as primitive data types, and they are available in software libraries for many others. Content-addressable memory is a form of direct hardware-level support for associative arrays.
Associative arrays have many applications including such fundamental programming patterns as memoization and the decorator pattern
ディクショナリはキーから値への写像ができるオブジェクトを表わす抽象クラスです。このモジュールではディクショナリに対してよく使うジェネリック関数、および他のディクショナリクラスの上に構築される汎用的なディクショナリクラスを提供します。
;; Generic dictionary interface. ;; Required methods: ;; ;; dict-get dict key [default] ;; dict-put! dict key value ;; dict-delete! dict key ; for deletable dictionary
/* * Class stuff */ SCM_DEFINE_ABSTRACT_CLASS(Scm_CollectionClass, SCM_CLASS_DEFAULT_CPL); SCM_DEFINE_ABSTRACT_CLASS(Scm_SequenceClass, SCM_CLASS_COLLECTION_CPL); SCM_DEFINE_ABSTRACT_CLASS(Scm_DictionaryClass, SCM_CLASS_COLLECTION_CPL); SCM_DEFINE_ABSTRACT_CLASS(Scm_OrderedDictionaryClass, Scm__OrderedDictionaryCPL+1); ScmClass *Scm__OrderedDictionaryCPL[] = { SCM_CLASS_STATIC_PTR(Scm_OrderedDictionaryClass), SCM_CLASS_STATIC_PTR(Scm_SequenceClass), SCM_CLASS_STATIC_PTR(Scm_DictionaryClass), SCM_CLASS_STATIC_PTR(Scm_CollectionClass), SCM_CLASS_STATIC_PTR(Scm_TopClass), NULL }; ScmClass *Scm__SequenceCPL[] = { SCM_CLASS_STATIC_PTR(Scm_SequenceClass), SCM_CLASS_STATIC_PTR(Scm_CollectionClass), SCM_CLASS_STATIC_PTR(Scm_TopClass), NULL };
- Shiro(2013/04/18 00:08:42 UTC): 確かにオブジェクトをスロットから値へマップする辞書とみることはできますが(JavaScriptやPerlは両者の区別がほとんど無いですしね)、get/put!目的ならref (~) が使えるわけですし、辞書として統一的に扱う意味が無い、というかむしろ、動的型言語ではプログラマが型を意識して使い方を変えた方が見通しが良くなるんで、「普通辞書として使わないものは、辞書として使えるべきでない」とする方が理にかなっているように思います。実際、オブジェクトを(スロット . 値)のcollectionやsequenceと見なすことだってできるんですがあえてそうしていません。
- Shiro :allocation :virtualなスロットは (変更がある場合) ひとつのエントリの変更が別のエントリに影響を及ぼすわけで、それはむしろ「オブジェクトのスロット-値の関係を辞書にしてはいけない理由」と素直に考えれば良いと思うんですが。
- yamasushi(2013/04/13 22:11:15 UTC) メモ化の側面として、これはdictionaryに値を入れるための方法の一つとして見ることができなあと思いました。つまり手続きを与えて、それの挙動をdictionaryに記録している・・・ように見えます。(これにどういう意味があるのかはわかりません。)
- Shiro(2013/04/13 22:54:17 UTC): 純粋な関数は写像なので、引数から結果を計算しようが、 あらかじめ全ての引数とそれに対応する結果を辞書に入れといて単にルックアップしようが、 外部から見た機能は同じです。メモ化はこの「辞書」をlazyに構築していると考えられますね。
- yamasushi
また、いまのdictinaryフレームワークではfallbackが定数なのですが、これをf手続き(applicable)にできれば、若干柔軟な処理ができそうな気がします。
- Shiro
なお、fallbackを定数にすべきかthunkにすべきか、というのは昔からある議論で (hashtableのインタフェースに関して過去のsrfiやrnrsの議論を見てください)、どちらも一長一短があります。
Also note that the current specification is not correct:
Procedure: hash-table-ref/default hash-table key default -> value
Equivalent to (hash-table-ref hash-table key (lambda () default)).
Consider default = ((lambda (x) (x x)) (lambda (x) (x x))). The program (hash-table-ref ht k (lambda () default)) diverges only when the key k is not found. The program (hash-table-ref/default ht k default) always diverges.
; define-dict-interfaceを改造。slotにprotocolを伝播する。 (define-macro (define-dict-interface-propagate class slot . kinds) (define (gen-def kind) (let ([dict (gensym)] [key (gensym)] [start (gensym)] [val (gensym)] [default (gensym)] [proc (gensym)] [seed (gensym)]) (case kind [(:get) `(define-method dict-get ((,dict ,class) ,key . ,default) (if (null? ,default) (dict-get (slot-ref ,dict (quote ,slot)) ,key) (dict-get (slot-ref ,dict (quote ,slot)) ,key (car ,default))))] [(:put!) `(define-method dict-put! ((,dict ,class) ,key ,val) (dict-put! (slot-ref ,dict (quote ,slot)) ,key ,val))] [(:exists?) `(define-method dict-exists? ((,dict ,class) ,key) (dict-exists? (slot-ref ,dict (quote ,slot)) ,key))] [(:delete!) `(define-method dict-delete! ((,dict ,class) ,key) (dict-delete! (slot-ref ,dict (quote ,slot)) ,key))] [(:clear!) `(define-method dict-clear! ((,dict ,class)) (dict-clear! (slot-ref ,dict (quote ,slot))))] [(:fold) `(define-method dict-fold ((,dict ,class) ,proc ,seed) (dict-fold (slot-ref ,dict (quote ,slot)) ,proc ,seed))] [(:fold-right) `(define-method dict-fold-right ((,dict ,class) ,proc ,seed) (dict-fold-right (slot-ref ,dict (quote ,slot)) ,proc ,seed))] [(:map) `(define-method dict-map ((,dict ,class) ,proc) (dict-map (slot-ref ,dict (quote ,slot)) ,proc))] [(:for-each) `(define-method dict-for-each ((,dict ,class) ,proc) (dict-for-each (slot-ref ,dict (quote ,slot)) ,proc))] [(:keys) `(define-method dict-keys ((,dict ,class)) (dict-keys (slot-ref ,dict (quote ,slot))))] [(:values) `(define-method dict-values ((,dict ,class)) (dict-values (slot-ref ,dict (quote ,slot))))] [(:push!) `(define-method dict-push! ((,dict ,class) ,key ,val) (dict-push! (slot-ref ,dict (quote ,slot)) ,key ,val))] [(:pop!) `(define-method dict-pop! ((,dict ,class) ,key . ,default) (apply dict-pop! (slot-ref ,dict (quote ,slot)) ,key ,default))] [(:update!) `(define-method dict-update! ((,dict ,class) ,key . ,default) (apply dict-update! (slot-ref ,dict (quote ,slot)) ,key ,default))] [(:->alist) `(define-method dict->alist ((,dict ,class)) (dict->alist (slot-ref ,dict (quote ,slot))))] ;; [(:call-with-iterator) `(define-method call-with-iterator ((,dict ,class) ,proc :key ,start ) (call-with-iterator (slot-ref ,dict (quote ,slot)) ,proc :key ,start ))] ;; [else (error "invalid kind in define-dict-interface:" kind)]))) `(begin ,@(map gen-def kinds) ) )
(define-class <info-index-node> (<dictionary> <instance-pool-mixin> ) [node index]) ; dictionary protocol (define-dict-interface-propagate <info-index-node> index :get :put! :exists? :delete! :fold :call-with-iterator )
; ref ; ※ 万能アクセサを多用している場合、不愉快な効果が生じる。 ; <dictionary>なオブジェクトのslotをアクセスするのに~をつかっていると ; まずいことになる。 ; http://chaton.practical-scheme.net/gauche/a/2013/04/19#entry-5170d37e-42a42 ; kaki ; <dictionary> には ref がないんですね.でも <ordered-dictionary> は <sequence> を継承していて <sequence> には ref ; があるので…と思ったら referencer メソッドが無いと言われてしまった. ; <dictionary> は ref で dict-get できればいいような気がします.<hash-table> や <tree-map> でも ref 定義してありますし. ; http://chaton.practical-scheme.net/gauche/a/2013/04/19#entry-51710f9f-8df4f ; Shiro ; <dictionary>にrefがまだ無いのは、ordered-dictionaryでsequenceのrefと意味がかぶるからどうしようかなと ; 思って保留にしてた気がします。 (define-method ref ((obj <dictionary>) . arg) ;#?=arg (apply dict-get obj arg) )
- yamasushi(2013/04/20 05:35:16 UTC) 親クラスでrefが定義されていないときに継承していたものがあり、そこで万能アクセサでスロットにアクセスしていたのですが、親にrefを定義した途端にすべてが狂ってしまうという事態に遭遇したので、なんとかならないかなと思い、試行錯誤をしています。
(いまは<dictionary>にrefがないのですが、これに実験的にrefをつけてみて遭遇しました。)- Shiro(2013/04/20 22:07:47 UTC):ああ、<dictionary>にrefつけてないのはこの理由だったかも。
; dict-get/fallback-lazy : use fallback lazy object (define-method dict-get/fallback-lazy ((dict <dictionary>) key (fallback <promise>)) ($ force $ dict-get dict key fallback )) ; dict-get/fallback-thunk : use fallback thunk (define-method dict-get/fallback-thunk ((dict <dictionary>) key fallback-thunk) (dict-get/fallback-lazy dict key (delay (fallback-thunk) ) ) ) ; dict-get/fallback-proc : use fallback proc : dict -> key -> value (define-method dict-get/fallback-proc ((dict <dictionary>) key proc) (dict-get/fallback-thunk dict key (^[] (proc dict key) ) ) )
gosh> (define x (alist->hash-table '((1 . 2) (3 . 4)))) x gosh> ($ (cut dict-get/fallback-proc <> 4 (^(dict key) (dict-put! dict key 1234) ) ) x ) #<undef> gosh> ($ (cut dict-get/fallback-proc <> 4 (^(dict key) (dict-put! dict key 1234) ) ) x ) 1234
; single-memoize (define-method single-memoize ((dict <dictionary>) proc key) (dict-get/fallback-proc dict key (^(dict key) (rlet1 r (proc key) (dict-put! dict key r) ) ) ) ) ; make-single-memoized (define-method make-single-memoized ((dict <dictionary>) proc) (^x (single-memoize dict proc x) ) )
gosh> (define (foo key) (sys-sleep 1) (* key 2)) foo gosh> (define bar (make-single-memoized (make-hash-table) foo)) bar gosh> (foo 123) 246 gosh> (foo 123) 246 gosh> (bar 123) 246 gosh> (bar 123) 246
; dict-ref (define-method dict-ref ((dict <dictionary>) key) (dict-get/fallback-proc dict key dict-missing) ) ; dict-missing (define-method dict-missing ((dict <dictionary>) key) (errorf "~aにkey ~a がない" dict key) )
(define (%no-key obj key) (errorf "~a does not have an entry for a key:~a" obj key)) ; <dictionary>ではないが、dictionaryのようなオブジェクト (define (slot-get obj slot . opt ) (or (and (slot-exists? obj slot) (slot-ref obj slot)) (get-optional opt (%no-key obj slot) ) ) ) (define-dict-interface <top> :get slot-get :put! slot-set! ; :delete! ; :clear! :exists? slot-exists? ; :fold ; :for-each ; :map ; :keys ; :values :pop! slot-pop! :push! slot-push! ; :update! ; :->alist ) (define (dict-update! dict key proc . maybe-default) (let1 r (apply dict-get dict key maybe-default) (dict-put! dict key (proc r))))
(define-method lookup ((x <dictionary>) key) (dict-get x key)) (define-method lookup ((x <my-struct>) key) (my-struct-lookup x key))
; dict->alist (define-method dict->alist ((dict <dictionary>)) (coerce-to <list> dict) ) ; lazy-dict : 遅延辞書生成 (define-method lazy-dict ((init <dictionary>) filler) (let1 ht init (and (applicable? filler <dictionary>) (delay (and (filler ht) ht))))) ; 生成protocol ; alist->dict ; TODO case文の排除 ; TODO <dictionary>のサブクラスで生成可能なものは指定可能にしたい。 ; TODO sparse-table, sparse-vectorの処理 (define-method alist->dict ((class <class>) alist . rest) (case (class-name class) [(<trie> ) (apply trie rest alist) ] [(<tree-map> ) (apply alist->tree-map alist rest)] [(<hash-table>) (apply alist->hash-table alist rest)] ; TODO [(<sparse-table>) (apply alist->sparse-table alist rest)] ;; ; TODO [(<sparse-vector>) (apply alist->sparse-vector alist rest)] ; TODO [(<sparse-vector-base>) (apply alist->sparse-vector alist rest)] ; TODO [(<sparse-s8vector>) (alist->sparse-vector alist 's8 )] ; TODO [(<sparse-u8vector>) (alist->sparse-vector alist 'u8 )] ; TODO [(<sparse-s16vector>) (alist->sparse-vector alist 's16)] ; TODO [(<sparse-u16vector>) (alist->sparse-vector alist 'u16)] ; TODO [(<sparse-s32vector>) (alist->sparse-vector alist 's32)] ; TODO [(<sparse-u32vector>) (alist->sparse-vector alist 'u32)] ; TODO [(<sparse-s64vector>) (alist->sparse-vector alist 's64)] ; TODO [(<sparse-u64vector>) (alist->sparse-vector alist 'u64)] ; TODO [(<sparse-f16vector>) (alist->sparse-vector alist 'f16)] ; TODO [(<sparse-f32vector>) (alist->sparse-vector alist 'f32)] ; TODO [(<sparse-f64vector>) (alist->sparse-vector alist 'f64)] ;; [else (errorf "unknown dictionary ~a" class) ] ) ) ; dict-make ; TODO case文の排除 ; TODO <dictionary>のサブクラスで生成可能なものは指定可能にしたい。 (define-method dict-make ((class <class>) . rest ) (case (class-name class) [(<trie> ) (apply make-trie rest) ] [(<tree-map> ) (apply make-tree-map rest)] [(<hash-table>) (apply make-hash-table rest)] [(<sparse-table>) (apply make-sparse-table rest)] ;; [(<sparse-vector>) (apply make-sparse-vector rest)] [(<sparse-vector-base>) (apply make-sparse-vector rest)] [(<sparse-s8vector>) (make-sparse-vector 's8 )] [(<sparse-u8vector>) (make-sparse-vector 'u8 )] [(<sparse-s16vector>) (make-sparse-vector 's16 )] [(<sparse-u16vector>) (make-sparse-vector 'u16 )] [(<sparse-s32vector>) (make-sparse-vector 's32 )] [(<sparse-u32vector>) (make-sparse-vector 'u32 )] [(<sparse-s64vector>) (make-sparse-vector 's64 )] [(<sparse-u64vector>) (make-sparse-vector 'u64 )] [(<sparse-f16vector>) (make-sparse-vector 'f16 )] [(<sparse-f32vector>) (make-sparse-vector 'f32 )] [(<sparse-f64vector>) (make-sparse-vector 'f64 )] ;; [else (errorf "unknown dictionary ~a" class) ] ) )
generic.sequence generic.collectionはGauche:MOP:GenericCollectionを参照。
; generic dictionary ; Scheme:MOP:パラメタライズドクラス ; http://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3aMOP%3a%E3%83%91%E3%83%A9%E3%83%A1%E3%82%BF%E3%83%A9%E3%82%A4%E3%82%BA%E3%83%89%E3%82%AF%E3%83%A9%E3%82%B9 ;--------------------------------------------------------------- ; orderd-dictionary時のときに、modifier,subseqで入力したときの扱い? (define-module generic.dictionary (extend gauche.dictionary generic.sequence generic.collection ) ;; (use util.match) (use komono-dict :only (define-dict-interface-propagate) ) (export <generic-dictionary-meta> <generic-ordered-dictionary-meta> <generic-dictionary> <generic-ordered-dictionary> ) ) (select-module generic.dictionary) (define-class <generic-dictionary-meta> [<generic-collection-meta>] [ (key-type :init-keyword :key-type :init-value <top>) (value-type :init-keyword :value-type :init-value <top>) ] ) (define-class <generic-ordered-dictionary-meta> [<generic-sequence-meta>] [ (key-type :init-keyword :key-type :init-value <top>) (value-type :init-keyword :value-type :init-value <top>) ] ) (define-class <generic-dictionary> [ <generic-collection> <dictionary> ] [] :metaclass <generic-dictionary-meta>) (define-class <generic-ordered-dictionary> [ <generic-sequence> <ordered-dictionary> ] [] :metaclass <generic-ordered-dictionary-meta>) (define-method write-object ((self <generic-dictionary-meta>) port) (format port "<generic-dictionary-meta type:~a opts:~a key-type:~a value-type:~a >" (slot-ref self'collection-type ) (slot-ref self'collection-opts ) (slot-ref self'key-type ) (slot-ref self'value-type) ) ) (define-method write-object ((self <generic-ordered-dictionary>) port) (format port "<generic-ordered-dictionary type:~a opts:~a key-type:~a value-type:~a >" (slot-ref self'collection-type ) (slot-ref self'collection-opts ) (slot-ref self'key-type ) (slot-ref self'value-type) ) ) (define-method write-object ((self <generic-dictionary>) port) (format port "<generic-dictionary elems:~a >" (slot-ref self'elements) ) ) (define-method write-object ((self <generic-ordered-dictionary>) port) (format port "<generic-ordered-dictionary elems:~a >" (slot-ref self'elements) ) ) (define-dict-interface-propagate <generic-dictionary> elements :get :exists? :delete! :clear! :fold :map :for-each :keys :values :pop! :->alist :call-with-iterator) (define-dict-interface-propagate <generic-ordered-dictionary> elements :get :exists? :delete! :clear! :fold :fold-right :map :for-each :keys :values :pop! :->alist :call-with-iterator) (define (%dict-put! self key val) (and-let* [ [dict (slot-ref self'elements) ] [class (class-of self) ] [key-type (slot-ref class'key-type) ] [value-type (slot-ref class'value-type) ] ] (unless (is-a? key key-type ) (errorf "type error@dict-put! key:~s" key) ) (unless (is-a? val value-type ) (errorf "type error@dict-put! val:~s" val) ) (dict-put! dict key val) ) ) (define (%dict-push! self key val) (and-let* [ [dict (slot-ref self'elements) ] [class (class-of self) ] [key-type (slot-ref class'key-type) ] [value-type (slot-ref class'value-type) ] ] (unless (is-a? key key-type ) (errorf "type error@dict-push! key:~s" key) ) (unless (is-a? val value-type ) (errorf "type error@dict-push! val:~s" val) ) (dict-push! dict key val) ) ) ; TODO fallbackを型チェックすべきか? (define (%dict-update! self key proc :optional fallback) (and-let* [ [dict (slot-ref self'elements) ] [class (class-of self) ] [key-type (slot-ref class'key-type) ] [value-type (slot-ref class'value-type) ] ] (unless (is-a? key key-type ) (errorf "type error@dict-update! key:~s" key) ) (dict-update! dict key (^x (rlet1 v (proc x) (unless (is-a? v value-type) (errorf "type error@dict-update! value:~s" v) ) ) ) fallback) ) ) (define (%call-with-builder class proc . more-opts) (and-let* [ [%type (slot-ref class'collection-type) ] [%opts (slot-ref class'collection-opts) ] [%key-type (slot-ref class'key-type) ] [%value-type (slot-ref class'value-type) ] ] (let [[ %make (slot-ref class'collection-make) ] [ %put! (slot-ref class'collection-put!) ] ] (if (and %make %put!) (let1 obj (apply %make (append %opts more-opts) ) (proc (^x (match x [((? (cut is-a? <> %key-type ) _ ) . (? (cut is-a? <> %value-type ) _ ) ) (%put! obj x) ] [ _ (errorf "type error@call-with-builder x:~a" x) ] ) ) (^[] (make class :elements obj ) ) ) ) (apply call-with-builder %type (^[add! get] (proc (^x (match x [((? (cut is-a? <> %key-type ) _ ) . (? (cut is-a? <> %value-type ) _ ) ) (add! x) ] [ _ (errorf "type error@call-with-builder x:~a" x) ] ) ) (^[] (make class :elements (get) ) ) ) ) (append %opts more-opts) ) ) ) ) ) ; generic-dictionary (define-method dict-put! ( (self <generic-dictionary> ) key val) (%dict-put! self key val) ) (define-method dict-push! ( (self <generic-dictionary>) key val) (%dict-push! self key val) ) (define-method dict-update! ((self <generic-dictionary>) key proc :optional fallback) (%dict-update! self key proc fallback)) (define-method call-with-builder ((class <generic-dictionary-meta> ) proc . more-opts) (apply %call-with-builder class proc more-opts) ) ; generic-ordered-dictionary (define-method dict-put! ( (self <generic-ordered-dictionary> ) key val) (%dict-put! self key val) ) (define-method dict-push! ( (self <generic-ordered-dictionary>) key val) (%dict-push! self key val) ) (define-method dict-update! ((self <generic-ordered-dictionary>) key proc :optional fallback) (%dict-update! self key proc fallback)) (define-method call-with-builder ((class <generic-ordered-dictionary-meta> ) proc . more-opts) (apply %call-with-builder class proc more-opts) )
(use generic.dictionary) (use util.sparse) (debug-print-width #f) ;--------------------------------------------------------------- (define-class <eq-hash-table> [<generic-dictionary>][] :metaclass <generic-dictionary-meta> :collection-type <hash-table> :collection-opts '(:type eq?) ) #?=<eq-hash-table> (define-class <eqv-hash-table> [<generic-dictionary>][] :metaclass <generic-dictionary-meta> :collection-type <hash-table> :collection-opts '(:type eqv?) ) #?=<eqv-hash-table> (define-class <equal-hash-table> [<generic-dictionary>][] :metaclass <generic-dictionary-meta> :collection-type <hash-table> :collection-opts '(:type equal?) ) #?=<equal-hash-table> (define-class <string-hash-table> [<generic-dictionary>][] :metaclass <generic-dictionary-meta> :collection-type <hash-table> :collection-opts '(:type string=?) :key-type <string> :value-type <number> ) #?=<string-hash-table> (define-class <number-tree-map> [<generic-ordered-dictionary>][] :metaclass <generic-ordered-dictionary-meta> :collection-type <tree-map> :collection-opts (list :key=? = :key<? < ) :key-type <number> :value-type <number> ) #?=<number-tree-map> (define-class <string-tree-map> [<generic-ordered-dictionary>][] :metaclass <generic-ordered-dictionary-meta> :collection-type <tree-map> :collection-opts (list :key=? string=? :key<? string<? ) :key-type <string> :value-type <number> ) #?=<string-tree-map> (define-class <generic-sparse-u8vector> [<generic-dictionary>][] :metaclass <generic-dictionary-meta> :collection-type <sparse-u8vector> :collection-opts '(u8) :collection-make (^[type . rest] (make-sparse-vector type) ) :collection-put! (^[o kv] (sparse-vector-set! o (car kv) (cdr kv) ) ) ) #?=<generic-sparse-u8vector> (define-class <generic-sparse-u32vector> [<generic-dictionary>][] :metaclass <generic-dictionary-meta> :collection-type <sparse-u32vector> :collection-opts '(u32) :collection-make (^[type . rest] (make-sparse-vector type) ) :collection-put! (^[o kv] (sparse-vector-set! o (car kv) (cdr kv) ) ) ) #?=<generic-sparse-u32vector> (define-class <eq-sparse-table> [<generic-dictionary>][] :metaclass <generic-dictionary-meta> :collection-type <sparse-table> :collection-opts '(eq?) :collection-make (^[type . rest] (make-sparse-table type) ) :collection-put! (^[o kv] (sparse-table-set! o (car kv) (cdr kv) ) ) ) (define-class <eqv-sparse-table> [<generic-dictionary>][] :metaclass <generic-dictionary-meta> :collection-type <sparse-table> :collection-opts '(eqv?) :collection-make (^[type . rest] (make-sparse-table type) ) :collection-put! (^[o kv] (sparse-table-set! o (car kv) (cdr kv) ) ) ) (define-class <equal-sparse-table> [<generic-dictionary>][] :metaclass <generic-dictionary-meta> :collection-type <sparse-table> :collection-opts '(equal?) :collection-make (^[type . rest] (make-sparse-table type) ) :collection-put! (^[o kv] (sparse-table-set! o (car kv) (cdr kv) ) ) ) (define-class <string-sparse-table> [<generic-dictionary>][] :metaclass <generic-dictionary-meta> :collection-type <sparse-table> :collection-opts '(string=?) :collection-make (^[type . rest] (make-sparse-table type) ) :collection-put! (^[o kv] (sparse-table-set! o (car kv) (cdr kv) ) ) ) ;(exit) (define x (make <string-sparse-table>)) (set! (dict-get x "a") 12) (set! (dict-get x "A") 12) (set! (dict-get x "B") 2) (set! (dict-get x "C") 3) #?=(coerce-to <list> x) ;(exit) (dict-put! x "K" 12 ) (dict-push! x "AA" 666 ) (dict-put! x "C" 123 ) #?=(dict-get x "A") (dict-update! x "A" (^x (+ x 11000000) )) #?=(coerce-to <list> x) ;(exit) (define y (with-builder (<string-hash-table> add! get) (add! '("a" . 1111) ) (add! '("a" . 12.34) ) (add! '("b" . 2222) ) (add! '("c" . 3333) ) (add! '("d" . 4444) ) (get) ) ) #?=(coerce-to <list> y) (define z (coerce-to <eq-sparse-table> '( (a . 1) (a . 'a11) (b . 2) (c . 3)) )) #?=(class-of z) #?=(coerce-to <list> z) #?=(dict-get z 'a) (exit) (define x (make <string-tree-map>)) (set! (dict-get x "A") 1) (set! (dict-get x "A") 111) (set! (dict-get x "B") 2) (set! (dict-get x "C") 3) #?=(coerce-to <list> x) (define y (with-builder (<string-tree-map> add! get) (add! '("a" . 1111) ) (add! '("a" . 1234) ) (add! '("b" . 2222) ) (add! '("c" . 3333) ) (add! '("d" . 4444) ) (get) ) ) #?=(coerce-to <list> y) (define z (coerce-to <string-tree-map> '( ("a" . 1) ("a" . 11) ("b" . 2) ("c" . 3)) )) #?=(dict-get z "a") #?=(coerce-to <list> z) (define nx (make <number-tree-map>)) (set! (dict-get nx 1) 1) (set! (dict-get nx 1) 111) (set! (dict-get nx 2.5) 2) (set! (dict-get nx 3) 3) #?=(dict-fold nx cons* '() ) #?=(dict-fold-right nx cons* '() ) #?=(coerce-to <list> nx) (newline) (for-each-with-index (pa$ format #t "[~a] ~s~%") nx) (define ny (with-builder (<number-tree-map> add! get) (add! '(1 . 1111) ) (add! '(1 . 111 ) ) (add! '(1.0 . 1234) ) (add! '(2 . 2222) ) (add! '(3 . 3333) ) (add! '(4 . 4444) ) (get) ) ) #?=(dict-fold ny cons* '() ) #?=(dict-fold-right ny cons* '() ) #?=(coerce-to <list> ny) (newline) (for-each-with-index (pa$ format #t "[~a] ~s~%") ny) (define nz (coerce-to <number-tree-map> '( (1 . 1) (1 . 11) (2 . 2) (3 . 3) (4 . 4) ) )) #?=(dict-fold nz cons* '() ) #?=(dict-fold-right nz cons* '() ) #?=(dict-get nz 1) #?=(coerce-to <list> nz) (newline) (for-each-with-index (pa$ format #t "[~a] ~s~%") nz) ;(set! (ref (~ nz'elements ) 2.5) 12) ;(set! (ref nz 2.5) 12 ) (newline) (print "------") (for-each-with-index (pa$ format #t "[~a] ~s~%") (subseq nz 1 2)) (define s1 (coerce-to <generic-sparse-u8vector> '( (1 . 9) (1 . 8) (2 . 7) (3 . 6)) )) #?=(slot-ref s1'elements) #?=(coerce-to <list> s1)
Tag: gauche.dictionary