マクロを書くマクロで Arc の角括弧構文
Haskellっぽいカリー化関数の構文で、「Haskellっぽい」と言いながらも Arc の角括弧みたいな構文を導入しました。
実際にはそれにも偽りがありまして、見た目は Arc っぽいんですが実体は SRFI-26 の cut の糖衣構文に過ぎなかったわけです (次のように変換されます)
[+ _ 1] ; => (cut + <> 1)
個人的に cut は見た目が美しくないと感じるので全く使ってなかったんですが、この構文ならスマートですよね。
ただ、Arc のコードを見ていると、こんな用法もあることに気付きます。
[is (cadr _) name] [if _ (+ _ 1) 1]
cut とはまるで別物です。_ で受けた値に関数を適用したり、if 文までも関数化したりしています。
前者はともかくとして、後者は関数適用の構文をハックする前回の手法ではどうしようもありません。
便利そうなのでやってみたいんですが、Arc のように reader に手を入れるのは何となく気が引けます (やったことが無いので)。
あきらめかけたところ、これも何となくなんですが、マクロを1つ書けば良いだけなんじゃ？という閃きがあり、その通りにしてみたら、驚くほど簡単に実現できました。
先に実装を示します:
(define (syntax->tree src-stx stop?)
(define (cert stx)
(syntax-recertify stx src-stx (current-code-inspector) #f))
(let loop ((stx src-stx))
(cond ((stop? stx) (cert stx))
((syntax? stx)
(loop (syntax-e stx)))
((pair? stx)
(cons (loop (car stx))
(loop (cdr stx))))
(else stx))))
;; Adapted from: http://okmij.org/ftp/Scheme/zipper-in-scheme.txt
(define (map* f l)
(if (not (pair? l))
l
(cons (f (car l)) (map* f (cdr l)))))
(define (depth-first handle tree)
(cond ((handle tree))
((pair? tree)
(map* (lambda (kid)
(depth-first handle kid))
tree))
(else tree)))
(define (bracketed? stx)
(and (syntax? stx)
(eq? (syntax-property stx 'paren-shape) #\[)))
(define (unbracket stx)
(syntax-property stx 'paren-shape #f))
(define (underscore? stx)
(and (syntax? stx) (eq? (syntax-e stx) '_)))
(define-syntax (make-brackets-funny stx)
(syntax-case stx ()
((make-brackets-funny orig)
(with-syntax ((new
(string->symbol
(format "new-~a" (syntax-e #'orig)))))
(syntax/loc stx
(begin
(define-syntax (new stx)
(syntax-case stx ()
((new . e)
(bracketed? stx)
(let ((g (gensym)))
(quasisyntax/loc stx
(lambda (#,g)
(orig . #,(depth-first
(lambda (x)
(and (underscore? x) g))
(syntax->tree (unbracket #'e)
(lambda (x)
(or (identifier? x)
(bracketed? x))))))))))
((new . e)
(syntax/loc stx (orig . e)))))
(provide (rename-out (new orig)))))))
((make-brackets-funny orig rest ...)
(syntax/loc stx
(begin (make-brackets-funny orig) (make-brackets-funny rest ...))))))
(make-brackets-funny #%app if or and)関数適用や if 等の構文で角括弧が使われていた場合に、Arc 同様1変数のラムダに変換するという macro-generating macro です (make-brackets-funny)。すなわち、例えば
[if _ (+ _ 1) 1] ; => (lambda (g) (if g (+ g 1) 1))
という変換が行われるように任意の構文を拡張するマクロを書くマクロです。
syntax->tree でコードをコンスのツリー構造に変換、ツリー探索 (depth-first) によりアンダースコアを探して実際の変数 (g) で置き換えていきます。
ただしその際、角括弧がネストできるように内側の角括弧の _ を置き換えてしまわないよう注意しなければなりません。
syntax->tree の第2引数はこのための対策で、コード分解を途中で止めるための停止条件を与えています。角括弧の式はバラさないでおくことで、内側の _ を置き換えから保護しているわけです。
用例を幾つか示しましょう。
cdr 部が 0 のコンスを探す
> (findf [= (cdr _) 0] '((a . 1) (b . 2) (c . 0))) (c . 0)
絶対値関数はこのように書けます。
> (my-abs := [if (negative? _) (- _) _]) > (my-abs 1) 1 > (my-abs -1) 1
ネストの例
> ([map [+ _ 1] _] (1 .. 3)) (2 3 4)
thunk を呼ぶ例1
> (for-each [newline] (1 .. 3)) >
thunk を呼ぶ例2
> (map [_]
(list (lambda () 1)
(lambda () 2)
(lambda () 3)))
(1 2 3)
