Skip to content
Snippets Groups Projects
Commit 9199c6d2 authored by ram's avatar ram
Browse files

Changed compiler error contexts to hold stringified source forms so that

undefined warnings don't hold onto the original source (and possibly hold on
the IR, since sometimes we splice LEAF structures into the source.)
parent 8e5356f6
No related branches found
No related tags found
No related merge requests found
...@@ -1179,6 +1179,30 @@ ...@@ -1179,6 +1179,30 @@
(basic-combination-args dest))))))))))) (basic-combination-args dest)))))))))))
;;; We bind print level and length when printing out messages so that we don't
;;; dump huge amounts of garbage.
;;;
(proclaim '(type (or unsigned-byte null) *error-print-level*
*error-print-length*))
(defvar *error-print-level* 3
"The value for *Print-Level* when printing compiler error messages.")
(defvar *error-print-length* 5
"The value for *Print-Length* when printing compiler error messages.")
;;; STRINGIFY-FORM -- Internal
;;;
;;; Convert a source form to a string, formatted suitably for use in
;;; compiler warnings.
;;;
(defun stringify-form (form)
(let ((*print-level* *error-print-level*)
(*print-length* *error-print-length*)
(*print-circle* t))
(format nil " ~S~%")))
;;; FIND-ERROR-CONTEXT -- Interface ;;; FIND-ERROR-CONTEXT -- Interface
;;; ;;;
;;; Return a COMPILER-ERROR-CONTEXT structure describing the current error ;;; Return a COMPILER-ERROR-CONTEXT structure describing the current error
...@@ -1199,10 +1223,11 @@ ...@@ -1199,10 +1223,11 @@
(when (and context (not *current-form*)) (when (and context (not *current-form*))
(find-enclosing-source context)) (find-enclosing-source context))
(make-compiler-error-context (make-compiler-error-context
:source source :source (stringify-form source)
:original-source form :original-source (stringify-form form)
:context src-context :context src-context
:enclosing-source enclosing :enclosing-source (when enclosing
(stringify-form enclosing))
:enclosed-how how)))))))) :enclosed-how how))))))))
...@@ -1214,15 +1239,6 @@ ...@@ -1214,15 +1239,6 @@
(defvar *compiler-error-bailout* (defvar *compiler-error-bailout*
#'(lambda () (error "Compiler-Error with no bailout."))) #'(lambda () (error "Compiler-Error with no bailout.")))
;;; We bind print level and length when printing out messages so that we don't
;;; dump huge amounts of garbage.
;;;
(proclaim '(type (or unsigned-byte null) *error-print-level* *error-print-length*))
(defvar *error-print-level* 3
"The value for *Print-Level* when printing compiler error messages.")
(defvar *error-print-length* 5
"The value for *Print-Length* when printing compiler error messages.")
;;; We save the context information that we printed out most recently so that ;;; We save the context information that we printed out most recently so that
;;; we don't print it out redundantly. ;;; we don't print it out redundantly.
...@@ -1286,37 +1302,37 @@ ...@@ -1286,37 +1302,37 @@
(enclosing (compiler-error-context-enclosing-source context)) (enclosing (compiler-error-context-enclosing-source context))
(how (compiler-error-context-enclosed-how context))) (how (compiler-error-context-enclosed-how context)))
(unless (tree-equal context *last-source-context*) (unless (equal context *last-source-context*)
(note-message-repeats) (note-message-repeats)
(setq *last-source-context* context) (setq *last-source-context* context)
(setq *last-original-source* '#(invalid)) (setq *last-original-source* nil)
(format stream "~2&In:~{~<~% ~4:;~{ ~S~}~>~^ =>~}~%" context)) (format stream "~2&In:~{~<~% ~4:;~{ ~S~}~>~^ =>~}~%" context))
(unless (tree-equal form *last-original-source*) (unless (equal form *last-original-source*)
(note-message-repeats) (note-message-repeats)
(setq *last-original-source* form) (setq *last-original-source* form)
(setq *last-enclosing-source* '#(invalid)) (setq *last-enclosing-source* nil)
(setq *last-format-string* nil) (setq *last-format-string* nil)
(format stream " ~S~%" form)) (write-string form stream))
(unless (or (tree-equal source form) (unless (equal source form)
(and (member source form) (member source format-args))) (unless (or (equal enclosing *last-enclosing-source*)
(unless (or (tree-equal enclosing *last-enclosing-source*) (equal enclosing form))
(tree-equal enclosing form))
(note-message-repeats) (note-message-repeats)
(setq *last-source-form* '#(invalid)) (setq *last-source-form* nil)
(setq *last-enclosing-source* enclosing) (setq *last-enclosing-source* enclosing)
(when enclosing (when enclosing
(format stream "==>~% ~S~%" enclosing))) (write-line "==>" stream)
(write-string enclosing stream)))
(unless (tree-equal source *last-source-form*) (unless (tree-equal source *last-source-form*)
(note-message-repeats) (note-message-repeats)
(setq *last-source-form* source) (setq *last-source-form* source)
(setq *last-format-string* nil) (setq *last-format-string* nil)
(unless (member source format-args) (if *last-enclosing-source*
(if *last-enclosing-source* (format stream "The ~A:~%" how)
(format stream "The ~A:~% ~S~%" how source) (write-line "==>" stream))
(format stream "==>~% ~S~%" source))))))) (write-string source stream)))))
(t (t
(note-message-repeats) (note-message-repeats)
(format stream "~2&"))) (format stream "~2&")))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment