X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1report.lisp;h=c8dced28c4e11de16e0c6ff41c659bbcfd55b459;hb=148e3820ad314a9b59d0133c1d60eaac4af9118b;hp=3a81b986a2451c976db676a25ebe63746761c87f;hpb=6e7e59adb6f6c30f84b31695b48cb51e2c519d75;p=sbcl.git

diff --git a/src/compiler/ir1report.lisp b/src/compiler/ir1report.lisp
index 3a81b98..c8dced2 100644
--- a/src/compiler/ir1report.lisp
+++ b/src/compiler/ir1report.lisp
@@ -129,11 +129,14 @@
 (defun source-form-context (form)
   (cond ((atom form) nil)
 	((>= (length form) 2)
-	 (funcall (gethash (first form) *source-context-methods*
-			   (lambda (x)
-			     (declare (ignore x))
-			     (list (first form) (second form))))
-		  (rest form)))
+         (let* ((context-fun-default (lambda (x)
+				       (declare (ignore x))
+				       (list (first form) (second form))))
+		(context-fun (gethash (first form)
+				      *source-context-methods*
+				      context-fun-default)))
+           (declare (type function context-fun))
+           (funcall context-fun (rest form))))
 	(t
 	 form)))
 
@@ -192,22 +195,6 @@
          (format nil "~<~@;  ~S~:>" (list form))
          (prin1-to-string form)))))
 
-;;; shorthand for creating debug names from source names or other
-;;; stems, e.g.
-;;;   (DEBUG-NAMIFY "FLET ~S" SOURCE-NAME)
-;;;   (DEBUG-NAMIFY "top level form ~S" FORM)
-;;;
-;;; FIXME: This function seems to have a lot in common with
-;;; STRINGIFY-FORM, and perhaps there's some way to merge the two
-;;; functions.
-(defun debug-namify (format-string &rest format-arguments)
-  (with-standard-io-syntax
-   (let ((*print-readably* nil)
-         (*package* *cl-package*)
-         (*print-length* 3)
-         (*print-level* 2))
-     (apply #'format nil format-string format-arguments))))
-
 ;;; shorthand for a repeated idiom in creating debug names
 ;;;
 ;;; the problem, part I: We want to create debug names that look like