diff options
| -rw-r--r-- | src/ChangeLog | 12 | ||||
| -rw-r--r-- | src/algebra/java.spad.pamphlet | 2 | ||||
| -rw-r--r-- | src/algebra/syntax.spad.pamphlet | 36 | ||||
| -rw-r--r-- | src/interp/fnewmeta.lisp | 139 | ||||
| -rw-r--r-- | src/interp/lexing.boot | 21 | ||||
| -rw-r--r-- | src/interp/parsing.lisp | 73 | ||||
| -rw-r--r-- | src/interp/spad-parser.boot | 18 |
7 files changed, 118 insertions, 183 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index cc61e6b3..1d148d1f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,15 @@ +2011-10-11 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/lexing.boot (matchAdvanceString): New. + * interp/spad-parser.boot: New parsing functions. + * interp/fnewmeta.lisp: Use them. + (PARSE-VarForm): Remove. + (PARSE-Scripts): Likewise. + (PARSE-ScriptItem): Likewise. + (PARSE-AnyId): Likewise. + * interp/parsing.lisp (PARSE-OperatorFunctionName): Remove. + (MATCH-ADVANCE-STRING): Likewise. + 2011-10-10 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/lexing.boot (matchString): New. diff --git a/src/algebra/java.spad.pamphlet b/src/algebra/java.spad.pamphlet index d09d8607..11d69455 100644 --- a/src/algebra/java.spad.pamphlet +++ b/src/algebra/java.spad.pamphlet @@ -238,7 +238,7 @@ JVMOpcode(): Public == Private where 'ifge, 'ifle, 'if__icmpeq, 'if__icmpne, 'if__icmplt, _ 'if__cmpge, 'if__cmpgt, 'if__cmple, 'if__cmpeq, 'if__acmpeq,_ 'if__acmpne, 'goto, 'jsr, 'ret, 'tableswitch, 'lookupswitch,_ - 'ireturn, 'lreturn, 'freturn, 'dreturn, 'areturn, 'return, _ + 'ireturn, 'lreturn, 'freturn, 'dreturn, 'areturn, '_return, _ 'getstatic, 'putstatic, 'getfield,'putfield, 'invokevirtual,_ 'invokespecial, 'invokestatic, 'invokeinterface, _ 'xxxunusedxxx, 'new, 'newarray, 'anewarray, 'arraylength, _ diff --git a/src/algebra/syntax.spad.pamphlet b/src/algebra/syntax.spad.pamphlet index 783459b1..bd908bf0 100644 --- a/src/algebra/syntax.spad.pamphlet +++ b/src/algebra/syntax.spad.pamphlet @@ -724,7 +724,7 @@ ImportAst(): Public == Private where Private == add import Pair Rep == Pair(Identifier, List TypeAst) - coerce(ts: List TypeAst): % == per pair('import,ts) + coerce(ts: List TypeAst): % == per pair('_import,ts) imports x == second rep x coerce(x: %): OutputForm == elt('ImportAst::OutputForm, @@ -1694,7 +1694,7 @@ SpadAst(): SpadAstExports() == add isAst(x: %, tag: Identifier): Boolean == (op := getOperator(x::Syntax)) case Identifier and op = tag - x case ImportAst == isAst(x,'import) + x case ImportAst == isAst(x,'_import) autoCoerce(x: %): ImportAst == x : ImportAst x case DefinitionAst == isAst(x,'DEF) @@ -1703,7 +1703,7 @@ SpadAst(): SpadAstExports() == add x case MacroAst == isAst(x,'MDEF) autoCoerce(x: %): MacroAst == x : MacroAst - x case WhereAst == isAst(x,'where) + x case WhereAst == isAst(x,'_where) autoCoerce(x: %): WhereAst == x : WhereAst x case CategoryAst == isAst(x,'CATEGORY) @@ -1745,16 +1745,16 @@ SpadAst(): SpadAstExports() == add x case ConstructAst == isAst(x,'construct) autoCoerce(x: %): ConstructAst == x : ConstructAst - x case ExitAst == isAst(x,'exit) + x case ExitAst == isAst(x,'_exit) autoCoerce(x: %): ExitAst == x : ExitAst - x case ReturnAst == isAst(x,'return) + x case ReturnAst == isAst(x,'_return) autoCoerce(x: %): ReturnAst == x : ReturnAst x case CoerceAst == isAst(x,'_:_:) autoCoerce(x: %): CoerceAst == x : CoerceAst - x case PretendAst == isAst(x,'pretend) + x case PretendAst == isAst(x,'_pretend) autoCoerce(x: %): PretendAst == x : PretendAst x case RestrictAst == isAst(x,'_@) @@ -1775,13 +1775,13 @@ SpadAst(): SpadAstExports() == add x case ColonAst == isAst(x,'_:) autoCoerce(x: %): ColonAst == x : ColonAst - x case CaseAst == isAst(x,'case) + x case CaseAst == isAst(x,'_case) autoCoerce(x: %): CaseAst == x : CaseAst - x case HasAst == isAst(x,'has) + x case HasAst == isAst(x,'_has) autoCoerce(x: %): HasAst == x : HasAst - x case IsAst == isAst(x,'is) + x case IsAst == isAst(x,'_is) autoCoerce(x: %): IsAst == x : IsAst x case Identifier == (x::Syntax) case Identifier @@ -1803,21 +1803,21 @@ SpadAst(): SpadAstExports() == add op = 'STEP => x:StepAst::OutputForm op = 'COLLECT => x:CollectAst::OutputForm op = 'construct => x:ConstructAst::OutputForm - op = 'exit => x:ExitAst::OutputForm - op = 'return => x:ReturnAst::OutputForm + op = '_exit => x:ExitAst::OutputForm + op = '_return => x:ReturnAst::OutputForm op = 'SEQ => x:SequenceAst::OutputForm op = '%LET => x:LetAst::OutputForm - op = 'pretend => x:PretendAst::OutputForm + op = '_pretend => x:PretendAst::OutputForm op = '_:_: => x:CoerceAst::OutputForm op = '_@ => x:RestrictAst::OutputForm op = 'SEGMENT => x:SegmentAst::OutputForm op = '_| => x:SuchThatAst::OutputForm op = '_: => x:ColonAst::OutputForm - op = 'add => x:AddAst::OutputForm - op = 'case => x:CaseAst::OutputForm - op = 'has => x:CaseAst::OutputForm - op = 'is => x:CaseAst::OutputForm - op = 'where => x:WhereAst::OutputForm + op = '_add => x:AddAst::OutputForm + op = '_case => x:CaseAst::OutputForm + op = '_has => x:CaseAst::OutputForm + op = '_is => x:CaseAst::OutputForm + op = '_where => x:WhereAst::OutputForm op = '%Comma => x:CommaAst::OutputForm op = 'Mapping => x:MappingAst::OutputForm op = 'DEF => x:DefinitionAst::OutputForm @@ -1827,7 +1827,7 @@ SpadAst(): SpadAstExports() == add op = 'CATEGORY => x:CategoryAst::OutputForm op = 'Join => x:JoinAst::OutputForm op = 'CAPSULE => x:CapsuleAst::OutputForm - op = 'import => x:ImportAst::OutputForm + op = '_import => x:ImportAst::OutputForm x'::OutputForm x'::OutputForm diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp index af2861f3..0a79d120 100644 --- a/src/interp/fnewmeta.lisp +++ b/src/interp/fnewmeta.lisp @@ -58,7 +58,7 @@ (DEFUN |PARSE-Command| () - (AND (MATCH-ADVANCE-STRING ")") (MUST (|PARSE-SpecialKeyWord|)) + (AND (|matchAdvanceString| ")") (MUST (|PARSE-SpecialKeyWord|)) (MUST (|PARSE-SpecialCommand|)) (|pushReduction| '|PARSE-Command| NIL))) @@ -70,10 +70,10 @@ (DEFUN |PARSE-SpecialCommand| () - (OR (AND (MATCH-ADVANCE-STRING "show") + (OR (AND (|matchAdvanceString| "show") (BANG FIL_TEST (OPTIONAL - (OR (MATCH-ADVANCE-STRING "?") + (OR (|matchAdvanceString| "?") (|PARSE-Expression|)))) (|pushReduction| '|PARSE-SpecialCommand| (CONS '|show| (CONS (|popStack1|) NIL))) @@ -102,7 +102,7 @@ (DEFUN |PARSE-TokenOption| () - (AND (MATCH-ADVANCE-STRING ")") (MUST (|PARSE-TokenList|)))) + (AND (|matchAdvanceString| ")") (MUST (|PARSE-TokenList|)))) (DEFUN |PARSE-CommandTail| () @@ -114,13 +114,13 @@ (DEFUN |PARSE-PrimaryOrQM| () - (OR (AND (MATCH-ADVANCE-STRING "?") + (OR (AND (|matchAdvanceString| "?") (|pushReduction| '|PARSE-PrimaryOrQM| '?)) (|PARSE-Primary|))) (DEFUN |PARSE-Option| () - (AND (MATCH-ADVANCE-STRING ")") + (AND (|matchAdvanceString| ")") (MUST (STAR REPEATOR (|PARSE-PrimaryOrQM|))))) @@ -128,7 +128,7 @@ (AND (|PARSE-Expr| 0) (OPTIONAL (AND (STAR REPEATOR - (AND (MATCH-ADVANCE-STRING ",") + (AND (|matchAdvanceString| ",") (MUST (|PARSE-Expr| 0)))) (|pushReduction| '|PARSE-Statement| (CONS '|Series| @@ -163,21 +163,21 @@ (CONS (|popStack3|) (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) - (AND (MATCH-ADVANCE-STRING "(") (MUST (|PARSE-Category|)) + (AND (|matchAdvanceString| "(") (MUST (|PARSE-Category|)) (BANG FIL_TEST (OPTIONAL (STAR REPEATOR - (AND (MATCH-ADVANCE-STRING ";") + (AND (|matchAdvanceString| ";") (MUST (|PARSE-Category|)))))) - (MUST (MATCH-ADVANCE-STRING ")")) + (MUST (|matchAdvanceString| ")")) (|pushReduction| '|PARSE-Category| (CONS 'CATEGORY (CONS (|popStack2|) (APPEND (|popStack1|) NIL))))) (AND (ACTION (SETQ G1 (|lineNumber| |$spadLine|))) (OR (|PARSE-Application|) - (|PARSE-OperatorFunctionName|)) - (MUST (OR (AND (MATCH-ADVANCE-STRING ":") + (|parseOperatorFunctionName|)) + (MUST (OR (AND (|matchAdvanceString| ":") (MUST (|PARSE-Expression|)) (|pushReduction| '|PARSE-Category| (CONS '|%Signature| @@ -202,7 +202,7 @@ (DEFUN |PARSE-Import| () (AND (MATCH-ADVANCE-KEYWORD "import") (MUST (|PARSE-Expr| 1000)) - (OR (AND (MATCH-ADVANCE-STRING ":") + (OR (AND (|matchAdvanceString| ":") (MUST (|PARSE-Expression|)) (MUST (MATCH-ADVANCE-KEYWORD "from")) (MUST (|PARSE-Expr| 1000)) @@ -214,7 +214,7 @@ (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR - (AND (MATCH-ADVANCE-STRING ",") + (AND (|matchAdvanceString| ",") (MUST (|PARSE-Expr| 1000)))))) (|pushReduction| '|PARSE-Import| (CONS '|import| @@ -235,7 +235,7 @@ (DEFUN |PARSE-Scheme| () (OR (AND (|PARSE-Quantifier|) (MUST (|PARSE-QuantifiedVariableList|)) - (MUST (MATCH-ADVANCE-STRING ".")) + (MUST (|matchAdvanceString| ".")) (MUST (|PARSE-Expr| 200)) (MUST (|pushReduction| '|PARSE-Forall| (CONS (|popStack3|) @@ -250,21 +250,21 @@ (MUST (|pushReduction| '|PARSE-Quantifier| '|%Exist|))))) (DEFUN |PARSE-QuantifiedVariableList| () - (AND (MATCH-ADVANCE-STRING "(") + (AND (|matchAdvanceString| "(") (MUST (|PARSE-QuantifiedVariable|)) (OPTIONAL (AND (STAR REPEATOR - (AND (MATCH-ADVANCE-STRING ",") + (AND (|matchAdvanceString| ",") (MUST (|PARSE-QuantifiedVariable|)))) (|pushReduction| '|PARSE-QuantifiedVariableList| (CONS '|%Sequence| (CONS (|popStack2|) (APPEND (|popStack1|) NIL)))))) - (MUST (MATCH-ADVANCE-STRING ")")))) + (MUST (|matchAdvanceString| ")")))) (DEFUN |PARSE-QuantifiedVariable| () (AND (|parseName|) - (MUST (MATCH-ADVANCE-STRING ":")) + (MUST (|matchAdvanceString| ":")) (MUST (|PARSE-Application|)) (MUST (|pushReduction| '|PARSE-QuantifiedVariable| (CONS '|:| @@ -308,13 +308,13 @@ (DEFUN |PARSE-Qualification| () - (AND (MATCH-ADVANCE-STRING "$") (MUST (|PARSE-Primary1|)) + (AND (|matchAdvanceString| "$") (MUST (|PARSE-Primary1|)) (|pushReduction| '|PARSE-Qualification| (|dollarTran| (|popStack1|) (|popStack1|))))) (DEFUN |PARSE-SemiColon| () - (AND (MATCH-ADVANCE-STRING ";") + (AND (|matchAdvanceString| ";") (MUST (OR (|PARSE-Expr| 82) (|pushReduction| '|PARSE-SemiColon| '|/throwAway|))) (|pushReduction| '|PARSE-SemiColon| @@ -439,7 +439,7 @@ (DEFUN |PARSE-Variable| () (OR (AND (|parseName|) - (OPTIONAL (AND (MATCH-ADVANCE-STRING ":") + (OPTIONAL (AND (|matchAdvanceString| ":") (MUST (|PARSE-Application|)) (MUST (|pushReduction| '|PARSE-Variable| (CONS '|:| @@ -463,7 +463,7 @@ (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) (OPTIONAL - (AND (MATCH-ADVANCE-STRING "|") + (AND (|matchAdvanceString| "|") (MUST (|PARSE-Expr| 111)) (|pushReduction| '|PARSE-Iterator| (CONS '|\|| (CONS (|popStack1|) NIL)))))) @@ -493,8 +493,8 @@ (DEFUN |PARSE-Label| () - (AND (MATCH-ADVANCE-STRING "<<") (MUST (|parseName|)) - (MUST (MATCH-ADVANCE-STRING ">>")))) + (AND (|matchAdvanceString| "<<") (MUST (|parseName|)) + (MUST (|matchAdvanceString| ">>")))) (DEFUN |PARSE-LedPart| (RBP) @@ -577,12 +577,12 @@ (DEFUN |PARSE-Selector| () (OR (AND |$nonblank| (EQ (|currentSymbol|) '|.|) - (CHAR-NE (|currentChar|) '| |) (MATCH-ADVANCE-STRING ".") + (CHAR-NE (|currentChar|) '| |) (|matchAdvanceString| ".") (MUST (|PARSE-PrimaryNoFloat|)) (MUST (|pushReduction| '|PARSE-Selector| (CONS (|popStack2|) (CONS (|popStack1|) NIL))))) (AND (OR (|PARSE-Float|) - (AND (MATCH-ADVANCE-STRING ".") + (AND (|matchAdvanceString| ".") (MUST (|PARSE-Primary|)))) (MUST (|pushReduction| '|PARSE-Selector| (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) @@ -597,7 +597,7 @@ (DEFUN |PARSE-Primary1| () - (OR (AND (|PARSE-VarForm|) + (OR (AND (|parseName|) (OPTIONAL (AND |$nonblank| (EQ (|currentSymbol|) '|(|) (MUST (|PARSE-Primary1|)) @@ -605,7 +605,7 @@ (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) (|PARSE-Quad|) (|parseString|) (|parseInteger|) (|parseFormalParameter|) - (AND (MATCH-ADVANCE-STRING "'") + (AND (|matchAdvanceString| "'") (MUST (AND (MUST (|PARSE-Data|)) (|pushReduction| '|PARSE-Primary1| (|popStack1|))))) (|PARSE-Sequence|) (|PARSE-Enclosure|))) @@ -634,7 +634,7 @@ (DEFUN |PARSE-FloatBasePart| () - (AND (MATCH-ADVANCE-STRING ".") + (AND (|matchAdvanceString| ".") (MUST (OR (AND (DIGITP (|currentChar|)) (|pushReduction| '|PARSE-FloatBasePart| (|tokenNonblank?| (|currentToken|))) @@ -649,9 +649,9 @@ (OR (AND (MEMBER (|currentSymbol|) '(E |e|)) (FIND (|currentChar|) "+-") (ACTION (|advanceToken|)) (MUST (OR (|parseInteger|) - (AND (MATCH-ADVANCE-STRING "+") + (AND (|matchAdvanceString| "+") (MUST (|parseInteger|))) - (AND (MATCH-ADVANCE-STRING "-") + (AND (|matchAdvanceString| "-") (MUST (|parseInteger|)) (|pushReduction| '|PARSE-FloatExponent| (MINUS (|popStack1|)))) @@ -663,27 +663,27 @@ (DEFUN |PARSE-Enclosure| () - (OR (AND (MATCH-ADVANCE-STRING "(") + (OR (AND (|matchAdvanceString| "(") (MUST (OR (AND (|PARSE-Expr| 6) - (MUST (MATCH-ADVANCE-STRING ")"))) - (AND (MATCH-ADVANCE-STRING ")") + (MUST (|matchAdvanceString| ")"))) + (AND (|matchAdvanceString| ")") (|pushReduction| '|PARSE-Enclosure| (CONS '|%Comma| NIL)))))) - (AND (MATCH-ADVANCE-STRING "{") + (AND (|matchAdvanceString| "{") (MUST (OR (AND (|PARSE-Expr| 6) - (MUST (MATCH-ADVANCE-STRING "}")) + (MUST (|matchAdvanceString| "}")) (|pushReduction| '|PARSE-Enclosure| (CONS '|brace| (CONS (CONS '|construct| (CONS (|popStack1|) NIL)) NIL)))) - (AND (MATCH-ADVANCE-STRING "}") + (AND (|matchAdvanceString| "}") (|pushReduction| '|PARSE-Enclosure| (CONS '|brace| NIL)))))) - (AND (MATCH-ADVANCE-STRING "[|") + (AND (|matchAdvanceString| "[|") (MUST (AND (|PARSE-Statement|) - (MUST (MATCH-ADVANCE-STRING "|]")) + (MUST (|matchAdvanceString| "|]")) (|pushReduction| '|PARSE-Enclosure| (CONS '|[\|\|]| (CONS (|popStack1|) NIL))) @@ -691,38 +691,9 @@ )) (DEFUN |PARSE-Quad| () - (AND (MATCH-ADVANCE-STRING "$") + (AND (|matchAdvanceString| "$") (|pushReduction| '|PARSE-Quad| '$))) -(DEFUN |PARSE-VarForm| () - (AND (|parseName|) - (OPTIONAL - (AND (|PARSE-Scripts|) - (|pushReduction| '|PARSE-VarForm| - (CONS '|Scripts| - (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) - (|pushReduction| '|PARSE-VarForm| (|popStack1|)))) - - -(DEFUN |PARSE-Scripts| () - (AND |$nonblank| (MATCH-ADVANCE-STRING "[") (MUST (|PARSE-ScriptItem|)) - (MUST (MATCH-ADVANCE-STRING "]")))) - - -(DEFUN |PARSE-ScriptItem| () - (OR (AND (|PARSE-Expr| 90) - (OPTIONAL - (AND (STAR REPEATOR - (AND (MATCH-ADVANCE-STRING ";") - (MUST (|PARSE-ScriptItem|)))) - (|pushReduction| '|PARSE-ScriptItem| - (CONS '|;| - (CONS (|popStack2|) - (APPEND (|popStack1|) NIL))))))) - (AND (MATCH-ADVANCE-STRING ";") (MUST (|PARSE-ScriptItem|)) - (|pushReduction| '|PARSE-ScriptItem| - (CONS '|PrefixSC| (CONS (|popStack1|) NIL)))))) - (DEFUN |PARSE-Data| () (AND (ACTION (SETQ LABLASOC NIL)) (|PARSE-Sexpr|) (|pushReduction| '|PARSE-Data| @@ -736,24 +707,24 @@ (DEFUN |PARSE-Sexpr1| () (OR (|parseInteger|) (|parseString|) - (AND (|PARSE-AnyId|) + (AND (|parseAnyId|) (OPTIONAL (AND (|PARSE-NBGliphTok| '=) (MUST (|PARSE-Sexpr1|)) (ACTION (SETQ LABLASOC (CONS (CONS (|popStack2|) (|nthStack| 1)) LABLASOC)))))) - (AND (MATCH-ADVANCE-STRING "'") (MUST (|PARSE-Sexpr1|)) + (AND (|matchAdvanceString| "'") (MUST (|PARSE-Sexpr1|)) (|pushReduction| '|PARSE-Sexpr1| (CONS 'QUOTE (CONS (|popStack1|) NIL)))) ;; next form disabled -- gdr, 2009-06-15. -; (AND (MATCH-ADVANCE-STRING "-") (MUST (|parseInteger|)) +; (AND (|matchAdvanceString| "-") (MUST (|parseInteger|)) ; (|pushReduction| '|PARSE-Sexpr1| (MINUS (|popStack1|)))) - (AND (MATCH-ADVANCE-STRING "[") + (AND (|matchAdvanceString| "[") (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Sexpr1|)))) - (MUST (MATCH-ADVANCE-STRING "]")) + (MUST (|matchAdvanceString| "]")) (|pushReduction| '|PARSE-Sexpr1| (LIST2VEC (|popStack1|)))) - (AND (MATCH-ADVANCE-STRING "(") + (AND (|matchAdvanceString| "(") (BANG FIL_TEST (OPTIONAL (AND (STAR REPEATOR (|PARSE-Sexpr1|)) @@ -762,7 +733,7 @@ (MUST (|PARSE-Sexpr1|)) (|pushReduction| '|PARSE-Sexpr1| (|append!| (|popStack2|) (|popStack1|)))))))) - (MUST (MATCH-ADVANCE-STRING ")"))))) + (MUST (|matchAdvanceString| ")"))))) (DEFUN |PARSE-NBGliphTok| (|tok|) @@ -776,21 +747,11 @@ (AND (|matchCurrentToken| 'GLIPH (INTERN |tok|)) (ACTION (|advanceToken|)))) - -(DEFUN |PARSE-AnyId| () - (OR (|parseName|) - (OR (AND (|matchString| "$") - (|pushReduction| '|PARSE-AnyId| (|currentSymbol|)) - (ACTION (|advanceToken|))) - (|parseToken| 'KEYWORD) - (|PARSE-OperatorFunctionName|)))) - - (DEFUN |PARSE-Sequence| () (OR (AND (|PARSE-OpenBracket|) (MUST (|PARSE-Sequence1|)) - (MUST (MATCH-ADVANCE-STRING "]"))) + (MUST (|matchAdvanceString| "]"))) (AND (|PARSE-OpenBrace|) (MUST (|PARSE-Sequence1|)) - (MUST (MATCH-ADVANCE-STRING "}")) + (MUST (|matchAdvanceString| "}")) (|pushReduction| '|PARSE-Sequence| (CONS '|brace| (CONS (|popStack1|) NIL)))))) diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot index 712b1927..8be1464f 100644 --- a/src/interp/lexing.boot +++ b/src/interp/lexing.boot @@ -39,7 +39,9 @@ import sys_-macros namespace BOOT -module lexing +module lexing where + matchString: %String -> %Maybe %Short + matchAdvanceString: %String -> %Maybe %Short --% --% Line abstract datatype @@ -326,10 +328,12 @@ getIdentifier(tok,esc?) == 'IDENTIFIER tokenInstall(s,tt,tok,$nonblank) +escapeKeywords: (%String,%Symbol) -> %String escapeKeywords(nm,id) == symbolMember?(id,Keywords) => strconc('"__",nm) nm +underscore: %String -> %String underscore s == n := #s - 1 and/[alphabetic? stringChar(s,i) for i in 0..n] => s @@ -341,6 +345,7 @@ underscore s == buf := [c,:buf] listToString reverse! buf +quoteIfString: %Thing -> %Maybe %String quoteIfString tok == tok = nil => nil tt := tokenType tok @@ -349,7 +354,7 @@ quoteIfString tok == tt is 'SPECIAL_-CHAR => charString tokenSymbol tok tt is 'IDENTIFIER => escapeKeywords(symbolName tokenSymbol tok,tokenSymbol tok) - tokenSymbol tok + symbolName tokenSymbol tok ungetTokens() == $validTokens = 0 => true @@ -385,6 +390,18 @@ matchString x == and/[stringChar(x,i) = stringChar(buf,idx + i) for i in 0..nx-1] and nx nil +++ Same as matchString except if successful, advance inputstream past `x'. +matchAdvanceString x == + n := #x >= #quoteIfString currentToken() and matchString x => + lineCurrentIndex($spadLine) := lineCurrentIndex $spadLine + n + c := + linePastEnd? $spadLine => charByName '"Space" + lineBuffer($spadLine).(lineCurrentIndex $spadLine) + lineCurrentChar($spadLine) := c + $priorToken := makeToken(makeSymbol x,'IDENTIFIER,$nonblank) + n + nil + --% --% Stack abstract datatype. --% Operational semantics: diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp index 1dd53dea..668bf1e3 100644 --- a/src/interp/parsing.lisp +++ b/src/interp/parsing.lisp @@ -46,15 +46,6 @@ ; CONTENTS: ; -; 0. Current I/O Stream definition -; -; 1. Data structure declarations (defstructs) for parsing objects -; -; A. Line Buffer -; B. Stack -; C. Token -; D. Reduction -; ; 2. Recursive descent parsing support routines ; A. Stacking and retrieving reductions of rules. ; B. Applying metagrammatical elements of a production (e.g., Star). @@ -70,10 +61,6 @@ ; ; 5. Routines for inspecting and resetting total I/O system state ; -; METALEX.LISP: Meta file handling, auxiliary parsing actions and tokenizing -; -; BOOTLEX.LISP: Boot file handling, auxiliary parsing actions and tokenizing -; NEWMETA.LISP: Boot parsing (import-module "lexing") @@ -87,34 +74,10 @@ (defparameter out-stream t "Current output stream.") (defparameter File-Closed nil "Way to stop EOF tests for console input.") - -; 1. Data structure declarations (defstructs) for parsing objects -; -; A. Line Buffer - -; 1A. A Line Buffer -; -; The philosophy of lines is that -; -; a) NEXT LINE will always get you a non-blank line or fail. -; b) Every line is terminated by a blank character. -; -; Hence there is always a current character, because there is never a non-blank line, -; and there is always a separator character between tokens on separate lines. -; Also, when a line is read, the character pointer is always positioned ON the first -; character. - -; FUNCTIONS DEFINED IN THIS SECTION: -; -; Line-New-Line, Line-Advance-Char, Line-Past-End-P, Line-At-End-P -; Make-Line - (defun Line-Print (line) (format out-stream "~&~5D> ~A~%" (|lineNumber| line) (|lineBuffer| Line)) (format out-stream "~v@T^~%" (+ 7 (|lineCurrentIndex| line)))) -; *** Next Line - (defun make-string-adjustable (s) (cond ((adjustable-array-p s) s) (t (make-array (array-dimensions s) :element-type 'character @@ -221,16 +184,6 @@ Symbolics read-line returns embedded newlines in a c-m-Y.") (progn (format t "The prior token was~%") (describe |$priorToken|)))) -; Parsing of operator tokens depends on tables initialized by BOTTOMUP.LISP - -(defun |PARSE-OperatorFunctionName| () - (let ((id (|makeSymbolOf| (or (|matchCurrentToken| 'keyword) - (|matchCurrentToken| 'gliph) - (|matchCurrentToken| 'special-char))))) - (when (and id (member id |$OperatorFunctionNames|)) - (|pushReduction| '|PARSE-OperatorFunctionName| id) - (action (|advanceToken|))))) - (defun make-adjustable-string (n) (make-array (list n) :element-type 'character :adjustable t)) @@ -342,32 +295,6 @@ the stack, then stack a NIL. Return the value of prod." ; (3) Line handling: Next Line, Print Next Line ; (X) Random Stuff -; 3A (0). String grabbing - -; String grabbing is the art of matching initial segments of the current -; line, and removing them from the line before the get tokenized if they -; match (or removing the corresponding current tokens). - -; FUNCTIONS DEFINED IN THIS SECTION: -; -; Match-Advance-String - -(defun Match-Advance-String (x) - "Same as matchString except if successful, advance inputstream past X." - (let ((y (if (>= (length (string x)) - (length (string (|quoteIfString| (|currentToken|))))) - (|matchString| x) - nil))) ; must match at least the current token - (if y (progn (incf (|lineCurrentIndex| |$spadLine|) y) - (if (not (|linePastEnd?| |$spadLine|)) - (setf (|lineCurrentChar| |$spadLine|) - (elt (|lineBuffer| |$spadLine|) - (|lineCurrentIndex| |$spadLine|))) - (setf (|lineCurrentChar| |$spadLine|) #\Space)) - (setq |$priorToken| - (|makeToken| (intern (string x)) 'identifier |$nonblank|)) - t)))) - (defun match-advance-keyword (str) (and (|matchToken| (|currentToken|) 'keyword (intern str)) (action (|advanceToken|)))) diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot index 3ab5c41a..c7f6e8a8 100644 --- a/src/interp/spad-parser.boot +++ b/src/interp/spad-parser.boot @@ -67,6 +67,24 @@ parseName() == parseFormalParameter() == parseToken 'ARGUMENT_-DESIGNATOR +parseOperatorFunctionName() == + id := makeSymbolOf(matchCurrentToken 'KEYWORD + or matchCurrentToken 'GLIPH + or matchCurrentToken 'SPECIAL_-CHAR) + symbolMember?(id,$OperatorFunctionNames) => + pushReduction('parseOperatorFunctionName,id) + advanceToken() + true + false + +parseAnyId() == + parseName() => true + matchString '"$" => + pushReduction('parseAnyId,currentSymbol()) + advanceToken() + true + parseOperatorFunctionName() + --% ++ Given a pathname to a source file containing Spad code, returns |