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)) ; !うまくいかない
(define-class <generator-dispatcher> () :metaclass <singleton-meta>) (define generator-dispatcher (instance-of <generator-dispatcher>)) (define-method generic-append ((dispatcher <generator-dispatcher>) . args) (apply gappend args)) (define-method generic-map ((dispatcher <generator-dispatcher>) proc . args) (apply gmap proc args))そんで、
(define (compose-with-dispatcher dispatcher . procs) (if (null? procs) identity (lambda (var) ((car procs) dispatcher ((apply compose-with-dispatcher dispatcher (cdr procs)) var)))))みたいにdispatcherを第一引数に渡してゆくようなcomposeと組み合わせるとか。(つまり、引数そのものによってディスパッチするのではなく、ディスパッチ用の情報を別に流し込んでやるということです。Scheme:ExplicitMonadと似た発想。)
(define instsym-seq '(append car cdr concatenate cons cons* drop drop-while filter filter-map fold fold-right for-each iota map map-accum merge null range rxmatch slices state-filter take take-while unfold *->generator *->list *->lseq *->stream *->string list->* port->byte-* port->char-* port->line-* port->sexp-* reverse-bits->* reverse-vector->* string->* vector->* x->*)) ; このリストと「命令セット」からdispacherを生成する。どうも、マクロのことがよくわかっていないので、うまくできないのですが・・・(汗
; instsym ... 命令シンボル ; instset ... 命令セット (define-macro (define-dispatcher prefix instsym instset) (let* [[arg (gensym)] [str #`",(symbol->string prefix)-dispatcher"] [cls (string->symbol (string-append "<" str ">" ))] [obj (string->symbol str)]] `(begin (use gauche.mop.singleton) (define-class ,cls () () :metaclass <singleton-meta>) (define ,obj (instance-of ,cls)) ; (methodを生成する) ) ) )ここまで書いたのはいいのですが、肝心のmethod生成で詰まってます。
(define (lambda-with-inst-set proc inst-set . param) (let1 code (map inst-set param) (if (every identity code ) (^ arg (apply proc (append code arg) ) ) (error (format #f "未対応のコードがあります ~a --> ~a " param code) ) ) ) ) (define-macro (define-with-inst-set name inst-set proc . param) `(define ,name (lambda-with-inst-set ,proc ,inst-set ,@(map (^c `(quote ,c)) param) ) ) )