From 39982663dc44f7b44c63af6ae4182f8d60d7d341 Mon Sep 17 00:00:00 2001 From: dos-reis 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/ChangeLog | 12 +++++++++ src/interp/fnewmeta.lisp | 59 ++------------------------------------------- src/interp/newaux.lisp | 12 ++++----- src/interp/parse.boot | 16 ++++++------ src/interp/spad-parser.boot | 39 ++++++++++++++++++++++++++++++ 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,3 +1,15 @@ +2011-10-12 Gabriel Dos Reis + + * 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 * algebra/boolean.spad.pamphlet (Reference) [elt]: Remove. 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() -- cgit v1.2.3