X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcoerce.lisp;h=f1dca41e23bcb23ce367125109aef3bb56d8b0a1;hb=c7de1989d006e0b3a4f26143b7a81c9bdb754101;hp=576aba5965a36dc093ef0a295a71a9852ae10d0a;hpb=789a365f2d49a2d2774797dec5759a6e9c7e0d5a;p=sbcl.git

diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp
index 576aba5..f1dca41 100644
--- a/src/code/coerce.lisp
+++ b/src/code/coerce.lisp
@@ -116,11 +116,7 @@
 	((csubtypep type (specifier-type 'character))
 	 (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
@@ -132,7 +128,6 @@
 		  :expected-type '(satisfies fboundp)
 	       :format-control "~S isn't fbound."
 	       :format-arguments (list object)))
-	 #!+high-security
 	 (when (and (symbolp object)
 		    (sb!xc:macro-function object))
 	   (error 'simple-type-error
@@ -140,7 +135,6 @@
 		  :expected-type '(not (satisfies sb!xc:macro-function))
 		  :format-control "~S is a macro."
 		  :format-arguments (list object)))
-	 #!+high-security
 	 (when (and (symbolp object)
 		    (special-operator-p object))
 	   (error 'simple-type-error
@@ -150,46 +144,63 @@
 		  :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)
 	     (cond ((type= type (specifier-type 'list))