在 common lisp (SBCL) 中生成结构名称

Generating struct names in common lisp (SBCL)

我正在使用 SBCL 按以下方式生成一些类型

(defun subpennant-sym (i) (make-symbol (format nil "SUBPENNANT-~D" i)))
(defun pennant-type-name (ty i) (make-symbol (format nil "PENNANT-TYPE-~D" i)))

(defmacro def-pennant-internal (ty n)
  "A pennant is a balanced tree of depth N. (def-pennant 5 integer) expands to


; ... define pennant-type-{0..4}
  (struct pennant-type-5
  (node :type integer)
  (subpennant-0 :type pennant-type-0)
  (subpennant-1 :type pennant-type-1)
  (subpennant-2 :type pennant-type-2)
  (subpennant-3 :type pennant-type-3)
  (subpennant-4 :type pennant-type-4))"

  (when (>= n 0)
    `(,@(macroexpand `(def-pennant-internal ,ty ,(- n 1)))
       (defstruct ,(pennant-type-name ty n)
         (node nil :type ,ty)
         ,@(loop for i to (- n 1)
                 collect
                 `(,(subpennant-sym i) nil :type ,(pennant-type-name ty i)))))))

(defmacro def-pennant (ty n)
  `(progn ,@(macroexpand `(def-pennant-internal ,ty ,n))))

但是当我评估时:

CL-USER> (def-pennant fixnum 1)
(PROGN
 (DEFSTRUCT #:PENNANT-TYPE-0 (NODE NIL :TYPE FIXNUM))
 (DEFSTRUCT #:PENNANT-TYPE-1
   (NODE NIL :TYPE FIXNUM)
   (#:SUBPENNANT-0 NIL :TYPE #:PENNANT-TYPE-0)))
T
CL-USER> (def-pennant fixnum 1)
[...]
; 
; compilation unit finished
;   Undefined type:
;     #:PENNANT-TYPE-0
;   caught 2 STYLE-WARNING conditions
CL-USER> (make-pennant-type-0 :node 1) ; weird that it works...
#S(#:PENNANT-TYPE-0 :NODE 1)

谁能解释一下“错误”是什么意思?

编辑:虽然上面的错误看起来是良性的,但当尝试使用由 defstruct 创建的符号时,我们会得到一个正确的错误。所以以上不适用于以下

(defun subpennant-sym (i) (make-symbol (format nil "SUBPENNANT-~D" i)))
(defun pennant-type-name (ty i) (make-symbol (format nil "PENNANT-TYPE-~D" i)))

(defmacro def-pennant-internal (ty n)
  "A pennant is a balanced tree of depth N. (def-pennant 5 integer) expands to


; ... define pennant-type-{0..4}
  (struct pennant-type-5
  (node :type integer)
  (subpennant-0 :type pennant-type-0)
  (subpennant-1 :type pennant-type-1)
  (subpennant-2 :type pennant-type-2)
  (subpennant-3 :type pennant-type-3)
  (subpennant-4 :type pennant-type-4))"

  (when (>= n 0)
    (let ((pen-ty (pennant-type-name ty n)))
      `(,@(macroexpand `(def-pennant-internal ,ty ,(- n 1)))
        (defstruct ,pen-ty
          (node nil :type ,ty)
          ,@(loop for i to (- n 1)
                  collect
                  `(,(subpennant-sym i) nil :type ,(pennant-type-name ty i))))
        (setf (get ,pen-ty :order) ,n)))))

(defmacro def-pennant (ty n)
  `(progn ,@(macroexpand `(def-pennant-internal ,ty ,n))))

(def-pennant fixnum 4)

(defmacro pennant-order (obj) (get (type-of obj) 'order))

这个得到

The variable PENNANT-TYPE-0 is unbound.
   [Condition of type UNBOUND-VARIABLE]

EDIT2:冒着偏离主题的风险(虽然我认为我正在接近问题的根源),也许我不明白的相关事情是为什么会发生以下情况:

CL-USER> (eq 'hello (make-symbol "hello"))
NIL
CL-USER> (eq 'hello (intern "hello"))
NIL
CL-USER> (eq 'hello 'hello)
T

我在宏展开中看到类似 (setf (get foo :bar) 0) 的内容。

FOO 未绑定。您可能想要引用符号?

另外:为什么要在宏中调用 MACROEXPAND?为什么不直接生成代码并让 Lisp 为您宏扩展代码呢?通常需要遵循一个关于如何编写宏的清晰模型:不要将宏扩展与您自己的宏扩展混合在一起。如果需要的话,更好地记录机器 -> 否则没有人会理解你的代码。