(when (and (constant-symbol-p class)
(let ((initargs-tail initargs))
(loop (when (null initargs-tail) (return t))
(when (and (constant-symbol-p class)
(let ((initargs-tail initargs))
(loop (when (null initargs-tail) (return t))
;; 1. Don't worry, I know what I'm doing.
;; 2. You and what army?
;; 3. If you were as smart as you think you are, you
;; 1. Don't worry, I know what I'm doing.
;; 2. You and what army?
;; 3. If you were as smart as you think you are, you
;; This is case #1.:-) Even if SYM hasn't been defined yet,
;; it must be an implementation function, or we we wouldn't
;; have expanded into it. So declare SYM as defined, so that
;; even if it hasn't been defined yet, the user doesn't get
;; obscure warnings about undefined internal implementation
;; functions like HAIRY-MAKE-instance-name.
;; This is case #1.:-) Even if SYM hasn't been defined yet,
;; it must be an implementation function, or we we wouldn't
;; have expanded into it. So declare SYM as defined, so that
;; even if it hasn't been defined yet, the user doesn't get
;; obscure warnings about undefined internal implementation
;; functions like HAIRY-MAKE-instance-name.
`(,sym ',class (list ,@initargs)))))))
(defmacro expanding-make-instance-toplevel (&rest forms &environment env)
`(,sym ',class (list ,@initargs)))))))
(defmacro expanding-make-instance-toplevel (&rest forms &environment env)
(cached-name (intern (format nil "~A-CACHED-~A" type name))))
`(defmacro ,reader-name (info)
`(let ((value (,',cached-name ,info)))
(cached-name (intern (format nil "~A-CACHED-~A" type name))))
`(defmacro ,reader-name (info)
`(let ((value (,',cached-name ,info)))
(defmacro reset-initialize-info-internal (info)
`(progn
,@(mapcar (lambda (cname)
(defmacro reset-initialize-info-internal (info)
`(progn
,@(mapcar (lambda (cname)
',cached-names)))
(defun initialize-info-bound-slots (info)
(let ((slots nil))
,@(mapcar (lambda (name cached-name)
',cached-names)))
(defun initialize-info-bound-slots (info)
(let ((slots nil))
,@(mapcar (lambda (name cached-name)
(and (every #'check-meth initialize-instance-methods)
(every #'check-meth shared-initialize-methods))))
(return-from get-make-instance-function nil))
(and (every #'check-meth initialize-instance-methods)
(every #'check-meth shared-initialize-methods))))
(return-from get-make-instance-function nil))
initialize-instance-methods)))))
(lambda (class1 initargs)
(if (not (eq wrapper (class-wrapper class)))
initialize-instance-methods)))))
(lambda (class1 initargs)
(if (not (eq wrapper (class-wrapper class)))
(fn (initialize-info-make-instance-function info)))
(declare (type function fn))
(funcall fn 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)))
(list wrapper *the-wrapper-of-t*))))
(lambda (class1 initargs)
(if (not (eq wrapper (class-wrapper class)))
(fn (initialize-info-make-instance-function info)))
(declare (type function fn))
(funcall fn 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)
(wrapper (class-wrapper class))
(constants (when simple-p
(make-list (wrapper-no-of-instance-slots wrapper)
(slots (class-slots class))
(slot-names (mapcar #'slot-definition-name slots))
(slots-key (mapcar (lambda (slot)
(slots (class-slots class))
(slot-names (mapcar #'slot-definition-name slots))
(slots-key (mapcar (lambda (slot)
(skip-when-instance-boundp
(let* ((pv-offset (cadr form))
(location (pvref pv pv-offset))
(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)
pv slots ,(const pv-offset)
,default
,(typecase (pvref pv pv-offset)
,@(let ((sforms (cons nil nil)))
(dotimes-fixnum (i (cadddr form) (car sforms))
(add-forms (first-form-to-lisp forms cvector pv)
,@(let ((sforms (cons nil nil)))
(dotimes-fixnum (i (cadddr form) (car sforms))
(add-forms (first-form-to-lisp forms cvector pv)