fakedrake
fakedrake

Reputation: 6856

Generating struct names in common lisp (SBCL)

I am using SBCL to generate some types in the following way

(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))))

But when I evaluate:

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)

Can someone explain what that "error" means?

EDIT: While the above error seems benign, when trying to use the symbol created by defstruct we get a proper error. So the above does not work for the following

(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))

This one gets

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

EDIT2: At the risk of going off topic (although I think I am approaching the root of the issue), maybe a related thing I don't understand is why the following happens:

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

Upvotes: 0

Views: 136

Answers (1)

Rainer Joswig
Rainer Joswig

Reputation: 139251

I see something like (setf (get foo :bar) 0) in the macroexpansion.

FOO is unbound. You might want to quote the symbol?

Also: why would you call MACROEXPAND in your macros? Why not just generate the code and let Lisp macroexpand the code for you? Usually one needs to follow a clear model of how macros should be written: don't mix macroexpansion with your own macroexpansion. If that's needed, one better document the machinery -> otherwise no one will understand your code.

Upvotes: 1

Related Questions