如何構建這個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))