Changeset 13696


Ignore:
Timestamp:
May 13, 2010, 10:06:28 PM (10 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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/defstruct-lds.lisp

    r13067 r13696  
    286286  (intern (%str-cat (string name1) (string name2))))
    287287
    288 (defun wrap-with-type-check (value slot &aux (slot-type (ssd-type slot)))
     288(defun wrap-with-type-declaration (value slot &aux (slot-type (ssd-type slot)))
    289289  (if (eq t slot-type)
    290290    value
    291     `(require-type ,value ',slot-type)))
     291    `(the ,slot-type ,value)))
    292292
    293293(defun make-class-cells-list (class-names)
     
    316316      (if (eql 0 name)
    317317        (push (make-class-cells-list (ssd-initform slot)) values)
    318         (push (wrap-with-type-check (ssd-initform slot) slot) values))
     318        (push (wrap-with-type-declaration (ssd-initform slot) slot) values))
    319319      (let* ((temp (make-symbol (symbol-name name))))
    320320        (push (list (list (make-keyword name) temp) (ssd-initform slot)) args)
    321         (push (wrap-with-type-check temp slot) values)))
     321        (push (wrap-with-type-declaration temp slot) values)))
    322322    (setq offset (%i+ offset 1)))
    323323  (setq values (nreverse values))
     
    375375          values)
    376376    (setq offset (%i+ offset 1)))
    377   (setq values (mapcar #'wrap-with-type-check (nreverse values) (sd-slots sd)))
     377  (setq values (mapcar #'wrap-with-type-declaration (nreverse values) (sd-slots sd)))
    378378  `(defun ,(car boa) ,(nreverse args)
    379379    ,(case (setq slot (defstruct-reftype (sd-type sd)))
Note: See TracChangeset for help on using the changeset viewer.