diff --git a/pcl/ctor.lisp b/pcl/ctor.lisp index 3aae7fd3ad16df092e312120315680312dcb29c9..3e10e9c522d443473246595975373d6214339df3 100644 --- a/pcl/ctor.lisp +++ b/pcl/ctor.lisp @@ -46,7 +46,7 @@ ;;; is called. (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/ctor.lisp,v 1.14 2003/07/01 14:49:39 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/ctor.lisp,v 1.15 2003/07/01 16:32:41 gerd Exp $") (in-package "PCL") @@ -110,6 +110,10 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (define-function-name-syntax ctor (name) + (when (symbolp (cadr name)) + (values t (cadr name)))) + + (define-function-name-syntax make-instance (name) (when (symbolp (cadr name)) (values t (cadr name))))) @@ -240,16 +244,19 @@ (defvar *the-system-si-method* nil) (defun install-optimized-constructor (ctor) - (flet ((install (optimized-p) - (without-package-locks - (multiple-value-bind (lambda fn) - (if optimized-p - (constructor-function-form ctor) - (fallback-generator ctor)) - (setf (kernel:funcallable-instance-function ctor) - (or fn - (letf (((compiler-macro-function 'make-instance) nil)) - (compile-lambda lambda)))))))) + (labels ((lambda-name (ctor) + (cons 'make-instance + (cdr (ctor-function-name ctor)))) + (install (optimized-p) + (without-package-locks + (multiple-value-bind (lambda fn) + (if optimized-p + (constructor-function-form ctor) + (fallback-generator ctor)) + (setf (kernel:funcallable-instance-function ctor) + (or fn + (letf (((compiler-macro-function 'make-instance) nil)) + (compile-lambda lambda :name (lambda-name ctor))))))))) (let ((class (find-class (ctor-class-name ctor) nil))) (setf (ctor-class ctor) class) (cond ((null class)