Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv22643

Modified Files: conditions.lisp Log Message: Add various standard conditions.

--- /project/movitz/cvsroot/movitz/losp/muerte/conditions.lisp 2008/04/17 19:32:27 1.27 +++ /project/movitz/cvsroot/movitz/losp/muerte/conditions.lisp 2008/04/21 19:31:54 1.28 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Wed Nov 20 15:47:04 2002 ;;;; -;;;; $Id: conditions.lisp,v 1.27 2008/04/17 19:32:27 ffjeld Exp $ +;;;; $Id: conditions.lisp,v 1.28 2008/04/21 19:31:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -38,10 +38,6 @@ condition)))) ',name))

-#+ignore -(defmethod print-object ((c condition) s) - foo) - (define-condition condition (standard-object) ((format-control :initarg :format-control @@ -66,10 +62,12 @@ :reader simple-condition-format-arguments))) (define-condition serious-condition () ()) (define-condition error (serious-condition) ()) +(define-condition storage-condition (serious-condition) ()) (define-condition warning () ()) (define-condition style-warning () ()) (define-condition simple-error (simple-condition error) ()) (define-condition simple-warning (simple-condition warning) ()) +(define-condition parse-error (error) ())

(define-condition cell-error (error) ((name @@ -100,6 +98,24 @@ (format s "Unbound variable ~S." (cell-error-name c)))))

+(define-condition unbound-slot (cell-error) + ((instance + :initarg :instance + :reader unbound-slot-instance)) + (:report (lambda (c s) + (format s "The slot ~S is unbound in the object ~S." + (cell-error-name c) + (unbound-slot-instance c))))) + + +(define-condition print-not-readable (error) + ((object + :initarg :object + :reader print-not-readable-object)) + (:report (lambda (c s) + (format s "Cannot print ~S readably." + (print-not-readable-object c))))) + (define-condition program-error (error) ())

(defun simple-program-error (format-control &rest format-arguments) @@ -120,6 +136,8 @@ (type-error-datum c) (type-error-expected-type c)))))

+(define-condition simple-type-error (simple-condition type-error) ()) + (define-condition etypecase-error (type-error) () (:report (lambda (c s) @@ -183,6 +201,8 @@ :initarg :stream :reader stream-error-stream)))

+(define-condition reader-error (parse-error stream-error) ()) + (define-condition end-of-file (stream-error) () (:report (lambda (c s) @@ -328,7 +348,7 @@ (cond ((not *debugger-function*) (let ((*never-use-print-object* t)) - (backtrace :spartan t)) + (backtrace :spartan t :conflate nil)) (format t "~&No debugger in *debugger-function*...") (dotimes (i 100000) (write-string "")) @@ -371,3 +391,8 @@ nil)

(define-condition newline () ()) + +(define-condition floating-point-inexact (arithmetic-error) ()) +(define-condition floating-point-invalid-operation (arithmetic-error) ()) +(define-condition floating-point-overflow (arithmetic-error) ()) +(define-condition floating-point-underflow (arithmetic-error) ())