vallog: syntax-rules: cut っぽい let

2010/08/26

たまたま、試しにこういうアナフォリックマクロを書いていました。値を一時的に束縛したいけど、名前を付けたいわけではないことがよくある気がしたので。別に <> じゃなくて On Lisp の aif や aand みたいに it でも良いんですけども。

view raw cet1.scm hosted with ❤ by GitHub

そこで、srfi-26 の cut っぽい let があったら便利そうだなぁ。。と思ったので、こちらも試しに書いてみました。みましたが・・・。（名前は、cut っぽい let -> cutlet -> cet と取りあえず）

	(define-syntax cet-helper
	(syntax-rules (cet <>)
	;; base
	((_ val (x ...)())
	(x ...))
	;; list
	((_ val (x ...)((nest ...) rest ...))
	(cet-helper val (x ... (cet-helper val ()(nest ...)))(rest ...)))
	((_ val (x ...)(<> rest ...))
	(cet-helper val (x ... val)(rest ...)))
	((_ val (x ...)(a rest ...))
	(cet-helper val (x ... a)(rest ...)))
	;; atom
	((_ val (x ...) <>)
	val)
	((_ val (x ...) a)
	a)))

	(define-syntax cet
	(syntax-rules ()
	((_ expr body ...)
	(let ((tmp expr))
	(cet-helper tmp () body ...)))))

	(cet (* 2 2)
	(list <> <> <> <>))
	;; (4 4 4 4)

	(cet 10 <>)
	;; 10

	(use srfi-1)
	(cet 10 (map list (iota <>)))
	;; ((0) (1) (2) (3) (4) (5) (6) (7) (8) (9))

	(cet (* 2 2)
	(apply + <> (list <> (+ 1 <>))))
	;; 13

	(cet 2
	(cet (* <> 2)
	(list <> (+ 1 <>))))
	;; error

view raw cet2.scm hosted with ❤ by GitHub

ネストした時ダメですね。。こういう時はどう扱ったら良いんでしょうか。わかりません。以下のように少し書き足してもみましたが・・・。動いたとしても、ここまでするなら一番最初のアナフォリックマクロで良いかなーと思いました。

	(define-syntax cet-helper
	(syntax-rules (cet <>)
	;; base
	((_ val (x ...)())
	(x ...))

	;; add
	((_ val (x ...)((cet exp b ...) rest ...))
	(cet-helper val (x ... (cet (cet-helper val () exp) b ...))(rest ...)))

	;; list
	((_ val (x ...)((nest ...) rest ...))
	(cet-helper val (x ... (cet-helper val ()(nest ...)))(rest ...)))
	((_ val (x ...)(<> rest ...))
	(cet-helper val (x ... val)(rest ...)))
	((_ val (x ...)(a rest ...))
	(cet-helper val (x ... a)(rest ...)))
	;; atom
	((_ val (x ...) <>)
	val)
	((_ val (x ...) a)
	a)))

	(cet 2
	(cet (* <> 2)
	(list <> (+ 1 <>))))
	;; error

view raw cet3.scm hosted with ❤ by GitHub

しかし、srfi のコードは美しいですねぇ。今回も大変勉強になりました。

追記

コメント欄が面白かったので。