X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefbangstruct.lisp;h=db3965a1d23393d345bdcfd7a79eaa25517605e3;hb=b0b168c08b31a748150f404398af754f26fd4813;hp=fecf0f8cd90d62fafe10c769b8d0fdb6a2d847f2;hpb=0b3ec4b1d978b887db175b7b3bada8e727683e15;p=sbcl.git diff --git a/src/code/defbangstruct.lisp b/src/code/defbangstruct.lisp index fecf0f8..db3965a 100644 --- a/src/code/defbangstruct.lisp +++ b/src/code/defbangstruct.lisp @@ -28,9 +28,6 @@ ;;; information for DEF!STRUCT-defined types (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) - ;; FIXME: All this could be byte compiled. (Perhaps most of the rest - ;; of the file could be, too.) - ;; (DEF!STRUCT-SUPERTYPE TYPE) is the DEF!STRUCT-defined type that ;; TYPE inherits from, or NIL if none. (defvar *def!struct-supertype* (make-hash-table)) @@ -71,7 +68,7 @@ (defun (setf def!struct-type-make-load-form-fun) (new-value type) (when #+sb-xc-host t #-sb-xc-host *type-system-initialized* (aver (subtypep type 'structure!object)) - (check-type new-value def!struct-type-make-load-form-fun)) + (aver (typep new-value 'def!struct-type-make-load-form-fun))) (setf (gethash type *def!struct-type-make-load-form-fun*) new-value))) ;;; the simplest, most vanilla MAKE-LOAD-FORM function for DEF!STRUCT @@ -100,7 +97,7 @@ ;; a description of a DEF!STRUCT call to be stored until we get ;; enough of the system running to finish processing it (defstruct delayed-def!struct - (args (required-argument) :type cons) + (args (missing-arg) :type cons) (package (sane-package) :type package)) ;; a list of DELAYED-DEF!STRUCTs stored until we get DEF!STRUCT ;; working fully so that we can apply it to them then. After @@ -146,30 +143,32 @@ #+sb-xc-host (progn (defun %instance-length (instance) - (check-type instance structure!object) + (aver (typep instance 'structure!object)) (layout-length (class-layout (sb!xc:find-class (type-of instance))))) (defun %instance-ref (instance index) - (check-type instance structure!object) + (aver (typep instance 'structure!object)) (let* ((class (sb!xc:find-class (type-of instance))) (layout (class-layout class))) (if (zerop index) layout (let* ((dd (layout-info layout)) (dsd (elt (dd-slots dd) (1- index))) - (accessor (dsd-accessor dsd))) - (declare (type symbol accessor)) - (funcall accessor instance))))) + (accessor-name (dsd-accessor-name dsd))) + (declare (type symbol accessor-name)) + (funcall accessor-name instance))))) (defun %instance-set (instance index new-value) - (check-type instance structure!object) + (aver (typep instance 'structure!object)) (let* ((class (sb!xc:find-class (type-of instance))) (layout (class-layout class))) (if (zerop index) (error "can't set %INSTANCE-REF FOO 0 in cross-compilation host") (let* ((dd (layout-info layout)) (dsd (elt (dd-slots dd) (1- index))) - (accessor (dsd-accessor dsd))) - (declare (type symbol accessor)) - (funcall (fdefinition `(setf ,accessor)) new-value instance)))))) + (accessor-name (dsd-accessor-name dsd))) + (declare (type symbol accessor-name)) + (funcall (fdefinition `(setf ,accessor-name)) + new-value + instance)))))) ;;; a helper function for DEF!STRUCT in the #+SB-XC-HOST case: Return ;;; DEFSTRUCT-style arguments with any class names in the SB!XC