diff --git a/pcl/construct.lisp b/pcl/construct.lisp index 17784e2fe792b510c81721bf1d0c3e075501eace..d03ef61d3fc56a10485224f223d8405d5a8bbfdd 100644 --- a/pcl/construct.lisp +++ b/pcl/construct.lisp @@ -178,7 +178,8 @@ ;;; ;;; The actual constructor objects. ;;; -(defclass constructor () +#+nil ; Class definition moved to defs.lisp. +(defclass constructor (standard-object #+cmu17 kernel:funcallable-instance) ((class ;The class with which this :initarg :class ;constructor is associated. :reader constructor-class) ;The actual class object, @@ -294,13 +295,11 @@ (defmethod install-lazy-constructor-installer ((constructor constructor)) (let ((class (constructor-class constructor))) (set-constructor-code constructor - #'(lambda (&rest args) + #'(#+cmu kernel:instance-lambda #-cmu lambda (&rest args) (multiple-value-bind (code type) (compute-constructor-code class constructor) - (prog1 (apply code args) - (set-constructor-code constructor - code - type)))) + (set-constructor-code constructor code type) + (apply constructor args))) 'lazy))) ;;; @@ -627,7 +626,7 @@ (lambda (&rest ignore) (declare (ignore ignore)) (function - (lambda ,arglist + (#+cmu kernel:instance-lambda #-cmu lambda ,arglist (make-instance ',(class-name class) ,@(gathering1 (collecting) @@ -669,7 +668,7 @@ (null (non-pcl-or-after-shared-initialize-methods-p shared))) (function - (lambda ,arglist + (#+cmu kernel:instance-lambda #-cmu lambda ,arglist (declare #.*optimize-speed*) (let* ((.instance. (,raw-allocator .wrapper. .constants.)) (.slots. (,slots-fetcher .instance.)) @@ -829,7 +828,7 @@ (when (and .constants. (null (non-pcl-initialize-instance-methods-p init)) (null (non-pcl-shared-initialize-methods-p shared))) - #'(lambda ,arglist + #'(#+cmu kernel:instance-lambda #-cmu lambda ,arglist (declare #.*optimize-speed*) (let* ((.instance. (,raw-allocator .wrapper. .constants.)) (.slots. (,slots-fetcher .instance.)) @@ -963,7 +962,7 @@ ',supplied-initargs) (when .constants. (function - (lambda ,arglist + (#+cmu kernel:instance-lambda #-cmu lambda ,arglist (declare #.*optimize-speed*) (let* ((.instance. (,raw-allocator .wrapper. .constants.)) (.slots. (,slots-fetcher .instance.)) diff --git a/pcl/defs.lisp b/pcl/defs.lisp index 976b9c18a6f3a85f0c1033d79a7e6b2af87105ce..4d22c16776c007067013319befb31936f14dccd5 100644 --- a/pcl/defs.lisp +++ b/pcl/defs.lisp @@ -954,6 +954,43 @@ (options :reader method-combination-options :initarg :options))) +;;; +;;; The constructor objects. See construct.lisp. +;;; +(defclass constructor (standard-object #+cmu17 kernel:funcallable-instance) + ((class ;The class with which this + :initarg :class ;constructor is associated. + :reader constructor-class) ;The actual class object, + ;not the class name. + ; + (name ;The name of this constructor. + :initform nil ;This is the symbol in whose + :initarg :name ;function cell the constructor + :reader constructor-name) ;usually sits. Of course, this + ;is optional. defconstructor + ;makes named constructors, but + ;it is possible to manipulate + ;anonymous constructors also. + ; + (code-type ;The type of code currently in + :initform nil ;use by this constructor. This + :accessor constructor-code-type) ;is mostly for debugging and + ;analysis purposes. + ;The lazy installer sets this + ;to LAZY. The most basic and + ;least optimized type of code + ;is called FALLBACK. + ; + (supplied-initarg-names ;The names of the initargs this + :initarg :supplied-initarg-names ;constructor supplies when it + :reader ;"calls" make-instance. + constructor-supplied-initarg-names) ; + ; + (code-generators ;Generators for the different + :initarg :code-generators ;types of code this constructor + :reader constructor-code-generators)) ;could use. + (:metaclass funcallable-standard-class)) + (defparameter *early-class-predicates* '((specializer specializerp) (exact-class-specializer exact-class-specializer-p) diff --git a/pcl/defsys.lisp b/pcl/defsys.lisp index bc1e6234322e051fbf38b715e5ed06a8b41b9a3a..26b264f4de47d43823980184cb7b97d38f429295 100644 --- a/pcl/defsys.lisp +++ b/pcl/defsys.lisp @@ -602,7 +602,6 @@ and load your system with: (fixup t t (boot defs low fin)) (defcombin t t (defclass boot defs low fin)) (ctypes t t (defclass defcombin)) - #+ignore (construct t t (defclass boot defs low)) (env t t (defclass boot defs low fin)) (compat t t ())