Gauche:streamをsequenceのサブクラスにする
<stream> クラスにプロミスを持たせる方法
horii(2005/12/30 03:20:05 PST): util.stream のストリームをコンストラクタとセレクタを変更することで、シーケンスとして使えるようにしてみました。 <stream> というクラスにプロミスを持たせるという単純な実装。
util.stream の変更点。
追加するのは、<stream-meta>, <stream>, %stream-force の3つ。 変更するのは、stream?, %make-stream, stream-null?, stream-pair?, stream-car, stream-cdr の6つ。
(define-class <stream-meta> (<class>)
())
(define-class <stream> (<sequence>)
((stream :init-keyword :stream))
:metaclass <stream-meta>)
(define (%stream-force strm)
(slot-set! strm 'stream
(let loop ((strm strm))
(let ((forced (force (slot-ref strm 'stream))))
(if (stream? forced)
(loop forced)
forced))))
(slot-ref strm 'stream))
(define (stream? obj)
(is-a? obj <stream>))
(define (%make-stream promise)
(set! (promise-kind promise) 'stream)
(make <stream> :stream promise))
(define (stream-null? obj)
(and (stream? obj)
(null? (%stream-force obj))))
(define (stream-pair? obj)
(and (stream? obj)
(not (null? (%stream-force obj)))))
(define (stream-car strm)
(car (%stream-force strm)))
(define (stream-cdr strm)
(cdr (%stream-force strm)))
シーケンスフレームワーク用のメソッド
partition-to, subseq はデフォルトのだと動かないので実装してあります。 subseq のセッターは未実装。
(define-method object-equal? ((strm1 <stream>) (strm2 <stream>))
(stream= equal? strm1 strm2))
(define-method call-with-iterator ((strm <stream>) proc . opts)
(let* ((start (get-keyword :start opts 0))
(strm (stream-drop strm start)))
(proc (lambda ()
(stream-null? strm))
(lambda ()
(begin0 (stream-car strm)
(set! strm (stream-cdr strm)))))))
(define-method call-with-builder ((class <stream-meta>) proc . opts)
(iterator->stream proc))
(define-method partition-to ((class <stream-meta>) pred? (coll <collection>))
(values (filter-to <stream> pred? coll)
(remove-to <stream> pred? coll)))
(define-method referencer ((strm <stream>)) stream-ref)
(define-method modifier ((s <stream>))
(lambda (strm idx obj)
(set-car! (%stream-force (stream-drop strm idx)) obj)))
(define (stream-copy strm)
(stream-map identity strm))
(define-method subseq ((strm <stream>))
(stream-copy strm))
(define-method subseq ((strm <stream>) start)
(stream-copy (stream-drop strm start)))
(define-method subseq ((strm <stream>) start end)
(if (>= end 0)
(stream-copy (stream-take (stream-drop strm start)
(- end start)))
(let loop ((strm (stream-drop strm start))
(droped (stream-drop strm (+ start (- end)))))
(stream-delay
(if (stream-null? droped)
stream-null
(stream-cons (stream-car strm)
(loop (stream-cdr strm)
(stream-cdr droped))))))))
例
gosh> (map + (stream 1 2 3) '(4 5 6)) (5 7 9) gosh> (map list (stream-iota #f) '(1 2 3) #(4 5 6)) ((0 1 4) (1 2 5) (2 3 6)) gosh> (define s (map-to <stream> (lambda (x) (print #`"[,|x|]") x) '(1 2 3))) s gosh> (stream-car s) [1] 1 gosh> (ref s 2) [2] [3] 3 gosh> (coerce-to <vector> s) #(1 2 3)
問題点
一応動くのですが、元の util.stream に比べてかなり遅くなります。 もっと効率のよい実装方法がある方はコメント頂けると幸いです。
プロミスの kind に <stream> クラスを持たせる方法
horii (2006/01/03 20:57:06 PST): 別の実装方法を思いついたので書いておこうと思います。
元の util.stream では、プロミスの kind に 'stream というシンボルを持たせていますが、シンボルの代わりにクラスを持たせます。 そして、プロミスのクラスを kind に保持しているクラスであると見なすようにします。 具体的には、class.c の Scm_ClassOf を以下のように変更します。
--- class.c.orig 2006-01-04 13:16:12.774041884 +0900
+++ class.c 2006-01-04 13:17:19.000000000 +0900
@@ -454,6 +454,8 @@
else return SCM_CLASS_UNKNOWN;
} else if (SCM_PAIRP(obj)) {
return SCM_CLASS_PAIR;
+ } else if (SCM_PROMISEP(obj) && SCM_CLASSP(SCM_PROMISE(obj)->kind)) {
+ return SCM_CLASS(SCM_PROMISE(obj)->kind);
} else {
return SCM_CLASS_OF(obj);
}
これで、kind に <foo> クラスを持っていた場合、 プロミスのクラスを <foo> であると見なせます。
gosh> (define-class <foo> () ())
<foo>
gosh> (define p (delay 1))
p
gosh> p
#<promise 0x82de9a0>
gosh> (set! (promise-kind p) <foo>)
#<undef>
gosh> p
#<<foo> 0x82de9a0>
gosh> (define-method foo ((obj <foo>))
(force obj))
#<generic foo (1)>
gosh> (foo p)
1
util.stream の変更点。
以下のように、<stream-meta>, <stream> を追加し、stream?, %make-stream を変更します。
(define-class <stream-meta> (<class>) ()) (define-class <stream> (<sequence>) () :metaclass <stream-meta>) (define (stream? obj) (is-a? obj <stream>)) (define (%make-stream promise) (set! (promise-kind promise) <stream>) promise)
シーケンスフレームワーク用のメソッドは上に書いたものと同じです。
問題点
速度的には、もとの util.stream とほとんど変わらないと思います。 Gauche のオブジェクトシステムを完全に理解していないので、 上の実装では、問題点や、他への悪影響等あるかもしれません。 一応、make check はすべてパスします。 また、ライブラリのために、Scm_ClassOf を書き換えるのは美しくないような気もします。
議論、コメント
Shiro(2006/01/04 02:10:43 PST): horiiさんのはアクロバティックですね。 ただ、オブジェクトシステムの根幹のところをいじってるので、色々 動かなくなると思います。特にCで定義されたクラスオブジェクトは そのインスタンスのメモリ上でのレイアウトを仮定しているので、 たぶんこういういじりかたをするとクラッシュするでしょう。
速度に関しては、ラッパークラスを別につくって利便性と速度の トレードオフを利用者に選ばせる、というのが現実的な選択のような 気もします。streamはジェネリックでない故にまだ最適化の余地が あるので。
Tag: util.stream