[slime-cvs] CVS update: slime/ChangeLog slime/swank.lisp

[Edi Weitz]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv32297

Modified Files:
	ChangeLog swank.lisp 
Log Message:
New version of SWANK::TRANSPOSE-LISTS

Date: Tue Aug  9 15:56:55 2005
Author: eweitz

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.735 slime/ChangeLog:1.736
--- slime/ChangeLog:1.735	Mon Aug  8 18:32:02 2005
+++ slime/ChangeLog	Tue Aug  9 15:56:54 2005
@@ -1,3 +1,8 @@
+2005-08-09  Edi Weitz  <edi at agharta.de>
+
+	* swank.lisp (transpose-lists): Reimplemented without APPLY so we
+	don't have problems with CALL-ARGUMENTS-LIMIT.
+
 2005-08-08  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
 
 	* slime.el (undo-in-progress): Define for XEmacs compatibility.


Index: slime/swank.lisp
diff -u slime/swank.lisp:1.319 slime/swank.lisp:1.320
--- slime/swank.lisp:1.319	Sat Aug  6 16:50:20 2005
+++ slime/swank.lisp	Tue Aug  9 15:56:54 2005
@@ -2566,8 +2566,17 @@
 For example:
 \(transpose-lists '((ONE TWO THREE) (1 2)))
   => ((ONE 1) (TWO 2))"
-  ;; A cute function from PAIP p.574
-  (if lists (apply #'mapcar #'list lists)))
+  (catch 'done
+    (loop with result
+          with collectors = (loop for list in lists
+                                  collect (let ((list list))
+                                            (lambda ()
+                                              (cond ((null list)
+                                                     (throw 'done result))
+                                                    (t (pop list))))))
+          collect (loop for collector in collectors
+                        collect (funcall collector)) into temp-result
+          do (setq result temp-result))))
 
 
 ;;;;; Completion Tests