tupple.scm

; tupleのコレクション、つまり、コレクションのコレクションとはなにか？
; multi.multi-collectionはhttps://gist.github.com/yamasushi/5563229
; 
(define-module multi.tuple-collection (extend gauche.collection multi.multi-collection)
  (export
    <tuple-collection-meta>
    <tuple-collection>
  ) )
(select-module multi.tuple-collection)

(define-class <tuple-collection-meta> [<class>]
  [ (type       :init-keyword :type       :init-value <list>)
    (tuple-type :init-keyword :tuple-type :init-value <list>)
    ] )
(define-method write-object ((self <tuple-collection-meta>) port)
  (format port "<tuple-collection-meta type:~a tuple-type:~a >" (slot-ref self'type) (slot-ref self'tuple-type) ) )

(define-class <tuple-collection> [<collection> <multi-collection>]
  [(coll :init-keyword :coll :init-value '()) ]
  :metaclass <tuple-collection-meta> )

(define-method call-with-iterator ((self <tuple-collection>) proc :key start)
  (and-let* [[coll (slot-ref self'coll) ]]
    (call-with-iterator coll proc :start start)
    ) )

(define-method call-with-multi-iterator ((self <tuple-collection>) proc :key start)
  (and-let* [[coll (slot-ref self'coll) ]]
    (with-iterator (coll end? next :start start)
      (proc
        ;end?
        (^[] (end?))
        ;next
        (^[] ($ values $* coerce-to <list> (next) ) )
    ) ) ) )

(define-method call-with-multi-builder ((class <tuple-collection-meta>) proc :key size)
  (and-let* [ [type        (slot-ref class'type)]
              [tupple-type (slot-ref class'tupple-type)] ]
    (with-builder (type add! get)
      (proc
        ;add!
        (^ arg
          (with-builder (tuple-type tuple-add! tuple-get)
            (for-each tupple-add! args)
            ($ add! $ tuple-get) ) )
        ;get
        (^[] (get)) ) ) ) )