X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Ffast-init.lisp;h=88219f56714dfc516f60497e180091eb17e97071;hb=85b5d31eda93a427acf97f835f78654a9b5c4f4f;hp=c3d28ab99411c55c317f4c6046eef7e83913e939;hpb=d40a76606c86722b0aef8179155f9f2840739b72;p=sbcl.git

diff --git a/src/pcl/fast-init.lisp b/src/pcl/fast-init.lisp
index c3d28ab..88219f5 100644
--- a/src/pcl/fast-init.lisp
+++ b/src/pcl/fast-init.lisp
@@ -43,7 +43,7 @@
 
 (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))
@@ -51,7 +51,7 @@
 			 (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))
@@ -64,7 +64,7 @@
 	  ;;   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.
+	  ;;      wouldn't be a cop.
 	  ;; 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
@@ -88,7 +88,7 @@
 		 (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))
@@ -128,8 +128,9 @@
 		(*print-case* :upcase)
 		(*print-pretty* nil))
 	    (intern (format nil
-			    "MAKE-INSTANCE ~S ~S ~S"
-			    class-name
+			    "MAKE-INSTANCE ~A::~A ~S ~S"
+			    (package-name (symbol-package class-name))
+			    (symbol-name class-name)
 			    keys
 			    allow-other-keys-p))))))))
 
@@ -141,7 +142,7 @@
 	(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))
@@ -180,12 +181,12 @@
        (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))
@@ -391,8 +392,8 @@
 				  (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))
@@ -431,7 +432,7 @@
 (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))))))))
@@ -491,7 +492,7 @@
 				      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))
@@ -534,7 +535,7 @@
 	     (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))
@@ -619,7 +620,7 @@
 	 (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)
@@ -856,9 +857,9 @@
 	       `((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))
@@ -878,9 +879,9 @@
 			    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)