Gauche:共通の「命令」をつかう処理を記述する

Gauche:共通の「命令」をつかう処理を記述する

yamasushi(2013/03/30 04:34:39 UTC)リスト処理のなかには、共通の「命令セット」のようなものがあり、それだけを使ったコードなら、別のデータにも使えるというケースがあると思いました。
yamasushi(2013/03/30 21:51:29 UTC)listなど基本的な列データならコレクションを使えばよいのですが、無限列を考えると、統一したインターフェースがないように思いました。それで、以下のような試みをしてみました。
yamasushi(2013/04/13 11:26:28 UTC)無限列のほかにもdictionaryも同じような「命令セット」をつくれそうな気がしています。

; 命令セット
(use gauche.generator)
(use gauche.lazy)
(use util.stream)
(use srfi-13)


(define-macro (inst-generator sym)
  (case sym
    ((append      ) gappend)
    ((car         ) #f)
    ((cdr         ) #f)
    ((concatenate ) gconcatenate)
    ((cons        ) gcons*)
    ((cons*       ) gcons*)
    ((drop        ) gdrop )
    ((drop-while  ) gdrop-while)
    ((filter      ) gfilter    )
    ((filter-map  ) gfilter-map)
    ((fold        ) generator-fold)
    ((fold-right  ) generator-fold-right)
    ((for-each    ) generator-for-each)
    ((iota        ) giota)
    ((map         ) gmap )
    ((map-accum   ) gmap-accum)
    ((merge       ) gmerge)
    ((null        ) null-generator)
    ((range       ) grange)
    ((rxmatch     ) grxmatch)
    ((slices      ) gslices)
    ((state-filter) gstate-filter)
    ((take        ) gtake)
    ((take-while  ) gtake-while)
    ((unfold      ) gunfold)
    ((*->generator ) identity)
    ((*->list      ) generator->list)
    ((*->lseq      ) generator->lseq)
    ((*->stream    ) #f )
    ((*->string    ) #f )
    ((list->*      )     list->generator)
    ((port->byte-* )     port->byte-generator)
    ((port->char-* )     port->char-generator)
    ((port->line-* )     port->line-generator)
    ((port->sexp-* )     port->sexp-generator)
    ((reverse-bits->*  ) reverse-bits->generator)
    ((reverse-vector->*) reverse-vector->generator)
    ((string->*        ) string->generator)
    ((vector->*        ) vector->generator)
    ((x->*             ) x->generator)
    (else #f)
))

(define-macro (inst-lseq sym)
  (case sym
    ((append      ) lappend)
    ((car         ) car)
    ((cdr         ) cdr)
    ((concatenate ) lconcatenate)
    ((cons        ) lcons )
    ((cons*       ) lcons*)
    ((drop        ) drop*)
    ((drop-while  ) drop-while)
    ((filter      ) lfilter)
    ((filter-map  ) lfilter-map)
    ((fold        ) fold)
    ((fold-right  ) fold-right)
    ((for-each    ) for-each)
    ((iota        ) liota)
    ((map         ) lmap)
    ((map-accum   ) lmap-accum)
    ((merge       ) #f)
    ((null        ) '())
    ((range       ) lrange)
    ((rxmatch     ) lrxmatch)
    ((slices      ) #f )
    ((state-filter) lstate-filter)
    ((take        ) ltake)
    ((take-while  ) ltake-while)
    ((unfold      ) lunfold)
    ((*->generator) list->generator ) ; ?
    ((*->list     )  identity)
    ((*->lseq     )  identity)
    ((*->stream   )  #f )
    ((*->string   )  list->string )
    ((list->*     )  x->lseq )
    ((port->byte-*     ) ($ generator->lseq $ port->byte-generator $) )
    ((port->char-*     ) ($ generator->lseq $ port->char-generator $) )
    ((port->line-*     ) ($ generator->lseq $ port->line-generator $) )
    ((port->sexp-*     ) ($ generator->lseq $ port->sexp-generator $) )
    ((reverse-bits->*  ) ($ generator->lseq $ reverse-bits->generator $) )
    ((reverse-vector->*) ($ generator->lseq $ reverse-vector->generator $) )
    ((string->*        ) ($ generator->lseq $ string->generator $) )
    ((vector->*        ) ($ generator->lseq $ vector->generator $) )
    ((x->*             ) x->lseq )
    (else #f)
))

(define-macro (inst-stream sym)
  (case sym
    ((append      ) stream-append)
    ((car         ) stream-car)
    ((cdr         ) stream-cdr)
    ((concatenate ) stream-concatenate)
    ((cons        ) stream-cons)
    ((cons*       ) stream-cons*)
    ((drop        ) stream-drop)
    ((drop-while  ) stream-drop-while)
    ((filter      ) stream-filter)
    ((filter-map  ) #f )
    ((fold        ) #f )
    ((fold-right  ) #f )
    ((for-each    ) stream-for-each)
    ((iota        ) #f ) ; stream-iotaは仕様が違う
    ((map         ) stream-map)
    ((map-accum   ) #f )
    ((merge       ) #f )
    ((null        ) stream-null)
    ((range       ) #f )
    ((rxmatch     ) #f )
    ((slices      ) #f )
    ((state-filter) #f )
    ((take        ) stream-take)
    ((take-while  ) stream-take-while)
    ((unfold      )  #f )
    ((*->generator )     #f )
    ((*->list      )     stream->list)
    ((*->lseq      )     #f )
    ((*->stream    )     identity)
    ((*->string    )     stream->string)
    ((list->*      )     list->stream)
    ((port->byte-* )     #f)
    ((port->char-* )     #f)
    ((port->line-* )     #f)
    ((port->sexp-* )     #f)
    ((reverse-bits->* )  #f)
    ((reverse-vector->*) #f)
    ((string->*)         string->stream)
    ((vector->*)         #f)
    ((x->*     )         #f)
    (else #f)
))

(define-macro (inst-string sym) ; 文字列についても試してみます。
  (case sym
    ((append      ) string-append)
    ((car         ) #f)
    ((cdr         ) #f)
    ((concatenate ) string-concatenate)
    ((cons        ) #f)
    ((cons*       ) #f)
    ((drop        ) string-drop )
    ((drop-while  ) #f)
    ((filter      ) string-filter )
    ((filter-map  ) #f)
    ((fold        ) string-fold)
    ((fold-right  ) string-fold-right)
    ((for-each    ) string-for-each)
    ((iota        ) #f)
    ((map         ) string-map )
    ((map-accum   ) #f)
    ((merge       ) #f)
    ((null        ) "")
    ((range       ) #f)
    ((rxmatch     ) #f) ; ! stringのrxmatchと列のrxmatchのあつかいの違い
    ((slices      ) #f)
    ((state-filter) #f)
    ((take        ) string-take)
    ((take-while  ) #f)
    ((unfold      )  string-unfold)
    ((*->generator)  string->generator )
    ((*->list     )  string->list)
    ((*->lseq     )  ($ x->lseq $ string->list $) )
    ((*->stream   )  string->stream )
    ((*->string   )  string->list )
    ((list->*     )  list->string )
    ((port->byte-*     ) #f)
    ((port->char-*     ) #f)
    ((port->line-*     ) #f)
    ((port->sexp-*     ) #f)
    ((reverse-bits->*  ) #f)
    ((reverse-vector->*) #f)
    ((string->*        ) identity)
    ((vector->*        ) ($ list->string $ vector->list $) )
    ((x->*             ) x->string) ; ! これはまずい
    (else #f)
  ))
(define-macro (define-with-inst-set name inst-set proc . param)
  (let [[arg  (gensym)]
        [code (map (^s (macroexpand `(,inst-set ,s)) ) param)]
        ]
    ;(print code)
    (if (every identity code )
      (begin
        ;(print code)
        `(define (,name . ,arg)
           (apply ,proc ,@code ,arg) ) )
      (error (format #f "未対応のコードがあります ~a --> ~a " param code) )
    ) ) )

(define (hoge appendfn foreachfn x->*fn x y)
  ($ foreachfn print $ appendfn (x->*fn x) (x->*fn y) ) )

(define-with-inst-set hoge-generator inst-generator hoge append for-each x->* )
(define-with-inst-set hoge-lseq      inst-lseq      hoge append for-each x->* )
(define-with-inst-set hoge-stream    inst-stream    hoge append for-each x->* )
(define-with-inst-set hoge-string    inst-string hoge append for-each x->* )

(hoge-lseq "123" "456")
(hoge-lseq '(a b c) '(d e f))

(hoge-generator "123" "456")
(hoge-generator '(a b c) '(d e f))

(hoge-string "123" "456")
(hoge-string '(a b c) '(d e f)) ; !うまくいかない
More ...