Gauche:Clojure:->,->>
yamasushi(2013/04/28 06:12:43 UTC)clojureにあるわりと便利なマクロ。
-> , ->> とは?
(source code : ClojureSource:src/clj/clojure/core.clj )
- ClojureRef:clojure.core/->
Usage: (-> x) (-> x form) (-> x form & more) Threads the expr through the forms. Inserts x as the second item in the first form, making a list of it if it is not a list already. If there are more forms, inserts the first form as the second item in second form, etc.
- ClojureRef:clojure.core/->>
Usage: (->> x form) (->> x form & more) Threads the expr through the forms. Inserts x as the last item in the first form, making a list of it if it is not a list already. If there are more forms, inserts the first form as the last item in second form, etc.
define-macro版
(define-macro (-> x form . more)
(if (pair? more)
`(-> (-> ,x ,form) ,@more )
(if (pair? form)
`(,(car form) ,x ,@(cdr form))
`(,form ,x))))
(define-macro (->> x form . more)
(if (pair? more)
`(->> (->> ,x ,form) ,@more )
(if (pair? form)
`(,(car form) ,@(cdr form) ,x)
`(,form ,x))))
define-syntax版
(define-syntax ->
(syntax-rules ()
[(_ x) x]
[(_ x (proc args ...) expr ...)
(-> (proc x args ... ) expr ...) ]
[(_ x proc expr ... )
(-> (proc x) expr ... ) ] ) )
(define-syntax ->>
(syntax-rules ()
[(_ x) x]
[(_ x (proc args ...) expr ...)
(->> (proc args ... x) expr ...) ]
[(_ x proc expr ... )
(->> (proc x) expr ... ) ] ) )
実行結果
gosh> (-> 1 (list 2 3) (list 4 5 6)) ((1 2 3) 4 5 6) gosh> (->> 1 (list 2 3) (list 4 5 6)) (4 5 6 (2 3 1)) gosh> (->> '(45 3) ($ values->list $ apply quotient&remainder )) (15 0) gosh> (->> '(9 3) ($ values->list $ apply quotient&remainder )) (3 0) gosh> (->> '(9 5) ($ values->list $ apply quotient&remainder )) (1 4) gosh> (->> '(9 5) ($ values->list $ apply quotient&remainder ) ($ values->list $ apply quotient&remainder ) ) (0 1)
拡張してみる
formの挿入先を明示する
<*>でformの挿入位置を明示する。cutの<>のようなもの。cutと組み合わせると面白いかもしれない。
(define-macro (-*> x form . more)
(if (pair? more)
`(-*> (-*> ,x ,form) ,@more)
(if (pair? form)
(receive (head tail) (break (cut eq? '<*> <>) form)
(if (null? tail)
`(,@head ,x)
`(,@head ,x ,@(cdr tail) ) ) )
`(,form ,x) ) ) )
gosh> (-*> 1 (+ 12 <*>)) 13 gosh> (-*> 1 (cut + 12 <*>)) #<closure #f> gosh> (-*> 1 (cut + 12 <*>) (<*>) ) 13 gosh> (-*> 1 (cut list 12 <*>) (<*>) ) (12 1) gosh> (-*> 1 (cut list 12 <*> 67 ) (<*>) ) (12 1 67) gosh> (-*> (quotient&remainder 13 5) (receive (x y) <*> (print x y))) 23 #<undef> gosh> (-*> (quotient&remainder 13 5) (receive (x y) <*> (list x y))) (2 3) gosh> (-*> 'gauche (find-module <*>)) #<module gauche> gosh> (-*> 'gauche (find-module <*>) (~ <*> 'table ) ) #<hash-table eq? 0x96f4ed8> gosh> (-*> 'gauche (find-module <*>) (~ <*> 'table ) (~ <*> 'cond-list)) #<gloc gauche#cond-list> gosh> (-*> 'gauche (find-module <*>) (global-variable-ref <*> 'cond-list)) #<macro cond-list> gosh> (-*> 'gauche find-module ) #<module gauche> gosh> (-*> 'gauche find-module module-exports) () gosh> (-*> 'gauche find-module d) #<module gauche> is an instance of class <module> slots: name : gauche mpl : (#<module gauche> #<module scheme> #<module null>) parents : (#<module scheme>) imports : (#<module srfi-1>) exports : () export-all: #f table : #<hash-table eq? 0x96f4ed8> depends : () origin : #f prefix : #f gosh> (-*> 'gauche find-module (global-variable-ref <*> 'cond-list)) #<macro cond-list>
- 齊藤: 拡張版を syntax-rules で (R5RS ポータブルに) 書き直してみました。 マイナス記号で始まる識別子は (マイナス記号一文字の場合を除いて) R5RS 違反なので、別の名前に変えてあります。 (2013/04/30 08:03:20 UTC)
(define-syntax =*>-helper
(syntax-rules (<*>)
((_ () x (acc ...))
(acc ...))
((_ (<*> rest ...) x (acc ...))
(acc ... x rest ...))
((_ (a rest ...) x (acc ...))
(=*>-helper (rest ...) x (acc ... a)))))
(define-syntax =*>
(syntax-rules ()
((_ x) x)
((_ x form rest ...)
(let ((r (=*>-helper form x ())))
(=*> r rest ...)))))
- yamasushi(2013/04/30 08:23:54 UTC) おお、どうやったらdefine-syntaxでかけるのか小一時間なやんであきらめていたのでした。勉強になります。なるほど、-記号は頭においたらいけないのですね。
複数の位置に挿入する。
define-macro版
; <*>を複数指定できるが、複数評価される。多値に対応
(define-macro (-*> x form . more)
(if (pair? more)
`(-*> (-*> ,x ,form) ,@more)
(if (pair? form)
(map (^t (if (eq? t '<*>) x t)) form)
`(,form ,x) ) ) )
; <*>が複数でも一回のみ評価される、多値に対応できない
(define-macro (-**> x form . more)
(if (pair? more)
`(-**> (-**> ,x ,form) ,@more)
(if (pair? form)
(let* [ [r (gensym)]
[form (map (^t (if (eq? t '<*>) r t )) form)] ]
`(let1 ,r ,x ,form) )
`(,form ,x) ) ) )
define-syntax版
; <*>が複数でもよい。
; TODO 多値にどう対応するか？
(define-syntax %-*>
(syntax-rules (<*>)
[(_ (acc ...) x () )
(acc ... ) ]
[(_ (acc ...) x (<*> rest ...) )
(%-*> (acc ... x) x (rest ...) ) ]
[(_ (acc ...) x (a rest ...) )
(%-*> (acc ... a) x (rest ...) ) ]
[(_ () x form )
(form x) ] ) )
; <*>を複数指定すると複数評価される。多値に対応
(define-syntax -*>
(syntax-rules ()
[(_ x) x ]
[(_ x form rest ...)
(-*> (%-*> () x form ) rest ...) ] ) )
; <*>が複数でもよいが、多値に対応できない
(define-syntax -**>
(syntax-rules ()
[(_ x) x ]
[(_ x form rest ...)
(-**>
(let1 y x (%-*> () y form ) ) rest ...) ] ) )
実行例
gosh> (-*> 12 (list <*> 111 <*>)) (12 111 12) gosh> (-*> gauche.generator use) #<undef> gosh> (-*> 'gauche.generator find-module) #<module gauche.generator> gosh> (-*> 'gauche.generator ($ cons <*> $ find-module <*> ) ) (gauche.generator . #<module gauche.generator>)
Post a comment