Gauche:Clojure:-?>,-?>>

Gauche:Clojure:-?>,-?>>

yamasushi(2013/04/30 10:28:56 UTC) clojureにある便利そうなマクロ。



-?> , -?>> とは?

(source code ClojureContribSource:src/main/clojure/clojure/contrib/core.clj)

define-macro版

(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版

(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版

(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版

; <*>が複数でもよい。; -*>で使用したもの。
(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>

問題点

先頭文字に-を使うとポータブルではない。R5RSでは識別子とみなされない。


コメント

Past comment(s)

shiro (2013/04/30 12:20:07):

先頭に-があるのはR5RSでは識別子とみなされない (R5RSの範囲では動作は未定義。処理系独自の拡張は可能) というだけで、「違反」というのとはちょっと違うと思います。ポータブルではない、とは言えますが。srfiの中にも-で始まる識別子を使ってるのがあったりします。

yamasushi (2013/04/30 13:20:17):

ありがとうございます。修正してみました。

Post a comment

Name:



Tags: Clojure, -?>, -?>>


Last modified : 2013/04/30 13:56:20 UTC