Commit 5911ec7c authored by rtoy's avatar rtoy
Browse files

Define a new condition class, COMPILER-READ-ERROR, a subtype of

COMPILER-ERROR, to allow slime better control of read errors.

Patch from Helmut Eller, cmucl-imp, 2004-10-25.
parent 3d733bdf
Loading
Loading
Loading
Loading
+17 −2
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.106 2004/08/23 11:37:52 emarsden Exp $")
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.107 2004/10/26 13:31:38 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -2107,6 +2107,15 @@ these can be NIL if unavailable or inapplicable.")
;;;
(define-condition compiler-error (simple-program-error) ())

;;; A special condition for read time errors.  It includes the source
;;; position where the error occured.
;;;
(define-condition compiler-read-error (compiler-error)
  ((position :initarg :position :reader compiler-read-error-position)
   (message :initarg :message :reader compiler-read-error-message))
  (:report (lambda (condition stream)
             (format stream "~A~%" (compiler-read-error-message condition)))))

;;; COMPILER-{ERROR,WARNING,STYLE-WARNING}-HANDLER  --  Interface
;;;
;;;    Condition handlers established by the compiler.  We re-signal the
@@ -2138,7 +2147,8 @@ these can be NIL if unavailable or inapplicable.")
;;; simple-style-warning, inhibited if brevity is 3.  anything when Brevity is
;;; 3.  Compiler-Error calls the bailout function so that it never returns.
;;; Compiler-Error-Message returns like Compiler-Warning, but signals a
;;; Compiler-Error.
;;; Compiler-Error.  Compiler-Read-Error is like Compiler-Error-Message but
;;; signals a Compile-Read-Error.
;;;
(defun compiler-error (format-string &rest format-args)
  (declare (string format-string))
@@ -2152,6 +2162,11 @@ these can be NIL if unavailable or inapplicable.")
	  'compiler-error :format-control format-string
	  :format-arguments format-args))
;;; 
(defun compiler-read-error (position format-string &rest format-args)
  (cerror "replace form with call to ERROR."
	  'compiler-read-error :position position
	  :message (apply #'format nil format-string format-args)))
;;;
(defun compiler-warning (format-string &rest format-args)
  (declare (string format-string))
  (apply #'warn format-string format-args)
+7 −8
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.142 2004/05/10 20:05:18 rtoy Exp $")
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.143 2004/10/26 13:31:38 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -768,10 +768,9 @@ in the user USER-INFO slot of STREAM-SOURCE-LOCATIONs.")
	(let ((line (read-line stream nil))
	      (end (file-position stream)))
	  (when (>= end pos)
	    (compiler-error-message
	     "Read error at ~D:~% \"~A/\\~A\"~%~A"
	     pos
	     (string-left-trim " 	"
	    (compiler-read-error 
	     pos "Read error at ~D:~% \"~A/\\~A\"~%~A"
	     pos (string-left-trim '(#\space #\tab)
				   (subseq line 0 (- pos start)))
	     (subseq line (- pos start))
	     condition)
@@ -817,8 +816,8 @@ in the user USER-INFO slot of STREAM-SOURCE-LOCATIONs.")
	 (unless (or res (zerop (length line)))
	   (setq res line))))

    (compiler-error-message
     "Read error in form starting at ~D:~%~@[ \"~A\"~%~]~A"
    (compiler-read-error 
     pos "Read error in form starting at ~D:~%~@[ \"~A\"~%~]~A"
     pos res condition)

    (file-position stream eof-pos)