* interp/spad-parser.spad: New parsing functions.

	* interp/fnewmeta.lisp: Use them,
	(PARSE-Return): Remove.
	(PARSE-Throw): Likewise.
	(PARSE-Jump): Likewise.
	(PARSE-Exit): Likewise.
	(PARSE-Leave): Likewise.
	(PARSE-ElseClause): Likewise.
	(PARSE-Label): Likewise.

5 files changed, 67 insertions, 71 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 0836540f..d20c8c5e 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,17 @@
 2011-10-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/spad-parser.spad: New parsing functions.
+	* interp/fnewmeta.lisp: Use them,
+	(PARSE-Return): Remove.
+	(PARSE-Throw): Likewise.
+	(PARSE-Jump): Likewise.
+	(PARSE-Exit): Likewise.
+	(PARSE-Leave): Likewise.
+	(PARSE-ElseClause): Likewise.
+	(PARSE-Label): Likewise.
+
+2011-10-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* algebra/boolean.spad.pamphlet (Reference) [elt]: Remove.
 	[setelt]: Likewise.
 	* algebra/lodof.spad.pamphlet: Adjust use.
diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp
index cb8d2f18..f36d4f37 100644
--- a/src/interp/fnewmeta.lisp
+++ b/src/interp/fnewmeta.lisp
@@ -210,18 +210,6 @@
        (|pushReduction| '|PARSE-SemiColon|
            (CONS '|;| (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) 
 
-;; We should factorize these boilerplates
-(DEFUN |PARSE-Return| ()
-  (AND (MATCH-ADVANCE-KEYWORD "return") (MUST (|PARSE-Expression|))
-       (|pushReduction| '|PARSE-Return|
-           (CONS '|return| (CONS (|popStack1|) NIL))))) 
-
-(DEFUN |PARSE-Throw| ()
-  (AND (MATCH-ADVANCE-KEYWORD "throw")
-       (MUST (|PARSE-Expression|))
-       (|pushReduction| '|PARSE-Throw|
-           (CONS '|%Throw| (CONS (|popStack1|) NIL))))) 
-
 (DEFUN |PARSE-Catch| ()
   (AND (MATCH-SPECIAL ";")
        (MATCH-KEYWORD-NEXT "catch")
@@ -265,30 +253,6 @@
 					   (CONS (|popStack1|) 
 						 NIL))))))))))
 
-
-(DEFUN |PARSE-Jump| ()
-  (LET ((S (|currentSymbol|)))
-       (AND S 
-	    (ACTION (|advanceToken|))
-	    (|pushReduction| '|PARSE-Jump| S))))
-
-
-(DEFUN |PARSE-Exit| ()
-  (AND (MATCH-ADVANCE-KEYWORD "exit")
-       (MUST (OR (|PARSE-Expression|)
-                 (|pushReduction| '|PARSE-Exit| '|$NoValue|)))
-       (|pushReduction| '|PARSE-Exit|
-           (CONS '|exit| (CONS (|popStack1|) NIL)))))
-
-
-(DEFUN |PARSE-Leave| ()
-  (AND (MATCH-ADVANCE-KEYWORD "leave")
-       (MUST (OR (|PARSE-Expression|)
-                 (|pushReduction| '|PARSE-Leave| '|$NoValue|)))
-       (MUST (|pushReduction| '|PARSE-Leave|
-                 (CONS '|leave| (CONS (|popStack1|) NIL))))))
-
-
 (DEFUN |PARSE-Seg| ()
   (AND (|PARSE-GlyphTok| "..")
        (BANG FIL_TEST (OPTIONAL (|PARSE-Expression|)))
@@ -303,18 +267,12 @@
        (BANG FIL_TEST
              (OPTIONAL
                  (AND (MATCH-ADVANCE-KEYWORD "else")
-                      (MUST (|PARSE-ElseClause|)))))
+                      (MUST (|parseElseClause|)))))
        (|pushReduction| '|PARSE-Conditional|
            (CONS '|if|
                  (CONS (|popStack3|)
                        (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) 
 
-
-(DEFUN |PARSE-ElseClause| ()
-  (OR (AND (EQ (|currentSymbol|) '|if|) (|PARSE-Conditional|))
-      (|PARSE-Expression|))) 
-
-
 (DEFUN |PARSE-Loop| ()
   (OR (AND (STAR REPEATOR (|PARSE-Iterator|))
            (MUST (MATCH-ADVANCE-KEYWORD "repeat"))
@@ -381,12 +339,6 @@
        (OPTIONAL (STAR OPT_EXPR (|PARSE-LedPart| RBP)))
        (|pushReduction| '|PARSE-Expr| (|popStack1|)))) 
 
-
-(DEFUN |PARSE-Label| ()
-  (AND (|matchAdvanceString| "<<") (MUST (|parseName|))
-       (MUST (|matchAdvanceString| ">>")))) 
-
-
 (DEFUN |PARSE-LedPart| (RBP)
   (DECLARE (SPECIAL RBP))
   (AND (|PARSE-Operation| '|Led| RBP)
@@ -443,14 +395,7 @@
 
 (DEFUN |PARSE-Form| ()
   (OR (AND (MATCH-ADVANCE-KEYWORD "iterate")
-           (BANG FIL_TEST
-                 (OPTIONAL
-                     (AND (MATCH-ADVANCE-KEYWORD "from")
-                          (MUST (|PARSE-Label|))
-                          (|pushReduction| '|PARSE-Form|
-                              (CONS (|popStack1|) NIL)))))
-           (|pushReduction| '|PARSE-Form|
-               (CONS '|iterate| (APPEND (|popStack1|) NIL))))
+           (|pushReduction| '|PARSE-Form| (CONS '|iterate| NIL)))
       (AND (MATCH-ADVANCE-KEYWORD "yield") (MUST (|PARSE-Application|))
            (|pushReduction| '|PARSE-Form|
                (CONS '|yield| (CONS (|popStack1|) NIL))))
diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp
index eb99de79..555c489c 100644
--- a/src/interp/newaux.lisp
+++ b/src/interp/newaux.lisp
@@ -153,13 +153,13 @@
           (|not| 260 259 NIL)
           (~ 260 259 nil)
           (= 400 700)
-          (|return| 202 201 (|PARSE-Return|))
+          (|return| 202 201 (|parseReturn|))
           (|try| 202 201 (|PARSE-Try|))
-	  (|throw| 202 201 (|PARSE-Throw|))
-          (|leave| 202 201 (|PARSE-Leave|))
-          (|exit| 202 201 (|PARSE-Exit|))
-	  (|break| 202 201 (|PARSE-Jump|))
-	  (|iterate| 202 201 (|PARSE-Jump|))
+	  (|throw| 202 201 (|parseThrow|))
+          (|leave| 202 201 (|parseLeave|))
+          (|exit| 202 201 (|parseExit|))
+	  (|break| 202 201 (|parseJump|))
+	  (|iterate| 202 201 (|parseJump|))
           (|from|)
           (|yield|)
           (|if| 130 0 (|PARSE-Conditional|))    ; was 130
diff --git a/src/interp/parse.boot b/src/interp/parse.boot
index f7db82fe..1af246df 100644
--- a/src/interp/parse.boot
+++ b/src/interp/parse.boot
@@ -264,9 +264,9 @@ parseOr t ==
     parseIf ["IF",y,parseOr ["or",:rest u],"true"]
   parseIf ["IF",x,"true",parseOr ["or",:rest u]]
  
-parseExit: %ParseForm -> %Form
-parseExit t ==
-  t isnt ["exit",a,:b] => systemErrorHere ["parseExit",t]
+doParseExit: %ParseForm -> %Form
+doParseExit t ==
+  t isnt ["exit",a,:b] => systemErrorHere ["doParseExit",t]
   --  note: I wanted to convert 1s to 0s here to facilitate indexing in
   --   comp code; unfortunately, parseTran-ning is sometimes done more
   --   than once so that the count can be decremented more than once
@@ -279,9 +279,9 @@ parseExit t ==
   ["exit",1,a]
  
 
-parseLeave: %ParseForm -> %Form
-parseLeave t ==
-  t isnt ["leave",a,:b] => systemErrorHere ["parseLeave",t]
+doParseLeave: %ParseForm -> %Form
+doParseLeave t ==
+  t isnt ["leave",a,:b] => systemErrorHere ["doParseLeave",t]
   a:= parseTran a
   b:= parseTran b
   b =>
@@ -448,7 +448,7 @@ for x in [[":", :"parseColon"],_
 	  ["CATEGORY", :"parseCategory"],_
 	  ["construct", :"parseConstruct"],_
 	  ["DEF", :"parseDEF"],_
-	  ["exit", :"parseExit"],_
+	  ["exit", :"doParseExit"],_
 	  ["has", :"parseHas"],_
 	  ["IF", :"parseIf"],_
 	  ["IN", :"parseIn"],_
@@ -456,7 +456,7 @@ for x in [[":", :"parseColon"],_
 	  ["is", :"parseIs"],_
 	  ["isnt", :"parseIsnt"],_
 	  ["Join", :"parseJoin"],_
-	  ["leave", :"parseLeave"],_
+	  ["leave", :"doParseLeave"],_
 	  ["%LET", :"parseLET"],_
 	  ["LETD", :"parseLETD"],_
 	  ["MDEF", :"parseMDEF"],_
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index 7a381471..a7780674 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -154,6 +154,10 @@ parseInfixWith() ==
   parseWith() and
     pushReduction('parseInfixWith,["Join",popStack2(),popStack1()])
 
+parseElseClause() ==
+  currentSymbol() is "if" => PARSE_-Conditional()
+  PARSE_-Expression()
+
 ++ domain inlining.  Same syntax as import directive; except
 ++ deliberate restriction on naming one type at a time.
 ++ -- gdr, 2009-02-28.
@@ -177,6 +181,41 @@ parseQuantifiedVariable() ==
     pushReduction('parseQuantifiedVariable,[":",popStack2(),popStack1()])
   nil
 
+++ We should factorize these boilerplates
+parseReturn() ==
+  matchAdvanceKeyword "return" =>
+    compulsorySyntax PARSE_-Expression()
+    pushReduction('parseReturn,["return",popStack1()])
+  nil
+
+parseThrow() ==
+  matchAdvanceKeyword "throw" =>
+    compulsorySyntax PARSE_-Expression()
+    pushReduction('parseReturn,["%Throw",popStack1()])
+  nil
+
+parseExit() ==
+  matchAdvanceKeyword "exit" =>
+    x :=
+      PARSE_-Expression() => popStack1()
+      "$NoValue"
+    pushReduction('parseExit,["exit",x])
+  nil
+
+parseLeave() ==
+  matchAdvanceKeyword "leave" =>
+    x :=
+      PARSE_-Expression() => popStack1()
+      "$NoValue"
+    pushReduction('parseLeave,["leave",x])
+  nil
+
+parseJump() ==
+  s := currentSymbol() =>
+    advanceToken()
+    pushReduction('parseJump,s)
+  nil
+
 parseNewExpr() ==
   matchString '")" =>
     processSynonyms()