X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fseqtran.lisp;h=647a8626f8f1cace2baca91988c6cf640f22c09d;hb=670010e3f3dcd62efaf23f61abdc73950edb88c6;hp=acaef21ac1a09af29b0b29e9f6be0c810e1acbb9;hpb=e795ac27a9780a35a7d561bfe34d7df224958fbd;p=sbcl.git

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index acaef21..647a862 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -75,8 +75,8 @@
 ;;; MAP is %MAP plus a check to make sure that any length specified in
 ;;; the result type matches the actual result. We also wrap it in a
 ;;; TRULY-THE for the most specific type we can determine.
-(deftransform map ((result-type-arg fun &rest seqs) * * :node node)
-  (let* ((seq-names (make-gensym-list (length seqs)))
+(deftransform map ((result-type-arg fun seq &rest seqs) * * :node node)
+  (let* ((seq-names (make-gensym-list (1+ (length seqs))))
 	 (bare `(%map result-type-arg fun ,@seq-names))
 	 (constant-result-type-arg-p (constant-continuation-p result-type-arg))
 	 ;; what we know about the type of the result. (Note that the
@@ -130,7 +130,7 @@
   (declare (type list seqs seq-names)
            (type symbol into))
   (collect ((bindings)
-           (declarations)
+	    (declarations)
             (vector-lengths)
             (tests)
             (places))
@@ -145,7 +145,7 @@
            for seq-name in seq-names
            for type = (continuation-type seq)
            do (cond ((csubtypep type (specifier-type 'list))
-                     (let ((index (gensym "I")))
+		     (with-unique-names (index)
                        (bindings `(,index ,seq-name (cdr ,index)))
                        (declarations `(type list ,index))
                        (places `(car ,index))
@@ -180,9 +180,9 @@
 ;;; handle that case more efficiently, but it's left as an exercise to
 ;;; the reader, because the code is complicated enough already and I
 ;;; don't happen to need that functionality right now. -- WHN 20000410
-(deftransform %map ((result-type fun &rest seqs) * * :policy (>= speed space))
+(deftransform %map ((result-type fun seq &rest seqs) * *
+		    :policy (>= speed space))
   "open code"
-  (unless seqs (abort-ir1-transform "no sequence args"))
   (unless (constant-continuation-p result-type)
     (give-up-ir1-transform "RESULT-TYPE argument not constant"))
   (labels ( ;; 1-valued SUBTYPEP, fails unless second value of SUBTYPEP is true
@@ -202,24 +202,25 @@
 				   (t
 				    (give-up-ir1-transform
 				     "can't determine result type")))))
-      (cond ((and result-type-value (= 1 (length seqs)))
+      (cond ((and result-type-value (null seqs))
 	     ;; The consing arity-1 cases can be implemented
 	     ;; reasonably efficiently as function calls, and the cost
 	     ;; of consing should be significantly larger than
 	     ;; function call overhead, so we always compile these
 	     ;; cases as full calls regardless of speed-versus-space
 	     ;; optimization policy.
-	     (cond ((subtypep 'list result-type-value)
-		    '(apply #'%map-to-list-arity-1 fun seqs))
+	     (cond ((subtypep result-type-value 'list)
+		    '(%map-to-list-arity-1 fun seq))
 		   ( ;; (This one can be inefficient due to COERCE, but
 		    ;; the current open-coded implementation has the
 		    ;; same problem.)
 		    (subtypep result-type-value 'vector)
-		    `(coerce (apply #'%map-to-simple-vector-arity-1 fun seqs)
+		    `(coerce (%map-to-simple-vector-arity-1 fun seq)
 			     ',result-type-value))
 		   (t (bug "impossible (?) sequence type"))))
 	    (t
-	     (let* ((seq-args (make-gensym-list (length seqs))))
+	     (let* ((seqs (cons seq seqs))
+		    (seq-args (make-gensym-list (length seqs))))
 	       (multiple-value-bind (push-dacc result)
 		   (ecase result-supertype
 		     (null (values nil nil))
@@ -865,13 +866,7 @@
 							    end-arg
 							    element
 							    done-p-expr)
-  (let ((offset (gensym "OFFSET"))
-	(block (gensym "BLOCK"))
-	(index (gensym "INDEX"))
-	(n-sequence (gensym "N-SEQUENCE-"))
-	(sequence (gensym "SEQUENCE"))
-	(n-end (gensym "N-END-"))
-	(end (gensym "END-")))
+  (with-unique-names (offset block index n-sequence sequence n-end end)
     `(let ((,n-sequence ,sequence-arg)
 	   (,n-end ,end-arg))
        (with-array-data ((,sequence ,n-sequence :offset-var ,offset)
@@ -900,7 +895,7 @@
 
 (def!macro %find-position-vector-macro (item sequence
 					     from-end start end key test)
-  (let ((element (gensym "ELEMENT")))
+  (with-unique-names (element)
     (%find-position-or-find-position-if-vector-expansion
      sequence
      from-end
@@ -914,7 +909,7 @@
 
 (def!macro %find-position-if-vector-macro (predicate sequence
 						     from-end start end key)
-  (let ((element (gensym "ELEMENT")))
+  (with-unique-names (element)
     (%find-position-or-find-position-if-vector-expansion
      sequence
      from-end
@@ -925,7 +920,7 @@
 
 (def!macro %find-position-if-not-vector-macro (predicate sequence
 							 from-end start end key)
-  (let ((element (gensym "ELEMENT")))
+  (with-unique-names (element)
     (%find-position-or-find-position-if-vector-expansion
      sequence
      from-end