0.pre7.114:

[sbcl.git] / src / compiler / ir1report.lisp

diff --git a/src/compiler/ir1report.lisp b/src/compiler/ir1report.lisp
index eadcf86..c12736a 100644 (file)
--- a/src/compiler/ir1report.lisp
+++ b/src/compiler/ir1report.lisp
@@ -97,9 +97,9 @@
 ;;; it's a reasonable thing to put in SB-EXT in case some dedicated
 ;;; user wants to do some heavy tweaking to make SBCL give more
 ;;; informative output about his code.
-(defmacro def-source-context (name lambda-list &body body)
+(defmacro define-source-context (name lambda-list &body body)
   #!+sb-doc
-  "DEF-SOURCE-CONTEXT Name Lambda-List Form*
+  "DEFINE-SOURCE-CONTEXT Name Lambda-List Form*
    This macro defines how to extract an abbreviated source context from the
    Named form when it appears in the compiler input. Lambda-List is a DEFMACRO
    style lambda-list used to parse the arguments. The Body should return a
@@ -109,13 +109,17 @@
           #'(lambda (,n-whole)
               (destructuring-bind ,lambda-list ,n-whole ,@body)))))
 
-(def-source-context defstruct (name-or-options &rest slots)
+(defmacro def-source-context (&rest rest)
+  (deprecation-warning 'def-source-context 'define-source-context)
+  `(define-source-context ,@rest))
+
+(define-source-context defstruct (name-or-options &rest slots)
   (declare (ignore slots))
   `(defstruct ,(if (consp name-or-options)
                   (car name-or-options)
                   name-or-options)))
 
-(def-source-context function (thing)
+(define-source-context function (thing)
   (if (and (consp thing) (eq (first thing) 'lambda) (consp (rest thing)))
       `(lambda ,(second thing))
       `(function ,thing)))
@@ -204,6 +208,27 @@
          (*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
+;;; "&MORE processor for <something>" where <something> might be
+;;; either a source-name value (typically a symbol) or a non-symbol
+;;; debug-name value (typically a string). It's awkward to handle this
+;;; with FORMAT because we'd like to splice a source-name value using
+;;; "~S" (to get package qualifiers) but a debug-name value using "~A"
+;;; (to avoid irrelevant quotes at string splice boundaries).
+;;;
+;;; the problem, part II: The <something> is represented as a pair
+;;; of values, SOURCE-NAME and DEBUG-NAME, where SOURCE-NAME is used
+;;; if it's not null.
+;;;
+;;; the solution: Use this function to convert whatever it is to a
+;;; string, which FORMAT can then splice using "~A".
+(defun as-debug-name (source-name debug-name)
+  (if source-name
+      (debug-namify "~S" source-name)
+      debug-name))
+
 ;;; Return a COMPILER-ERROR-CONTEXT structure describing the current
 ;;; error context, or NIL if we can't figure anything out. ARGS is a
 ;;; list of things that are going to be printed out in the error
@@ -277,7 +302,7 @@
   (cond ((= *last-message-count* 1)
         (when terpri (terpri *error-output*)))
        ((> *last-message-count* 1)
-          (format *error-output* "~&; [Last message occurs ~D times.]~2%"
+          (format *error-output* "~&; [Last message occurs ~W times.]~2%"
                 *last-message-count*)))
   (setq *last-message-count* 0))