;; a list of stringified enclosing non-original source forms
(source nil :type list)
;; the stringified form in the original source that expanded into SOURCE
- (original-source (required-argument) :type simple-string)
+ (original-source (missing-arg) :type simple-string)
;; a list of prefixes of "interesting" forms that enclose original-source
(context nil :type list)
;; the FILE-INFO-NAME for the relevant FILE-INFO
- (file-name (required-argument)
- :type (or pathname (member :lisp :stream)))
- ;; the file position at which the top-level form starts, if applicable
+ (file-name (missing-arg) :type (or pathname (member :lisp :stream)))
+ ;; the file position at which the top level form starts, if applicable
(file-position nil :type (or index null))
;; the original source part of the source path
(original-source-path nil :type list))
;;; Convert a source form to a string, suitably formatted for use in
;;; compiler warnings.
(defun stringify-form (form &optional (pretty t))
- (let ((*print-level* *compiler-error-print-level*)
- (*print-length* *compiler-error-print-length*)
- (*print-lines* *compiler-error-print-lines*)
- (*print-pretty* pretty))
- (if pretty
- (format nil "~<~@; ~S~:>" (list form))
- (prin1-to-string form))))
+ (with-standard-io-syntax
+ (let ((*print-readably* nil)
+ (*print-pretty* pretty)
+ (*print-level* *compiler-error-print-level*)
+ (*print-length* *compiler-error-print-length*)
+ (*print-lines* *compiler-error-print-lines*))
+ (if pretty
+ (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))))
;;; Return a COMPILER-ERROR-CONTEXT structure describing the current
;;; error context, or NIL if we can't figure anything out. ARGS is a
;;; The politically correct way to print out progress messages and
;;; such like. We clear the current error context so that we know that
-;;; it needs to be reprinted, and we also Force-Output so that the
+;;; it needs to be reprinted, and we also FORCE-OUTPUT so that the
;;; message gets seen right away.
(declaim (ftype (function (string &rest t) (values)) compiler-mumble))
(defun compiler-mumble (format-string &rest format-args)