Changeset 13696

Timestamp:

May 13, 2010, 3:06:28 PM (15 years ago)

Author:

gz

Message:

in defstruct constructors, wrap-with-type-check => wrap-with-type-declaration (whether that turns into a type check is controlled by the same settings as any other declaration). Fixes ticket:683

File:

• trunk/source/lib/defstruct-lds.lisp (modified) (3 diffs)

trunk/source/lib/defstruct-lds.lisp

@@ -286 +286 @@
   (intern (%str-cat (string name1) (string name2))))
 
-(defun wrap-with-type-check (value slot &aux (slot-type (ssd-type slot)))
+(defun wrap-with-type-declaration (value slot &aux (slot-type (ssd-type slot)))
   (if (eq t slot-type)
     value
-    `(require-type ,value ',slot-type)))
+    `(the ,slot-type ,value)))
 
 (defun make-class-cells-list (class-names)
@@ -316 +316 @@
       (if (eql 0 name)
         (push (make-class-cells-list (ssd-initform slot)) values) 
-        (push (wrap-with-type-check (ssd-initform slot) slot) values))
+        (push (wrap-with-type-declaration (ssd-initform slot) slot) values))
       (let* ((temp (make-symbol (symbol-name name))))
         (push (list (list (make-keyword name) temp) (ssd-initform slot)) args)
-        (push (wrap-with-type-check temp slot) values)))
+        (push (wrap-with-type-declaration temp slot) values)))
     (setq offset (%i+ offset 1)))
   (setq values (nreverse values))
@@ -375 +375 @@
           values)
     (setq offset (%i+ offset 1)))
-  (setq values (mapcar #'wrap-with-type-check (nreverse values) (sd-slots sd)))
+  (setq values (mapcar #'wrap-with-type-declaration (nreverse values) (sd-slots sd)))
   `(defun ,(car boa) ,(nreverse args)
     ,(case (setq slot (defstruct-reftype (sd-type sd)))