X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fseqtran.lisp;h=660f804fcde86c6f5d64336cf66b408d5d9f797b;hb=91392754bf1d241cd6913c728268caf18eae1485;hp=9792a4bcc040882d412dcbe60c7673ac2607f0ca;hpb=627c66211b93537e90c08b34b387edbd7e301011;p=sbcl.git

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 9792a4b..660f804 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -87,20 +87,33 @@
 				result-type-arg-value)))))
     `(lambda (result-type-arg fun ,@seq-names)
        (truly-the ,result-type
-	 ,(cond ((policy node (> speed safety))
+	 ,(cond ((policy node (< safety 3))
+		 ;; ANSI requires the length-related type check only
+		 ;; when the SAFETY quality is 3... in other cases, we
+		 ;; skip it, because it could be expensive.
 		 bare)
 		((not constant-result-type-arg-p)
 		 `(sequence-of-checked-length-given-type ,bare
 							 result-type-arg))
 		(t
-		 (let ((result-ctype (ir1-transform-specifier-type result-type)))
+		 (let ((result-ctype (ir1-transform-specifier-type
+				      result-type)))
 		   (if (array-type-p result-ctype)
-		       (let* ((dims (array-type-dimensions result-ctype))
-			      (dim (first dims)))
-			 (if (eq dim '*)
-			     bare
-			     `(vector-of-checked-length-given-length ,bare
-								     ,dim)))
+		       (let ((dims (array-type-dimensions result-ctype)))
+			 (unless (and (listp dims) (= (length dims) 1))
+			   (give-up-ir1-transform "invalid sequence type"))
+			 (let ((dim (first dims)))
+			   (if (eq dim '*)
+			       bare
+			       `(vector-of-checked-length-given-length ,bare
+				                                       ,dim))))
+		       ;; FIXME: this is wrong, as not all subtypes of
+		       ;; VECTOR are ARRAY-TYPEs [consider, for
+		       ;; example, (OR (VECTOR T 3) (VECTOR T
+		       ;; 4))]. However, it's difficult to see what we
+		       ;; should put here... maybe we should
+		       ;; GIVE-UP-IR1-TRANSFORM if the type is a
+		       ;; subtype of VECTOR but not an ARRAY-TYPE?
 		       bare))))))))
 
 ;;; Try to compile %MAP efficiently when we can determine sequence