如何构造这个 lisp 宏？

Question

我正在通过 l99 学习 lisp。

这是来自here，我希望应用宏只是为了练习，用宏编写所有((x) (x (evaluate-boolean left bindings) (evaluate-boolean right bindings)))s。

(defun evaluate-boolean (expression bindings)
  "Evaluates the boolean expression. Returns t or nil

expression := variable 
            | constant 
            | '(' operator expression expression ')' 
            | '(' not expression ')'
            .
constant := 'true' | 'fail' .
variable := symbol .
operator := 'and' | 'or' | 'nand' | 'nor' | 'xor' | 'impl' | 'equ' .

bindings is a list of pairs (variable . constant)
"
  (cond ((eq expression 'true) t)
        ((eq expression 'fail) nil)
        ((symbolp expression)
         (let ((pair (assoc expression bindings)))
           (if pair
               (progn
                 (assert (member (cdr pair) '(true fail)))
                 (eql 'true (cdr pair)))
               (error "No variable named ~A in the bindings." expression))))
        ((atom expression) (error "Invalid atom ~A in the expression." expression))
        (t (case (length expression)
             ((2) (destructuring-bind (op subexpression) expression
                    (case op
                      ((not) (not (evaluate-boolean subexpression bindings)))
                      (otherwise (error "Invalid operator ~A in ~A" op expression)))))
             ((3) (destructuring-bind (op left right) expression
                    (case op
                      ((and)  (and  (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
                      ((or)   (or   (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
                      ((nand) (nand (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
                      ((nor)  (nor  (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
                      ((xor)  (xor  (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
                      ((impl) (impl (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
                      ((equ)  (equ  (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
                      (otherwise (error "Invalid operator ~A" op)))))
             (otherwise (error "Invalid expression ~A" expression))))))

我尝试了一些方法，但它们似乎都给出了报告缺少变量的错误。

我将如何实现宏

• defmacro，或
• 在evaluate-boolean 函数中使用macrolet？

我通常先用defun 或defmacro 测试东西，然后用flet 替换它。对此有何建议？

Answer 1

既然你没有说你尝试了什么，我不知道你做错了什么，但我猜你可能试图用宏调用替换 CASE 中的个别情况？这不起作用，因为外部宏 (CASE) 在内部宏之前扩展，因此内部宏不能用于生成外部宏的语法（除非专门编写外部宏以允许这样做，这这里不是这样）。

所以解决方案是编写一个宏来为你生成整个CASE。比如：

(macrolet ((ops-case (op-sym (&rest ops))
             `(case ,op-sym
                ,@(loop for op in ops
                        collect `((,op) (,op (evaluate-boolean left bindings)
                                             (evaluate-boolean right bindings))))
                (otherwise (error "Invalid operator ~A" ,op-sym)))))
  (ops-case op (and or nand nor xor impl equ)))

虽然我不相信这真的是个好主意。像这样的一次性宏往往会使您的代码更难理解，这也不会显着缩短代码。通常你会想要使用宏来抽象在你的代码中出现多次的模式。

更通用的方法可能是这样的：

(defmacro ecase-template (keyform template &body cases)
  `(ecase ,keyform
     ,@(loop for case in cases
             collect (sublis `((_ . ,case)) template))))

这会通过用 case 中的值替换 tempate 中的下划线来生成 case 表达式。例如：

CL-USER> (macroexpand-1 '(ecase-template op
                             ((_) (_ (evaluate-boolean left bindings)
                                     (evaluate-boolean right bindings)))
                           and or nand nor xor impl equ))
(ECASE OP
  ((AND)
   (AND (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS)))
  ((OR)
   (OR (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS)))
  ((NAND)
   (NAND (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS)))
  ((NOR)
   (NOR (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS)))
  ((XOR)
   (XOR (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS)))
  ((IMPL)
   (IMPL (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS)))
  ((EQU)
   (EQU (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS))))

Answer 2

这可能不是您所追求的，但 CLOS 非常适合这种基于符号的调度评估。

这是您的评估器的一个（经过最少测试的）实现，它使用一对通用函数（当然，对于您的小语言来说，它们实际上是 eval 和 apply）以及一个允许您定义的宏apply 泛型函数的“直接”方法。 “直接”方法可以简单地转换为涉及在 subtrate 语言中具有相同名称的运算符的形式（这基本上涵盖了代码中所有大的嵌套 case）。

（在某些情况下，它的工作方式与您的代码稍有不同：例如，一旦找到绑定变量，它就会将其值返回到评估器中，而不是具有任何额外的特殊情况聪明。）

(defgeneric evaluate-boolean (expression bindings)
  (:documentation
   "Evaluates the boolean expression. Returns t or nil

expression := variable 
            | constant 
            | '(' operator expression expression ')' 
            | '(' not expression ')'
            .
constant := 'true' | 'fail' .
variable := symbol .
operator := 'and' | 'or' | 'nand' | 'nor' | 'xor' | 'impl' | 'equ' .

bindings is a list of pairs (variable . constant)
")
  (:method ((expression (eql 'true)) bindings)
   (declare (ignore bindings))
   t)
  (:method ((expression (eql 'false)) bindings)
   (declare (ignore bindings))
   nil)
  (:method ((expression symbol) bindings)
   (let ((binding (assoc expression bindings)))
     (if binding
         (evaluate-boolean (cdr binding) bindings)
       (error "no binding for ~A" expression))))
  (:method ((expression cons) bindings)
   (apply-boolean-operator (car expression) (cdr expression) bindings))
  (:method (expression bindings)
   (error "malformed expression ~A" expression)))

(defgeneric apply-boolean-operator (op args bindings)
  (:documentation "apply an operator to some arguments with some bindings")
  (:method (op args bindings)
   (error "unknown operator ~A" op)))

(defmacro define-direct-boolean-operator (op-name arg-names)
  (unless (and (symbolp op-name) (list arg-names) (every #'symbolp arg-names))
    ;; not even worth trying
    (error "mutant boolean operator definition"))
  `(defmethod apply-boolean-operator ((op (eql ',op-name))
                                      args bindings)
     ;; this smells unhygenic but I think it is actually fine
     (let ((la (length args))
           (lr ,(length arg-names)))
       (unless (= la lr)
         (error "~A wanted ~D argument~P but got ~D" op lr lr la)))
     (destructuring-bind ,arg-names args
       (,op-name ,@(mapcar (lambda (a)
                             `(evaluate-boolean ,a bindings))
                           arg-names)))))

(define-direct-boolean-operator not (x))
(define-direct-boolean-operator and (x y))
(define-direct-boolean-operator or (x y))
(define-direct-boolean-operator nand (x y))
(define-direct-boolean-operator xor (x y))
(define-direct-boolean-operator impl (x y))
(define-direct-boolean-operator equ (x y))