Add support for exception handling.

	* interp/parsing.lisp (TEST-LEXING): Remove.
	(RTRACE): Likewise.
	(RUNTRACE): Likewise.
	(MATCH-ADVANCE-KEYWORD): New.
	(MATCH-ADVANCE-GLYPH): Likewise.
	(MATCH-ADVANCE-SPECIAL): Likewise.
	(MATCH-SPECIAL): Likewise.
	(MATCH-KEYWORD-NEXT): Likewise.
	* interp/newaux.lisp: Make try and throw prefix operators.
	* interp/metalex.lisp (KEYWORDS): Include finally, catch and throw.
	* interp/fnewmeta.lisp (PARSE-Throw): New. Parse throw-expressions.
	(PARSE-Catch): New.  Parse catch-expressions.
	(PARSE-Finally): New. Parse finally-expressions.
	(PARSE-Try): New. Parse try-expressions.
	* interp/compiler.boot (compThrow): New. Register to compile
	throw-expressions. 
	(compTry): New. Register to compiler try-expressions.
	(compCatch): New. Compile catch-handler expression.
	* interp/g-opt.boot (optTry): New.  Simplify simple expressions in
	the try operand.
	* interp/g-util.boot (expandThrow): New.  Expand %throw forms.
	(domainMatchCode): New.
	(expandTry): New. Expand %try forms.
	* doc/msgs/s2-us.msgs: Add new message with key S2GE0020.
	* interp/g-error.boot (systemErrorHandler): Handle possible
	uncaucght expression condition.

1 files changed, 51 insertions, 2 deletions

diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp
index e575c8af..024ed7c5 100644
--- a/src/interp/fnewmeta.lisp
+++ b/src/interp/fnewmeta.lisp
@@ -50,7 +50,6 @@
 (defun |isTokenDelimiter| () 
        (MEMBER (CURRENT-SYMBOL) '(\) END\_UNIT NIL)))
 
-
 (DEFUN |PARSE-NewExpr| ()
   (OR (AND (MATCH-STRING ")") (ACTION (|processSynonyms|))
            (MUST (|PARSE-Command|)))
@@ -321,12 +320,62 @@
        (PUSH-REDUCTION '|PARSE-SemiColon|
            (CONS '|;| (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) 
 
-
+;; We should factorize these boilerplates
 (DEFUN |PARSE-Return| ()
   (AND (MATCH-ADVANCE-STRING "return") (MUST (|PARSE-Expression|))
        (PUSH-REDUCTION '|PARSE-Return|
            (CONS '|return| (CONS (POP-STACK-1) NIL))))) 
 
+(DEFUN |PARSE-Throw| ()
+  (AND (MATCH-ADVANCE-KEYWORD "throw")
+       (MUST (|PARSE-Expression|))
+       (PUSH-REDUCTION '|PARSE-Throw|
+           (CONS '|%Throw| (CONS (POP-STACK-1) NIL))))) 
+
+(DEFUN |PARSE-Catch| ()
+  (AND (MATCH-SPECIAL ";")
+       (MATCH-KEYWORD-NEXT "catch")
+       (ACTION (ADVANCE-TOKEN))
+       (ACTION (ADVANCE-TOKEN))
+       (MUST (MATCH-ADVANCE-GLYPH "("))
+       (MUST (|PARSE-QuantifiedVariable|))
+       (MUST (MATCH-ADVANCE-SPECIAL ")"))
+       (MUST (MATCH-ADVANCE-GLYPH "=>"))
+       (MUST (|PARSE-Expression|))
+       (PUSH-REDUCTION '|PARSE-Catch|
+	  (CONS (POP-STACK-2)
+		(CONS (POP-STACK-1) NIL)))))
+
+(DEFUN |PARSE-Finally| ()
+  (AND (MATCH-SPECIAL ";")
+       (MATCH-KEYWORD-NEXT "finally")
+       (ACTION (ADVANCE-TOKEN))
+       (ACTION (ADVANCE-TOKEN))
+       (MUST (|PARSE-Expression|))))
+
+(DEFUN |PARSE-Try| ()
+  (AND (MATCH-ADVANCE-KEYWORD "try")
+       (MUST (|PARSE-Expression|))
+       ;; exception handlers: either a finally-expression, or
+       ;; a series of catch-expressions optionally followed by
+       ;; a finally-expression.
+       (MUST (OR (AND (|PARSE-Finally|)
+		      (PUSH-REDUCTION '|PARSE-Try|
+                         (CONS '|%Try| 
+			       (CONS (POP-STACK-2)
+				     (CONS NIL
+					   (CONS (POP-STACK-1) NIL))))))
+		 (AND (MUST (STAR REPEATOR (|PARSE-Catch|)))
+		      (BANG FIL_TEST
+			    (OPTIONAL (|PARSE-Finally|)))
+		      (PUSH-REDUCTION '|PARSE-Try|
+                         (CONS '|%Try|
+			       (CONS (POP-STACK-3)
+				     (CONS (POP-STACK-2)
+					   (CONS (POP-STACK-1) 
+						 NIL))))))))))
+
+
 (DEFUN |PARSE-Jump| ()
   (LET ((S (CURRENT-SYMBOL)))
        (AND S