(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "XCL" (USE)))

(il:filecreated "22-Aug-90 09:45:58" il:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>CONDITION-HIERARCHY.;6|
 11320  

      il:|changes| il:|to:|  (il:structures file-not-found)

      il:|previous| il:|date:| " 9-Jul-90 12:21:39" 
il:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>CONDITION-HIERARCHY.;5|)


; Copyright (c) 1986, 1987, 1988, 1990 by Venue & Xerox Corporation.  All rights reserved.

(il:prettycomprint il:condition-hierarchycoms)

(il:rpaqq il:condition-hierarchycoms ((il:structures condition simple-condition warning simple-warning serious-condition error simple-error assertion-failed hash-table-full) (il:structures cell-error unbound-variable undefined-function attempt-to-change-constant attempt-to-rplac-nil) (il:files il:condition-hierarchy-si il:condition-hierarchy-post-si) (il:coms (il:functions il:pretty-type-name) (il:structures type-error simple-type-error type-mismatch)) (il:structures control-error program-error illegal-go illegal-return illegal-throw bad-proceed-case) (il:structures stream-error stream-not-open read-error symbol-name-too-long end-of-file) (il:structures storage-condition stack-overflow critical-storage-condition storage-exhausted symbol-ht-full array-space-full data-types-exhausted) (il:structures device-error simple-device-error) (il:structures file-error file-wont-open fs-resources-exceeded fs-protection-violation fs-renamefile-source-couldnt-delete) (il:structures arithmetic-error division-by-zero floating-point-overflow floating-point-underflow) (il:structures pathname-error file-not-found invalid-pathname) (il:functions simple-condition-format-arguments simple-condition-format-string) (il:files il:condition-hierarchy-il) (il:prop (il:filetype il:makefile-environment) il:condition-hierarchy)))

(define-condition condition nil nil (:report (lambda (condition *standard-output*) (format t "Condition ~S occurred." condition))))

(define-condition simple-condition (condition) (format-string format-arguments) (:conc-name "%SIMPLE-CONDITION-") (:report (lambda (condition stream) (apply (quote format) stream (%simple-condition-format-string condition) (%simple-condition-format-arguments condition)))))

(define-condition warning (condition) (condition) (:report (lambda (c s) (format s "Warning: ~A" (warning-condition s)))))

(define-condition simple-warning (warning) (format-string format-arguments) (:conc-name "%SIMPLE-WARNING-") (:report (lambda (condition stream) (apply (quote format) stream (%simple-warning-format-string condition) (%simple-warning-format-arguments condition)))))

(define-condition serious-condition (condition) nil (:report (lambda (condition *standard-output*) (format t "Serious condition ~S occurred." (type-of condition)))))

(define-condition error (serious-condition) nil)

(define-condition simple-error (error) (format-string format-arguments) (:conc-name "%SIMPLE-ERROR-") (:report (lambda (condition stream) (apply (quote format) stream (%simple-error-format-string condition) (%simple-error-format-arguments condition)))))

(define-condition assertion-failed (simple-error) nil (:report (lambda (condition *standard-output*) (apply (quote format) t (or (assertion-failed-format-string condition) "Assertion failed.") (assertion-failed-format-arguments condition)))))

(define-condition hash-table-full (error) (table) (:report (lambda (condition *standard-output*) (format t "Hash table full: ~S" (hash-table-full-table condition)))))

(define-condition cell-error (error) (name))

(define-condition unbound-variable (cell-error) nil (:report (lambda (c s) (format s "~S is an unbound variable." (unbound-variable-name c)))))

(define-condition undefined-function (cell-error) nil (:report (lambda (c s) (format s "~S is an undefined function." (undefined-function-name c)))))

(define-condition attempt-to-change-constant (cell-error) nil)

(define-condition attempt-to-rplac-nil (attempt-to-change-constant) nil (:report (lambda (condition *standard-output*) (format t "Attempt to rplac NIL with ~S" (attempt-to-rplac-nil-name condition)))))

(il:filesload il:condition-hierarchy-si il:condition-hierarchy-post-si)

(defun il:pretty-type-name (il:typespec) (il:if (eq (car (il:listp il:typespec)) (quote or)) il:then (let ((il:types (il:subset (cdr il:typespec) (il:function (il:lambda (il:name) (not (il:some (cdr il:typespec) (il:function (il:lambda (il:other) (and (il:neq il:other il:name) (subtypep il:name il:other))))))))))) (il:if (il:equal (il:sort il:types) (quote (complex float integer ratio))) il:then "a number" il:else (il:concatlist (cdr (il:for il:x il:in il:types il:join (list " or " (il:pretty-type-name il:x))))))) il:else (let (il:doc) (if (and (symbolp il:typespec) (il:setq il:doc (documentation il:typespec (quote type)))) il:doc (il:concat "a " il:typespec)))))

(define-condition type-error (error) (expected-type datum) (:report (lambda (c s) (format s "Arg not ~A~&~S" (il:pretty-type-name (type-error-expected-type c)) (type-error-datum c)))))

(define-condition simple-type-error (il:* il:|;;;| "This is a pretty worthless type to have around.") (type-error) (format-string format-arguments) (:conc-name "%SIMPLE-TYPE-ERROR-") (:report (lambda (c s) (apply (quote format) s (%simple-type-error-format-string c) (%simple-type-error-format-arguments c)))))

(define-condition type-mismatch (type-error) (name value message) (:report (lambda (condition *standard-output*) (if (eql (type-mismatch-name condition) (type-mismatch-value condition)) (format t "~S is not ~A." (type-mismatch-value condition) (or (type-mismatch-message condition) (il:pretty-type-name (type-mismatch-expected-type condition)))) (format t "The value of ~S, ~S, is not ~A." (type-mismatch-name condition) (type-mismatch-value condition) (or (type-mismatch-message condition) (il:pretty-type-name (type-mismatch-expected-type condition))))))))

(define-condition control-error (error) nil)

(define-condition program-error (error) nil)

(define-condition illegal-go (program-error) (tag) (:report (lambda (condition *standard-output*) (format t "GO to a nonexistent tag: ~S." (illegal-go-tag condition)))))

(define-condition illegal-return (program-error) (tag) (:report (lambda (condition *standard-output*) (format t "RETURN to nonexistent block: ~S." (illegal-return-tag condition)))))

(define-condition illegal-throw (control-error) (tag) (:report (lambda (condition *standard-output*) (format t "Tag for THROW not found: ~S." (illegal-throw-tag condition)))))

(define-condition bad-proceed-case (control-error) (name) (:report (lambda (condition *standard-output*) (format t "Proceed case ~S is not currently active." (bad-proceed-case-name condition)))))

(define-condition stream-error (error) (stream) (:report (lambda (condition *standard-output*) (format t "Stream error on ~S." (stream-error-stream condition)))))

(define-condition stream-not-open (stream-error) nil (:report (lambda (condition *standard-output*) (format t "Stream not open: ~S" (stream-not-open-stream condition)))))

(define-condition read-error (error) nil)

(define-condition symbol-name-too-long (read-error) nil (:report "Symbol name too long"))

(define-condition end-of-file (stream-error) nil (:report (lambda (condition stream) (format stream "End of file ~S" (end-of-file-stream condition)))))

(define-condition storage-condition (serious-condition) nil)

(define-condition stack-overflow (storage-condition) nil (:report "Stack overflow"))

(define-condition critical-storage-condition (storage-condition) nil)

(define-condition storage-exhausted (critical-storage-condition) nil)

(define-condition symbol-ht-full (critical-storage-condition) nil (:report "Symbol hash table full"))

(define-condition array-space-full (critical-storage-condition) nil (:report "Array space full"))

(define-condition data-types-exhausted (critical-storage-condition) nil (:report "No more data types available"))

(define-condition device-error (serious-condition) (device))

(define-condition simple-device-error (device-error) (message) (:report (lambda (condition *standard-output*) (format t "Device error: ~A" (simple-device-error-message condition)))))

(define-condition file-error (error) (pathname))

(define-condition file-wont-open (file-error) nil (:report (lambda (condition *standard-output*) (format t "File won't open: ~A" (file-wont-open-pathname condition)))))

(define-condition fs-resources-exceeded (file-error) nil (:report (lambda (c s) (format s "File system resources exceeded: ~A" (fs-resources-exceeded-pathname c)))))

(define-condition fs-protection-violation (file-error) nil (:report (lambda (c s) (format s "Protection violation: ~A" (file-error-pathname c)))))

(define-condition fs-renamefile-source-couldnt-delete (file-error) nil (:report (lambda (condition *standard-output*) (format t "Couldn't delete the source file: ~A" (fs-renamefile-source-couldnt-delete-pathname condition)))))

(define-condition arithmetic-error (error) (operation operands) (:report (lambda (c s) (format s "Arithmetic error during (~S~{ ~S~})" (arithmetic-error-operation c) (arithmetic-error-operands c)))))

(define-condition division-by-zero (arithmetic-error) nil (:report "Attempt to divide by zero."))

(define-condition floating-point-overflow (arithmetic-error) nil (:report "Floating point overflow."))

(define-condition floating-point-underflow (arithmetic-error) nil (:report "Floating point underflow."))

(define-condition pathname-error (error) (pathname))

(define-condition file-not-found (file-error) nil (:report (lambda (condition *standard-output*) (format t "File not found: ~A" (file-not-found-pathname condition)))) (:handle (lambda (condition) (cond ((boundp (quote il:errorpos)) (let ((newname (il:spellfile (il:rootfilename (file-not-found-pathname condition)) nil il:nofilespellflg))) (cond (newname (il:envapply (il:stkname il:errorpos) (il:subst newname (file-not-found-pathname condition) (mapcar (function (lambda (x) (if (pathnamep x) (namestring x) x))) (il:stkargs il:errorpos))) (il:stknth -1 il:errorpos il:errorpos) il:errorpos t t)))))))))

(define-condition invalid-pathname (pathname-error) nil (:report (lambda (condition *standard-output*) (format t "Invalid pathname: ~A" (invalid-pathname-pathname condition)))))

(defun simple-condition-format-arguments (condition) (etypecase condition (simple-error (%simple-error-format-arguments condition)) (simple-type-error (%simple-type-error-format-arguments condition)) (simple-condition (%simple-condition-format-arguments condition)) (simple-warning (%simple-warning-format-arguments condition))))

(defun simple-condition-format-string (condition) (etypecase condition (simple-error (%simple-error-format-string condition)) (simple-type-error (%simple-type-error-format-string condition)) (simple-condition (%simple-condition-format-string condition)) (simple-warning (%simple-warning-format-string condition))))

(il:filesload il:condition-hierarchy-il)

(il:putprops il:condition-hierarchy il:filetype compile-file)

(il:putprops il:condition-hierarchy il:makefile-environment (:readtable "XCL" :package (defpackage "XCL" (:use))))
(il:putprops il:condition-hierarchy il:copyright ("Venue & Xerox Corporation" 1986 1987 1988 1990))
(il:declare\: il:dontcopy
  (il:filemap (nil)))
il:stop