在宏中定义类和方法

Question

我对 Common Lisp 宏还是很陌生。

对于具有 defgeneric 的 defclass 的抽象，我认为制作一个宏会很好。

一个非常幼稚的实现看起来像：

(defmacro defgserver (name &key call-handler cast-handler)
  "TODO: needs firther testing. Convenience macro to more easily create a new `gserver' class."
  `(progn
     (defclass ,name (gserver) ())
     (defmethod handle-call ((server ,name) message current-state)
       ,(if call-handler call-handler nil))
     (defmethod handle-cast ((server ,name) message current-state)
       ,(if cast-handler cast-handler nil))))

使用时，错误提示“消息”未知。 我不知道。 'message' 是defgeneric 的参数名称：

(defgeneric handle-call (gserver message current-state))

使用宏我看到警告“未定义的变量消息”：

(defgserver foo :call-handler 
           (progn
             (print message)))
; in: DEFGSERVER FOO
;     (PRINT MESSAGE)
; 
; caught WARNING:
;   undefined variable: COMMON-LISP-USER::MESSAGE

使用时会产生这样的后果：

CL-USER> (defvar *my* (make-instance 'foo))
*MY*
CL-USER> (call *my* "Foo")
 <WARN> [10:55:10] cl-gserver gserver.lisp (handle-message fun5) -
  Error condition was raised on message processing: CL-GSERVER::C: #<UNBOUND-VARIABLE MESSAGE {1002E24553}>

所以message 和/或current-state 一定会发生一些事情。 是否应该将它们实习到使用宏的当前包中？

曼弗雷德

Answer 1

如前所述，问题在于您在谈论不同的符号。

然而，这确实是一个更普遍问题的症状：您正在尝试做的是一种 照应。如果您修复了包结构，那么它可以工作：

(defgserver foo :call-handler 
           (progn
             (print message)))

那么，message 到底是什么？它是从哪里来的，在那个范围内还有哪些其他绑定？照应可能很有用，但它也可能成为此类隐蔽错误的来源。

所以，我认为避免这个问题的更好方法是说*-handler 选项应该指定他们期望的参数。因此，您可以编写如下内容，而不是上面的表格：

(defgserver foo
  :call-handler ((server message state)
                 (print message)
                 (detonate server)))

所以这里，:call-handler-option 的值是函数的参数列表和主体，宏将把它变成专门处理第一个参数的方法。因为它创建的方法具有宏用户提供的参数列表，所以名称从来没有问题，也没有照应。

因此，一种方法是做两件事：

• 使这些选项的默认值适合处理成没有任何特殊大小写的方法；
• 在宏中编写一个小的局部函数，将这些规范之一转换为合适的(defmethod ...) 形式。

第二部分当然是可选的，但它节省了一点代码。

除此之外，我还做了一个小技巧：我更改了宏定义，使其具有&body 选项，其值被忽略。我这样做的唯一原因是帮助我的编辑更好地缩进。

所以，这是一个修订版：

(defmacro defgserver (name &body forms &key 
                           (call-handler '((server message current-state)
                                           (declare (ignorable 
                                                     server message current-state))
                                           nil))
                           (cast-handler '((server message current-state)
                                           (declare (ignorable 
                                                     server message current-state))
                                           nil)))
  "TODO: needs firther testing. Convenience macro to more easily
create a new `gserver' class."
  (declare (ignorable forms))
  (flet ((write-method (mname mform)
           (destructuring-bind (args &body decls/forms) mform
             `(defmethod ,mname ((,(first args) ,name) ,@(rest args))
               ,@decls/forms))))
    `(progn
       (defclass ,name (gserver) ())
       ,(write-method 'handle-call call-handler)
       ,(write-method 'handle-cast cast-handler))))

现在

(defgserver foo
  :call-handler ((server message state)
                 (print message)
                 (detonate server)))

扩展到

(progn
  (defclass foo (gserver) nil)
  (defmethod handle-call ((server foo) message state)
    (print message)
    (detonate server))
  (defmethod handle-cast ((server foo) message current-state)
    (declare (ignorable server message current-state))
    nil))