From 39982663dc44f7b44c63af6ae4182f8d60d7d341 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 12 Oct 2011 19:46:02 +0000
Subject: 	* 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.

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

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

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