(!defstruct-with-alternate-metaclass ctor
:slot-names (function-name class-name class initargs)
:boa-constructor %make-ctor
- :superclass-name pcl-funcallable-instance
+ :superclass-name funcallable-instance
:metaclass-name random-pcl-classoid
:metaclass-constructor make-random-pcl-classoid
:dd-type funcallable-structure
(setf (ctor-class ctor) class)
(pushnew ctor (plist-value class 'ctors))
(setf (funcallable-instance-fun ctor)
- ;; KLUDGE: Gerd here has the equivalent of (COMPILE NIL
- ;; (CONSTRUCTOR-FUNCTION-FORM)), but SBCL's COMPILE doesn't
- ;; deal with INSTANCE-LAMBDA expressions, only with LAMBDA
- ;; expressions. The below should be equivalent, since we
- ;; have a compiler-only implementation.
- ;;
- ;; (except maybe for optimization qualities? -- CSR,
- ;; 2004-07-12)
- ;;
- ;; FIXME: INSTANCE-LAMBDA is no more. We could change this.
(multiple-value-bind (form locations names)
(constructor-function-form ctor)
(apply (compile nil `(lambda ,names ,form)) locations)))))
(defun optimizing-generator (ctor ii-methods si-methods)
(multiple-value-bind (locations names body before-method-p)
(fake-initialization-emf ctor ii-methods si-methods)
- (values
+ (values
`(lambda ,(make-ctor-parameter-list ctor)
(declare #.*optimize-speed*)
,(wrap-in-allocate-forms ctor body before-method-p))
,(case type
(constant `',(eval value))
((param var) `,value)
- (initfn `(funcall ,value))))
+ (initfn `(funcall ,value))))
into class-init-forms
finally (return (values names locations class-init-forms)))
(multiple-value-bind (vars bindings)
collect var into vars
collect `(,var (funcall ,initfn)) into bindings
finally (return (values vars bindings)))
- (values locations names
- bindings vars
+ (values locations names
+ bindings vars
(nreverse defaulting-initargs)
`(,@(delete nil instance-init-forms)
,@class-init-forms))))))))