使用Lisp宏创建类似的函数

时间:2014-09-19 20:55:04

标签: macros lisp common-lisp metaprogramming

在我的工作中,我尝试在Common Lisp中使用宏并提出一些问题。 我有两个功能

(defun when-tagflag ()
  (when (= tagflag 1)
   (setf tagflag 0)
   (push tagbuf taglist)
   (setf tagbuf "")))


 (defun when-attrflag ()
  (when (= attrflag 1)
   (setf attrflag 0)
   (push attrbuf attrlist)
   (setf attrbuf "")))

非常类似的功能。经过几个小时的实验,我得到了这样一个宏观

defmacro when-flag (name)
 (let ((flag (read-from-string (concatenate 'string (string name) "flag")))
       (lst (read-from-string (concatenate 'string (string name) "list")))
       (buf (read-from-string (concatenate 'string (string name) "buf"))))
 `(when (= ,flag 1)
   (setf ,flag 0)
   (push ,buf ,lst)
   (setf ,buf ""))))


 > (pprint (macroexpand-1 '(when-flag "tag")))
 > (WHEN (= TAGFLAG 1) (SETF TAGFLAG 0) (PUSH TAGBUF TAGLIST) (SETF TAGBUF ""))

在when-flag中我使用连接字符串和read-from-string,但我认为我的方法不是规范的。有没有更合适的方法来解决这个问题?

P.S。这个解决方案对我不起作用Can you create interactive functions in an Emacs Lisp macro?

1 个答案:

答案 0 :(得分:0)

Common Lisp中的符号名称默认为内部大写。

CL-USER 10 > (intern (concatenate 'string "TAG" "FLAG") "CL-USER")
TAGFLAG
:INTERNAL

CL-USER 11 > (intern (format nil "~:@(~AFLAG~)" "TAG") "CL-USER")
TAGFLAG
:INTERNAL

示例:

(defmacro when-flag (prefix &key (package-name "CL-USER"))
  (flet ((create-symbol (suffix)
           (intern (format nil "~:@(~A~A~)" prefix suffix)
                   package-name)))
    (let ((flag-sym (create-symbol "FLAG"))
          (list-sym (create-symbol "LIST"))
          (buf-sym  (create-symbol "BUF")))
      `(when (= ,flag-sym 1)
         (setf ,flag-sym 0)
         (push ,buf-sym ,list-sym)
         (setf ,buf-sym "")))))