yamasushi(2013/04/30 10:28:56 UTC) clojureにある便利そうなマクロ。
(source code ClojureContribSource:src/main/clojure/clojure/contrib/core.clj)
-?> clojure.contrib.core
(-?> x form)
(-?> x form & forms)
Same as clojure.core/-> but returns nil as soon as the threaded value is nil itself (thus short-circuiting any pending computation).
Examples :
(-?> "foo" .toUpperCase (.substring 1)) returns "OO" (-?> nil .toUpperCase (.substring 1)) returns nil
-?>> clojure.contrib.core
(-?>> x form)
(-?>> x form & forms)
Same as clojure.core/->> but returns nil as soon as the threaded value is nil itself (thus short-circuiting any pending computation).
Examples :
(-?>> (range 5) (map inc)) returns (1 2 3 4 5) (-?>> [] seq (map inc)) returns nil
(define-macro (-?> x form . more)
(let1 v (gensym)
(if (pair? more)
`(if-let1 ,v (-?> ,x ,form) (-?> ,v ,@more ) #f )
(if (pair? form)
`(,(car form) ,x ,@(cdr form))
`(,form ,x)))))
(define-macro (-?>> x form . more)
(let1 v (gensym)
(if (pair? more)
`(if-let1 ,v (-?>> ,x ,form) (-?>> ,v ,@more ) #f )
(if (pair? form)
`(,(car form) ,@(cdr form) ,x)
`(,form ,x)))))
(define-syntax -?>
(syntax-rules ()
[(_ x) x]
[(_ x (proc args ...) expr ...)
(if-let1 y (proc x args ... ) (-?> y expr ...) ) ]
[(_ x proc expr ... )
(if-let1 y (proc x) (-?> y expr ... ) #f ) ] ) )
(define-syntax -?>>
(syntax-rules ()
[(_ x) x]
[(_ x (proc args ...) expr ...)
(if-let1 y (proc args ... x) (-?>> y expr ...) ) ]
[(_ x proc expr ... )
(if-let1 y (proc x) (-?>> y expr ... ) #f ) ] ) )
gosh> (-?>> 'sxml.sxpath find-module module-exports ) #f gosh> (use sxml.sxpath) #<undef> gosh> (-?>> 'sxml.sxpath find-module module-exports ) (sxml:string sxml:relational-cmp take-until sxml:child-nodes car-sxpath node-pos sxml:equal? sxml:preceding if-sxpath node-eq? sxml:following-sibling node-or ntype-namespace-id?? node-join sxml:descendant-or-self ntype-names?? sxml:attr-list select-kids sxml:ancestor-or-self as-nodeset sxml:string-value sxml:parent node-reverse sxpath sxml:boolean take-after sxml:attribute sxml:child-elements sxml:id-alist sxml:not-equal? sxml:filter sxml:preceding-sibling if-car-sxpath node-equal? sxml:equality-cmp sxml:namespace node-closure sxml:invert node-reduce sxml:following ....) gosh>
(define-macro (-?*> x form . more)
(let [ [v (gensym)] [r (gensym)] ]
(if (pair? more)
`(if-let1 ,v (-**> ,x ,form) (-**> ,v ,@more) #f )
(if (pair? form)
(let1 form (map (^x (if (eq? x '<*>) r x )) form)
`(let1 ,r ,x ,form) )
`(,form ,x) ) ) ) )
; <*>が複数でもよい。; -*>で使用したもの。
(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 ...)
(if-let1 r (%-*> () x form )
(-?*> r rest ...)
#f ) ] ) )
-*>についてはGauche:Clojure:->,->>を参照。
gosh> (-?*> '(1 2 3) (number? <*>) (print <*> " OK " ) ) #<undef> gosh> (-?*> '(1 2 3) (list? <*>) (print <*> " OK " ) ) #t OK #<undef> gosh> (-?*> '(1 2 3) (list? <*>) (print <*> " OK " <*> ) ) #t OK #t #<undef>
shiro (2013/04/30 12:20:07):
yamasushi (2013/04/30 13:20:17):