(defun expand-make-instance-form (form)
(let ((class (cadr form)) (initargs (cddr form))
- (keys nil)(allow-other-keys-p nil) key value)
+ (keys nil) (allow-other-keys-p nil) key value)
(when (and (constant-symbol-p class)
(let ((initargs-tail initargs))
(loop (when (null initargs-tail) (return t))
(return nil))
(setq key (eval (pop initargs-tail)))
(setq value (pop initargs-tail))
- (when (eq ':allow-other-keys key)
+ (when (eq :allow-other-keys key)
(setq allow-other-keys-p value))
(push key keys))))
(let* ((class (eval class))
(walk-form form env
(lambda (subform context env)
(declare (ignore env))
- (or (and (eq context ':eval)
+ (or (and (eq context :eval)
(consp subform)
(eq (car subform) 'make-instance)
(expand-make-instance-form subform))
(cached-name (intern (format nil "~A-CACHED-~A" type name))))
`(defmacro ,reader-name (info)
`(let ((value (,',cached-name ,info)))
- (if (eq value ':unknown)
+ (if (eq value :unknown)
(progn
(,',trap ,info ',',name)
(,',cached-name ,info))
(defmacro reset-initialize-info-internal (info)
`(progn
,@(mapcar (lambda (cname)
- `(setf (,cname ,info) ':unknown))
+ `(setf (,cname ,info) :unknown))
',cached-names)))
(defun initialize-info-bound-slots (info)
(let ((slots nil))
,@(mapcar (lambda (name cached-name)
- `(unless (eq ':unknown (,cached-name info))
+ `(unless (eq :unknown (,cached-name info))
(push ',name slots)))
*initialize-info-cached-slots* cached-names)
slots))
(eq (car (method-specializers meth))
*the-class-slot-object*)
(and (null (cdr quals))
- (or (eq (car quals) ':before)
- (eq (car quals) ':after)))))))
+ (or (eq (car quals) :before)
+ (eq (car quals) :after)))))))
(and (every #'check-meth initialize-instance-methods)
(every #'check-meth shared-initialize-methods))))
(return-from get-make-instance-function nil))
(defun complicated-instance-creation-method (m)
(let ((qual (method-qualifiers m)))
(if qual
- (not (and (null (cdr qual)) (eq (car qual) ':after)))
+ (not (and (null (cdr qual)) (eq (car qual) :after)))
(let ((specl (car (method-specializers m))))
(or (not (classp specl))
(not (eq 'slot-object (class-name specl))))))))
initialize-instance-methods)))))
(lambda (class1 initargs)
(if (not (eq wrapper (class-wrapper class)))
- (let* ((info (initialize-info class1 initargs))
+ (let* ((info (initialize-info (coerce-to-class class1) initargs))
(fn (initialize-info-make-instance-function info)))
(declare (type function fn))
(funcall fn class1 initargs))
(list wrapper *the-wrapper-of-t*))))
(lambda (class1 initargs)
(if (not (eq wrapper (class-wrapper class)))
- (let* ((info (initialize-info class1 initargs))
+ (let* ((info (initialize-info (coerce-to-class class1) initargs))
(fn (initialize-info-make-instance-function info)))
(declare (type function fn))
(funcall fn class1 initargs))
(wrapper (class-wrapper class))
(constants (when simple-p
(make-list (wrapper-no-of-instance-slots wrapper)
- ':initial-element +slot-unbound+)))
+ :initial-element +slot-unbound+)))
(slots (class-slots class))
(slot-names (mapcar #'slot-definition-name slots))
(slots-key (mapcar (lambda (slot)
`((instance-write-internal pv slots ,(const pv-offset) value
,default
,(typecase location
- (fixnum ':instance)
- (cons ':class)
- (t ':default)))))))
+ (fixnum :instance)
+ (cons :class)
+ (t :default)))))))
(skip-when-instance-boundp
(let* ((pv-offset (cadr form))
(location (pvref pv pv-offset))
pv slots ,(const pv-offset)
,default
,(typecase (pvref pv pv-offset)
- (fixnum ':instance)
- (cons ':class)
- (t ':default))))
+ (fixnum :instance)
+ (cons :class)
+ (t :default))))
,@(let ((sforms (cons nil nil)))
(dotimes-fixnum (i (cadddr form) (car sforms))
(add-forms (first-form-to-lisp forms cvector pv)