;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 126.85
;;; Reason:
;;;  The documentation on TYPECASE, ECASE, etc., were wretched, useless, inaccurate,
;;;  and so forth.
;;; Written 15-Sep-88 04:30:16 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 3
;;; with Experimental System 126.84, Experimental ZWEI 126.10, Experimental ZMail 74.1, Experimental Local-File 76.0, Experimental File-Server 25.0, Experimental Unix-Interface 14.0, Experimental Tape 25.1, Experimental Lambda-Diag 18.0, microcode 1762, SDU Boot Tape 3.14, SDU ROM 103, Lambda/Falcon Development System.



; From modified file DJ: L.SYS2; LMMAC.LISP#470 at 15-Sep-88 04:30:38
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; LMMAC  "


(make-obsolete messagecase "actually, it's just CASE, and indicates old ZetaLISP keyword message protocol")


))

; From modified file DJ: L.SYS2; LMMAC.LISP#470 at 15-Sep-88 04:30:44
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; LMMAC  "


(defmacro etypecase (place &body clauses)
  "Execute the first clause whose type specifier PLACE fits.
/
The first element of each clause is a type specifier.
It is used as the second argument to TYPEP to test the type of PLACE.
If the result is T, the rest of that clause is excuted and the values
  of the last form in it are the values of the ETYPECASE form.
If no clause fits, an uncorrectable error is signaled."
  (declare (zwei:indentation 1 1))
  (expand-case-macro 'etypecase place clauses
		     (lambda (test-exp c)
		       (if (memq c '(otherwise t))
			   `t
			 `(typep ,test-exp ',c)))
		     (lambda (test-exp)
		       `(no-case-error nil 'etypecase ',place ,test-exp
				       '(or . ,(mapcar #'car clauses))))))


))

; From modified file DJ: L.SYS2; LMMAC.LISP#470 at 15-Sep-88 04:30:46
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; LMMAC  "


(defmacro ecase (place &body clauses)
  "Execute the first clause that matches PLACE.
The first element of each clause is a match value or a list of match values.
/
PLACE is compared with the match values using EQL.
When a match-value matches, the rest of that clause is executed
  and the value of the last thing in the clause is the value of the ECASE.
If no clause matches, an uncorrectable error is signaled."
  (declare (zwei:indentation 1 1))
  (expand-case-macro 'ecase place clauses
		     (lambda (test-exp c)
		       (cond ((memq c '(otherwise t))
			      `t)
			     ((atom c)
			      `(eql ,test-exp ',c))
			     (t
			      `(member-eql ,test-exp ',c))))
		     (lambda (test-exp)
		       `(no-case-error nil 'ecase ',place ,test-exp
				       '(cl:member
					  . ,(mapcan (lambda (clause)
						       (let ((match (car clause)))
							 (if (not (consp match))
							     (list match)
							   (copy-list match))))
						     clauses))))))

))

; From modified file DJ: L.SYS2; LMMAC.LISP#470 at 15-Sep-88 04:36:21
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; LMMAC  "

(defmacro typecase (place &body clauses)
  "Execute the first clause whose type specifier PLACE fits.
/
The first element of each clause is a type specifier.
  It is used as the second argument to TYPEP to test the type of PLACE.
  It may be a type symbol, or a list such as /(OR NUMBER SYMBOL/).
If the type comparison is satisfied, the rest of that clause 
  is executed, and the values of the last form in it are the
  values returned from the TYPECASE form.
If no clause fits, the value of the TYPECASE is NIL.
/
For example:
/
  /(let ((thing (read instream)))
     (typecase thing
       (number (princ 'a-number))
       ((member :special :better) (princ 'special))
       (symbol (princ 'random-symbol))
       (t (princ 'something-else))))"
  (declare (zwei:indentation 1 1))
  (expand-case-macro 'typecase place clauses
		     (lambda (test-exp c)
		       (if (memq c '(otherwise t))
			   `t
			 `(typep ,test-exp ',c)))))

))