(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")

(FILECREATED "17-Oct-86 17:29:18" {ERIS}<LISPCORE>SOURCES>CL-ERROR.;7
        

      changes to%:  (FUNCTIONS DEFINE-CONDITION IGNORE-ERRORS WITH-GENSYMS CL:CHECK-TYPE HANDLER-BIND 
                           PROCEED-ARG-COLLECTOR PROCEED-CASE REAL-PROCEED-CASE CONDITION-TYPECASE 
                           WITH-ERR-LOOP-VARS MAKE-FAKE-REPORT-FUNCTION MAKE-REPORT-FUNCTION 
                           NORMALIZE-CONDITION-CLAUSES PROCEED-CASE-FROM-CLAUSE 
                           COLLECT-CASE-SELECTORS NO-PROCEED-TEST CL:ETYPECASE CONDITION-CASE 
                           REAL-CONDITION-CASE)
                    (VARS CL-ERRORCOMS)

      previous date%: "16-Oct-86 17:34:09" {ERIS}<DANIELS>LISP>CL-ERROR.;13)


(* "
Copyright (c) 1986 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT CL-ERRORCOMS)

(RPAQQ CL-ERRORCOMS
 
       ((COMS (* ;; 
               "Temporary bootstrapping stuff. Anything in here gets changed once CL starts working."
                 )
              (FUNCTIONS CONDITION-TYPECASE CONDITION-BLOCK CONDITION-RETURN))
        (COMS (* ;; "Internal stuff.")
              (EXPORT (VARIABLES %%CONDITION-TYPES-REAL))
              (FUNCTIONS DEFAULT-PROCEED-REPORT)
              (FUNCTIONS WITH-GENSYMS WITH-ERR-LOOP-VARS STRIP-KEYWORDS MAKE-FAKE-REPORT-FUNCTION 
                     MAKE-REPORT-FUNCTION MAKE-ENCAPSULATION NORMALIZE-SLOT-DESCRIPTIONS 
                     EXTRACT-CONDITION-BINDINGS NORMALIZE-CONDITION-CLAUSES 
                     MASSAGE-CATCH-CONDITION-CLAUSES SPLIT-PROCEED-CLAUSES PROCEED-CASE-FROM-CLAUSE 
                     PROCESS-PROCEED-KEYWORDS CHECK-*CASE-SELECTOR COLLECT-CASE-SELECTORS 
                     NO-PROCEED-TEST %%PREFIX-SYMBOL %%SUFFIX-SYMBOL PROCEED-ARG-COLLECTOR))
        (COMS (* ;; 
           "User-visible forms. These should all be external symbols. Any others should be internal."
                 )
              (FUNCTIONS DEFINE-CONDITION CL:CHECK-TYPE CL:ETYPECASE CTYPECASE CL:ECASE CL:CCASE 
                     CL:ASSERT HANDLER-BIND CONDITION-BIND CONDITION-CASE REAL-CONDITION-CASE 
                     IGNORE-ERRORS PROCEED-CASE REAL-PROCEED-CASE DEFINE-PROCEED-FUNCTION CATCH-ABORT
                     ))
        (PROP FILETYPE CL-ERROR)
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA)))))



(* ;; "Temporary bootstrapping stuff. Anything in here gets changed once CL starts working.")


(DEFMACRO CONDITION-TYPECASE
 (OBJECT &REST CLAUSES)
   (LET
    ((VAL (CL:GENSYM)))
    (CL:IF
     %%CONDITION-TYPES-REAL
     `(CL:TYPECASE ,OBJECT ,@CLAUSES)
     `(LET ((,VAL ,OBJECT))
           (COND
              ,@(CL:MAPCAR #'(CL:LAMBDA (CLAUSE)
                                    (DESTRUCTURING-BIND (SELECTOR . BODY)
                                           CLAUSE
                                           (CL:IF (EQ SELECTOR T)
                                                  CLAUSE
                                                  `((CONDITION-TYPEP ,VAL ',SELECTOR)
                                                    ,@BODY)))) CLAUSES))))))

(DEFMACRO CONDITION-BLOCK
 (TAG &BODY FORMS) `(CL:CATCH ',TAG ,@FORMS))

(DEFMACRO CONDITION-RETURN
 (TAG &OPTIONAL RESULT) `(CL:THROW ',TAG ,RESULT))




(* ;; "Internal stuff.")


(* FOLLOWING DEFINITIONS EXPORTED)


(CL:DEFCONSTANT %%CONDITION-TYPES-REAL
 NIL)



(* END EXPORTED DEFINITIONS)

(DEFMACRO DEFAULT-PROCEED-REPORT
 (PROCEED-TYPE) `(CL:GET ,PROCEED-TYPE '%%DEFAULT-PROCEED-REPORT
                                                        'DEFAULT-PROCEED-REPORTER))

(DEFMACRO WITH-GENSYMS
 (VARS PREFIX &BODY BODY)
   `(LET ,(MAPCAR VARS (FUNCTION (CL:LAMBDA (VAR)
                                        `(,VAR (GENSYM ,PREFIX))))) ,@BODY))

(DEFMACRO WITH-ERR-LOOP-VARS
 (PREFIX &BODY BODY) `(WITH-