新千葉 ガーベージ・コレクション

FPGA マガジンやインターフェースで書けなかったこと等をちょぼちょぼ書いてます。@ryos36

複雑な(?)マクロ

  • まずは目標
"abc" と `(:tag ,aa)  -> (:tag "abc")

としたい。 簡単には

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

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

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

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

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

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

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

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

できた。arg が冗長。

(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 で他の大丈夫か不安。 データを作る。

(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 を評価する関数を作る。

(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 する。

(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 が余計だ。なんとかならないのか?これはまた考える。