2010/04/24

LOL defmacro!


defmacro!。これを書いておかないと何も始まりませんね。LET OVER LAMBDA Edition 1.0は。

まだslimeの使い方がよくわかりません。C-c C-cはコンパイルで、C-x C-eがreplに読み込む、ということくらいでしょうか。その時、コード中に見つからないシンボルがあるとアンダーラインで示してくれるなど(↑画像)、ありがたいです。

schemeにもそういうのないのかな。quack.elにはたぶんないんですよね。
(defun mkstr (&rest args)
(with-output-to-string (s)
(dolist (a args)(princ a s))))
(defun symb (&rest args)
(values (intern (apply #'mkstr args))))
(defun flatten (x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec
(car x)
(rec (cdr x) acc))))))
(rec x nil)))
(defun g!-symbol-p (s)
(and (symbolp s)
(> (length (symbol-name s)) 2)
(string= (symbol-name s)
"G!"
:start1 0
:end1 2)))
(defmacro defmacro/g! (name args &rest body)
(let ((syms (remove-duplicates
(remove-if-not #'g!-symbol-p
(flatten body)))))
`(defmacro ,name ,args
(let , (mapcar
(lambda (s)
`(,s (gensym ,(subseq
(symbol-name s)
2))))
syms)
,@body))))
(defmacro/g! nif (expr pos zero neg)
`(let ((,g!result ,expr))
(cond ((plusp ,g!result) ,pos)
((zerop ,g!result) ,zero)
(t ,neg))))
(macroexpand-1 '(defmacro/g! nif (expr pos zero neg)
`(let ((,g!result ,expr))
(cond ((plusp ,g!result) ,pos)
((zerop ,g!result) ,zero)
(t ,neg)))))
(nif -1 1 0 -1)
; => -1
(defun o!-symbol-p (s)
(and (symbolp s)
(> (length (symbol-name s)) 2)
(string= (symbol-name s)
"o!"
:start1 0
:end1 2)))
(defun o!-symbol-to-g!-symbol (s)
(symb "G!"
(subseq (symbol-name s) 2)))
(defmacro defmacro! (name args &rest body)
(let* ((os (remove-if-not #'o!-symbol-p args))
(gs (mapcar #'o!-symbol-to-g!-symbol os)))
`(defmacro/g! ,name ,args
`(let ,(mapcar #'list (list ,@gs)(list ,@os))
,(progn ,@body)))))
(defmacro! square (o!x)
`(* ,g!x ,g!x))
(macroexpand '(square (incf x)))


Gaucheのshiroさんも以下のようにおっしゃっているので、きっとslimeって多機能なんだろうなぁ。
shiro: うーむCL+slimeで作業してるとやっぱりgauche+quackは物足りなく感じるなあ。 http://bit.ly/b35LjH

LET OVER LAMBDA Edition 1.0

0 件のコメント:

コメントを投稿