[Sbcl-commits] CVS: sbcl/src/compiler ir1util.lisp, 1.109, 1.110 locall.lisp, 1.82, 1.83

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv26074/src/compiler

Modified Files:
	ir1util.lisp locall.lisp 
Log Message:
1.0.13.36: better HAIRY-FUNCTION-ENTRY debug-names

 * Instead of LVAR-FUN-NAME, use new LVAR-FUN-DEBUG-NAME, which works
   even for multiply-used lvars, by returning the list of names
   instead of just NIL.


Index: ir1util.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1util.lisp,v
retrieving revision 1.109
retrieving revision 1.110
diff -u -d -r1.109 -r1.110
--- ir1util.lisp	27 Sep 2007 15:43:25 -0000	1.109
+++ ir1util.lisp	15 Jan 2008 12:25:55 -0000	1.110
@@ -1636,6 +1636,15 @@
               nil))
         nil)))
 
+(defun lvar-fun-debug-name (lvar)
+  (declare (type lvar lvar))
+  (let ((uses (lvar-uses lvar)))
+    (flet ((name1 (use)
+             (leaf-debug-name (ref-leaf use))))
+      (if (ref-p uses)
+        (name1 uses)
+        (mapcar #'name1 uses)))))
+
 ;;; Return the source name of a combination. (This is an idiom
 ;;; which was used in CMU CL. I gather it always works. -- WHN)
 (defun combination-fun-source-name (combination)

Index: locall.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/locall.lisp,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -d -r1.82 -r1.83
--- locall.lisp	27 Sep 2007 15:43:25 -0000	1.82
+++ locall.lisp	15 Jan 2008 12:25:55 -0000	1.83
@@ -595,7 +595,7 @@
                (declare (ignorable ,@ignores))
                (%funcall ,entry ,@args))
             :debug-name (debug-name 'hairy-function-entry
-                                    (lvar-fun-name
+                                    (lvar-fun-debug-name
                                      (basic-combination-fun call)))))))
     (convert-call ref call new-fun)
     (dolist (ref (leaf-refs entry))