mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-16 14:21:48 -08:00
Format undefined variable warnings as the rest of compiler messages (T. Rittweiler)
This commit is contained in:
parent
64e0ee75ab
commit
2fc236ba80
4 changed files with 40 additions and 30 deletions
|
|
@ -1,7 +1,7 @@
|
|||
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
|
||||
;;;;
|
||||
|
||||
(in-package 'compiler)
|
||||
(in-package "COMPILER")
|
||||
|
||||
;;; The production version:
|
||||
(proclaim '(optimize (safety 0) (space 3) (speed 3)))
|
||||
|
|
|
|||
|
|
@ -32,6 +32,31 @@
|
|||
(setf output f)))
|
||||
finally (return output))))
|
||||
|
||||
;; For indirect use in :REPORT functions
|
||||
(defun compiler-message-report (stream c format-control &rest format-arguments)
|
||||
(let ((position (compiler-message-file-position c))
|
||||
(prefix (compiler-message-prefix c))
|
||||
(file (compiler-message-file c))
|
||||
(form (innermost-non-expanded-form (compiler-message-toplevel-form c))))
|
||||
(if (and form
|
||||
position
|
||||
(not (minusp position))
|
||||
(not (equalp form '|compiler preprocess|)))
|
||||
(let* ((*print-length* 2)
|
||||
(*print-level* 2))
|
||||
(format stream
|
||||
"~A:~% in file ~A, position ~D~& at ~A"
|
||||
prefix
|
||||
(make-pathname :name (pathname-name file)
|
||||
:type (pathname-type file)
|
||||
:version (pathname-version file))
|
||||
position
|
||||
form))
|
||||
(format stream "~A:" prefix))
|
||||
(format stream (compiler-message-format c)
|
||||
format-control
|
||||
format-arguments)))
|
||||
|
||||
(define-condition compiler-message (simple-condition)
|
||||
((prefix :initform "Note" :accessor compiler-message-prefix)
|
||||
(format :initform +note-format+ :accessor compiler-message-format)
|
||||
|
|
@ -43,30 +68,10 @@
|
|||
:accessor compiler-message-toplevel-form)
|
||||
(form :initarg :form :initform *current-form*
|
||||
:accessor compiler-message-form))
|
||||
(:REPORT
|
||||
(lambda (c stream)
|
||||
(let ((position (compiler-message-file-position c))
|
||||
(prefix (compiler-message-prefix c))
|
||||
(file (compiler-message-file c))
|
||||
(form (innermost-non-expanded-form (compiler-message-toplevel-form c))))
|
||||
(if (and form
|
||||
position
|
||||
(not (minusp position))
|
||||
(not (equalp form '|compiler preprocess|)))
|
||||
(let* ((*print-length* 2)
|
||||
(*print-level* 2))
|
||||
(format stream
|
||||
"~A:~% in file ~A, position ~D~& at ~A"
|
||||
prefix
|
||||
(make-pathname :name (pathname-name file)
|
||||
:type (pathname-type file)
|
||||
:version (pathname-version file))
|
||||
position
|
||||
form))
|
||||
(format stream "~A:" prefix))
|
||||
(format stream (compiler-message-format c)
|
||||
(simple-condition-format-control c)
|
||||
(simple-condition-format-arguments c))))))
|
||||
(:report (lambda (c stream)
|
||||
(apply #'compiler-message-report stream c
|
||||
(simple-condition-format-control c)
|
||||
(simple-condition-format-arguments c)))))
|
||||
|
||||
(define-condition compiler-note (compiler-message) ())
|
||||
|
||||
|
|
@ -93,9 +98,11 @@
|
|||
(define-condition compiler-undefined-variable (compiler-style-warning)
|
||||
((variable :initarg :name :initform nil))
|
||||
(:report
|
||||
(lambda (condition stream)
|
||||
(format stream "Variable ~A was undefined. Compiler assumes it is a global."
|
||||
(slot-value condition 'variable)))))
|
||||
(lambda (c stream)
|
||||
(compiler-message-report stream c
|
||||
"Variable ~A was undefined. ~
|
||||
Compiler assumes it is a global."
|
||||
(slot-value c 'variable)))))
|
||||
|
||||
(defun print-compiler-message (c stream)
|
||||
(unless (typep c *suppress-compiler-messages*)
|
||||
|
|
|
|||
|
|
@ -21,7 +21,10 @@
|
|||
(tagbody again
|
||||
(restart-case
|
||||
(error 'simple-type-error
|
||||
:format-control "In ~:[an anonymous function~;~:*function ~A~], ~:[found object~;~:*the value of ~A is~]~%~8t~S~%which is not of expected type ~A"
|
||||
:format-control
|
||||
"In ~:[an anonymous function~;~:*function ~A~], ~
|
||||
~:[found object~;~:*the value of ~A is~]~%~8t~S~%~
|
||||
which is not of expected type ~A"
|
||||
:format-arguments (list function place object type)
|
||||
:datum object
|
||||
:expected-type type
|
||||
|
|
|
|||
|
|
@ -701,7 +701,7 @@
|
|||
args))
|
||||
|
||||
(eval-when (:load-toplevel :execute)
|
||||
(defmacro c-inline (args arg-types ret-type &rest others)
|
||||
(defmacro c-inline (args arg-types ret-type &body others)
|
||||
`(error "The special form c-inline cannot be used in the interpreter: ~A"
|
||||
(list (list ,@args) ',arg-types ',ret-type ,@others))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue