From 7ca9a1812e8db22382fe1710cf248bc5a0a10e8b Mon Sep 17 00:00:00 2001 From: dos-reis Date: Tue, 4 Oct 2011 10:36:48 +0000 Subject: * interp/lexing.boot (stackClear!): Fix typo. Add new grammar reduction abstract datatype facility. * interp/fnewmeta.lisp: Use it. * interp/parsing.lisp: Likewise. * interp/bootlex.lisp (SPAD): Use popStack1. * interp/spad-parser.boot (parseSpadFile): Likewise. * interp/metalex.lisp: Remove REDUCTION and associated functions. --- src/ChangeLog | 10 ++ src/interp/bootlex.lisp | 2 +- src/interp/fnewmeta.lisp | 384 ++++++++++++++++++++++---------------------- src/interp/lexing.boot | 60 ++++++- src/interp/metalex.lisp | 67 +------- src/interp/parsing.lisp | 31 ++-- src/interp/spad-parser.boot | 2 +- src/interp/util.lisp | 2 +- 8 files changed, 280 insertions(+), 278 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 8c11fae0..31d4aa5d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2011-10-04 Gabriel Dos Reis + + * interp/lexing.boot (stackClear!): Fix typo. + Add new grammar reduction abstract datatype facility. + * interp/fnewmeta.lisp: Use it. + * interp/parsing.lisp: Likewise. + * interp/bootlex.lisp (SPAD): Use popStack1. + * interp/spad-parser.boot (parseSpadFile): Likewise. + * interp/metalex.lisp: Remove REDUCTION and associated functions. + 2011-10-04 Gabriel Dos Reis * interp/lexing.boot: New. diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp index 31022c0a..c3e5d4c0 100644 --- a/src/interp/bootlex.lisp +++ b/src/interp/bootlex.lisp @@ -122,7 +122,7 @@ (let ((LINE (cdar Boot-Line-Stack))) (declare (special LINE)) (|PARSE-NewExpr|) - (let ((parseout (pop-stack-1)) ) + (let ((parseout (|popStack1|)) ) (when parseout (let ((|$OutputStream| out-stream)) (S-PROCESS parseout)) diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp index 28c9e03c..44650661 100644 --- a/src/interp/fnewmeta.lisp +++ b/src/interp/fnewmeta.lisp @@ -60,7 +60,7 @@ (DEFUN |PARSE-Command| () (AND (MATCH-ADVANCE-STRING ")") (MUST (|PARSE-SpecialKeyWord|)) (MUST (|PARSE-SpecialCommand|)) - (PUSH-REDUCTION '|PARSE-Command| NIL))) + (|pushReduction| '|PARSE-Command| NIL))) (DEFUN |PARSE-SpecialKeyWord| () @@ -75,8 +75,8 @@ (OPTIONAL (OR (MATCH-ADVANCE-STRING "?") (|PARSE-Expression|)))) - (PUSH-REDUCTION '|PARSE-SpecialCommand| - (CONS '|show| (CONS (POP-STACK-1) NIL))) + (|pushReduction| '|PARSE-SpecialCommand| + (CONS '|show| (CONS (|popStack1|) NIL))) (MUST (|PARSE-CommandTail|))) (AND (MEMBER (CURRENT-SYMBOL) |$noParseCommands|) (ACTION (FUNCALL (CURRENT-SYMBOL)))) @@ -89,16 +89,16 @@ (DEFUN |PARSE-TokenList| () (STAR REPEATOR (AND (NOT (|isTokenDelimiter|)) - (PUSH-REDUCTION '|PARSE-TokenList| (CURRENT-SYMBOL)) + (|pushReduction| '|PARSE-TokenList| (CURRENT-SYMBOL)) (ACTION (ADVANCE-TOKEN))))) (DEFUN |PARSE-TokenCommandTail| () (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-TokenOption|)))) (|atEndOfLine|) - (PUSH-REDUCTION '|PARSE-TokenCommandTail| - (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL))) - (ACTION (|systemCommand| (POP-STACK-1))))) + (|pushReduction| '|PARSE-TokenCommandTail| + (CONS (|popStack2|) (APPEND (|popStack1|) NIL))) + (ACTION (|systemCommand| (|popStack1|))))) (DEFUN |PARSE-TokenOption| () @@ -108,14 +108,14 @@ (DEFUN |PARSE-CommandTail| () (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Option|)))) (|atEndOfLine|) - (PUSH-REDUCTION '|PARSE-CommandTail| - (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL))) - (ACTION (|systemCommand| (POP-STACK-1))))) + (|pushReduction| '|PARSE-CommandTail| + (CONS (|popStack2|) (APPEND (|popStack1|) NIL))) + (ACTION (|systemCommand| (|popStack1|))))) (DEFUN |PARSE-PrimaryOrQM| () (OR (AND (MATCH-ADVANCE-STRING "?") - (PUSH-REDUCTION '|PARSE-PrimaryOrQM| '?)) + (|pushReduction| '|PARSE-PrimaryOrQM| '?)) (|PARSE-Primary|))) @@ -130,22 +130,22 @@ (AND (STAR REPEATOR (AND (MATCH-ADVANCE-STRING ",") (MUST (|PARSE-Expr| 0)))) - (PUSH-REDUCTION '|PARSE-Statement| + (|pushReduction| '|PARSE-Statement| (CONS '|Series| - (CONS (POP-STACK-2) - (APPEND (POP-STACK-1) NIL)))))))) + (CONS (|popStack2|) + (APPEND (|popStack1|) NIL)))))))) (DEFUN |PARSE-InfixWith| () (AND (|PARSE-With|) - (PUSH-REDUCTION '|PARSE-InfixWith| - (CONS '|Join| (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) + (|pushReduction| '|PARSE-InfixWith| + (CONS '|Join| (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) (DEFUN |PARSE-With| () (AND (MATCH-ADVANCE-KEYWORD "with") (MUST (|PARSE-Category|)) - (PUSH-REDUCTION '|PARSE-With| - (CONS '|with| (CONS (POP-STACK-1) NIL))))) + (|pushReduction| '|PARSE-With| + (CONS '|with| (CONS (|popStack1|) NIL))))) (DEFUN |PARSE-Category| () @@ -158,11 +158,11 @@ (OPTIONAL (AND (MATCH-ADVANCE-KEYWORD "else") (MUST (|PARSE-Category|))))) - (PUSH-REDUCTION '|PARSE-Category| + (|pushReduction| '|PARSE-Category| (CONS '|if| - (CONS (POP-STACK-3) - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))))) + (CONS (|popStack3|) + (CONS (|popStack2|) + (CONS (|popStack1|) NIL)))))) (AND (MATCH-ADVANCE-STRING "(") (MUST (|PARSE-Category|)) (BANG FIL_TEST (OPTIONAL @@ -170,33 +170,33 @@ (AND (MATCH-ADVANCE-STRING ";") (MUST (|PARSE-Category|)))))) (MUST (MATCH-ADVANCE-STRING ")")) - (PUSH-REDUCTION '|PARSE-Category| + (|pushReduction| '|PARSE-Category| (CONS 'CATEGORY - (CONS (POP-STACK-2) - (APPEND (POP-STACK-1) NIL))))) + (CONS (|popStack2|) + (APPEND (|popStack1|) NIL))))) (AND (ACTION (SETQ G1 (LINE-NUMBER CURRENT-LINE))) (OR (|PARSE-Application|) (|PARSE-OperatorFunctionName|)) (MUST (OR (AND (MATCH-ADVANCE-STRING ":") (MUST (|PARSE-Expression|)) - (PUSH-REDUCTION '|PARSE-Category| + (|pushReduction| '|PARSE-Category| (CONS '|%Signature| - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))) + (CONS (|popStack2|) + (CONS (|popStack1|) NIL)))) (ACTION (|recordSignatureDocumentation| - (NTH-STACK 1) G1))) - (AND (PUSH-REDUCTION '|PARSE-Category| + (|nthStack| 1) G1))) + (AND (|pushReduction| '|PARSE-Category| (CONS '|%Attribute| - (CONS (POP-STACK-1) NIL))) + (CONS (|popStack1|) NIL))) (ACTION (|recordAttributeDocumentation| - (NTH-STACK 1) G1)))))))))) + (|nthStack| 1) G1)))))))))) (DEFUN |PARSE-Expression| () (AND (|PARSE-Expr| (|PARSE-rightBindingPowerOf| (MAKE-SYMBOL-OF PRIOR-TOKEN) |ParseMode|)) - (PUSH-REDUCTION '|PARSE-Expression| (POP-STACK-1)))) + (|pushReduction| '|PARSE-Expression| (|popStack1|)))) (DEFUN |PARSE-Import| () @@ -206,19 +206,19 @@ (MUST (|PARSE-Expression|)) (MUST (MATCH-ADVANCE-KEYWORD "from")) (MUST (|PARSE-Expr| 1000)) - (PUSH-REDUCTION '|PARSE-Import| + (|pushReduction| '|PARSE-Import| (CONS '|%SignatureImport| - (CONS (POP-STACK-3) - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))))) + (CONS (|popStack3|) + (CONS (|popStack2|) + (CONS (|popStack1|) NIL)))))) (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (AND (MATCH-ADVANCE-STRING ",") (MUST (|PARSE-Expr| 1000)))))) - (PUSH-REDUCTION '|PARSE-Import| + (|pushReduction| '|PARSE-Import| (CONS '|import| - (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL)))))))) + (CONS (|popStack2|) (APPEND (|popStack1|) NIL)))))))) ;; domain inlining. Same syntax as import directive; except ;; deliberate restriction on naming one type at a time. @@ -226,8 +226,8 @@ (DEFUN |PARSE-Inline| () (AND (MATCH-ADVANCE-KEYWORD "inline") (MUST (|PARSE-Expr| 1000)) - (PUSH-REDUCTION '|PARSE-Inline| - (CONS '|%Inline| (CONS (POP-STACK-1) NIL))))) + (|pushReduction| '|PARSE-Inline| + (CONS '|%Inline| (CONS (|popStack1|) NIL))))) ;; quantified types. At the moment, these are used only in ;; pattern-mathing cases. @@ -237,17 +237,17 @@ (MUST (|PARSE-QuantifiedVariableList|)) (MUST (MATCH-ADVANCE-STRING ".")) (MUST (|PARSE-Expr| 200)) - (MUST (PUSH-REDUCTION '|PARSE-Forall| - (CONS (POP-STACK-3) - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))))) + (MUST (|pushReduction| '|PARSE-Forall| + (CONS (|popStack3|) + (CONS (|popStack2|) + (CONS (|popStack1|) NIL)))))) (|PARSE-Application|))) (DEFUN |PARSE-Quantifier| () (OR (AND (MATCH-ADVANCE-KEYWORD "forall") - (MUST (PUSH-REDUCTION '|PARSE-Quantifier| '|%Forall|))) + (MUST (|pushReduction| '|PARSE-Quantifier| '|%Forall|))) (AND (MATCH-ADVANCE-KEYWORD "exist") - (MUST (PUSH-REDUCTION '|PARSE-Quantifier| '|%Exist|))))) + (MUST (|pushReduction| '|PARSE-Quantifier| '|%Exist|))))) (DEFUN |PARSE-QuantifiedVariableList| () (AND (MATCH-ADVANCE-STRING "(") @@ -256,43 +256,43 @@ (AND (STAR REPEATOR (AND (MATCH-ADVANCE-STRING ",") (MUST (|PARSE-QuantifiedVariable|)))) - (PUSH-REDUCTION '|PARSE-QuantifiedVariableList| + (|pushReduction| '|PARSE-QuantifiedVariableList| (CONS '|%Sequence| - (CONS (POP-STACK-2) - (APPEND (POP-STACK-1) NIL)))))) + (CONS (|popStack2|) + (APPEND (|popStack1|) NIL)))))) (MUST (MATCH-ADVANCE-STRING ")")))) (DEFUN |PARSE-QuantifiedVariable| () (AND (|PARSE-Name|) (MUST (MATCH-ADVANCE-STRING ":")) (MUST (|PARSE-Application|)) - (MUST (PUSH-REDUCTION '|PARSE-QuantifiedVariable| + (MUST (|pushReduction| '|PARSE-QuantifiedVariable| (CONS '|:| - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL))))))) + (CONS (|popStack2|) + (CONS (|popStack1|) NIL))))))) (DEFUN |PARSE-Infix| () - (AND (PUSH-REDUCTION '|PARSE-Infix| (CURRENT-SYMBOL)) + (AND (|pushReduction| '|PARSE-Infix| (CURRENT-SYMBOL)) (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|)) (MUST (|PARSE-Expression|)) - (PUSH-REDUCTION '|PARSE-Infix| - (CONS (POP-STACK-2) - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) + (|pushReduction| '|PARSE-Infix| + (CONS (|popStack2|) + (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) (DEFUN |PARSE-Prefix| () - (AND (PUSH-REDUCTION '|PARSE-Prefix| (CURRENT-SYMBOL)) + (AND (|pushReduction| '|PARSE-Prefix| (CURRENT-SYMBOL)) (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|)) (MUST (|PARSE-Expression|)) - (PUSH-REDUCTION '|PARSE-Prefix| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))) + (|pushReduction| '|PARSE-Prefix| + (CONS (|popStack2|) (CONS (|popStack1|) NIL))))) (DEFUN |PARSE-Suffix| () - (AND (PUSH-REDUCTION '|PARSE-Suffix| (CURRENT-SYMBOL)) + (AND (|pushReduction| '|PARSE-Suffix| (CURRENT-SYMBOL)) (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|)) - (PUSH-REDUCTION '|PARSE-Suffix| - (CONS (POP-STACK-1) (CONS (POP-STACK-1) NIL))))) + (|pushReduction| '|PARSE-Suffix| + (CONS (|popStack1|) (CONS (|popStack1|) NIL))))) (DEFUN |PARSE-TokTail| () @@ -309,28 +309,28 @@ (DEFUN |PARSE-Qualification| () (AND (MATCH-ADVANCE-STRING "$") (MUST (|PARSE-Primary1|)) - (PUSH-REDUCTION '|PARSE-Qualification| - (|dollarTran| (POP-STACK-1) (POP-STACK-1))))) + (|pushReduction| '|PARSE-Qualification| + (|dollarTran| (|popStack1|) (|popStack1|))))) (DEFUN |PARSE-SemiColon| () (AND (MATCH-ADVANCE-STRING ";") (MUST (OR (|PARSE-Expr| 82) - (PUSH-REDUCTION '|PARSE-SemiColon| '|/throwAway|))) - (PUSH-REDUCTION '|PARSE-SemiColon| - (CONS '|;| (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) + (|pushReduction| '|PARSE-SemiColon| '|/throwAway|))) + (|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|)) - (PUSH-REDUCTION '|PARSE-Return| - (CONS '|return| (CONS (POP-STACK-1) NIL))))) + (|pushReduction| '|PARSE-Return| + (CONS '|return| (CONS (|popStack1|) NIL))))) (DEFUN |PARSE-Throw| () (AND (MATCH-ADVANCE-KEYWORD "throw") (MUST (|PARSE-Expression|)) - (PUSH-REDUCTION '|PARSE-Throw| - (CONS '|%Throw| (CONS (POP-STACK-1) NIL))))) + (|pushReduction| '|PARSE-Throw| + (CONS '|%Throw| (CONS (|popStack1|) NIL))))) (DEFUN |PARSE-Catch| () (AND (MATCH-SPECIAL ";") @@ -342,9 +342,9 @@ (MUST (MATCH-ADVANCE-SPECIAL ")")) (MUST (|PARSE-GlyphTok| "=>")) (MUST (|PARSE-Expression|)) - (PUSH-REDUCTION '|PARSE-Catch| - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL))))) + (|pushReduction| '|PARSE-Catch| + (CONS (|popStack2|) + (CONS (|popStack1|) NIL))))) (DEFUN |PARSE-Finally| () (AND (MATCH-SPECIAL ";") @@ -360,19 +360,19 @@ ;; a series of catch-expressions optionally followed by ;; a finally-expression. (MUST (OR (AND (|PARSE-Finally|) - (PUSH-REDUCTION '|PARSE-Try| + (|pushReduction| '|PARSE-Try| (CONS '|%Try| - (CONS (POP-STACK-2) + (CONS (|popStack2|) (CONS NIL - (CONS (POP-STACK-1) NIL)))))) + (CONS (|popStack1|) NIL)))))) (AND (MUST (STAR REPEATOR (|PARSE-Catch|))) (BANG FIL_TEST (OPTIONAL (|PARSE-Finally|))) - (PUSH-REDUCTION '|PARSE-Try| + (|pushReduction| '|PARSE-Try| (CONS '|%Try| - (CONS (POP-STACK-3) - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) + (CONS (|popStack3|) + (CONS (|popStack2|) + (CONS (|popStack1|) NIL)))))))))) @@ -380,31 +380,31 @@ (LET ((S (CURRENT-SYMBOL))) (AND S (ACTION (ADVANCE-TOKEN)) - (PUSH-REDUCTION '|PARSE-Jump| S)))) + (|pushReduction| '|PARSE-Jump| S)))) (DEFUN |PARSE-Exit| () (AND (MATCH-ADVANCE-KEYWORD "exit") (MUST (OR (|PARSE-Expression|) - (PUSH-REDUCTION '|PARSE-Exit| '|$NoValue|))) - (PUSH-REDUCTION '|PARSE-Exit| - (CONS '|exit| (CONS (POP-STACK-1) NIL))))) + (|pushReduction| '|PARSE-Exit| '|$NoValue|))) + (|pushReduction| '|PARSE-Exit| + (CONS '|exit| (CONS (|popStack1|) NIL))))) (DEFUN |PARSE-Leave| () (AND (MATCH-ADVANCE-KEYWORD "leave") (MUST (OR (|PARSE-Expression|) - (PUSH-REDUCTION '|PARSE-Leave| '|$NoValue|))) - (MUST (PUSH-REDUCTION '|PARSE-Leave| - (CONS '|leave| (CONS (POP-STACK-1) NIL)))))) + (|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|))) - (PUSH-REDUCTION '|PARSE-Seg| + (|pushReduction| '|PARSE-Seg| (CONS 'SEGMENT - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) + (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) (DEFUN |PARSE-Conditional| () @@ -414,10 +414,10 @@ (OPTIONAL (AND (MATCH-ADVANCE-KEYWORD "else") (MUST (|PARSE-ElseClause|))))) - (PUSH-REDUCTION '|PARSE-Conditional| + (|pushReduction| '|PARSE-Conditional| (CONS '|if| - (CONS (POP-STACK-3) - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))) + (CONS (|popStack3|) + (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) (DEFUN |PARSE-ElseClause| () @@ -429,22 +429,22 @@ (OR (AND (STAR REPEATOR (|PARSE-Iterator|)) (MUST (MATCH-ADVANCE-KEYWORD "repeat")) (MUST (|PARSE-Expr| 110)) - (PUSH-REDUCTION '|PARSE-Loop| + (|pushReduction| '|PARSE-Loop| (CONS 'REPEAT - (APPEND (POP-STACK-2) (CONS (POP-STACK-1) NIL))))) + (APPEND (|popStack2|) (CONS (|popStack1|) NIL))))) (AND (MATCH-ADVANCE-KEYWORD "repeat") (MUST (|PARSE-Expr| 110)) - (PUSH-REDUCTION '|PARSE-Loop| - (CONS 'REPEAT (CONS (POP-STACK-1) NIL)))))) + (|pushReduction| '|PARSE-Loop| + (CONS 'REPEAT (CONS (|popStack1|) NIL)))))) (DEFUN |PARSE-Variable| () (OR (AND (|PARSE-Name|) (OPTIONAL (AND (MATCH-ADVANCE-STRING ":") (MUST (|PARSE-Application|)) - (MUST (PUSH-REDUCTION '|PARSE-Variable| + (MUST (|pushReduction| '|PARSE-Variable| (CONS '|:| - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))))))) + (CONS (|popStack2|) + (CONS (|popStack1|) NIL)))))))) (|PARSE-Primary|))) (DEFUN |PARSE-Iterator| () @@ -453,26 +453,26 @@ (MUST (|PARSE-Expression|)) (MUST (OR (AND (MATCH-ADVANCE-KEYWORD "by") (MUST (|PARSE-Expr| 200)) - (PUSH-REDUCTION '|PARSE-Iterator| + (|pushReduction| '|PARSE-Iterator| (CONS 'INBY - (CONS (POP-STACK-3) - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))))) - (PUSH-REDUCTION '|PARSE-Iterator| + (CONS (|popStack3|) + (CONS (|popStack2|) + (CONS (|popStack1|) NIL)))))) + (|pushReduction| '|PARSE-Iterator| (CONS 'IN - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))))) + (CONS (|popStack2|) + (CONS (|popStack1|) NIL)))))) (OPTIONAL (AND (MATCH-ADVANCE-STRING "|") (MUST (|PARSE-Expr| 111)) - (PUSH-REDUCTION '|PARSE-Iterator| - (CONS '|\|| (CONS (POP-STACK-1) NIL)))))) + (|pushReduction| '|PARSE-Iterator| + (CONS '|\|| (CONS (|popStack1|) NIL)))))) (AND (MATCH-ADVANCE-KEYWORD "while") (MUST (|PARSE-Expr| 190)) - (PUSH-REDUCTION '|PARSE-Iterator| - (CONS 'WHILE (CONS (POP-STACK-1) NIL)))) + (|pushReduction| '|PARSE-Iterator| + (CONS 'WHILE (CONS (|popStack1|) NIL)))) (AND (MATCH-ADVANCE-KEYWORD "until") (MUST (|PARSE-Expr| 190)) - (PUSH-REDUCTION '|PARSE-Iterator| - (CONS 'UNTIL (CONS (POP-STACK-1) NIL)))))) + (|pushReduction| '|PARSE-Iterator| + (CONS 'UNTIL (CONS (|popStack1|) NIL)))))) (DEFUN |PARSE-Match| () @@ -480,16 +480,16 @@ (MUST (|PARSE-Expr| 400)) (MATCH-ADVANCE-KEYWORD "is") (MUST (|PARSE-Expr| 110)) - (PUSH-REDUCTION '|PARSE-Match| + (|pushReduction| '|PARSE-Match| (CONS '|%Match| - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))))) + (CONS (|popStack2|) + (CONS (|popStack1|) NIL)))))) (DEFUN |PARSE-Expr| (RBP) (DECLARE (SPECIAL RBP)) (AND (|PARSE-NudPart| RBP) (OPTIONAL (STAR OPT_EXPR (|PARSE-LedPart| RBP))) - (PUSH-REDUCTION '|PARSE-Expr| (POP-STACK-1)))) + (|pushReduction| '|PARSE-Expr| (|popStack1|)))) (DEFUN |PARSE-Label| () @@ -500,14 +500,14 @@ (DEFUN |PARSE-LedPart| (RBP) (DECLARE (SPECIAL RBP)) (AND (|PARSE-Operation| '|Led| RBP) - (PUSH-REDUCTION '|PARSE-LedPart| (POP-STACK-1)))) + (|pushReduction| '|PARSE-LedPart| (|popStack1|)))) (DEFUN |PARSE-NudPart| (RBP) (DECLARE (SPECIAL RBP)) (AND (OR (|PARSE-Operation| '|Nud| RBP) (|PARSE-Reduction|) (|PARSE-Form|)) - (PUSH-REDUCTION '|PARSE-NudPart| (POP-STACK-1)))) + (|pushReduction| '|PARSE-NudPart| (|popStack1|)))) (DEFUN |PARSE-Operation| (|ParseMode| RBP) @@ -539,15 +539,15 @@ (DEFUN |PARSE-Reduction| () (AND (|PARSE-ReductionOp|) (MUST (|PARSE-Expr| 1000)) - (PUSH-REDUCTION '|PARSE-Reduction| + (|pushReduction| '|PARSE-Reduction| (CONS '|%Reduce| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) + (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) (DEFUN |PARSE-ReductionOp| () (AND (GETL (CURRENT-SYMBOL) '|Led|) (MATCH-NEXT-TOKEN 'GLIPH '/) - (PUSH-REDUCTION '|PARSE-ReductionOp| (CURRENT-SYMBOL)) + (|pushReduction| '|PARSE-ReductionOp| (CURRENT-SYMBOL)) (ACTION (ADVANCE-TOKEN)) (ACTION (ADVANCE-TOKEN)))) @@ -557,13 +557,13 @@ (OPTIONAL (AND (MATCH-ADVANCE-KEYWORD "from") (MUST (|PARSE-Label|)) - (PUSH-REDUCTION '|PARSE-Form| - (CONS (POP-STACK-1) NIL))))) - (PUSH-REDUCTION '|PARSE-Form| - (CONS '|iterate| (APPEND (POP-STACK-1) NIL)))) + (|pushReduction| '|PARSE-Form| + (CONS (|popStack1|) NIL))))) + (|pushReduction| '|PARSE-Form| + (CONS '|iterate| (APPEND (|popStack1|) NIL)))) (AND (MATCH-ADVANCE-KEYWORD "yield") (MUST (|PARSE-Application|)) - (PUSH-REDUCTION '|PARSE-Form| - (CONS '|yield| (CONS (POP-STACK-1) NIL)))) + (|pushReduction| '|PARSE-Form| + (CONS '|yield| (CONS (|popStack1|) NIL)))) (|PARSE-Application|))) @@ -571,21 +571,21 @@ (AND (|PARSE-Primary|) (OPTIONAL (STAR OPT_EXPR (|PARSE-Selector|))) (OPTIONAL (AND (|PARSE-Application|) - (PUSH-REDUCTION '|PARSE-Application| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))) + (|pushReduction| '|PARSE-Application| + (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) (DEFUN |PARSE-Selector| () (OR (AND NONBLANK (EQ (CURRENT-SYMBOL) '|.|) (CHAR-NE (CURRENT-CHAR) '| |) (MATCH-ADVANCE-STRING ".") (MUST (|PARSE-PrimaryNoFloat|)) - (MUST (PUSH-REDUCTION '|PARSE-Selector| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))) + (MUST (|pushReduction| '|PARSE-Selector| + (CONS (|popStack2|) (CONS (|popStack1|) NIL))))) (AND (OR (|PARSE-Float|) (AND (MATCH-ADVANCE-STRING ".") (MUST (|PARSE-Primary|)))) - (MUST (PUSH-REDUCTION '|PARSE-Selector| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))) + (MUST (|pushReduction| '|PARSE-Selector| + (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) (DEFUN |PARSE-PrimaryNoFloat| () @@ -601,23 +601,23 @@ (OPTIONAL (AND NONBLANK (EQ (CURRENT-SYMBOL) '|(|) (MUST (|PARSE-Primary1|)) - (PUSH-REDUCTION '|PARSE-Primary1| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) + (|pushReduction| '|PARSE-Primary1| + (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) (|PARSE-Quad|) (|PARSE-String|) (|PARSE-IntegerTok|) (|PARSE-FormalParameter|) (AND (MATCH-ADVANCE-STRING "'") (MUST (AND (MUST (|PARSE-Data|)) - (PUSH-REDUCTION '|PARSE-Primary1| (POP-STACK-1))))) + (|pushReduction| '|PARSE-Primary1| (|popStack1|))))) (|PARSE-Sequence|) (|PARSE-Enclosure|))) (DEFUN |PARSE-Float| () (AND (|PARSE-FloatBase|) (MUST (OR (AND NONBLANK (|PARSE-FloatExponent|)) - (PUSH-REDUCTION '|PARSE-Float| 0))) - (PUSH-REDUCTION '|PARSE-Float| - (MAKE-FLOAT (POP-STACK-4) (POP-STACK-2) (POP-STACK-2) - (POP-STACK-1))))) + (|pushReduction| '|PARSE-Float| 0))) + (|pushReduction| '|PARSE-Float| + (MAKE-FLOAT (|popStack4|) (|popStack2|) (|popStack2|) + (|popStack1|))))) (DEFUN |PARSE-FloatBase| () @@ -626,21 +626,21 @@ (MUST (|PARSE-FloatBasePart|))) (AND (INTEGERP (CURRENT-SYMBOL)) (CHAR-EQ (CHAR-UPCASE (CURRENT-CHAR)) 'E) - (|PARSE-IntegerTok|) (PUSH-REDUCTION '|PARSE-FloatBase| 0) - (PUSH-REDUCTION '|PARSE-FloatBase| 0)) + (|PARSE-IntegerTok|) (|pushReduction| '|PARSE-FloatBase| 0) + (|pushReduction| '|PARSE-FloatBase| 0)) (AND (DIGITP (CURRENT-CHAR)) (EQ (CURRENT-SYMBOL) '|.|) - (PUSH-REDUCTION '|PARSE-FloatBase| 0) + (|pushReduction| '|PARSE-FloatBase| 0) (|PARSE-FloatBasePart|)))) (DEFUN |PARSE-FloatBasePart| () (AND (MATCH-ADVANCE-STRING ".") (MUST (OR (AND (DIGITP (CURRENT-CHAR)) - (PUSH-REDUCTION '|PARSE-FloatBasePart| + (|pushReduction| '|PARSE-FloatBasePart| (TOKEN-NONBLANK (CURRENT-TOKEN))) (|PARSE-IntegerTok|)) - (AND (PUSH-REDUCTION '|PARSE-FloatBasePart| 0) - (PUSH-REDUCTION '|PARSE-FloatBasePart| 0)))))) + (AND (|pushReduction| '|PARSE-FloatBasePart| 0) + (|pushReduction| '|PARSE-FloatBasePart| 0)))))) (DEFUN |PARSE-FloatExponent| () @@ -653,13 +653,13 @@ (MUST (|PARSE-IntegerTok|))) (AND (MATCH-ADVANCE-STRING "-") (MUST (|PARSE-IntegerTok|)) - (PUSH-REDUCTION '|PARSE-FloatExponent| - (MINUS (POP-STACK-1)))) - (PUSH-REDUCTION '|PARSE-FloatExponent| 0)))) + (|pushReduction| '|PARSE-FloatExponent| + (MINUS (|popStack1|)))) + (|pushReduction| '|PARSE-FloatExponent| 0)))) (AND (IDENTP (CURRENT-SYMBOL)) (SETQ G1 (FLOATEXPID (CURRENT-SYMBOL))) (ACTION (ADVANCE-TOKEN)) - (PUSH-REDUCTION '|PARSE-FloatExponent| G1)))))) + (|pushReduction| '|PARSE-FloatExponent| G1)))))) (DEFUN |PARSE-Enclosure| () @@ -667,26 +667,26 @@ (MUST (OR (AND (|PARSE-Expr| 6) (MUST (MATCH-ADVANCE-STRING ")"))) (AND (MATCH-ADVANCE-STRING ")") - (PUSH-REDUCTION '|PARSE-Enclosure| + (|pushReduction| '|PARSE-Enclosure| (CONS '|%Comma| NIL)))))) (AND (MATCH-ADVANCE-STRING "{") (MUST (OR (AND (|PARSE-Expr| 6) (MUST (MATCH-ADVANCE-STRING "}")) - (PUSH-REDUCTION '|PARSE-Enclosure| + (|pushReduction| '|PARSE-Enclosure| (CONS '|brace| (CONS (CONS '|construct| - (CONS (POP-STACK-1) NIL)) + (CONS (|popStack1|) NIL)) NIL)))) (AND (MATCH-ADVANCE-STRING "}") - (PUSH-REDUCTION '|PARSE-Enclosure| + (|pushReduction| '|PARSE-Enclosure| (CONS '|brace| NIL)))))) (AND (MATCH-ADVANCE-STRING "[|") (MUST (AND (|PARSE-Statement|) (MUST (MATCH-ADVANCE-STRING "|]")) - (PUSH-REDUCTION '|PARSE-Enclosure| + (|pushReduction| '|PARSE-Enclosure| (CONS '|[\|\|]| - (CONS (POP-STACK-1) NIL))) + (CONS (|popStack1|) NIL))) ))) )) @@ -696,7 +696,7 @@ (DEFUN |PARSE-FloatTok| () (AND (PARSE-NUMBER) - (PUSH-REDUCTION '|PARSE-FloatTok| (POP-STACK-1)))) + (|pushReduction| '|PARSE-FloatTok| (|popStack1|)))) (DEFUN |PARSE-FormalParameter| () (|PARSE-FormalParameterTok|)) @@ -707,7 +707,7 @@ (DEFUN |PARSE-Quad| () (AND (MATCH-ADVANCE-STRING "$") - (PUSH-REDUCTION '|PARSE-Quad| '$))) + (|pushReduction| '|PARSE-Quad| '$))) (DEFUN |PARSE-String| () (PARSE-SPADSTRING)) @@ -717,10 +717,10 @@ (AND (|PARSE-Name|) (OPTIONAL (AND (|PARSE-Scripts|) - (PUSH-REDUCTION '|PARSE-VarForm| + (|pushReduction| '|PARSE-VarForm| (CONS '|Scripts| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) - (PUSH-REDUCTION '|PARSE-VarForm| (POP-STACK-1)))) + (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) + (|pushReduction| '|PARSE-VarForm| (|popStack1|)))) (DEFUN |PARSE-Scripts| () @@ -734,23 +734,23 @@ (AND (STAR REPEATOR (AND (MATCH-ADVANCE-STRING ";") (MUST (|PARSE-ScriptItem|)))) - (PUSH-REDUCTION '|PARSE-ScriptItem| + (|pushReduction| '|PARSE-ScriptItem| (CONS '|;| - (CONS (POP-STACK-2) - (APPEND (POP-STACK-1) NIL))))))) + (CONS (|popStack2|) + (APPEND (|popStack1|) NIL))))))) (AND (MATCH-ADVANCE-STRING ";") (MUST (|PARSE-ScriptItem|)) - (PUSH-REDUCTION '|PARSE-ScriptItem| - (CONS '|PrefixSC| (CONS (POP-STACK-1) NIL)))))) + (|pushReduction| '|PARSE-ScriptItem| + (CONS '|PrefixSC| (CONS (|popStack1|) NIL)))))) (DEFUN |PARSE-Name| () - (AND (PARSE-IDENTIFIER) (PUSH-REDUCTION '|PARSE-Name| (POP-STACK-1)))) + (AND (PARSE-IDENTIFIER) (|pushReduction| '|PARSE-Name| (|popStack1|)))) (DEFUN |PARSE-Data| () (AND (ACTION (SETQ LABLASOC NIL)) (|PARSE-Sexpr|) - (PUSH-REDUCTION '|PARSE-Data| - (CONS 'QUOTE (CONS (TRANSLABEL (POP-STACK-1) LABLASOC) NIL))))) + (|pushReduction| '|PARSE-Data| + (CONS 'QUOTE (CONS (TRANSLABEL (|popStack1|) LABLASOC) NIL))))) (DEFUN |PARSE-Sexpr| () @@ -764,19 +764,19 @@ (OPTIONAL (AND (|PARSE-NBGliphTok| '=) (MUST (|PARSE-Sexpr1|)) (ACTION (SETQ LABLASOC - (CONS (CONS (POP-STACK-2) - (NTH-STACK 1)) + (CONS (CONS (|popStack2|) + (|nthStack| 1)) LABLASOC)))))) (AND (MATCH-ADVANCE-STRING "'") (MUST (|PARSE-Sexpr1|)) - (PUSH-REDUCTION '|PARSE-Sexpr1| - (CONS 'QUOTE (CONS (POP-STACK-1) NIL)))) + (|pushReduction| '|PARSE-Sexpr1| + (CONS 'QUOTE (CONS (|popStack1|) NIL)))) ;; next form disabled -- gdr, 2009-06-15. ; (AND (MATCH-ADVANCE-STRING "-") (MUST (|PARSE-IntegerTok|)) -; (PUSH-REDUCTION '|PARSE-Sexpr1| (MINUS (POP-STACK-1)))) +; (|pushReduction| '|PARSE-Sexpr1| (MINUS (|popStack1|)))) (AND (MATCH-ADVANCE-STRING "[") (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Sexpr1|)))) (MUST (MATCH-ADVANCE-STRING "]")) - (PUSH-REDUCTION '|PARSE-Sexpr1| (LIST2VEC (POP-STACK-1)))) + (|pushReduction| '|PARSE-Sexpr1| (LIST2VEC (|popStack1|)))) (AND (MATCH-ADVANCE-STRING "(") (BANG FIL_TEST (OPTIONAL @@ -784,8 +784,8 @@ (OPTIONAL (AND (|PARSE-GlyphTok| ".") (MUST (|PARSE-Sexpr1|)) - (PUSH-REDUCTION '|PARSE-Sexpr1| - (|append!| (POP-STACK-2) (POP-STACK-1)))))))) + (|pushReduction| '|PARSE-Sexpr1| + (|append!| (|popStack2|) (|popStack1|)))))))) (MUST (MATCH-ADVANCE-STRING ")"))))) @@ -804,7 +804,7 @@ (DEFUN |PARSE-AnyId| () (OR (|PARSE-Name|) (OR (AND (MATCH-STRING "$") - (PUSH-REDUCTION '|PARSE-AnyId| (CURRENT-SYMBOL)) + (|pushReduction| '|PARSE-AnyId| (CURRENT-SYMBOL)) (ACTION (ADVANCE-TOKEN))) (PARSE-KEYWORD) (|PARSE-OperatorFunctionName|)))) @@ -815,32 +815,32 @@ (MUST (MATCH-ADVANCE-STRING "]"))) (AND (|PARSE-OpenBrace|) (MUST (|PARSE-Sequence1|)) (MUST (MATCH-ADVANCE-STRING "}")) - (PUSH-REDUCTION '|PARSE-Sequence| - (CONS '|brace| (CONS (POP-STACK-1) NIL)))))) + (|pushReduction| '|PARSE-Sequence| + (CONS '|brace| (CONS (|popStack1|) NIL)))))) (DEFUN |PARSE-Sequence1| () (AND (OR (AND (|PARSE-Expression|) - (PUSH-REDUCTION '|PARSE-Sequence1| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))) - (PUSH-REDUCTION '|PARSE-Sequence1| (CONS (POP-STACK-1) NIL))) + (|pushReduction| '|PARSE-Sequence1| + (CONS (|popStack2|) (CONS (|popStack1|) NIL)))) + (|pushReduction| '|PARSE-Sequence1| (CONS (|popStack1|) NIL))) (OPTIONAL (AND (|PARSE-IteratorTail|) - (PUSH-REDUCTION '|PARSE-Sequence1| + (|pushReduction| '|PARSE-Sequence1| (CONS 'COLLECT - (APPEND (POP-STACK-1) - (CONS (POP-STACK-1) NIL)))))))) + (APPEND (|popStack1|) + (CONS (|popStack1|) NIL)))))))) (DEFUN |PARSE-OpenBracket| () (LET ((G1 (CURRENT-SYMBOL))) (AND (EQ (|getToken| G1) '[) (MUST (OR (AND (EQCAR G1 '|elt|) - (PUSH-REDUCTION '|PARSE-OpenBracket| + (|pushReduction| '|PARSE-OpenBracket| (CONS '|elt| (CONS (CADR G1) (CONS '|construct| NIL))))) - (PUSH-REDUCTION '|PARSE-OpenBracket| '|construct|))) + (|pushReduction| '|PARSE-OpenBracket| '|construct|))) (ACTION (ADVANCE-TOKEN))))) @@ -848,11 +848,11 @@ (LET ((G1 (CURRENT-SYMBOL))) (AND (EQ (|getToken| G1) '{) (MUST (OR (AND (EQCAR G1 '|elt|) - (PUSH-REDUCTION '|PARSE-OpenBrace| + (|pushReduction| '|PARSE-OpenBrace| (CONS '|elt| (CONS (CADR G1) (CONS '|brace| NIL))))) - (PUSH-REDUCTION '|PARSE-OpenBrace| '|construct|))) + (|pushReduction| '|PARSE-OpenBrace| '|construct|))) (ACTION (ADVANCE-TOKEN))))) diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot index 506e22c6..d26ef72d 100644 --- a/src/interp/lexing.boot +++ b/src/interp/lexing.boot @@ -71,7 +71,7 @@ stackClear! st == stackStore(st) := nil stackSize(st) := 0 stackTop(st) := nil - stackUpdate?(st) := false + stackUpdated?(st) := false stackPush!(x,st) == stackStore(st) := [x,:stackStore st] @@ -86,3 +86,61 @@ stackPop! st == if stackStore st ~= nil then stackTop(st) := first stackStore st y + + +--% +--% Parsing reduction stack +--% +--% Abstractly; +--% structure Reduction == Record(rule: RuleName, value: ParseTree) +--% +makeReduction(p == nil,v == nil) == + [p,v] + +macro reductionRule r == + first r + +macro reductionValue r == + second r + +++ stack of results of reduced productions +$reduceStack := makeStack() + +pushReduction(rn,pt) == + stackPush!(makeReduction(rn,pt),$reduceStack) + +popReduction() == + stackPop! $reduceStack + +reduceStackClear() == + stackClear! $reduceStack + +popStack1() == + reductionValue popReduction() + +popStack2() == + r1 := popReduction() + r2 := popReduction() + stackPush!(r1,$reduceStack) + reductionValue r2 + +popStack3() == + r1 := popReduction() + r2 := popReduction() + r3 := popReduction() + stackPush!(r2,$reduceStack) + stackPush!(r1,$reduceStack) + reductionValue r3 + +popStack4() == + r1 := popReduction() + r2 := popReduction() + r3 := popReduction() + r4 := popReduction() + stackPush!(r3,$reduceStack) + stackPush!(r2,$reduceStack) + stackPush!(r1,$reduceStack) + reductionValue r4 + +nthStack n == + reductionValue stackStore($reduceStack).(n - 1) diff --git a/src/interp/metalex.lisp b/src/interp/metalex.lisp index 4e9c208a..532ed9e6 100644 --- a/src/interp/metalex.lisp +++ b/src/interp/metalex.lisp @@ -57,7 +57,6 @@ ; ; A. Line Buffer ; C. Token -; D. Reduction ; 1A. A Line Buffer ; @@ -320,36 +319,8 @@ NonBlank is true if the token is not preceded by a blank." (decf Valid-Tokens)))) -; 1D. A Reduction -; - -(defstruct (Reduction (:type list)) -"A reduction of a rule is any S-Expression the rule chooses to stack." - (Rule nil) ; Name of rule - (Value nil)) - -; 2. Recursive descent parsing support routines (semantically related to MetaLanguage) -; -; This section of the code contains: -; -; A. Routines for stacking and retrieving reductions of rules. -; B. Routines for applying certain metagrammatical elements -; of a production (e.g., Star). -; C. Token-level parsing utilities (keywords, strings, identifiers). - -; 2A. Routines for stacking and retrieving reductions of rules. - -; FUNCTIONS DEFINED IN THIS SECTION: -; -; Push-Reduction Pop-Reduction - -(defparameter Reduce-Stack (|makeStack|) "Stack of results of reduced productions.") - -(defun Push-Reduction (rule redn) - (|stackPush!| (make-reduction :rule rule :value redn) Reduce-Stack)) - (defun reduce-stack-show () - (let ((store (|stackStore| reduce-stack)) + (let ((store (|stackStore| |$reduceStack|)) (*print-pretty* t)) (if store (progn (format t "~%Reduction stack contains:~%") @@ -357,39 +328,9 @@ NonBlank is true if the token is not preceded by a blank." (if (eq (type-of x) 'token) (describe x) (print x))) - (|stackStore| reduce-stack))) + (|stackStore| |$reduceStack|))) (format t "~%There is nothing on the reduction stack.~%")))) -(defmacro reduce-stack-clear () `(|stackLoad!| nil reduce-stack)) - -(defun Pop-Reduction () (|stackPop!| Reduce-Stack)) - -(defmacro pop-stack-1 () '(reduction-value (Pop-Reduction))) - -(defmacro pop-stack-2 () - `(let* ((top (Pop-Reduction)) (next (Pop-Reduction))) - (|stackPush!| top Reduce-Stack) - (reduction-value next))) - -(defmacro pop-stack-3 () - `(let* ((top (Pop-Reduction)) (next (Pop-Reduction)) (nnext (Pop-Reduction))) - (|stackPush!| next Reduce-Stack) - (|stackPush!| top Reduce-Stack) - (reduction-value nnext))) - -(defmacro pop-stack-4 () - `(let* ((top (Pop-Reduction)) - (next (Pop-Reduction)) - (nnext (Pop-Reduction)) - (nnnext (Pop-Reduction))) - (|stackPush!| nnext Reduce-Stack) - (|stackPush!| next Reduce-Stack) - (|stackPush!| top Reduce-Stack) - (reduction-value nnnext))) - -(defmacro nth-stack (x) - `(reduction-value (nth (1- ,x) (|stackStore| Reduce-Stack)))) - ; *** 2. META Line Handling (defparameter Comment-Character #\% "Delimiter of comments in Meta code.") @@ -441,7 +382,7 @@ NonBlank is true if the token is not preceded by a blank." `(defun ,(intern (concatenate 'string "PARSE-" (string token))) () (let* ((tok (match-current-token ',token)) (symbol (if tok (token-symbol tok)))) - (if tok (progn (Push-Reduction + (if tok (progn (|pushReduction| ',(intern (concatenate 'string (string token) "-TOKEN")) (copy-tree symbol)) @@ -562,7 +503,7 @@ as keywords.") (match-current-token 'gliph) (match-current-token 'special-char))))) (when (and id (member id |$OperatorFunctionNames|)) - (Push-Reduction '|PARSE-OperatorFunctionName| id) + (|pushReduction| '|PARSE-OperatorFunctionName| id) (action (advance-token))))) ; Meta tokens fall into the following categories: diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp index e2f1c2e9..ae0b83f4 100644 --- a/src/interp/parsing.lisp +++ b/src/interp/parsing.lisp @@ -109,22 +109,22 @@ the sub-reductions of PROD and labelling them with LAB. E.G., (Star IDs (parse-id)) with A B C will stack (3 IDs (A B C)), where (parse-id) would stack (1 ID (A)) when applied once." - `(prog ((oldstacksize (|stackSize| reduce-stack))) + `(prog ((oldstacksize (|stackSize| |$reduceStack|))) (if (not ,prod) ;(progn (format t "~&Star failed for ~A.~%" ',lab) (return nil))) (return nil)) loop (if (not ,prod) - (let* ((newstacksize (|stackSize| reduce-stack)) + (let* ((newstacksize (|stackSize| |$reduceStack|)) (number-of-new-reductions (- newstacksize oldstacksize))) ; (format t "~&Starring ~A with ~D new reductions.~%" ; ',lab number-of-new-reductions) (if (> number-of-new-reductions 0) (return (do ((i 0 (1+ i)) (accum nil)) ((= i number-of-new-reductions) - (Push-Reduction ',lab accum) + (|pushReduction| ',lab accum) ; (format t "~&Star accumulated ~D reductions.~%" ; (length accum)) (return t)) - (push (pop-stack-1) accum))) + (push (|popStack1|) accum))) (return t))) (go loop)))) @@ -133,18 +133,13 @@ where (parse-id) would stack (1 ID (A)) when applied once." "If the execution of prod does not result in an increase in the size of the stack, then stack a NIL. Return the value of prod." - `(progn (setf (|stackUpdated?| reduce-stack) nil) -; (format t "~&Banging ~A~:[~; and I think the stack is updated!~].~%" ',lab -; (stack-updated reduce-stack)) + `(progn (setf (|stackUpdated?| |$reduceStack|) nil) (let* ((prodvalue ,prod) - (updated (|stackUpdated?| reduce-stack))) -; (format t "~&Bang thinks that ~A ~:[didn't do anything~;did something~].~&" -; ',lab prodvalue) + (updated (|stackUpdated?| |$reduceStack|))) (if updated (progn ; (format t "~&Banged ~A and I think the stack is updated!~%" ',lab) prodvalue) - (progn (push-reduction ',lab nil) - ; (format t "~&Banged ~A.~%" ',lab) + (progn (|pushReduction| ',lab nil) prodvalue))))) (defmacro must (dothis &optional (this-is nil) (in-rule nil)) @@ -233,7 +228,7 @@ the stack, then stack a NIL. Return the value of prod." (defun conversation (x y) (prog (u) - a (reduce-stack-clear) + a (|reduceStackClear|) (setq u (namederrset 'spad_reader (conversation1 x y) )) (cond (*eof* (return nil)) ((atom u) (go a)) @@ -247,7 +242,7 @@ the stack, then stack a NIL. Return the value of prod." ((and (current-token) (next-token)) (go top)) ((compfin) (return 't)) ((and (funcall firstfun) - (or (funcall procfun (pop-stack-1)))) + (or (funcall procfun (|popStack1|)))) (go top)) ((compfin) (return 't)) ) (spad_syntax_error) @@ -432,7 +427,7 @@ the stack, then stack a NIL. Return the value of prod." c1 (cond ( (not (identp tok)) (go d1))) (princ "/isid= ") ;; (princ (cond (isid "T") (t "NIL"))) - d1 (princ "/stack= ") (prin1 (|stackStore| reduce-stack)) + d1 (princ "/stack= ") (prin1 (|stackStore| |$reduceStack|)) (setq v (apply fun* argl*)) (setq /depth (- /depth 1)) (terpri) (trblanks (* 2 /depth)) (princ (stringimage (\1+ /depth))) @@ -447,7 +442,7 @@ the stack, then stack a NIL. Return the value of prod." c2 (if (not (identp tok)) (go d2)) (princ "/isid= ") ;; (princ (if isid "T" "NIL")) - d2 (princ "/stack= ") (prin1 (|stackStore| reduce-stack)) + d2 (princ "/stack= ") (prin1 (|stackStore| |$reduceStack|)) (princ "/value= ") (prin1 v) (return v))))))) @@ -502,11 +497,9 @@ the stack, then stack a NIL. Return the value of prod." (defun IOStat () "Tell me what the current state of the parsing world is." - ;(IOStreams-show) (current-line-show) (if $SPAD (next-lines-show)) (token-stack-show) - ;(reduce-stack-show) nil) (defun IOClear (&optional (in t) (out t)) @@ -514,7 +507,7 @@ the stack, then stack a NIL. Return the value of prod." (input-clear) (current-line-clear) (token-stack-clear) - (reduce-stack-clear) + (|reduceStackClear|) (if $SPAD (next-lines-clear)) nil) diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot index eab3bbec..719f7258 100644 --- a/src/interp/spad-parser.boot +++ b/src/interp/spad-parser.boot @@ -80,7 +80,7 @@ parseSpadFile sourceFile == BOOT_-LINE_-STACK : local := PREPARSE IN_-STREAM LINE : local := CDAR BOOT_-LINE_-STACK CATCH('SPAD__READER,PARSE_-NewExpr()) - asts := [parseTransform postTransform POP_-STACK_-1(), :asts] + asts := [parseTransform postTransform popStack1(), :asts] -- clean up the mess, and get out of here IOCLEAR(IN_-STREAM, OUT_-STREAM) SHUT IN_-STREAM diff --git a/src/interp/util.lisp b/src/interp/util.lisp index 73ebd5f6..0a6800cb 100644 --- a/src/interp/util.lisp +++ b/src/interp/util.lisp @@ -268,7 +268,7 @@ (ioclear) (LET* ((BOOT-LINE-STACK (LIST (CONS 1 LINE))) ($SPAD T) - (PARSEOUT (PROG2 (|PARSE-NewExpr|) (POP-STACK-1)))) + (PARSEOUT (PROG2 (|PARSE-NewExpr|) (|popStack1|)))) (DECLARE (SPECIAL BOOT-LINE-STACK $SPAD)) PARSEOUT)) -- cgit v1.2.3