Hi,
using the CMU Common Lisp Snapshot 2005-11 (19C) on Linux x86, I get
undesirable results for defstructs with b-o-a constructors like the
following:
(defstruct (foobar
(:constructor make-foobar
(xxx
&key (aaa nil) (bbb nil)
&aux
(foobar-data xxx)
(aaa (or aaa
(getf foobar-data :aaa)
1))
(bbb (or bbb
(getf foobar-data :bbb)
(1+ aaa))))))
(aaa (required-argument) :type fixnum)
(bbb (required-argument) :type fixnum))
The intent is to have a b-o-a constructor with keyword arguments with
more complicated defaults; in reality, the binding for FOOBAR-DATA is
a potentially expensive computation depending on XXX.
I believe the above is valid CL (cf. CLHS 3.4.6), and Clisp in fact
accepts it and produces the desired results:
[8]> (make-foobar nil)
#<FOOBAR :AAA 1 :BBB 2>
[9]> (make-foobar '(:a 5 :aaa 6))
#<FOOBAR :AAA 6 :BBB 7>
Compiling this definition in CMUCL, however, gives me warnings and
notes about elimination of code,
; In: DEFSTRUCT FOOBAR
; (GETF FOOBAR-DATA :AAA)
; Note: Deleting unreachable code.
;
; (GETF FOOBAR-DATA :BBB)
; Note: Deleting unreachable code.
;
; (1+ AAA)
; --> +
; ==>
; AAA
; Note: Deleting unreachable code.
;
; (DEFSTRUCT (FOOBAR
; #)
; (AAA # :TYPE FIXNUM)
; (BBB # :TYPE FIXNUM))
; ==>
; (C::%FUNCALL
; #<LAMBDA #x587DC2BD NAME= NIL TYPE= # WHERE-FROM= :DEFINED VARS= #>
; XXX
; NIL
; NIL)
; Warning: A possible binding of #:AAA-DEFAULTING-TEMP is not a
(VALUES &OPTIONAL FIXNUM &REST T):
; NIL
;
; Warning: A possible binding of #:BBB-DEFAULTING-TEMP is not a
(VALUES &OPTIONAL FIXNUM &REST T):
; NIL
;
; Compilation unit finished.
; 2 warnings
; 3 notes
and calls to make-foobar involving the defaulting behavior like those
given above raise TYPE-ERRORs: NIL is not of type FIXNUM.
Macroexpanding the DEFSTRUCT shows that the constructor is defined as
follows:
(DEFUN MAKE-FOOBAR
(XXX
&KEY (AAA NIL) (BBB NIL)
&AUX (FOOBAR-DATA XXX) (AAA (OR AAA (GETF FOOBAR-DATA :AAA) 1))
(BBB (OR BBB (GETF FOOBAR-DATA :BBB) (1+ AAA))))
(DECLARE (TYPE T XXX)
(TYPE FIXNUM AAA)
(TYPE FIXNUM BBB)
(TYPE T FOOBAR-DATA)
(TYPE FIXNUM AAA)
(TYPE FIXNUM BBB))
(LET ((#:G1760 (TRULY-THE FOOBAR (KERNEL:%MAKE-INSTANCE 3))))
(SETF (KERNEL:%INSTANCE-LAYOUT #:G1760)
(KERNEL::%GET-COMPILER-LAYOUT FOOBAR))
(SETF (KERNEL:%INSTANCE-REF #:G1760 1) AAA)
(SETF (KERNEL:%INSTANCE-REF #:G1760 2) BBB)
#:G1760))
I believe the declarations to be wrong. In my understanding the
correct expansion would be something like
(DEFUN MAKE-FOOBAR
(XXX
&KEY (AAA NIL) (BBB NIL)
&AUX (FOOBAR-DATA XXX)
(#:AAA (OR AAA (GETF FOOBAR-DATA :AAA) 1))
(#:BBB (OR BBB (GETF FOOBAR-DATA :BBB)
(LET ((AAA #:AAA)) (1+ AAA)))))
(DECLARE (TYPE T XXX)
(TYPE T AAA)
(TYPE T BBB)
(TYPE T FOOBAR-DATA)
(TYPE FIXNUM #:AAA)
(TYPE FIXNUM #:BBB))
(LET ((AAA #:AAA) (BBB #:BBB))
(LET ((#:G1760 (TRULY-THE FOOBAR (KERNEL:%MAKE-INSTANCE 3))))
(SETF (KERNEL:%INSTANCE-LAYOUT #:G1760)
(KERNEL::%GET-COMPILER-LAYOUT FOOBAR))
(SETF (KERNEL:%INSTANCE-REF #:G1760 1) AAA)
(SETF (KERNEL:%INSTANCE-REF #:G1760 2) BBB)
#:G1760)))
, where #:AAA and #:BBB are some gensyms. Another, more natural
option would be to simply cut the &aux arguments from the argument
list and to create the obvious let bindings, i.e.:
(DEFUN MAKE-FOOBAR
(XXX &KEY (AAA NIL) (BBB NIL))
(DECLARE (TYPE T XXX)
(TYPE T AAA)
(TYPE T BBB))
(LET* ((FOOBAR-DATA XXX)
(AAA (OR AAA (GETF FOOBAR-DATA :AAA) 1))
(BBB (OR BBB (GETF FOOBAR-DATA :BBB) (1+ AAA))))
(DECLARE (TYPE T FOOBAR-DATA)
(TYPE FIXNUM #:AAA)
(TYPE FIXNUM #:BBB))
(LET ((#:G1760 (TRULY-THE FOOBAR (KERNEL:%MAKE-INSTANCE 3))))
(SETF (KERNEL:%INSTANCE-LAYOUT #:G1760)
(KERNEL::%GET-COMPILER-LAYOUT FOOBAR))
(SETF (KERNEL:%INSTANCE-REF #:G1760 1) AAA)
(SETF (KERNEL:%INSTANCE-REF #:G1760 2) BBB)
#:G1760)))
Comments?
Thanks in advance,
Albert.
