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, 19 insertions, 22 deletions

diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp
index 33c8e635..9dfe1d02 100644
--- a/src/interp/parsing.lisp
+++ b/src/interp/parsing.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007, Gabriel Dos Reis.
+;; Copyright (C) 2007-2010, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -171,14 +171,6 @@ the stack, then stack a NIL. Return the value of prod."
 ;       (3) Line handling:      Next Line, Print Next Line
 ;       (X) Random Stuff
 
-; A good test for lexing is:
-
-(defmacro test-lexing ()
-  '(with-open-file (in-stream "lisp>meta.meta" :direction :input)
-    (with-open-file (out-stream "lisp>foo.pars" :direction :output :if-exists :supersede)
-      (loop (let ((z (advance-token)))
-              (if z (Token-Print z out-stream) (return nil)))))))
-
 ; 3A (0). String grabbing
 
 ; String grabbing is the art of matching initial segments of the current
@@ -215,13 +207,30 @@ the stack, then stack a NIL. Return the value of prod."
                                    :nonBlank nonblank))
                  t))))
 
+(defun match-advance-keyword (str)
+  (and (match-token (current-token) 'keyword (intern str))
+       (action (advance-token))))
+
+(defun match-advance-glyph (str)
+  (and (match-token (current-token) 'gliph (intern str))
+       (action (advance-token))))
+
+(defun match-advance-special (str)
+  (and (match-token (current-token) 'special-char (character str))
+       (action (advance-token))))
+
+(defun match-special (str)
+  (match-token (current-token) 'special-char (character str)))
+
+(defun match-keyword-next (str)
+  (match-token (next-token) 'keyword (intern str)))
+
 (defun initial-substring-p (part whole)
   "Returns length of part if part matches initial segment of whole."
   (let ((x (string<= part whole)))
     (and x (= x (length part)) x)))
 
 
-
 ; 3A 3. Line Handling.
 
 ; PARAMETERS DEFINED IN THIS SECTION:
@@ -401,18 +410,6 @@ the stack, then stack a NIL. Return the value of prod."
            (format t " reduced ~A~%" y)))
   y)
 
-#+Symbolics
-(defmacro rtrace (&rest rules)
-  `(compiler-let () .
-        ,(mapcar #'(lambda (x)
-                    (let ((rule (intern (strconc "PARSE-" x))))
-                      `(zl:advise ,rule :around nil nil
-                               (reduction-print :do-it ',rule))))
-                rules)))
-
-#+Symbolics
-(defmacro runtrace () `(zl:unadvise))
-
 (defmacro tracemeta (&rest l) `(trmeta ',l))
 
 (defparameter /depth 0 "Used in Debug.lisp.")