Copyright (C) 1994, Digital Equipment Corp. MODULE; IMPORT Constructor, Rd, SynParse, TextRefTbl, SynWr, SynLocation, Builder, SynScan, Fmt, Text; <* FATAL Crash *> REVEAL Grammar = Grammar_public BRANDED OBJECT gram: SynParse.Grammar := NIL; END; (* object *) PROCEDURE MetaParser NewClauseList (actionTable : ActionTable; fileName: TEXT; rd: Rd.T) : ClauseList RAISES {SynParse.Fail, SynScan.Fail, SynScan.NoReader} = BEGIN Builder.actionTable := actionTable; SynScan.PushInput(Constructor.metaParser.Scanner(), fileName, rd, TRUE, TRUE); RETURN Constructor.metaParser.Read(Constructor.grammar); END NewClauseList; PROCEDUREAddClauseList (tree: SynParse.Tree; p: SynParse.T) RAISES {SynParse.Fail}= BEGIN TYPECASE tree OF | NULL => RETURN | ClauseList(clauseList) => MergeEnv(clauseList, p); BeKeywordsOfClauseList(clauseList, SynScan.GetKeywordSet(p.Scanner())); ELSE RAISE SynParse.Fail ; END; END AddClauseList; PROCEDURENewParser (swr: SynWr.T; actionTable : ActionTable; fileName: TEXT; rd: Rd.T) : SynParse.T RAISES {SynParse.Fail, SynScan.Fail, SynScan.NoReader} = VAR clauseList: SynParse.Tree; parser: SynParse.T; BEGIN clauseList := NewClauseList(actionTable, fileName, rd); parser := SynParse.New(swr, SynParse.NewEnv()); AddClauseList(clauseList, parser); RETURN parser; END NewParser; PROCEDURESetup () = BEGIN END Setup; PROCEDUREPackageSetup () RAISES {SynParse.Fail} = BEGIN Constructor.Setup(); Setup(); END PackageSetup; PROCEDURENewActionTable (): ActionTable = VAR actions: ActionTable; BEGIN actions := NEW(TextRefTbl.Default).init(); (* link in default actions *) Constructor.LinkInSelects(actions); RETURN actions; END NewActionTable; EXCEPTION Crash; PROCEDURETableFromArray (<*NOWARN*>sourceTable : ActionProcTable; table: ActionTable ) =
transforms an array of (Text, Procedure) pairs into an actionTable
VAR
tmp : REF ActionProc ;
BEGIN
IF table = NIL THEN
RAISE Crash ;
END;
FOR i := FIRST(sourceTable) TO LAST(sourceTable) DO
tmp := NEW(REF ActionProc);
tmp^ := sourceTable[i].proc ;
EVAL table.put(sourceTable[i].name,tmp );
END;
END TableFromArray ;
PROCEDURE Register (name: TEXT; proc: ActionProc;
table: ActionTable ) =
VAR
ref : REF ActionProc ;
BEGIN
IF table = NIL THEN
RAISE Crash;
END;
ref := NEW(REF ActionProc);
ref^ := proc;
EVAL table.put(name,ref);
END Register;
PROCEDURE IdentifierToTree (self: SynParse.Identifier;
p: SynParse.T; name: TEXT;
READONLY info: SynLocation.Info): SynParse.Tree =
BEGIN
RETURN
NEW( TextTemp,
location := SynLocation.NewLineLocation(info) ,
text := name );
END IdentifierToTree;
PROCEDURE NameToTree (self: SynParse.Name;
p: SynParse.T; name: TEXT;
READONLY info: SynLocation.Info): SynParse.Tree =
BEGIN
RETURN
NEW( TextTemp,
location := SynLocation.NewLineLocation(info) ,
text := name );
END NameToTree;
PROCEDURE IntegerToTree (self: SynParse.Integer;
p: SynParse.T; int: INTEGER;
READONLY info: SynLocation.Info): SynParse.Tree =
BEGIN
RETURN
NEW( IntegerTemp,
location := SynLocation.NewLineLocation(info) ,
int := int ) ;
END IntegerToTree;
PROCEDURE RealToTree (self: SynParse.Real;
p: SynParse.T; real: LONGREAL;
READONLY info: SynLocation.Info): SynParse.Tree =
BEGIN
RETURN
NEW( RealTemp,
location := SynLocation.NewLineLocation(info) ,
real := real );
END RealToTree;
PROCEDURE CharToTree (self: SynParse.QuotedChar;
p: SynParse.T; char: CHAR;
READONLY info: SynLocation.Info): SynParse.Tree =
BEGIN
RETURN
NEW(TextTemp,
location := SynLocation.NewLineLocation(info) ,
text := Text.FromChar(char ) );
END CharToTree;
PROCEDURE StringToTree (self: SynParse.QuotedString;
p: SynParse.T; string: TEXT;
READONLY info: SynLocation.Info): SynParse.Tree =
BEGIN
RETURN
NEW(TextTemp,
location := SynLocation.NewLineLocation(info) ,
text := string);
END StringToTree;
PROCEDURE TextToTree (self: SynParse.QuotedString;
p: SynParse.T; text: TEXT ;
READONLY info: SynLocation.Info): SynParse.Tree =
BEGIN
RETURN
NEW(TextTemp,
location := SynLocation.NewLineLocation(info) ,
text := text );
END TextToTree;
PROCEDURE GInt (p: SynParse.T; loc :INTEGER): INTEGER RAISES {SynParse.Fail}=
BEGIN
RETURN
XInt(p.stack[loc]);
END GInt;
PROCEDURE GReal (p: SynParse.T; loc :INTEGER): LONGREAL RAISES {SynParse.Fail}=
BEGIN
RETURN
XReal(p.stack[loc]);
END GReal;
PROCEDURE GText (p: SynParse.T; loc :INTEGER): TEXT RAISES {SynParse.Fail}=
BEGIN
RETURN
XText(p.stack[loc]);
END GText;
PROCEDURE GBool (p: SynParse.T; loc: INTEGER): BOOLEAN RAISES {SynParse.Fail}=
BEGIN
RETURN
XBool(p.stack[loc]);
END GBool;
PROCEDURE XInt (tree: SynParse.Tree): INTEGER RAISES {SynParse.Fail}=
BEGIN
TYPECASE tree OF
| NULL =>
| IntegerTemp(node) => RETURN node.int ;
ELSE
END;
TypeError("Text",tree);
<*ASSERT FALSE*>
END XInt;
PROCEDURE XReal (tree: SynParse.Tree): LONGREAL RAISES {SynParse.Fail}=
BEGIN
TYPECASE tree OF
| NULL =>
| RealTemp(node) => RETURN node.real ;
ELSE
END;
TypeError("Text",tree);
<*ASSERT FALSE*>
END XReal;
PROCEDURE XText (tree: SynParse.Tree): TEXT RAISES {SynParse.Fail}=
BEGIN
TYPECASE tree OF
| NULL =>
| IntegerTemp(node) => RETURN Fmt.Int(node.int);
| RealTemp(node) => RETURN Fmt.LongReal(node.real);
| TextTemp(node) => RETURN node.text ;
ELSE
END;
TypeError("Text",tree);
<*ASSERT FALSE*>
END XText;
PROCEDURE XBool (tree: SynParse.Tree): BOOLEAN RAISES {SynParse.Fail}=
VAR
text : TEXT;
array : REF ARRAY OF CHAR;
l : INTEGER;
BEGIN
TYPECASE tree OF
| NULL =>
| IntegerTemp(node) => RETURN node.int # 0;
| RealTemp(node) => RETURN node.real # 0.0d0 ;
| TextTemp(node) =>
text := node.text;
l := Text.Length(text);
array := NEW( REF ARRAY OF CHAR, l );
FOR i := 0 TO l - 1 DO
array[i] := Text.GetChar(text,i);
END;
text := Text.FromChars(array^);
IF Text.Equal(text,"on") OR Text.Equal(text,"true") THEN
RETURN TRUE;
ELSIF Text.Equal(text,"off") OR Text.Equal(text,"false") THEN
RETURN FALSE;
END;
ELSE
END;
TypeError("Boolean",tree);
<*ASSERT FALSE*>
END XBool;
PROCEDURE TypeError (type: TEXT; tree: SynParse.Tree) RAISES {SynParse.Fail}=
BEGIN
IF tree = NIL THEN
SynWr.Text(SynWr.out, "Got NIL pointer instead of "&type, loud:=TRUE);
ELSE
SynWr.Text(SynWr.out, type & " expected at ", loud:=TRUE);
SynLocation.PrintLocation(SynWr.out, tree.location);
END;
SynWr.Text(SynWr.out, "\n", loud:=TRUE);
SynWr.Flush(SynWr.out, loud:=TRUE);
RAISE SynParse.Fail;
END TypeError;
PROCEDURE MergeEnv (list: ClauseList; p: SynParse.T) RAISES {SynParse.Fail} =
BEGIN
LOOP
IF list=NIL THEN RETURN END;
IF list.extend THEN
IF list.extendIter THEN
p.ExtendIter(list.ide.text, list.iterPosPresent, list.iterPos,
list.gram, list.args);
ELSE
p.Extend(list.ide.text, list.gram, list.args);
END;
ELSE
p.Add(list.ide.text, list.gram, list.args);
END;
list := list.rest;
END;
END MergeEnv;
PROCEDURE BeKeywords(list: ClauseList; keySet: SynScan.KeywordSet) RAISES {SynParse.Fail} = BEGIN LOOP IF list=NIL THEN RETURN END; BeKeywordsOfGram(list.gram, keySet); list := list.rest; END; END BeKeywords;
PROCEDUREBeKeywordsOfGramList (list: SynParse.GrammarList; keySet: SynScan.KeywordSet) RAISES {SynParse.Fail} = BEGIN LOOP IF list=NIL THEN RETURN END; BeKeywordsOfGram(list.first, keySet); list := list.rest; END; END BeKeywordsOfGramList; (* AK following procedure added *) PROCEDUREBeKeywordsOfClauseList (list: ClauseList; keySet: SynScan.KeywordSet) RAISES {SynParse.Fail} = BEGIN LOOP IF list=NIL THEN RETURN END; BeKeywordsOfGram(list.gram, keySet); list := list.rest; END; END BeKeywordsOfClauseList; PROCEDUREBeKeywordsOfGram (gram: SynParse.Grammar; keySet: SynScan.KeywordSet) RAISES {SynParse.Fail} = BEGIN TYPECASE gram OF | NULL => | SynParse.NonTerminal => | SynParse.Storage(node) => BeKeywordsOfGram(node.item, keySet); | SynParse.Action(node) => BeKeywordsOfGram(node.grammar, keySet); | SynParse.GivenKeyword(node) => EVAL SynScan.BeKeyword(node.key, keySet); | SynParse.Identifier, SynParse.Name, SynParse.QuotedChar, SynParse.Integer, SynParse.Real, SynParse.QuotedString, SynParse.GivenDelimiter => | SynParse.Sequence(node) => BeKeywordsOfGramList(node.items, keySet); | SynParse.Choice(node) => BeKeywordsOfGramList(node.choice, keySet); | SynParse.Iter(node) => BeKeywordsOfGram(node.base, keySet); BeKeywordsOfGram(node.iter, keySet); | SynParse.GivenName => | SynParse.Eof => ELSE <*ASSERT FALSE*> END; END BeKeywordsOfGram; PROCEDUREPrintGram (gram : SynParse.Grammar )= BEGIN TYPECASE gram OF | NULL => | SynParse.NonTerminal(node) => SynWr.Text(SynWr.out, node.name); | SynParse.Storage(node) => PrintGram(node.item); SynWr.Text(SynWr.out, Fmt.Int(node.position)); | SynParse.Action(node) => PrintGram(node.grammar); SynWr.Text(SynWr.out, " :: Action "); | SynParse.GivenKeyword(node) => SynWr.Text(SynWr.out, "\"" & node.key & "\"" ); | SynParse.GivenName(node) => SynWr.Text(SynWr.out, "\"~" & node.text & "\"" ); | SynParse.Identifier => SynWr.Text(SynWr.out, " identifier "); | SynParse.QuotedChar => SynWr.Text(SynWr.out, " quoted char "); | SynParse.Integer => SynWr.Text(SynWr.out, " integer "); | SynParse.Real => SynWr.Text(SynWr.out, " real "); | SynParse.QuotedString => SynWr.Text(SynWr.out, " quoted string "); | SynParse.GivenDelimiter(node) => SynWr.Text(SynWr.out, "\' "); SynWr.Char(SynWr.out, node.delim); SynWr.Text(SynWr.out, "\' "); | SynParse.Sequence(node) => SynWr.Text(SynWr.out, " [ "); PrintGramList(node.items); SynWr.Text(SynWr.out, " ] "); | SynParse.Choice(node) => SynWr.Text(SynWr.out, " { "); PrintGramList(node.choice); SynWr.Text(SynWr.out, " } "); | SynParse.Iter(node) => SynWr.Text(SynWr.out, " ( "); PrintGram(node.base); SynWr.Text(SynWr.out, " * "); PrintGram(node.base); SynWr.Text(SynWr.out, " ) "); | SynParse.Eof => SynWr.Text(SynWr.out, "EOF"); ELSE <*ASSERT FALSE*> END; END PrintGram; PROCEDUREPrintGramList (list: SynParse.GrammarList) = BEGIN WHILE list#NIL DO PrintGram(list.first); list:=list.rest; SynWr.Char(SynWr.out, ' '); END; END PrintGramList; PROCEDUREPrintClauseList (list: ClauseList) = BEGIN WHILE list#NIL DO SynWr.Text(SynWr.out, " " & list.ide.text); SynWr.Text(SynWr.out, "::= " ); PrintGram(list.gram); (* IF list.extend OR list.extendIter THEN SynWr.Text(SynWr.out, "(extended)"); END; *) list:=list.rest; SynWr.Char(SynWr.out, '\n'); END; END PrintClauseList; BEGIN END MetaParser .
PROCEDURE UndoMergeEnv(list: ClauseList; p: SynParse.T) RAISES {SynParse.Fail} ;
PROCEDURE UndoMergeEnv(list: ClauseList; p: SynParse.T) RAISES {SynParse.Fail} = BEGIN LOOP IF list=NIL THEN RETURN END; IF list.inserted THEN IF list.extend THEN IF list.extendIter THEN p.UndoExtendIter(list.ide.text, list.gram); ELSE p.UndoExtend(list.ide.text, list.gram); END; ELSE p.UndoAdd(list.ide.text); END; END; list.inserted := FALSE; list := list.rest; END; END UndoMergeEnv;
MergeEnv: list.inserted := TRUE;
Note that
AddClauseList has a side-effect on the inserted fields of clauseList,
which are used (only) to undo grammar extensions.