(defun constant-symbol-p (form)
(and (constantp form)
- (let ((constant (eval form)))
+ (let ((constant (constant-form-value form)))
(and (symbolp constant)
(not (null (symbol-package constant)))))))
(!defstruct-with-alternate-metaclass ctor
:slot-names (function-name class-name class initargs)
:boa-constructor %make-ctor
- :superclass-name pcl-funcallable-instance
+ :superclass-name function
:metaclass-name random-pcl-classoid
:metaclass-constructor make-random-pcl-classoid
:dd-type funcallable-structure
(loop for (key . more) on args by #'cddr do
(when (or (null more)
(not (constant-symbol-p key))
- (eq :allow-other-keys (eval key)))
+ (eq :allow-other-keys (constant-form-value key)))
(return-from make-instance->constructor-call nil)))))
(check-class)
(check-args)
;; VALUE-FORMS.
(multiple-value-bind (initargs value-forms)
(loop for (key value) on args by #'cddr and i from 0
- collect (eval key) into initargs
+ collect (constant-form-value key) into initargs
if (constantp value)
collect value into initargs
else
and collect value into value-forms
finally
(return (values initargs value-forms)))
- (let* ((class-name (eval class-name))
+ (let* ((class-name (constant-form-value class-name))
(function-name (make-ctor-function-name class-name initargs)))
;; Prevent compiler warnings for calling the ctor.
(proclaim-as-fun-name function-name)
;; calling it with a class, as here, we inhibit the optimization,
;; so removing the possibility of endless recursion. -- CSR,
;; 2004-07-12
- (make-instance ,(ctor-class ctor) ,@(ctor-initargs ctor))))
+ (make-instance ,(ctor-class ctor)
+ ,@(quote-plist-keys (ctor-initargs ctor)))))
(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))
`(when (eq (clos-slots-ref .slots. ,i)
+slot-unbound+)
(setf (clos-slots-ref .slots. ,i)
- ',(eval value)))
+ ',(constant-form-value value)))
`(setf (clos-slots-ref .slots. ,i)
- ',(eval value))))
+ ',(constant-form-value value))))
(constant
- `(setf (clos-slots-ref .slots. ,i) ',(eval value)))))))
+ `(setf (clos-slots-ref .slots. ,i)
+ ',(constant-form-value value)))))))
;; we are not allowed to modify QUOTEd locations, so we can't
;; generate code like (setf (cdr ',location) arg). Instead,
;; we have to do (setf (cdr .L0.) arg) and arrange for .L0. to
collect location into locations
collect `(setf (cdr ,name)
,(case type
- (constant `',(eval value))
+ (constant `',(constant-form-value 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))))))))