(sym (make-instance-function-symbol key)))
(push key *make-instance-function-keys*)
(when sym
- ;; MNA: cmucl-commit Sat, 27 Jan 2001 07:07:45 -0800 (PST)
- ;; Silence compiler warnings about undefined function
- ;; <hairy-make-instance-name>
- ;; when compiling a method containing a make-instance call.
- (progn ;; Lifted from c::%%defun.
- (sb-c::proclaim-as-function-name sym)
- (when (eq (sb-int:info :function :where-from sym) :assumed)
- (setf (sb-int:info :function :where-from sym) :defined)
- (when (sb-int:info :function :assumed-type sym)
- (setf (sb-int:info :function :assumed-type sym) nil))))
+ ;; (famous last words:
+ ;; 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
+ ;; wouldn't be a copy.
+ ;; 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.
+ (sb-kernel:become-defined-fun-name sym)
`(,sym ',class (list ,@initargs)))))))
-(defmacro expanding-make-instance-top-level (&rest forms &environment env)
+(defmacro expanding-make-instance-toplevel (&rest forms &environment env)
(let* ((*make-instance-function-keys* nil)
(form (macroexpand `(expanding-make-instance ,@forms) env)))
`(progn
subform))))
forms)))
-(defmacro defconstructor
- (name class lambda-list &rest initialization-arguments)
- `(expanding-make-instance-top-level
- (defun ,name ,lambda-list
- (make-instance ',class ,@initialization-arguments))))
-
(defun get-make-instance-functions (key-list)
(dolist (key key-list)
(let* ((cell (find-class-cell (car key)))
'initialize-info name)))
*initialize-info-cached-slots*)))
`(progn
- (defstruct initialize-info
+ (defstruct (initialize-info (:copier nil))
key wrapper
,@(mapcar #'(lambda (name)
`(,name :unknown))
(defvar *note-iis-entry-p* nil)
(defvar *compiled-initialize-instance-simple-functions*
- (make-hash-table :test #'equal))
+ (make-hash-table :test 'equal))
(defun initialize-instance-simple-function (use info class form-list)
(let* ((pv-cell (get-pv-cell-for-class class))
(defmacro precompile-iis-functions (&optional system)
`(progn
- ,@(gathering1 (collecting)
- (dolist (iis-entry *initialize-instance-simple-alist*)
- (when (or (null (caddr iis-entry))
- (eq (caddr iis-entry) system))
- (when system (setf (caddr iis-entry) system))
- (gather1
- `(load-precompiled-iis-entry
- ',(car iis-entry)
- #',(car iis-entry)
- ',system
- ',(cdddr iis-entry))))))))
+ ,@(let (collect)
+ (dolist (iis-entry *initialize-instance-simple-alist*)
+ (when (or (null (caddr iis-entry))
+ (eq (caddr iis-entry) system))
+ (when system (setf (caddr iis-entry) system))
+ (push `(load-precompiled-iis-entry
+ ',(car iis-entry)
+ #',(car iis-entry)
+ ',system
+ ',(cdddr iis-entry))
+ collect)))
+ (nreverse collect))))
(defun compile-iis-functions (after-p)
(let ((*compile-make-instance-functions-p* t)