Gauche:streamをsequenceのサブクラスにする

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


Last modified : 2013/05/06 09:58:02 UTC