Skip to content
Snippets Groups Projects
Commit 7a10c2a6 authored by ram's avatar ram
Browse files

Tweaked error message format a bit.

Added REOPTIMIZE-LAMBDA-VAR and made DELETE-REF call it when we delete
the second-to-last reference to a LAMBDA-VAR.
parent 3ef134ff
No related branches found
No related tags found
No related merge requests found
...@@ -473,6 +473,26 @@ ...@@ -473,6 +473,26 @@
(undefined-value)) (undefined-value))
;;; REOPTIMIZE-LAMBDA-VAR -- Internal
;;;
;;; Note that something interesting has happened to Var. We only deal with
;;; LET variables, marking the corresponding initial value arg as needing to be
;;; reoptimized.
;;;
(defun reoptimize-lambda-var (var)
(declare (type lambda-var var))
(let ((fun (lambda-var-home var)))
(when (and (eq (functional-kind fun) :let)
(leaf-refs var))
(reoptimize-continuation
(elt (basic-combination-args
(continuation-dest
(node-cont
(first (leaf-refs fun)))))
(position var (lambda-vars fun))))))
(undefined-value))
;;; Delete-Lambda -- Internal ;;; Delete-Lambda -- Internal
;;; ;;;
;;; Deal with deleting the last reference to a lambda. Since there is only ;;; Deal with deleting the last reference to a lambda. Since there is only
...@@ -592,7 +612,8 @@ ...@@ -592,7 +612,8 @@
(delete-optional-dispatch leaf))))) (delete-optional-dispatch leaf)))))
((null (rest refs)) ((null (rest refs))
(typecase leaf (typecase leaf
(clambda (maybe-let-convert leaf)))))) (clambda (maybe-let-convert leaf))
(lambda-var (reoptimize-lambda-var leaf))))))
(undefined-value)) (undefined-value))
...@@ -1223,8 +1244,9 @@ ...@@ -1223,8 +1244,9 @@
;;; indication of how many times it was repeated. We reset the message count ;;; indication of how many times it was repeated. We reset the message count
;;; when we are done. ;;; when we are done.
;;; ;;;
(defun note-message-repeats () (defun note-message-repeats (&optional (terpri t))
(cond ((= *last-message-count* 1) (terpri *compiler-error-output*)) (cond ((= *last-message-count* 1)
(when terpri (terpri *compiler-error-output*)))
((> *last-message-count* 1) ((> *last-message-count* 1)
(format *compiler-error-output* "[Last message occurs ~D times]~2%" (format *compiler-error-output* "[Last message occurs ~D times]~2%"
*last-message-count*))) *last-message-count*)))
...@@ -1264,7 +1286,7 @@ ...@@ -1264,7 +1286,7 @@
(setq *last-source-context* context) (setq *last-source-context* context)
(setq *last-original-source* nil) (setq *last-original-source* nil)
(format stream "~2&In:~{~<~% ~4:;~{ ~S~}~>~^ =>~}~%" context)) (format stream "~2&In:~{~<~% ~4:;~{ ~S~}~>~^ =>~}~%" context))
l
(unless (tree-equal form *last-original-source*) (unless (tree-equal form *last-original-source*)
(note-message-repeats) (note-message-repeats)
(setq *last-original-source* form) (setq *last-original-source* form)
...@@ -1273,8 +1295,9 @@ l ...@@ -1273,8 +1295,9 @@ l
(format stream " ~S~%" form)) (format stream " ~S~%" form))
(unless (or (tree-equal source form) (unless (or (tree-equal source form)
(member source form)) (and (member source form) (member source format-args)))
(unless (tree-equal enclosing *last-enclosing-source*) (unless (or (tree-equal enclosing *last-enclosing-source*)
(tree-equal enclosing form))
(note-message-repeats) (note-message-repeats)
(setq *last-source-form* '#(invalid)) (setq *last-source-form* '#(invalid))
(setq *last-enclosing-source* enclosing) (setq *last-enclosing-source* enclosing)
...@@ -1294,7 +1317,7 @@ l ...@@ -1294,7 +1317,7 @@ l
(unless (and (equal format-string *last-format-string*) (unless (and (equal format-string *last-format-string*)
(tree-equal format-args *last-format-args*)) (tree-equal format-args *last-format-args*))
(note-message-repeats) (note-message-repeats nil)
(setq *last-format-string* format-string) (setq *last-format-string* format-string)
(setq *last-format-args* format-args) (setq *last-format-args* format-args)
(format stream "~&~A: ~?~&" what format-string format-args))) (format stream "~&~A: ~?~&" what format-string format-args)))
...@@ -1353,11 +1376,9 @@ l ...@@ -1353,11 +1376,9 @@ l
;;; ;;;
(proclaim '(function compiler-mumble (string &rest t) void)) (proclaim '(function compiler-mumble (string &rest t) void))
(defun compiler-mumble (format-string &rest format-args) (defun compiler-mumble (format-string &rest format-args)
(when *last-format-string* (note-message-repeats)
(note-message-repeats) (setq *last-source-context* nil)
(terpri *compiler-error-output*) (setq *last-format-string* nil)
(setq *last-source-context* nil)
(setq *last-format-string* nil))
(apply #'format *compiler-error-output* format-string format-args) (apply #'format *compiler-error-output* format-string format-args)
(force-output *compiler-error-output*)) (force-output *compiler-error-output*))
......
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