aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog12
-rw-r--r--src/interp/fnewmeta.lisp59
-rw-r--r--src/interp/newaux.lisp12
-rw-r--r--src/interp/parse.boot16
-rw-r--r--src/interp/spad-parser.boot39
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()
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-26 06:18:57 +0000