Format undefined variable warnings as the rest of compiler messages (T. Rittweiler)

This commit is contained in:
Juan Jose Garcia Ripoll 2010-02-25 11:24:21 +01:00
parent 64e0ee75ab
commit 2fc236ba80
4 changed files with 40 additions and 30 deletions

View file

@ -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)))

View file

@ -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*)

View file

@ -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

View file

@ -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))))