2010年9月6日月曜日

Common Lispでオレオレforマクロを定義する

Common Lispにはやたらと高機能なかわりに構文がおかしなloopマクロが存在します。

loopマクロは高機能なのですが、多重ループを処理しようとすると collect や nconc などのキーワードを使ってネストさせる必要があります(多分)。

Clojureのforは多重ループ(のようなもの)を簡潔に記述できるので、似たような構文をマクロで定義してみようと思います。

(defun enumrate (from to)
(loop :for i from from to to :collect i))

(defun pattern-binding (form pattern)
(if (/= (length form) (length pattern))
nil
(let ((binding
(mapcar
#'(lambda (f p)
(cond
((and (keywordp f) (keywordp p))
(if (eq f p)
f
nil))
((keywordp p) nil)
((symbolp p) (list p f))
(T (error "Invalid pattern or form"))))
form
pattern)))
(if (member nil binding)
nil
(remove-if #'keywordp binding)))))

(defmacro keyword-pattern-case (form &body pattern-clauses)
(if (null pattern-clauses)
nil
(let ((binding (pattern-binding form (caar pattern-clauses))))
(if binding
`(let ,binding
,@(cdar pattern-clauses))
`(keyword-pattern-case ,form ,@(cdr pattern-clauses))))))


(defun expand-for-forms (forms body)
(if (null forms)
`(progn ,@body)
(let ((form (car forms))
(rest (cdr forms))
(sym1 (gensym))
(sym2 (gensym)))
(let ((gather (if rest :nconc :collect)))
`(keyword-pattern-case ,form
((,(car form) :in ,sym1)
(loop :for ,(car form) :in ,sym1
,gather ,(expand-for-forms rest body)))
((,(car form) :range ,sym1 ,sym2)
(loop :for ,(car form) :in (enumrate ,sym1 (1- ,sym2))
,gather ,(expand-for-forms rest body))))))))

(defmacro for ((&rest forms) &body body)
(unless (every #'listp forms)
(error "Invalid forms"))
(if (null forms)
`(progn
,@body)
(expand-for-forms forms body)))

;; example
(for ((i :in '(1 2 3))
(j :in '(4 5 6)))
(list i j))
;; => ((1 4) (1 5) (1 6) (2 4) (2 5) (2 6) (3 4) (3 5) (3 6))

(for ((i :in (list 2 3))
(j :range 10 13))
(list i j))
;; =>((2 10) (2 11) (2 12) (3 10) (3 11) (3 12))

現在、formとして許されるのは loopマクロのinに展開されるものと、 for - from - toに展開されるものだけです。また、手抜きパターンマッチのせいで:inや:rangeはキーワードでなければなりません。

展開後の一番外側のletのせいで警告が出てきますし、まだまだ改良が必要なようです。

0 件のコメント:

コメントを投稿