defstruct with by-order-of-argument constructor

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= EFINED 
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.

>>>>> "Albert" == Albert Reiner
<areinertph.tuwien.ac.at> writes:

    Albert> Hi,
    Albert> using the CMU Common Lisp Snapshot 2005-11
(19C) on Linux x86, I get
    Albert> undesirable results for defstructs with b-o-a
constructors like the
    Albert> following:

    Albert>   (defstruct (foobar
    Albert>                (:constructor make-foobar
    Albert>                              (xxx
    Albert>                               &key (aaa
nil) (bbb nil)
    Albert>                               &aux
    Albert>                               (foobar-data
xxx)
    Albert>                               (aaa (or aaa
    Albert>                                        (getf
foobar-data :aaa)
    Albert>                                        1))
    Albert>                               (bbb (or bbb
    Albert>                                        (getf
foobar-data :bbb)
    Albert>                                        (1+
aaa))))))
    Albert>     (aaa (required-argument) :type fixnum)
    Albert>     (bbb (required-argument) :type fixnum))

    Albert> The intent is to have a b-o-a constructor
with keyword arguments with
    Albert> more complicated defaults; in reality, the
binding for FOOBAR-DATA is
    Albert> a potentially expensive computation depending
on XXX.

    Albert> I believe the above is valid CL (cf. CLHS
3.4.6), and Clisp in fact
    Albert> accepts it and produces the desired results:

Sorry for the long delay.

I think your analysis is correct.  I think we still need at
least to
check the type is correct.  I just don't know exactly where
that
should be done now, and how to make it actually happen.

I'll poke around some more soon.

Ray

>>>>> "Albert" == Albert Reiner
<areinertph.tuwien.ac.at> writes:

    Albert> Hi,
    Albert> using the CMU Common Lisp Snapshot 2005-11
(19C) on Linux x86, I get
    Albert> undesirable results for defstructs with b-o-a
constructors like the
    Albert> following:

    Albert>   (defstruct (foobar
    Albert>                (:constructor make-foobar
    Albert>                              (xxx
    Albert>                               &key (aaa
nil) (bbb nil)
    Albert>                               &aux
    Albert>                               (foobar-data
xxx)
    Albert>                               (aaa (or aaa
    Albert>                                        (getf
foobar-data :aaa)
    Albert>                                        1))
    Albert>                               (bbb (or bbb
    Albert>                                        (getf
foobar-data :bbb)
    Albert>                                        (1+
aaa))))))
    Albert>     (aaa (required-argument) :type fixnum)
    Albert>     (bbb (required-argument) :type fixnum))

Try the following fix.  The macroexpansion for the
constructor
becomes:

  (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))))
    (CHECK-TYPE XXX T)
    (CHECK-TYPE AAA FIXNUM)
    (CHECK-TYPE BBB FIXNUM)
    (CHECK-TYPE FOOBAR-DATA T)
    (CHECK-TYPE AAA FIXNUM)
    (CHECK-TYPE BBB FIXNUM)
    (LET ((#:G12589 (TRULY-THE FOOBAR (KERNEL:%MAKE-INSTANCE
3))))
      (SETF (KERNEL:%INSTANCE-LAYOUT #:G12589)
              (KERNEL::%GET-COMPILER-LAYOUT FOOBAR))
      (SETF (KERNEL:%INSTANCE-REF #:G12589 1) AAA)
      (SETF (KERNEL:%INSTANCE-REF #:G12589 2) BBB)
      #:G12589))

Your tests work, and if, say, aaa is initialized to
something other
than a fixnum, you get a type error.

Ray

(defun create-structure-constructor
       (defstruct cons-name arglist vars types values)
  (let* ((temp (gensym))
	 (raw-index (dd-raw-index defstruct))
	 (n-raw-data (when raw-index (gensym))))
    `(defun ,cons-name ,arglist
       ,(mapcar #'(lambda (var type)
		     `(check-type ,var ,type))
		 vars types)
       (let ((,temp (truly-the ,(dd-name defstruct)
			       (%make-instance ,(dd-length defstruct))))
	     ,(when n-raw-data
		 `((,n-raw-data
		    (make-array ,(dd-raw-length defstruct)
				:element-type '(unsigned-byte 32))))))
	 (setf (%instance-layout ,temp)
	       (%get-compiler-layout ,(dd-name defstruct)))
	 ,(when n-raw-data
	     `((setf (%instance-ref ,temp ,raw-index)
,n-raw-data)))
	 ,(mapcar #'(lambda (dsd value)
		       (multiple-value-bind
			   (accessor index data)
			   (slot-accessor-form defstruct dsd temp n-raw-data)
			 `(setf (,accessor ,data ,index) ,value)))
		   (dd-slots defstruct)
		   values)
	 ,temp))))