(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)))
(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
;;;
;;; 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.
+;;; if it's not .ANONYMOUS. (This is parallel to the way that ordinarily
+;;; we don't use a value if it's NIL, instead defaulting it. But we
+;;; can't safely/comfortably use NIL for that in this context, since
+;;; the app programmer can use NIL as a name, so we use the private
+;;; symbol .ANONYMOUS. instead.)
;;;
;;; 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))
+ (if (eql source-name '.anonymous.)
+ debug-name
+ (debug-namify "~S" source-name)))
;;; Return a COMPILER-ERROR-CONTEXT structure describing the current
;;; error context, or NIL if we can't figure anything out. ARGS is a