-
- (let ((stream *error-output*)
- (context (find-error-context format-args)))
- (cond
- (context
- (let ((file (compiler-error-context-file-name context))
- (in (compiler-error-context-context context))
- (form (compiler-error-context-original-source context))
- (enclosing (compiler-error-context-enclosing-source context))
- (source (compiler-error-context-source context))
- (last *last-error-context*))
-
- (unless (and last
- (equal file (compiler-error-context-file-name last)))
- (when (pathnamep file)
- (note-message-repeats)
- (setq last nil)
- (format stream "~2&; file: ~A~%" (namestring file))))
-
- (unless (and last
- (equal in (compiler-error-context-context last)))
- (note-message-repeats)
- (setq last nil)
- (format stream "~&")
- (pprint-logical-block (stream nil :per-line-prefix "; ")
- (format stream "in:~{~<~% ~4:;~{ ~S~}~>~^ =>~}" in))
- (format stream "~%"))
-
-
- (unless (and last
- (string= form
- (compiler-error-context-original-source last)))
- (note-message-repeats)
- (setq last nil)
- (format stream "~&")
- (pprint-logical-block (stream nil :per-line-prefix "; ")
- (format stream " ~A" form))
- (format stream "~&"))
-
- (unless (and last
- (equal enclosing
- (compiler-error-context-enclosing-source last)))
- (when enclosing
- (note-message-repeats)
- (setq last nil)
- (format stream "~&; --> ~{~<~%; --> ~1:;~A~> ~}~%" enclosing)))
-
- (unless (and last
- (equal source (compiler-error-context-source last)))
- (setq *last-format-string* nil)
- (when source
- (note-message-repeats)
- (dolist (src source)
- (format stream "~&")
- (write-string "; ==>" stream)
- (format stream "~&")
- (pprint-logical-block (stream nil :per-line-prefix "; ")
- (write-string src stream)))))))
- (t
- (format stream "~&")
- (note-message-repeats)
- (setq *last-format-string* nil)
- (format stream "~&")))
-
- (setq *last-error-context* context)
-
- ;; FIXME: this testing for effective equality of compiler messages
- ;; is ugly, and really ought to be done at a higher level.
- (unless (and (equal format-string *last-format-string*)
- (tree-equal format-args *last-format-args*))
- (note-message-repeats nil)
- (setq *last-format-string* format-string)
- (setq *last-format-args* format-args)
- (let ((*print-level* *compiler-error-print-level*)
- (*print-length* *compiler-error-print-length*)
- (*print-lines* *compiler-error-print-lines*))
- (format stream "~&")
- (pprint-logical-block (stream nil :per-line-prefix "; ")
- (format stream "~&~?" format-string format-args))
- (format stream "~&"))))
+ (let ((context (find-error-context format-args)))
+ (cond (context
+ (let ((file (compiler-error-context-file-name context))
+ (in (compiler-error-context-context context))
+ (form (compiler-error-context-original-source context))
+ (enclosing (compiler-error-context-enclosing-source context))
+ (source (compiler-error-context-source context))
+ (last *last-error-context*))
+
+ (unless (and last
+ (equal file (compiler-error-context-file-name last)))
+ (when (pathnamep file)
+ (note-message-repeats stream)
+ (setq last nil)
+ (format stream "~2&; file: ~A~%" (namestring file))))
+
+ (unless (and last
+ (equal in (compiler-error-context-context last)))
+ (note-message-repeats stream)
+ (setq last nil)
+ (pprint-logical-block (stream nil :per-line-prefix "; ")
+ (format stream "in:~{~<~% ~4:;~{ ~S~}~>~^ =>~}" in))
+ (terpri stream))
+
+ (unless (and last
+ (string= form
+ (compiler-error-context-original-source last)))
+ (note-message-repeats stream)
+ (setq last nil)
+ (pprint-logical-block (stream nil :per-line-prefix "; ")
+ (format stream " ~A" form))
+ (fresh-line stream))
+
+ (unless (and last
+ (equal enclosing
+ (compiler-error-context-enclosing-source last)))
+ (when enclosing
+ (note-message-repeats stream)
+ (setq last nil)
+ (format stream "~&; --> ~{~<~%; --> ~1:;~A~> ~}~%" enclosing)))
+
+ (unless (and last
+ (equal source (compiler-error-context-source last)))
+ (setq *last-format-string* nil)
+ (when source
+ (note-message-repeats stream)
+ (dolist (src source)
+ (fresh-line stream)
+ (write-string "; ==>" stream)
+ (terpri stream)
+ (pprint-logical-block (stream nil :per-line-prefix "; ")
+ (write-string src stream)))))))
+ (t
+ (fresh-line stream)
+ (note-message-repeats stream)
+ (setq *last-format-string* nil)))
+
+ (setq *last-error-context* context))
+
+ ;; FIXME: this testing for effective equality of compiler messages
+ ;; is ugly, and really ought to be done at a higher level.
+ (unless (and (equal format-string *last-format-string*)
+ (tree-equal format-args *last-format-args*))
+ (note-message-repeats stream nil)
+ (setq *last-format-string* format-string)
+ (setq *last-format-args* format-args)
+ (fresh-line stream)
+ (pprint-logical-block (stream nil :per-line-prefix "; ")
+ (format stream "~&~?" format-string format-args))
+ (fresh-line stream))