X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftypetran.lisp;h=e569f477e63648dfdb07d4d175df22ec58df2637;hb=872175cd9cb5b4966a36d4bd92421cc407a0355b;hp=25e3cf9575ec41dd81cf353a4b55bf160013a11f;hpb=5b06386093fe448abe3a9086fae4f8e15709d8a3;p=sbcl.git

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 25e3cf9..e569f47 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -542,54 +542,23 @@
 
 ;;;; coercion
 
-;;; old working version
 (deftransform coerce ((x type) (* *) * :when :both)
   (unless (constant-continuation-p type)
     (give-up-ir1-transform))
   (let ((tspec (specifier-type (continuation-value type))))
     (if (csubtypep (continuation-type x) tspec)
 	'x
+	;; Note: The THE here makes sure that specifiers like
+	;; (SINGLE-FLOAT 0.0 1.0) can raise a TYPE-ERROR.
 	`(the ,(continuation-value type)
-	      ,(cond ((csubtypep tspec (specifier-type 'double-float))
-		      '(%double-float x))	
-		     ;; FIXME: If LONG-FLOAT is to be supported, we
-		     ;; need to pick it off here before falling through
-		     ;; to %SINGLE-FLOAT.
-		     ((csubtypep tspec (specifier-type 'float))
-		      '(%single-float x))
-		     (t
-		      (give-up-ir1-transform)))))))
+	   ,(cond
+	     ((csubtypep tspec (specifier-type 'double-float))
+	      '(%double-float x))	
+	     ;; FIXME: #!+long-float (t ,(error "LONG-FLOAT case needed"))
+	     ((csubtypep tspec (specifier-type 'float))
+	      '(%single-float x))
+	     ((csubtypep tspec (specifier-type 'simple-vector))
+	      '(coerce-to-simple-vector x))
+	     (t
+	      (give-up-ir1-transform)))))))
 
-;;; KLUDGE: new broken version -- 20000504
-;;; FIXME: should be fixed or deleted
-#+nil
-(deftransform coerce ((x type) (* *) * :when :both)
-  (unless (constant-continuation-p type)
-    (give-up-ir1-transform))
-  (let ((tspec (specifier-type (continuation-value type))))
-    (if (csubtypep (continuation-type x) tspec)
-	'x
-	`(if #+nil (typep x type) #-nil nil
-	     x
-	     (the ,(continuation-value type)
-		  ,(cond ((csubtypep tspec (specifier-type 'double-float))
-			  '(%double-float x))	
-			 ;; FIXME: If LONG-FLOAT is to be supported,
-			 ;; we need to pick it off here before falling
-			 ;; through to %SINGLE-FLOAT.
-			 ((csubtypep tspec (specifier-type 'float))
-			  '(%single-float x))
-			 #+nil
-			 ((csubtypep tspec (specifier-type 'list))
-			  '(coerce-to-list x))
-			 #+nil
-			 ((csubtypep tspec (specifier-type 'string))
-			  '(coerce-to-simple-string x))
-			 #+nil
-			 ((csubtypep tspec (specifier-type 'bit-vector))
-			  '(coerce-to-bit-vector x))
-			 #+nil
-			 ((csubtypep tspec (specifier-type 'vector))
-			  '(coerce-to-vector x type))
-			 (t
-			  (give-up-ir1-transform))))))))