Lisp-将未引用的列表传递给宏

时间:2019-12-30 11:31:15

标签: macros lisp common-lisp clos

我目前正在Lisp中尝试使用宏,我想编写一个可以处理如下语法的宏:

(my-macro (args1) (args2))

该宏应带有两个列表,这些列表随后将在我的宏中可用以进行进一步处理。然而,要注意的是,这些列表未加引号,以模仿某些实际Lisp / CLOS函数的语法。这可能吗?

当前尝试执行类似操作时出现以下错误:

Undefined function ARGS1 called with arguments ().

谢谢!

1 个答案:

答案 0 :(得分:3)

我认为您需要展示您尝试做的事情。这是一个(傻)宏的示例,该宏的参数模式几乎与您的参数模式相同:

(defmacro stupid-let ((&rest vars) (&rest values) &body forms)
  ;; Like LET but with a terrible syntax
  (unless (= (length vars) (length values))
    (error "need exactly one value for each variable"))
  (unless (every #'symbolp vars)
    (error "not every variable is a symbol"))
  `(let ,(mapcar #'list vars values) ,@forms))

然后

> (macroexpand '(stupid-let (a b c) (1 2 3) (+ a b c)))
(let ((a 1) (b 2) (c 3)) (+ a b c))

上面的宏取决于defmacro的arglist-destructuring,但是您不必这样做:

(defun proper-list-p (l)
  ;; elaborate version with an occurs check, quadratic.
  (labels ((plp (tail tails)
             (if (member tail tails)
                 nil
               (typecase tail
                 (null t)
                 (cons (plp (rest tail) (cons tail tails)))
                 (t nil)))))
    (plp l '())))

(defmacro stupid-let (vars values &body forms)
  ;; Like LET but with a terrible syntax
  (unless (and (proper-list-p vars) (proper-list-p values))
    (error "need lists of variables and values"))
  (unless (= (length vars) (length values))
    (error "need exactly one value for each variable"))
  (unless (every #'symbolp vars)
    (error "not every variable is a symbol"))
  `(let ,(mapcar #'list vars values) ,@forms))

作为一个稍微有用的示例,这是一个有点像CLOS with-slots / with-accessors宏的宏:

(defmacro with-mindless-accessors ((&rest accessor-specifications) thing
                                   &body forms)
  "Use SYMBOL-MACROLET to define mindless accessors for THING.

Each accessor specification is either a symbol which names the symbol
macro and the accessor, or a list (macroname accessorname) which binds
macroname to a symbol macro which calls accessornam.  THING is
evaluated once only."
  (multiple-value-bind (accessors functions)
      (loop for accessor-specification in accessor-specifications
            if (symbolp accessor-specification)
            collect accessor-specification into acs
            and collect accessor-specification into fns
            else if (and (proper-list-p accessor-specification)
                         (= (length accessor-specification) 2)
                         (every #'symbolp accessor-specification))
            collect (first accessor-specification) into acs
            and collect (second accessor-specification) into fns
            else do (error "bad accessor specification ~A" accessor-specification)
            end
            finally (return (values acs fns)))
    (let ((thingn (make-symbol "THING")))
    `(let ((,thingn ,thing))
       (symbol-macrolet ,(loop for accessor in accessors
                               for function in functions
                               collect `(,accessor (,function ,thingn)))
         ,@forms)))))

所以现在我们可以编写一些无用的代码了:

> (with-mindless-accessors (car cdr) (cons 1 2)
    (setf cdr 3)
    (+ car cdr))
4

这:

> (let ((l (list 1 2)))
    (with-mindless-accessors (second) l
      (setf second 4)
      l))
(1 4)