src/compiler/compiler-error.lisp

   1 ;;;; the bare essentials of compiler error handling
   2 ;;;;
   3 ;;;; (Logically, this might belong in early-c.lisp, since it's stuff
   4 ;;;; which might as well be visible to all compiler code. However,
   5 ;;;; physically its DEFINE-CONDITION forms depend on the condition
   6 ;;;; system being set up before it can be cold loaded, so we keep it
   7 ;;;; in this separate, loaded-later file instead of in early-c.lisp.)
   8
   9 ;;;; This software is part of the SBCL system. See the README file for
  10 ;;;; more information.
  11 ;;;;
  12 ;;;; This software is derived from the CMU CL system, which was
  13 ;;;; written at Carnegie Mellon University and released into the
  14 ;;;; public domain. The software is in the public domain and is
  15 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  16 ;;;; files for more information.
  17
  18 (in-package "SB!C")
  19
  20 ;;;; error-handling definitions which are easy to define early and
  21 ;;;; which are nice to have visible everywhere
  22
  23 ;;; a function that is called to unwind out of COMPILER-ERROR
  24 (declaim (type (function (&optional condition) nil) *compiler-error-bailout*))
  25 (defvar *compiler-error-bailout*)
  26
  27 ;;; an application programmer's error caught by the compiler
  28 ;;;
  29 ;;; We want a separate condition for application programmer errors so
  30 ;;; that we can distinguish them from system programming errors (bugs
  31 ;;; in SBCL itself). Application programmer errors should be caught
  32 ;;; and turned into diagnostic output and a FAILURE-P return value
  33 ;;; from COMPILE or COMPILE-FILE. Bugs in SBCL itself throw us into
  34 ;;; the debugger.
  35 ;;;
  36 ;;; A further word or two of explanation might be warranted here,
  37 ;;; since I (CSR) have spent the last day or so wandering in a
  38 ;;; confused daze trying to get this to behave nicely before finally
  39 ;;; hitting on the right solution.
  40 ;;;
  41 ;;; These objects obey a slightly involved protocol in order to
  42 ;;; achieve the right dynamic behaviour.  If we signal a
  43 ;;; COMPILER-ERROR from within the compiler, we want that the
  44 ;;; outermost call to COMPILE/COMPILE-FILE cease attempting to compile
  45 ;;; the code in question and instead compile a call to signal a
  46 ;;; PROGRAM-ERROR.  This is achieved by resignalling the condition
  47 ;;; from within the handler, so that the condition travels up the
  48 ;;; handler stack until it finds the outermost handler.  Why the
  49 ;;; outermost?  Well, COMPILE-FILE could call EVAL from an EVAL-WHEN,
  50 ;;; which could recursively call COMPILE, which could then signal an
  51 ;;; error; we want the inner EVAL not to fail so that we can go on
  52 ;;; compiling, so it's the outer COMPILE-FILE that needs to replace
  53 ;;; the erroneous call with a call to ERROR.
  54 ;;;
  55 ;;; This resignalling up the stack means that COMPILER-ERROR should
  56 ;;; not be a generalized instance of ERROR, as otherwise code such as
  57 ;;; (IGNORE-ERRORS (DEFGENERIC IF (X))) will catch and claim to handle
  58 ;;; the COMPILER-ERROR.  So we make COMPILER-ERROR inherit from
  59 ;;; CONDITION instead, as of sbcl-0.8alpha.0.2x, so that unless
  60 ;;; the user claims to be able to handle general CONDITIONs (and if he
  61 ;;; does, he deserves what's going to happen :-) [ Note: we don't make
  62 ;;; COMPILER-ERROR inherit from SERIOUS-CONDITION, because
  63 ;;; conventionally SERIOUS-CONDITIONs, if unhandled, end up in the
  64 ;;; debugger; although the COMPILER-ERROR might well trigger an entry
  65 ;;; into the debugger, it won't be the COMPILER-ERROR itself that is
  66 ;;; the direct cause. ]
  67 ;;;
  68 ;;; So, what if we're not inside the compiler, then?  Well, in that
  69 ;;; case we're in the evaluator, so we want to convert the
  70 ;;; COMPILER-ERROR into a PROGRAM-ERROR and signal it immediately.  We
  71 ;;; have to signal the PROGRAM-ERROR from the dynamic environment of
  72 ;;; attempting to evaluate the erroneous code, and not from any
  73 ;;; exterior handler, so that user handlers for PROGRAM-ERROR and
  74 ;;; ERROR stand a chance of running, in e.g. (IGNORE-ERRORS
  75 ;;; (DEFGENERIC IF (X))).  So this is where the SIGNAL-PROGRAM-ERROR
  76 ;;; restart comes in; the handler in EVAL-IN-LEXENV chooses this
  77 ;;; restart if it believes that the compiler is not present (which it
  78 ;;; tests using the BOUNDPness of *COMPILER-ERROR-BAILOUT*).  The
  79 ;;; restart executes in the dynamic environment of the original
  80 ;;; COMPILER-ERROR call, and all is well.
  81 ;;;
  82 ;;; CSR, 2003-05-13
  83 (define-condition compiler-error (encapsulated-condition) ()
  84   (:report (lambda (condition stream)
  85              (print-object (encapsulated-condition condition) stream))))
  86
  87 ;;; Signal the appropriate condition. COMPILER-ERROR calls the bailout
  88 ;;; function so that it never returns (but compilation continues).
  89 (declaim (ftype (function (t &rest t) #+(and sb-xc-host ccl) *
  90                                       #-(and sb-xc-host ccl) nil) compiler-error))
  91 (defun compiler-error (datum &rest arguments)
  92   (let ((condition (coerce-to-condition datum arguments
  93                                         'simple-program-error 'compiler-error)))
  94     (restart-case
  95         (cerror "Replace form with call to ERROR."
  96                 'compiler-error
  97                 :condition condition)
  98       (signal-error ()
  99         (error condition)))
 100     (funcall *compiler-error-bailout* condition)
 101     (bug "Control returned from *COMPILER-ERROR-BAILOUT*.")))
 102
 103 (defmacro with-compiler-error-resignalling (&body body)
 104   `(handler-bind
 105        ((compiler-error
 106           (lambda (c)
 107             (if (boundp '*compiler-error-bailout*)
 108                 ;; if we're in the compiler, delegate either to a higher
 109                 ;; authority or, if that's us, back down to the
 110                 ;; outermost compiler handler...
 111                 (signal c)
 112                 ;; ... if we're not in the compiler, better signal the
 113                 ;; error straight away.
 114                 (invoke-restart 'signal-error)))))
 115      ,@body))
 116
 117 (defun compiler-warn (datum &rest arguments)
 118   (apply #'warn datum arguments)
 119   (values))
 120
 121 (defun compiler-style-warn (datum &rest arguments)
 122   (apply #'style-warn datum arguments)
 123   (values))
 124
 125 (defun source-to-string (source)
 126   (write-to-string source
 127                    :escape t :readably nil :pretty t
 128                    :circle t :array nil))
 129
 130 (defun make-compiler-error-form (condition source)
 131   `(error 'compiled-program-error
 132           :message ,(princ-to-string condition)
 133           :source ,(source-to-string source)))
 134
 135 ;;; Fatal compiler errors. We export FATAL-COMPILER-ERROR as an
 136 ;;; interface for errors that kill the compiler dead
 137 ;;;
 138 ;;; These are not a COMPILER-ERRORs, since we don't try to recover
 139 ;;; from them and keep chugging along, but instead immediately bail
 140 ;;; out of the entire COMPILE-FILE.
 141
 142 (define-condition fatal-compiler-error (encapsulated-condition)
 143   ())
 144
 145 ;;; the condition of COMPILE-FILE being unable to READ from the
 146 ;;; source file
 147 ;;;
 148 ;;; (The old CMU CL code did try to recover from this condition, but
 149 ;;; the code for doing that was messy and didn't always work right.
 150 ;;; Since in Common Lisp the simple act of reading and compiling code
 151 ;;; (even without ever loading the compiled result) can have side
 152 ;;; effects, it's a little scary to go on reading code when you're
 153 ;;; deeply confused, so we violate what'd otherwise be good compiler
 154 ;;; practice by not trying to recover from this error and bailing out
 155 ;;; instead.)
 156 ;;; This name is inaccurate. Perhaps COMPILE/LOAD-INPUT-ERROR would be better.
 157 (define-condition input-error-in-compile-file (reader-error encapsulated-condition)
 158   (;; the position where the bad READ began, or NIL if unavailable,
 159    ;; redundant, or irrelevant
 160    (position :reader input-error-in-compile-file-position
 161              :initarg :position
 162              :initform nil)
 163    (line/col :reader input-error-in-compile-file-line/col
 164              :initarg :line/col
 165              :initform nil)
 166    (invoker :reader input-error-in-compile-file-invoker
 167             :initarg :invoker :initform 'compile-file))
 168   (:report
 169    (lambda (condition stream)
 170      (format stream
 171              "~@<~S error during ~S:~
 172                 ~@:_ ~2I~_~A~
 173                   ~@[~@:_~@:_(in form starting at ~:{~(~A~): ~S~:^, ~:_~})~]~
 174               ~:>"
 175              'read
 176              (input-error-in-compile-file-invoker condition)
 177              (encapsulated-condition condition)
 178              (let ((pos (input-error-in-compile-file-position condition)))
 179                (acond ((input-error-in-compile-file-line/col condition)
 180                        `((:line ,(car it))
 181                          (:column ,(cdr it))
 182                          (:position
 183                           ,(or pos (1- (file-position
 184                                         (stream-error-stream condition)))))))
 185                       (pos
 186                        (stream-error-position-info
 187                         (stream-error-stream condition) pos))))))))
 188
 189 (define-condition input-error-in-load (input-error-in-compile-file) ()
 190   (:default-initargs :invoker 'load))