X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcoerce.lisp;h=1d05f63ac2502cf3b2e17919ec9fe35bf5b1d452;hb=860543cc7ba0266e41e1d41ac9b6a208f3795f1a;hp=dfd208d1cb616531d45db4ae6ca9ba85065fb881;hpb=627c66211b93537e90c08b34b387edbd7e301011;p=sbcl.git

diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp
index dfd208d..1d05f63 100644
--- a/src/code/coerce.lisp
+++ b/src/code/coerce.lisp
@@ -117,10 +117,7 @@
 	 (character object))
 	((csubtypep type (specifier-type 'function))
 	 #!+high-security
-	 (when (and (or (symbolp object)
-			(and (listp object)
-			     (= (length object) 2)
-			     (eq (car object) 'setf)))
+	 (when (and (legal-fun-name-p object)
 		    (not (fboundp object)))
 	   (error 'simple-type-error
 		  :datum object
@@ -150,52 +147,82 @@
 		  :format-arguments (list object)))
 	 (eval `#',object))
 	((numberp object)
-	 (let ((res
-		(cond
-		  ((csubtypep type (specifier-type 'single-float))
-		   (%single-float object))
-		  ((csubtypep type (specifier-type 'double-float))
-		   (%double-float object))
-		  #!+long-float
-		  ((csubtypep type (specifier-type 'long-float))
-		   (%long-float object))
-		  ((csubtypep type (specifier-type 'float))
-		   (%single-float object))
-		  ((csubtypep type (specifier-type '(complex single-float)))
-		   (complex (%single-float (realpart object))
-			    (%single-float (imagpart object))))
-		  ((csubtypep type (specifier-type '(complex double-float)))
-		   (complex (%double-float (realpart object))
-			    (%double-float (imagpart object))))
-		  #!+long-float
-		  ((csubtypep type (specifier-type '(complex long-float)))
-		   (complex (%long-float (realpart object))
-			    (%long-float (imagpart object))))
-		  ((and (typep object 'rational)
-			(csubtypep type (specifier-type '(complex float))))
-		   ;; Perhaps somewhat surprisingly, ANSI specifies
-		   ;; that (COERCE FOO 'FLOAT) is a SINGLE-FLOAT, not
-		   ;; dispatching on *READ-DEFAULT-FLOAT-FORMAT*.  By
-		   ;; analogy, we do the same for complex numbers. --
-		   ;; CSR, 2002-08-06
-		   (complex (%single-float object)))
-		  ((csubtypep type (specifier-type 'complex))
-		   (complex object))
-		  (t
-		   (coerce-error)))))
-	   ;; If RES has the wrong type, that means that rule of canonical
-	   ;; representation for complex rationals was invoked. According to
-	   ;; the Hyperspec, (coerce 7/2 'complex) returns 7/2. Thus, if the
-	   ;; object was a rational, there is no error here.
-	   (unless (or (typep res output-type-spec) (rationalp object))
-	     (coerce-error))
-	   res))
+	 (cond
+	   ((csubtypep type (specifier-type 'single-float))
+	    (let ((res (%single-float object)))
+	      (unless (typep res output-type-spec)
+		(coerce-error))
+	      res))
+	   ((csubtypep type (specifier-type 'double-float))
+	    (let ((res (%double-float object)))
+	      (unless (typep res output-type-spec)
+		(coerce-error))
+	      res))
+	   #!+long-float
+	   ((csubtypep type (specifier-type 'long-float))
+	    (let ((res (%long-float object)))
+	      (unless (typep res output-type-spec)
+		(coerce-error))
+	      res))
+	   ((csubtypep type (specifier-type 'float))
+	    (let ((res (%single-float object)))
+	      (unless (typep res output-type-spec)
+		(coerce-error))
+	      res))
+	   (t
+	    (let ((res
+		   (cond
+		     ((csubtypep type (specifier-type '(complex single-float)))
+		      (complex (%single-float (realpart object))
+			       (%single-float (imagpart object))))
+		     ((csubtypep type (specifier-type '(complex double-float)))
+		      (complex (%double-float (realpart object))
+			       (%double-float (imagpart object))))
+		     #!+long-float
+		     ((csubtypep type (specifier-type '(complex long-float)))
+		      (complex (%long-float (realpart object))
+			       (%long-float (imagpart object))))
+		     ((and (typep object 'rational)
+			   (csubtypep type (specifier-type '(complex float))))
+		      ;; Perhaps somewhat surprisingly, ANSI specifies
+		      ;; that (COERCE FOO 'FLOAT) is a SINGLE-FLOAT,
+		      ;; not dispatching on
+		      ;; *READ-DEFAULT-FLOAT-FORMAT*.  By analogy, we
+		      ;; do the same for complex numbers. -- CSR,
+		      ;; 2002-08-06
+		      (complex (%single-float object)))
+		     ((csubtypep type (specifier-type 'complex))
+		      (complex object))
+		     (t
+		      (coerce-error)))))
+	      ;; If RES has the wrong type, that means that rule of
+	      ;; canonical representation for complex rationals was
+	      ;; invoked. According to the Hyperspec, (coerce 7/2
+	      ;; 'complex) returns 7/2. Thus, if the object was a
+	      ;; rational, there is no error here.
+	      (unless (or (typep res output-type-spec)
+			  (rationalp object))
+		(coerce-error))
+	      res))))
 	((csubtypep type (specifier-type 'list))
 	 (if (vectorp object)
-	     (vector-to-list* object)
+	     (cond ((type= type (specifier-type 'list))
+		    (vector-to-list* object))
+		   ((type= type (specifier-type 'null))
+		    (if (= (length object) 0)
+			'nil
+			(sequence-type-length-mismatch-error type
+							     (length object))))
+		   ((csubtypep (specifier-type '(cons nil t)) type)
+		    (if (> (length object) 0)
+			(vector-to-list* object)
+			(sequence-type-length-mismatch-error type 0)))
+		   (t (sequence-type-too-hairy (type-specifier type))))
 	     (coerce-error)))
 	((csubtypep type (specifier-type 'vector))
 	 (typecase object
+	   ;; FOO-TO-VECTOR* go through MAKE-SEQUENCE, so length
+	   ;; errors are caught there. -- CSR, 2002-10-18
 	   (list (list-to-vector* object output-type-spec))
 	   (vector (vector-to-vector* object output-type-spec))
 	   (t