Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1:/tmp/cvs-serv4630/src/compiler
Modified Files:
compiler-error.lisp ir1report.lisp
Log Message:
0.8alpha.0.28:
Fix bug 47d (DEFGENERIC must signal PROGRAM-ERROR when
attempting to create a generic function with the same name as a
special operator).
... sounds easy, huh? No.
... make COMPILER-ERROR not inherit from ERROR any more, so that
user handlers don't (wrongly) claim to handle it;
... establish a handler for COMPILER-ERROR around the evaluator
that delegates to the compiler handlers if present, but
handles them itself if not...
... by signalling an error from a new internal restart, to allow
user handlers for ERROR and friends a chance to run.
Index: compiler-error.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/compiler-error.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- compiler-error.lisp 31 Jan 2002 16:38:47 -0000 1.6
+++ compiler-error.lisp 13 May 2003 13:55:30 -0000 1.7
@@ -22,8 +22,7 @@
;;; a function that is called to unwind out of COMPILER-ERROR
(declaim (type (function () nil) *compiler-error-bailout*))
-(defvar *compiler-error-bailout*
- (lambda () (error "COMPILER-ERROR with no bailout")))
+(defvar *compiler-error-bailout*)
;;; an application programmer's error caught by the compiler
;;;
@@ -33,7 +32,51 @@
;;; and turned into diagnostic output and a FAILURE-P return value
;;; from COMPILE or COMPILE-FILE. Bugs in SBCL itself throw us into
;;; the debugger.
-(define-condition compiler-error (simple-error) ())
+;;;
+;;; A further word or two of explanation might be warranted here,
+;;; since I (CSR) have spent the last day or so wandering in a
+;;; confused daze trying to get this to behave nicely before finally
+;;; hitting on the right solution.
+;;;
+;;; These objects obey a slightly involved protocol in order to
+;;; achieve the right dynamic behaviour. If we signal a
+;;; COMPILER-ERROR from within the compiler, we want that the
+;;; outermost call to COMPILE/COMPILE-FILE cease attempting to compile
+;;; the code in question and instead compile a call to signal a
+;;; PROGRAM-ERROR. This is achieved by resignalling the condition
+;;; from within the handler, so that the condition travels up the
+;;; handler stack until it finds the outermost handler. Why the
+;;; outermost? Well, COMPILE-FILE could call EVAL from an EVAL-WHEN,
+;;; which could recursively call COMPILE, which could then signal an
+;;; error; we want the inner EVAL not to fail so that we can go on
+;;; compiling, so it's the outer COMPILE-FILE that needs to replace
+;;; the erroneous call with a call to ERROR.
+;;;
+;;; This resignalling up the stack means that COMPILER-ERROR should
+;;; not be a generalized instance of ERROR, as otherwise code such as
+;;; (IGNORE-ERRORS (DEFGENERIC IF (X))) will catch and claim to handle
+;;; the COMPILER-ERROR. So we make COMPILER-ERROR inherit from
+;;; SIMPLE-CONDITION and SERIOUS-CONDITION instead, as of
+;;; sbcl-0.8alpha.0.2x, so that unless the user claims to be able to
+;;; handle SERIOUS-CONDITION (and if he does, he deserves what's going
+;;; to happen :-)
+;;;
+;;; So, what if we're not inside the compiler, then? Well, in that
+;;; case we're in the evaluator, so we want to convert the
+;;; COMPILER-ERROR into a PROGRAM-ERROR and signal it immediately. We
+;;; have to signal the PROGRAM-ERROR from the dynamic environment of
+;;; attempting to evaluate the erroneous code, and not from any
+;;; exterior handler, so that user handlers for PROGRAM-ERROR and
+;;; ERROR stand a chance of running, in e.g. (IGNORE-ERRORS
+;;; (DEFGENERIC IF (X))). So this is where the SIGNAL-PROGRAM-ERROR
+;;; restart comes in; the handler in EVAL-IN-LEXENV chooses this
+;;; restart if it believes that the compiler is not present (which it
+;;; tests using the BOUNDPness of *COMPILER-ERROR-BAILOUT*). The
+;;; restart executes in the dynamic environment of the original
+;;; COMPILER-ERROR call, and all is well.
+;;;
+;;; CSR, 2003-05-13
+(define-condition compiler-error (simple-condition serious-condition) ())
;;; Signal the appropriate condition. COMPILER-ERROR calls the bailout
;;; function so that it never returns (but compilation continues).
@@ -47,12 +90,18 @@
:format-control format-string
:format-arguments format-args))
(defun compiler-error (format-string &rest format-args)
- (cerror "Replace form with call to ERROR."
- 'compiler-error
- :format-control format-string
- :format-arguments format-args)
- (funcall *compiler-error-bailout*)
- (bug "Control returned from *COMPILER-ERROR-BAILOUT*."))
+ (restart-case
+ (progn
+ (cerror "Replace form with call to ERROR."
+ 'compiler-error
+ :format-control format-string
+ :format-arguments format-args)
+ (funcall *compiler-error-bailout*)
+ (bug "Control returned from *COMPILER-ERROR-BAILOUT*."))
+ (signal-program-error ()
+ (error 'simple-program-error
+ :format-control format-string
+ :format-arguments format-args))))
(defun compiler-warn (format-string &rest format-args)
(apply #'warn format-string format-args)
(values))
Index: ir1report.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1report.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- ir1report.lisp 14 Dec 2002 22:10:11 -0000 1.11
+++ ir1report.lisp 13 May 2003 13:55:30 -0000 1.12
@@ -400,7 +400,7 @@
(what (etypecase condition
(style-warning 'style-warning)
(warning 'warning)
- (error 'error))))
+ ((or error compiler-error) 'error))))
(multiple-value-bind (format-string format-args)
(if (typep condition 'simple-condition)
(values (simple-condition-format-control condition)
|