common lisp でマクロの習作

まずは目標

"abc" と `(:tag ,aa)  -> (:tag "abc")

としたい。
簡単には

test.lisp

(defun f (arg) `(:tag ,arg))

これでいいのか、、、。でも defun とかが冗長。

test.lisp

(defmacro m0 (name arg tlst) `(defun ,name (,arg) ,tlst))

 (m0 ff arg `(:tag ,arg))

 (ff "abc")
(:TAG "abc")

なんとなく関数を作るマクロが出来た。lambda にしてみる。

test1.lisp

(defmacro m00 (arg tlst) `#'(lambda (,arg) ,tlst))

 (funcall (m00 arg `(:tag ,arg)) "abc")
(:TAG "abc")

できた。arg が冗長。

test2.isp

(defmacro m00 (tlst) `#'(lambda ,(remove nil (mapcar #'(lambda (i) (if (and (listp i) (eq (car i) 'SYSTEM::UNQUOTE)) (cadr i))) (cadr tlst))) ,tlst))

(m00 `(:tag ,arg))
#<FUNCTION :LAMBDA (ARG) `(:TAG ,ARG)>

(funcall (m00 `(:tag ,arg)) "abc")
(:TAG "abc")

より複雑なのが出来た。SYSTEM::UNIQUOTE は他の lisp で他の大丈夫か不安。
データを作る。

data.lisp

(defparameter *my-list*
   '((:tag . (m00 `(:tag ,arg)))
     (:tag2 . (m00 `(:tag2 :local-tag "local" ,arg)))))

(setf input-data '(("abc" . :tag) ("def" . :tag2)))

(funcall (eval (cdr (assoc :tag *my-list*))) "abc")
(:TAG "abc")

input-data を評価する関数を作る。

input-data.lisp

(defun eval-input-data (lst) (mapcar #'(lambda (x) (let ((word (car x)) (
tag (cdr x))) (funcall (eval (cdr (assoc tag *my-list*))) word))) lst))

(eval-input-data input-data )
((:TAG "abc") (:TAG2 :LOCAL-TAG "local" "def"))

なんとなくできた。毎回 eval するのは馬鹿らしいので cache する。

test.lisp

(defun eval-input-data (lst) (mapcar #'(lambda (x) (let ((word (car x)) (
tag (cdr x))) (let* ((func (cdr (assoc tag *cached-my-list*))) (new-func (if fun
c func (eval (cdr (assoc tag *my-list*)))))) (if (null func) (push `(,tag . ,new
-func) *cached-my-list*)) (funcall new-func word)))) lst))

(defparameter *cached-my-list* nil)

*cached-my-list*
NIL

(eval-input-data input-data )
((:TAG "abc") (:TAG2 :LOCAL-TAG "local" "def"))

 *cached-my-list*
((:TAG2 . #<FUNCTION :LAMBDA (ARG) `(:TAG2 :LOCAL-TAG "local" ,ARG)>)
 (:TAG . #<FUNCTION :LAMBDA (ARG) `(:TAG ,ARG)>))

(eval-input-data '(("fff" . :tag)))
((:TAG "fff"))

なんかできている気がする。
*my-list* の m00 が余計だ。なんとかならないのか？これはまた考える。

おまけ

eval と関数使ってできたけど、ちゃんとした関数がありそうなんだけど、、、

test.lisp

(defun do-m00 (lst) `(m00 ,lst))

(defun eval-input-data (lst) (mapcar #'(lambda (x) (let ((word (car x)) (
tag (cdr x))) (let* ((func (cdr (assoc tag *cached-my-list*))) (new-func (if fun
c func (eval (do-m00 (cdr (assoc tag *my-list*))))))) (if (null func) (push `(,t
ag . ,new-func) *cached-my-list*)) (funcall new-func word)))) lst))

埋め込んじゃえばいいのか。

(defun eval-input-data (lst) (mapcar #'(lambda (x) (let ((word (car x)) (tag (cd
r x))) (let* ((func (cdr (assoc tag *cached-my-list*))) (new-func (if func func
(eval `(m00 ,(cdr (assoc tag *my-list*))))))) (if (null func) (push `(,tag . ,ne
w-func) *cached-my-list*)) (funcall new-func word)))) lst))

(defparameter *cached-my-list* nil)
*CACHED-MY-LIST*

(eval-input-data input-data )
((:TAG "abc") (:TAG2 :LOCAL-TAG "local" "def"))

*cached-my-list*
((:TAG2 . #<FUNCTION :LAMBDA (ARG) `(:TAG2 :LOCAL-TAG "local" ,ARG)>)
 (:TAG . #<FUNCTION :LAMBDA (ARG) `(:TAG ,ARG)>))

できた。ことにしておく。