如何构建这个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，或
• 使用macrolet，在evaluate-boolean函数内？

我通常测试出来的东西与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)))) 

这产生通过与从壳体的值在一个tempate代下划线的情况下表达。例如：

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通用函数。 “直接”方法是将平凡翻译成涉及具有相同名称的运算符的表单（基本上覆盖代码中的所有大嵌套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))