X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fconstruct.lisp;h=5f3b40c96cfe507d56b0c05fb4c13e22342d2a22;hb=419ce099442b9bffe41eff8516c6a2be085259de;hp=bb1a24c61cae45ef24536708b17678bc94154123;hpb=475c832b081651e66ad9446d4852c62086f5e740;p=sbcl.git diff --git a/src/pcl/construct.lisp b/src/pcl/construct.lisp index bb1a24c..5f3b40c 100644 --- a/src/pcl/construct.lisp +++ b/src/pcl/construct.lisp @@ -202,12 +202,12 @@ :reader constructor-code-generators)) ;could use. (:metaclass funcallable-standard-class)) -;;; Because the value in the code-type slot should always correspond to the -;;; funcallable-instance-function of the constructor, this function should -;;; always be used to set the both at the same time. +;;; Because the value in the code-type slot should always correspond +;;; to the FUNCALLABLE-INSTANCE-FUN of the constructor, this function +;;; should always be used to set them both at the same time. (defun set-constructor-code (constructor code type) - (set-funcallable-instance-function constructor code) - (set-function-name constructor (constructor-name constructor)) + (set-funcallable-instance-fun constructor code) + (set-fun-name constructor (constructor-name constructor)) (setf (constructor-code-type constructor) type)) (defmethod describe-object ((constructor constructor) stream) @@ -221,8 +221,9 @@ (doplist (key val) (constructor-code-generators constructor) (gather1 key))))) -;;; I am not in a hairy enough mood to make this implementation be metacircular -;;; enough that it can support a defconstructor for constructor objects. +;;; I am not in a hairy enough mood to make this implementation be +;;; metacircular enough that it can support a defconstructor for +;;; constructor objects. (defun make-constructor (class name supplied-initarg-names code-generators) (make-instance 'constructor :class class @@ -253,9 +254,10 @@ name class) ()))) -;;; This is called to actually load a defconstructor constructor. It must -;;; install the lazy installer in the function cell of the constructor name, -;;; and also add this constructor to the list of constructors the class has. +;;; This is called to actually load a defconstructor constructor. It +;;; must install the lazy installer in the function cell of the +;;; constructor name, and also add this constructor to the list of +;;; constructors the class has. (defmethod load-constructor-internal ((class slot-class) name initargs generators) (let ((constructor (make-constructor class name initargs generators)) @@ -275,21 +277,23 @@ (apply constructor args))) 'lazy))) -;;; The interface to keeping the constructors updated. +;;; the interface to keeping the constructors updated ;;; -;;; add-method and remove-method (for standard-generic-function and -method), -;;; promise to call maybe-update-constructors on the generic function and -;;; the method. +;;; add-method and remove-method (for standard-generic-function and +;;; -method), promise to call maybe-update-constructors on the generic +;;; function and the method. ;;; -;;; The class update code promises to call update-constructors whenever the -;;; class is changed. That is, whenever the supers, slots or options change. -;;; If user defined classes of constructor needs to be updated in more than -;;; these circumstances, they should use the dependent updating mechanism to -;;; make sure update-constructors is called. +;;; The class update code promises to call update-constructors +;;; whenever the class is changed. That is, whenever the supers, slots +;;; or options change. If user defined classes of constructor needs to +;;; be updated in more than these circumstances, they should use the +;;; dependent updating mechanism to make sure update-constructors is +;;; called. ;;; -;;; Bootstrapping concerns force the definitions of maybe-update-constructors -;;; and update-constructors to be in the file std-class. For clarity, they -;;; also appear below. Be sure to keep the definition here and there in sync. +;;; Bootstrapping concerns force the definitions of +;;; maybe-update-constructors and update-constructors to be in the +;;; file std-class. For clarity, they also appear below. Be sure to +;;; keep the definition here and there in sync. ;(defvar *initialization-generic-functions* ; (list #'make-instance ; #'default-initargs @@ -443,7 +447,7 @@ (funcall fn constructor)) (dolist (subclass (class-direct-subclasses class)) (recurse subclass)))) - (recurse (find-class 't)) + (recurse (find-class t)) (values nclasses nconstructors)))) (defun reset-constructors () @@ -527,7 +531,7 @@ (when (eq flag ':unsupplied) (setq flag ':constants))) (t (push (cons name +slot-unbound+) constants) - (setq flag 't))))) + (setq flag t))))) (let* ((constants-alist (sort constants #'(lambda (x y) (memq (car y) (memq (car x) layout))))) @@ -637,7 +641,7 @@ (push val .initargs.) (push initarg .initargs.)) (dolist (pos (cddr entry)) - (setf (instance-ref .slots. pos) val)))) + (setf (clos-slots-ref .slots. pos) val)))) ,@(gathering1 (collecting) (doplist (initarg value) supplied-initargs @@ -646,7 +650,7 @@ (push .value. .initargs.) (push ',initarg .initargs.) (dolist (.p. (pop .positions.)) - (setf (instance-ref .slots. .p.) + (setf (clos-slots-ref .slots. .p.) .value.))))))) (dolist (fn .shared-initfns.) @@ -784,7 +788,7 @@ (dolist (entry .initfns-and-positions.) (let ((val (funcall (car entry)))) (dolist (pos (cdr entry)) - (setf (instance-ref .slots. pos) val)))) + (setf (clos-slots-ref .slots. pos) val)))) ,@(gathering1 (collecting) (doplist (initarg value) supplied-initargs @@ -792,7 +796,8 @@ (gather1 `(let ((.value. ,value)) (dolist (.p. (pop .positions.)) - (setf (instance-ref .slots. .p.) .value.))))))) + (setf (clos-slots-ref .slots. .p.) + .value.))))))) .instance.)))))))) @@ -914,8 +919,8 @@ (gather1 `(let ((.value. ,value)) (dolist (.p. (pop .positions.)) - (setf (instance-ref .slots. .p.) - .value.))))))) + (setf (clos-slots-ref .slots. .p.) + .value.))))))) .instance.))))))))))