[slime-cvs] CVS slime

[CVS User sboukarev]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv20750

Modified Files:
	ChangeLog swank-lispworks.lisp 
Log Message:
swank-lispworks.lisp (replace-strings-with-symbols): Didn't work on
non-proper lists. Reported by Madhu.


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/26 23:24:50	1.1866
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/28 11:33:43	1.1867
@@ -1,3 +1,8 @@
+2009-09-28  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-lispworks.lisp (replace-strings-with-symbols): Didn't work on
+	non-proper lists. Reported by Madhu.
+
 2009-09-27  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* swank-sbcl.lisp (call-with-debugger-hook): Correctly deal with
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/09/02 17:21:15	1.132
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/09/28 11:33:43	1.133
@@ -184,18 +184,26 @@
 
 ;;;; Documentation
 
+(defun map-list (function list)
+  "Map over proper and not proper lists."
+  (loop for (car . cdr) on list
+        collect (funcall function car) into result
+        when (null cdr) return result
+        when (atom cdr) return (nconc result (funcall function cdr))))
+
 (defun replace-strings-with-symbols (tree)
-  (mapcar (lambda (x)
-            (typecase x
-              (list
-               (replace-strings-with-symbols x))
-              (symbol
-               x)
-              (string
-               (intern x))
-              (t
-               (intern (write-to-string x)))))
-          tree))
+  (map-list
+   (lambda (x)
+     (typecase x
+       (list
+        (replace-strings-with-symbols x))
+       (symbol
+        x)
+       (string
+        (intern x))
+       (t
+        (intern (write-to-string x)))))
+   tree))
                
 (defimplementation arglist (symbol-or-function)
   (let ((arglist (lw:function-lambda-list symbol-or-function)))