horii(2005/12/30 03:20:05 PST): util.stream のストリームをコンストラクタとセレクタを変更することで、シーケンスとして使えるようにしてみました。 <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 に比べてかなり遅くなります。 もっと効率のよい実装方法がある方はコメント頂けると幸いです。
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
以下のように、<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