aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-10-11 22:00:39 +0000
committerdos-reis <gdr@axiomatics.org>2011-10-11 22:00:39 +0000
commit4aa013faa1399b7e31fa4220ae09b039c4a1b0e2 (patch)
tree82d673d5f3fe12e94f079c67d85fc2188393c73f
parent3d58c8ff9d2a29477d85828b0dd1c35fecbaab5b (diff)
downloadopen-axiom-4aa013faa1399b7e31fa4220ae09b039c4a1b0e2.tar.gz
* 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.
-rw-r--r--src/ChangeLog12
-rw-r--r--src/algebra/java.spad.pamphlet2
-rw-r--r--src/algebra/syntax.spad.pamphlet36
-rw-r--r--src/interp/fnewmeta.lisp139
-rw-r--r--src/interp/lexing.boot21
-rw-r--r--src/interp/parsing.lisp73
-rw-r--r--src/interp/spad-parser.boot18
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