From 871ae5f27191cd50a4629143243312da1be7ca94 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 7 Dec 2010 02:13:06 +0000
Subject: 	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.

---
 src/interp/fnewmeta.lisp | 53 ++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 51 insertions(+), 2 deletions(-)

(limited to 'src/interp/fnewmeta.lisp')

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 
-- 
cgit v1.2.3