2009年7月29日水曜日

マクロを書く練習

LET OVER LAMBDA 邦訳版を読んだため,マクロをうまく書けるようになりたい気持ちが沸いてきた.
ということで,練習がてらに書いてみる.

;;;引数の個数によって動作を変えるlambda
(defmacro olambda (&body body)
(let ((args (gensym "olambda-args")))
`(lambda (&rest ,args)
(case (length ,args)
,@(mapcar
#'(lambda (clause)
`(,(if (listp (car clause))
(length (car clause))
t)
(destructuring-bind ,(car clause)
,args
,@(cdr clause))))
body)))))

LOLに載っていたdlambdaのパクリっぽい.
dlambdaとの違いはキーワード引数ではなくて引数の数で動作を変えること.
lambdaに一文字足した名前にしようと思い,overloadのoを選んでみた.
以下,動作結果.

;;;引数すべての平均値を求める
>(defparameter avg
(olambda
(() 0) ;引数がなければ0を返す
((x) x) ;引数が1つならばそのまま返す
;;2つ以上引数があれば計算して返す
(args (/ (apply #'+ args) (length args)))))

>(funcall avg)
0

>(funcall avg 5)
5

>(funcall avg 1 2 3 4 5)
3

>(macroexpand-1
'(olambda
(() 0)
((x) x)
(args (/ (apply #'+ args) (length args)))))
(LAMBDA (&REST #:|olambda-args1425|)
(CASE (LENGTH #:|olambda-args1425|)
(0 (DESTRUCTURING-BIND () #:|olambda-args1425| 0))
(1 (DESTRUCTURING-BIND (X) #:|olambda-args1425| X))
(T
(DESTRUCTURING-BIND ARGS
#:|olambda-args1425|
(/ (APPLY #'+ ARGS) (LENGTH ARGS))))))

一応考えているとおりに動いてそうだ.

0 件のコメント:

コメントを投稿