Kimura Fuyuki
fuyuk****@hadal*****
2003年 1月 23日 (木) 15:44:30 JST
自分の理解をたしかめるために、hash-table のための call-with-iterator
を書いてみました。これ自体はもちろん二度手間もいいところなので、あくま
でイメージをはっきりさせるための実装です。
で、気づいたことをいくつか。
1. call-with-iterator に与えられた keys から重複を取り除くのはけっこう
めんどう or 重たい処理かもしれない。
2. 空のディクショナリに insert! する素直な手段がないような。
3. case によるディスパッチはやっぱり格好悪い。
4. SRFIとの名前の衝突はどうしたものか(remove!とかmap!とか)。
5. 「現在の要素は削除されているか」みたいな状態を押さえておくのが面倒。
6. remove! の pred などにはどんな引数を渡すべきか。
1については、keys を delete-duplicates にかけてしまうのが(それで済むの
なら)一番単純なやり方になると思います。検索しながら重複を排除するよう
なうまいやり方があればいいのですが。
3はかなり一般的な問題だと思うので(gettext.scmでもやっている)、何か適当
なユーティリティを提供したほうがいいのかもしれません。
4は前から気になっていたのですが、無視していました(いい解決を思いつかな
いから)。コレクションの fold みたいに再定義する手もありますが、ディク
ショナリの場合は関数の意味が違っているのであまりやりたくありません
(SRFIは結果を返すが、こっちのは副作用がすべて)。
6は、a) (key . val) を渡すか、b) key val という二つの値を渡すかの選択
です(コレクションとの連続性を気にするならa、そうでなければbか)。
*
実は自分の理解にも実装にもあまり自信がありません。変なことをやっていた
ら教えてください。
なお、demos のメソッドで (self <hash-table>) になっているところは、実
際にはもちろん (self <dictionary>) になります。
(define-method call-with-iterator ((self <hash-table>) iteratee seed . keys)
(let* ((inserted '())
(r (let loop ((keys (if (null? keys)
(hash-table-keys self)
keys)) ;XXX dups?
(seed seed))
(if (null? keys)
seed
(let1 key (car keys)
(if (hash-table-exists? self key)
(let1 deleted? #f
(define (cursor method . args)
(define (get)
(when deleted? (error "i don't exist"))
(values key (hash-table-get self key)))
(define (next seed)
(loop (cdr keys) seed))
(define (update! val)
(when deleted? (error "i don't exist"))
(hash-table-put! self key val))
(define (delete!)
(when deleted? (error "i don't exist"))
(hash-table-delete! self key)
(set! deleted? #t))
(define (insert! key val)
(push! inserted (cons key val)))
(apply (case method
((get) get)
((next) next)
((update!) update!)
((delete!) delete!)
((insert!) insert!)
(else (error "speak english")))
args))
(iteratee cursor seed))
(loop (cdr keys) seed)))))))
(dolist (kv inserted)
(hash-table-put! self (car kv) (cdr kv)))
r))
;; demos
(define h (make-hash-table))
(hash-table-put! h 'a 1)
(hash-table-put! h 'b 2)
(hash-table-put! h 'c 3)
(hash-table-put! h 'd 4)
(define-method length ((self <hash-table>))
(define (iteratee cursor seed)
(cursor 'next (+ seed 1)))
(call-with-iterator self iteratee 0))
(define-method write-object ((self <hash-table>) port)
(define (iteratee cursor seed)
(receive (key val) (cursor 'get)
(format port "~a => ~a\n" key val))
(cursor 'next seed))
(call-with-iterator self iteratee 0)
(print (length self) " items"))
(write-object h (current-output-port))
(define-method remove! ((self <hash-table>) pred)
(define (iteratee cursor seed)
(receive (key val) (cursor 'get)
(when (pred key val) (cursor 'delete!)))
(cursor 'next seed))
(call-with-iterator self iteratee 0))
(remove! h (lambda (key val) (odd? val)))
(print "remove!")
(write-object h (current-output-port))
(define-method map! ((self <hash-table>) proc)
(define (iteratee cursor seed)
(receive (key val) (cursor 'get)
(cursor 'update! (proc key val)))
(cursor 'next seed))
(call-with-iterator self iteratee 0))
(map! h (lambda (key val) (* val 2)))
(print "map!")
(write-object h (current-output-port))
(define-method dup! ((self <hash-table>))
(define (iteratee cursor seed)
(receive (key val) (cursor 'get)
(cursor 'insert!
(string-append (x->string key) (x->string key))
(string-append (x->string val) (x->string val))))
(cursor 'next seed))
(call-with-iterator self iteratee 0))
(dup! h)
(print "dup!")
(write-object h (current-output-port))
(define-method object-apply ((self <hash-table>) key)
(call/cc
(lambda (abort)
(define (iteratee cursor seed)
(receive (key val) (cursor 'get) (abort val)))
(call-with-iterator self iteratee 0 key)
(error "dictionary doesn't have an entry for key" key))))
(define-method object-apply ((self <hash-table>) key default)
(define (iteratee cursor seed)
(receive (key val) (cursor 'get) (cursor 'next val)))
(call-with-iterator self iteratee default key))
(print (h 'a #f))
(print (h 'b))
--
木村 冬樹