yamasushi(2013/04/28 06:12:43 UTC)clojureにあるわりと便利なマクロ。
(source code : ClojureSource:src/clj/clojure/core.clj )
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.
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 (-> 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 -> (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の挿入位置を明示する。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>
(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 ...)))))
; <*>を複数指定できるが、複数評価される。多値に対応 (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) ) ) )
; <*>が複数でもよい。 ; 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