The following file causes a problem in ABCL (1.1.0-dev-svn-14041) when compiled (!) and loaded.
(in-package cl-user)
(defstruct a (s1 nil))
(defstruct (b (:include a) (:conc-name foo-)) (s2 nil))
(defstruct (c (:include a) (:conc-name foo-)) (s3 nil))
(defun test () (let ((x (make-b :s1 1 :s2 2))) (foo-s1 x)))
CL-USER(4): (test) #<THREAD "interpreter" {2EF7D41F}>: Debugger invoked on condition of type SIMPLE-TYPE-ERROR The value #<B {564434F7}> is not of type C. Restarts: 0: TOP-LEVEL Return to top level. [1] CL-USER(6): (lisp-implementation-version) "1.1.0-dev-svn-14041" [1] CL-USER(7):
The problem is that the defstruct declaration for c "overwrites" the accessor foo-s1 generated by defstruct b. If foo-s1 is called for a b instance, the type assertions introduced by define-reader (and define-writer, see the ABCL implementation for defstruct) cause the error described above.
The code above runs fine in ACL, Lispworks, SBCL, and other Lisps. I had to remove the generation of type assertions in define-reader and define-accessor (see below) to make the code work in ABCL. Note, however, that there is no type checking pursued with the code below. Thus, a better solution might be developed.
Regards, Ralf Moeler http://www.sts.tu-harburg.de/~r.f.moeller/
(defun define-reader (slot) (let ((accessor-name (dsd-reader slot)) (index (dsd-index slot)) (type (dsd-type slot))) (cond ((eq *dd-type* 'list) `((declaim (ftype (function * ,type) ,accessor-name)) (setf (symbol-function ',accessor-name) (make-list-reader ,index)))) ((or (eq *dd-type* 'vector) (and (consp *dd-type*) (eq (car *dd-type*) 'vector))) `((declaim (ftype (function * ,type) ,accessor-name)) (setf (symbol-function ',accessor-name) (make-vector-reader ,index)) (define-source-transform ,accessor-name (instance) `(aref ,instance ,,index)))) (t `((declaim (ftype (function * ,type) ,accessor-name)) (setf (symbol-function ',accessor-name) (make-structure-reader ,index ',*dd-name*)) (define-source-transform ,accessor-name (instance) ,(if (eq type 't) ``(structure-ref ,instance ,,index) ``(the ,',type (structure-ref ,instance ,,index)))))))))
(defun define-writer (slot) (let ((accessor-name (dsd-reader slot)) (index (dsd-index slot))) (cond ((eq *dd-type* 'list) `((setf (get ',accessor-name 'setf-function) (make-list-writer ,index)))) ((or (eq *dd-type* 'vector) (and (consp *dd-type*) (eq (car *dd-type*) 'vector))) `((setf (get ',accessor-name 'setf-function) (make-vector-writer ,index)) (define-source-transform (setf ,accessor-name) (value instance) `(aset ,instance ,,index ,value)))) (t `((setf (get ',accessor-name 'setf-function) (make-structure-writer ,index ',*dd-name*)) (define-source-transform (setf ,accessor-name) (value instance) `(structure-set ,instance ,,index ,value)))))))