Re: Compiler bug?

[Bruno Haible <haible@ilog.fr>]

Matthias Lindner <lindner@bfws4o.forwiss.uni-erlangen.de> wrote:

> A strange error occurs wehen I try to compile a file containig the
> following three lines:
> 
> (defconstant *default* 'x)
> (defstruct A (slot *default*))
> (defstruct (B (:include A)))

Yes, this is a bug in the DEFSTRUCT macro. The following patch fixes
this and another (similar) bug.

*** defstruc.lsp.bak	Sat Jul 20 21:20:53 1996
--- defstruc.lsp	Fri Nov  8 01:35:10 1996
***************
*** 49,55 ****
  (defun ds-slot-name (slot) (svref slot 0))
  ;(defun ds-slot-initargs (slot) (svref slot 1)) ; only used in clos.lsp
  (defmacro ds-slot-offset (slot) `(svref ,slot 2))
! (defun ds-slot-initer (slot) (svref slot 3)) ; only used in clos.lsp
  (defmacro ds-slot-default (slot) `(svref ,slot 4))
  (defmacro ds-slot-type (slot) `(svref ,slot 5))
  (defmacro ds-slot-readonly (slot) `(svref ,slot 6))
--- 49,55 ----
  (defun ds-slot-name (slot) (svref slot 0))
  ;(defun ds-slot-initargs (slot) (svref slot 1)) ; only used in clos.lsp
  (defmacro ds-slot-offset (slot) `(svref ,slot 2))
! (defmacro ds-slot-initer (slot) `(svref ,slot 3)) ; used in clos.lsp
  (defmacro ds-slot-default (slot) `(svref ,slot 4))
  (defmacro ds-slot-type (slot) `(svref ,slot 5))
  (defmacro ds-slot-readonly (slot) `(svref ,slot 6))
***************
*** 582,588 ****
                (list
                  (list
                    (setq namesform (gensym))
!                   `(CONS ',name (LOAD-TIME-VALUE (SVREF (GET ',subname 'DEFSTRUCT-DESCRIPTION) 0)))
          )     ) )
          (unless (equalp (svref incl-desc 1) type-option)
            (error-of-type 'program-error
--- 582,588 ----
                (list
                  (list
                    (setq namesform (gensym))
!                   `(CONS ',name (SVREF (GET ',subname 'DEFSTRUCT-DESCRIPTION) 0))
          )     ) )
          (unless (equalp (svref incl-desc 1) type-option)
            (error-of-type 'program-error
***************
*** 591,597 ****
               FRANCAIS "~S ~S : La structure incluse ~S doit être du même type ~S.")
              'defstruct name subname type-option
          ) )
!         (setq slotlist (nreverse (mapcar #'copy-ds-slot (svref incl-desc 3))))
          ; slotlist ist die umgedrehte Liste der vererbten Slots
          (when slotlist (setq include-skip (1+ (ds-slot-offset (first slotlist)))))
          ; include-skip >=0 ist die Anzahl der bereits von der Teilstruktur
--- 591,608 ----
               FRANCAIS "~S ~S : La structure incluse ~S doit être du même type ~S.")
              'defstruct name subname type-option
          ) )
!         (setq slotlist
!           (nreverse
!             (mapcar #'(lambda (slot)
!                         (setq slot (copy-ds-slot slot))
!                         (when (car (ds-slot-initer slot))
!                           (setf (ds-slot-initer slot)
!                                 (cons (add-unquote (ds-slot-default slot)) 'NIL)
!                         ) )
!                         slot
!                       )
!                     (svref incl-desc 3)
!         ) ) )
          ; slotlist ist die umgedrehte Liste der vererbten Slots
          (when slotlist (setq include-skip (1+ (ds-slot-offset (first slotlist)))))
          ; include-skip >=0 ist die Anzahl der bereits von der Teilstruktur

Many thanks for the report!

Bruno