-- GenOneCasabaParserDriver.mesa
-- last edit     January 21, 1986 1:30:03 pm PST
-- Sturgis, May 6, 1986 10:51:30 am PDT

DIRECTORY
BasicTime USING[Now],
Commander USING[CommandProc, Register],
ConflictAnal USING[AnalyzeLALR1Conflicts],
Convert USING[RopeFromTime],
GenOneCasabaParserPrivate USING[],
GrammarBasic USING[BuildAGrammar, GetGrammarStats, GetSymbolText, Grammar],
IO USING[card, CharClass, Close, EndOfStream, GetCedarTokenRope, GetTokenRope, IDProc, int, PutF, PutRope, RIS, ROS, rope, 
RopeFromROS, STREAM, time, TokenKind],
FS USING[Error, StreamOpen],
LR1ItemSetsBasic USING[ForgetUnmarkedLR1ItemSets, MarkExistingLR1ItemSets],
OneCasabaParser USING[GetReportStream, RecordKipperedParserTableOnStream, RecordReadableParserTableOnStream, State],
ParserDisplay USING[ShowArcCounts, ShowGrammar, ShowGraph, ShowLR0Item, ShowLR1Item, ShowLR0ItemSet, ShowLR1ItemSet, ShowNode, 
ShowRingCounts, ShowTerminalSeq, ShowTerminalSeqSet, SignalNode, SignalRope, SignalSymbol, SignalTerminalSeq, SignalTerminalSeqSet, 
SignalLR0Item, SignalLR1Item, SignalLR0ItemSet, SignalLR1ItemSet, StartShowingSignals, StopShowingSignals],
ParserGraphAlgorithms USING[CheckAGraph, CreateLR0CanonicalParser, CreateLALR1Parser, GenerateParseActions, Event, MarkRingNumbers, 
SplitMarkedNodes, SplitUpToRing, TestSplitNodeGraphConsistency],
ParserGraphs USING[CleanTheGraph, GetGraphStats, Graph],
SyntaxDescReaders USING[GenNonTermsFromRope, GenSimpleTermsFromRope, GenSpelledTermsFromRope, GenGenericTermsFromRope, 
OneProductionFromRope, PGSFormat],
Rope USING[Cat, Equal, Fetch, Length, ROPE, Substr];

<<>>

GenOneCasabaParserDriver: CEDAR PROGRAM IMPORTS BasicTime, Commander, ConflictAnal, Convert, FS, GrammarBasic, IO, 
LR1ItemSetsBasic, OneCasabaParser, ParserDisplay, ParserGraphs, ParserGraphAlgorithms, Rope, SyntaxDescReaders EXPORTS 
GenOneCasabaParserPrivate =

BEGIN OPEN BasicTime, Commander, Convert, GrammarBasic, IO, LR1ItemSetsBasic, OneCasabaParser, ParserDisplay, 
ParserGraphAlgorithms, ParserGraphs, Rope, SyntaxDescReaders;



debugging: BOOLEAN _ FALSE; -- set to TRUE for some debugging output


<<This handles OneCasaba format grammar source files.>>
<<This should, and doesn't, check for distinct compound names.>>
<<We keep a record of productions and play them later because the basic grammar routines expect all declarations first, be we don't 
want them first in the file.>>
GenOneCasabaParser: CommandProc =
BEGIN
commandLineStream: STREAM;
rootName: ROPE;
sourceStream: STREAM;
targetStream: STREAM;
typeDeclContents: Rope.ROPE _ NIL;
abort: BOOLEAN _ FALSE; -- tentative

GenTheGrammar: PROC[ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[CARDINAL, ROPE], r: PROC[ROPE]] 
RETURNS[allowConflicts: BOOLEAN] =
{[typeDeclContents, allowConflicts] _ OneCasabaFormat[sourceStream, ut, gt, n, l, r]};


<<this block is nested to allow access to the local variables at error exits>>
BEGIN
commandLineStream _ RIS[cmd.commandLine];
rootName _ GetTokenRope[commandLineStream, IDProc
! EndOfStream => {rootName _ NIL; CONTINUE}].token;
Close[commandLineStream];

sourceStream _ FS.StreamOpen[Rope.Cat[rootName, ".oneCasaba"]];
targetStream _ FS.StreamOpen[Rope.Cat[rootName, ".kipperedParseTables"], create];

ProcessOneGrammar[GenTheGrammar, cmd.out, targetStream, FALSE, FALSE, FALSE, FALSE, FALSE
!
GetErrorInfo => {abort _ TRUE; RESUME[cmd.out, -1]};
KillParserGen => {abort _ TRUE; CONTINUE};
GetReportStream => {RESUME[cmd.out]}
-- GetReportStream is generated if conflicts have to be removed from parser table
];
IF abort THEN GOTO abort;

Close[sourceStream];
Close[targetStream];

IO.PutF[cmd.out, "\N\NThe following type decl is consistent with the productions of the grammar\N\NProductionNames: TYPE = 
{%g};\N\N\N", IO.rope[typeDeclContents]];

EXITS

abort =>
BEGIN
Close[sourceStream];
Close[targetStream];
IO.PutF[cmd.out, "parser generation is aborted due to errors\N"];
END;

END;

END;

ProcessOneGrammar: PROC[
genTheGrammar: PROC[PROC[ROPE, ROPE], PROC[ROPE, ROPE], PROC[ROPE], PROC[CARDINAL, ROPE], PROC[ROPE]] RETURNS[BOOLEAN], 
progressReportStream: IO.STREAM,
targetStream: IO.STREAM,
showGrammar, showLR0Graph, showLALR1Graph, showSplitGraph, showGeneratedParser: BOOLEAN _ FALSE] =

BEGIN
kill: BOOLEAN _ FALSE; -- tentative
on: IO.STREAM = progressReportStream; -- convenient name
showFlag: BOOLEAN _ FALSE; -- tentative
grammar: Grammar;
allowConflicts: BOOLEAN _ FALSE; -- set to true if conflicts are to be artificially resolved
lr0Parser: Graph;
lalr1Parser: Graph;
maxRing: CARDINAL;
consistent: BOOLEAN;
finalGraph: Graph;

eventCounts: ARRAY Event OF INT _ ALL[0];
nEvents: INT _ 0;
activity: Rope.ROPE _ " ";

ShowEventCounts: PROC[on: STREAM] =
BEGIN
on.PutF["\Nat %g", rope[RopeFromTime[from: Now[], end: seconds]]];
on.PutF["after %g events\N   choosingStage1Node: %g, propagatingItem: %g\N", int[nEvents], int[eventCounts[choosingStage1Node]], 
int[eventCounts[propagatingItem]]];
on.PutF["   freezingOldSet: %g, freezingNewSet: %g\N", int[eventCounts[freezingOldSet]], int[eventCounts[freezingNewSet]]];
on.PutF["   nodeBecomesDirty: %g, choosingDirtyNode: %g\N", int[eventCounts[nodeBecomesDirty]],  
int[eventCounts[choosingDirtyNode]]]; 
END;

RecordEvent: PROC[on: STREAM, event: Event] =
BEGIN
eventCounts[event] _ eventCounts[event] + 1;
nEvents _ nEvents + 1;
IF nEvents MOD 5000 = 0 AND debugging THEN
BEGIN
on.PutF["\Nwhile %g", rope[activity]];
ShowEventCounts[on];
END;
END;

NoteEvent: PROC[event: Event] = {RecordEvent[on, event]};

LocalGenGrammar: PROC[oneUniqueTerminal: PROC[ROPE, ROPE], oneGenericTerminal: PROC[ROPE, ROPE], oneNonTerminal: PROC[ROPE],  
oneLeftSide: PROC[CARDINAL, ROPE], aRightSideSymb: PROC[ROPE]] =
{allowConflicts _ genTheGrammar[oneUniqueTerminal, oneGenericTerminal, oneNonTerminal, oneLeftSide, aRightSideSymb]};
<<>>
<<following block is nested to allow catch phrases access to showFlag>>
<<and to allow error exits access to local variables>>
BEGIN ENABLE
BEGIN -- these catch phrases are for debugging
StartShowingSignals => {showFlag _ TRUE; PutRope[progressReportStream, text]; RESUME};
SignalRope => {IF showFlag THEN PutF[progressReportStream, "%g\N", rope[text]]; RESUME};
SignalSymbol => {IF showFlag THEN
PutF[progressReportStream, "   %g %g \N", rope[text], rope[GetSymbolText[symbol]]]; RESUME};
SignalTerminalSeq => {IF showFlag THEN
PutF[progressReportStream, "   %g ", rope[text]]; ShowTerminalSeq[on, 0, seq]; PutRope[on, "\N"]; RESUME};
SignalTerminalSeqSet => {IF showFlag THEN
PutF[progressReportStream, "   %g %g \N", rope[text]]; ShowTerminalSeqSet[on, 0, set]; RESUME};
SignalLR0Item => {IF showFlag THEN
{PutF[progressReportStream, "   %g ", rope[text]]; ShowLR0Item[on, 0, item]}; RESUME};
SignalLR1Item => {IF showFlag THEN
{PutF[progressReportStream, "   %g ", rope[text]]; ShowLR1Item[on, 0, item]}; RESUME};
SignalLR0ItemSet => {IF showFlag THEN
{PutF[progressReportStream, "   %g ", rope[text]]; ShowLR0ItemSet[on, 0, set]}; RESUME};
SignalLR1ItemSet => {IF showFlag THEN
{PutF[progressReportStream, "   %g ", rope[text]]; ShowLR1ItemSet[on, 0, set]}; RESUME};
SignalNode => {IF showFlag THEN
{PutF[progressReportStream, "   %g ", rope[text]]; ShowNode[on, 0, node]}; RESUME};
StopShowingSignals => {showFlag _ FALSE; PutRope[progressReportStream, text]; RESUME}
END;


activity _ "building grammar";
IO.PutF[progressReportStream, "\N\NBegin constructing grammar\N\Tat %g\N", IO.time[Now[]]];
grammar _ BuildAGrammar[LocalGenGrammar
! GetErrorInfo => {kill _ TRUE; RESUME[GetErrorInfo[].stream, -1]}];
IF showGrammar THEN ShowGrammar[progressReportStream, grammar];
IF kill THEN GOTO abort1;
<<nesting to allow private local variables>>
BEGIN
nProductions, nRightSideItems, nTerminals, nNonTerminals: INT;
[nProductions, nRightSideItems, nTerminals, nNonTerminals] _ GetGrammarStats[grammar];
IO.PutF[progressReportStream, "\N\T\TnTerminals: %g, nNonTerminals: %g\N\T\TnProductions: %g, nRightSideItems: %g\N\N", 
IO.int[nTerminals], IO.int[nNonTerminals], IO.int[nProductions], IO.int[nRightSideItems]];
END;

activity _ "constructing LR0 Parser";
IO.PutF[progressReportStream, "Begin constructing LR0 Parser\N\Tat %g\N", IO.time[Now[]]];
lr0Parser _ CreateLR0CanonicalParser[grammar, NoteEvent];
<<nesting to allow private local variables>>
BEGIN
nNodes, nArcs, nNodesMarkedToSplit: INT;
[nNodes, nArcs, nNodesMarkedToSplit] _ GetGraphStats[lr0Parser];
IF nNodesMarkedToSplit # 0 THEN ERROR;
IO.PutF[progressReportStream, "\N\T\TnNodes: %g, nArcs: %g\N\N", IO.int[nNodes], IO.int[nArcs]];
END;

activity _ "constructing LALR[1] Parser";
IO.PutF[progressReportStream, "Begin constructing LALR[1] Parser\N\Tat %g\N", IO.time[Now[]]];
lalr1Parser _ CreateLALR1Parser[lr0Parser, NoteEvent];

activity _ "performing consistency analysis for LALR[1] Parser";
IO.PutF[progressReportStream, "Begin consistency analysis for LALR[1] Parser\N\Tat %g\N", IO.time[Now[]]];
maxRing _ MarkRingNumbers[lalr1Parser];
consistent _ maxRing = LAST[CARDINAL];
IO.PutF[progressReportStream, "Consistency analysis complete\N\Tat %g\N", IO.time[Now[]]];

IF consistent THEN
BEGIN
IO.PutF[progressReportStream, "\N\N\Ngrammar is LALR[1]\N\N\N"];
finalGraph _ lalr1Parser;
END
 ELSE IF allowConflicts THEN
BEGIN
IO.PutF[progressReportStream, "\N\N\Ngrammar is NOT LALR[1]\N"];
IO.PutF[progressReportStream, "\Tbut conflicts will be artificially resolved\N"];
finalGraph _ lalr1Parser;
END
 ELSE
BEGIN
isLR1: BOOLEAN;
IO.PutF[progressReportStream, "\N\N\Ngrammar is NOT LALR[1]\N\N\N"];

activity _ "performing conflict analysis";
IO.PutF[progressReportStream, "Begin conflict analysis\N\Tat %g\N", IO.time[Now[]]];
isLR1 _ ConflictAnal.AnalyzeLALR1Conflicts[lalr1Parser, progressReportStream, NoteEvent];
IO.PutF[progressReportStream, "Conflict analysis complete\N\Tat %g\N", IO.time[Now[]]];


IF isLR1 THEN
BEGIN
IO.PutF[progressReportStream, "\N\N\Nhowever, grammar is LR[1]\N\N\N"];
<<nesting to allow private local variables>>
BEGIN
nNodes, nArcs, nNodesMarkedToSplit: INT;
[nNodes, nArcs, nNodesMarkedToSplit] _ GetGraphStats[lalr1Parser];
IF nNodesMarkedToSplit = 0 THEN ERROR;
IO.PutF[progressReportStream, "\N\T\TnNodesMarkedToSplit: %g\N\N", IO.int[nNodesMarkedToSplit]];
END;

IO.PutF[progressReportStream, "\N\TNote: This grammar may violate an informal conjecture:"];
IO.PutF[progressReportStream, "\N\T\TThere are no interesting LR[1] programming language\N\T\T\Tgrammars that are not also 
LALR[1]."];
IO.PutF[progressReportStream, "\N\TI would like to see this grammar"];
IO.PutF[progressReportStream, "\N\T\THoward Sturgis, Xerox Parc Computer Science Laboratory"];
IO.PutF[progressReportStream, "\N\T\T\T(415) 494-4434"];
IO.PutF[progressReportStream, "\N\T\T\Tor Sturgis.pa@Xerox.Com\N\N\N"];
activity _ "splitting nodes";
IO.PutF[progressReportStream, "Begin node splitting\N\Tat %g\N", IO.time[Now[]]];
finalGraph _ SplitMarkedNodes[lalr1Parser, NoteEvent];
IO.PutF[progressReportStream, "Node splitting complete\N\Tat %g\N", IO.time[Now[]]];
activity _ "performing consistency analysis for LR[1] Parser";
IO.PutF[progressReportStream, "Begin consistency analysis for LR[1] Parser\N\Tat %g\N", IO.time[Now[]]];
IF MarkRingNumbers[finalGraph] # LAST[CARDINAL] THEN ERROR; -- shouldn't happen
IO.PutF[progressReportStream, "Consistency analysis complete\N\Tat %g\N", IO.time[Now[]]];
<<nesting to allow private local variables>>
BEGIN
nNodes, nArcs, nNodesMarkedToSplit: INT;
[nNodes, nArcs, nNodesMarkedToSplit] _ GetGraphStats[finalGraph];
IF nNodesMarkedToSplit # 0 THEN ERROR;
IO.PutF[progressReportStream, "\N\T\TnNodes: %g, nArcs: %g\N\N", IO.int[nNodes], IO.int[nArcs]];
END;
END
  ELSE
BEGIN
IO.PutF[progressReportStream, "\N\N\Ngrammar is also NOT LR[1]\N\N\N"];
[] _ GetErrorInfo[]; -- this signal will prevent writing of the parser table
GOTO abort2;
END;



END;

IF targetStream # NIL THEN
BEGIN
activity _ "writing parser tables";
IO.PutF[progressReportStream, "Begin writing parser tables\N\Tat %g\N", IO.time[Now[]]];
WriteParserTables[targetStream, finalGraph];
IO.PutF[progressReportStream, "Parser tables written\N\Tat %g\N", IO.time[Now[]]];
END;

EXITS
abort1 => NULL;
abort2 => NULL;

END;

END;


WriteParserTables: PROC[on: STREAM, graph: Graph] =
BEGIN

GenInfo: PROC[
recordSymbol: PROC[ROPE],
recordUniqueToken: PROC[ROPE, ROPE],
recordGenericToken: PROC[ROPE, ROPE],
recordShift: PROC[State, ROPE, State],
recordReduction: PROC[State, ROPE, ROPE, CARDINAL, CARDINAL],
recordAcceptance: PROC[State,  ROPE],
recordStartState: PROC[State]] =
{GenerateParseActions[graph, recordSymbol, recordUniqueToken, recordGenericToken, recordShift, recordReduction, recordAcceptance, 
recordStartState]};

RecordKipperedParserTableOnStream[on, GenInfo];
END;


<<not currently used>>
OldSplitAlgorithm: PROC =
BEGIN
on: IO.STREAM;
grammar: Grammar;
maxRing: CARDINAL;
consistent: BOOLEAN;
lalr1Parser: Graph;
oldSplitGraph: Graph;
NoteEvent: PROC[event: Event];
ShowEventCounts: PROC[on: STREAM];
showSplitGraph: BOOLEAN;
finalGraph: Graph;

MarkExistingLR1ItemSets[grammar];
FOR ring: CARDINAL IN [0..maxRing] WHILE NOT consistent DO
splitGraph: Graph;
activityStream: STREAM _ ROS[];
activity: Rope.ROPE;

activityStream.PutF["splitting to ring %g", card[ring]];
activity _ RopeFromROS[activityStream];

oldSplitGraph _ CleanTheGraph[oldSplitGraph];
ForgetUnmarkedLR1ItemSets[grammar];

splitGraph _ SplitUpToRing[lalr1Parser, ring, NoteEvent];
ShowEventCounts[on];
consistent _ TestSplitNodeGraphConsistency[splitGraph];
IF consistent THEN PutF[on, "\N\N\N graph is consistent after splitting ring %g\N\N", card[ring]]
ELSE PutF[on, "\N\N\N graph is NOT consistent after splitting ring %g\N\N", card[ring]];
ShowArcCounts[on, splitGraph];
ShowRingCounts[on, splitGraph];
IF showSplitGraph THEN ShowGraph[on, FALSE, 0, splitGraph];
finalGraph _ splitGraph;
oldSplitGraph _ splitGraph;
CheckAGraph[splitGraph]; -- VERY expensive, n squared in the number of nodes, remove after debugging.
ENDLOOP;
END;



-- support code







<<>>




ShowParserTables: PROC[on: STREAM, graph: Graph] =
BEGIN

GenInfo: PROC[
recordSymbol: PROC[ROPE],
recordUniqueToken: PROC[ROPE, ROPE],
recordGenericToken: PROC[ROPE, ROPE],
recordShift: PROC[State, ROPE, State],
recordReduction: PROC[State, ROPE, ROPE, CARDINAL, CARDINAL],
recordAcceptance: PROC[State,  ROPE],
recordStartState: PROC[State]] =
{GenerateParseActions[graph, recordSymbol, recordUniqueToken, recordGenericToken, recordShift, recordReduction, recordAcceptance, 
recordStartState]};

RecordReadableParserTableOnStream[on, GenInfo];
END;







<<OneCasabaFormat>>

<<The following procedures generate a grammar from a description prepared in OneCasabaFormat.>>
<<These procedures could move to SyntaxDescReaders>>
<<>>
<<This procedure generates the components of a grammar for BuildAGrammar by using OneCasabaFormat1 to generate a structure from 
which the generation can be performed in the proper order for BuildAGrammar. >>
<<>>


OneCasabaFormat: PROC[sourceStream: STREAM, ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[CARDINAL, ROPE], r: 
PROC[ROPE]] RETURNS[typeDeclContents: Rope.ROPE, allowConflicts: BOOLEAN] =
BEGIN

ProdChainCell: TYPE = REF ProdChainCellBody;
ProdChainCellBody: TYPE = RECORD[
index: CARDINAL,
leftSide:  ROPE,
position: INT,
rightSide: RightSideChainCell,
next: ProdChainCell];

RightSideChainCell: TYPE = REF RightSideChainCellBody;
RightSideChainCellBody: TYPE = RECORD[
item:  ROPE,
position: INT,
next: RightSideChainCell];

prodIndex: CARDINAL _ 0;
prodChain: ProdChainCell _ NIL;
lastProd: ProdChainCell _ NIL;
lastRightSideCell: RightSideChainCell _ NIL;

CasabaLeftSide: PROC[nonTermName: ROPE, modifier: ROPE, itemPosition: INT] =
BEGIN
newProd: ProdChainCell _ NEW[ProdChainCellBody_[prodIndex, nonTermName, itemPosition, NIL, NIL]];
IF lastProd # NIL THEN lastProd.next _ newProd ELSE prodChain _ newProd;
lastProd _ newProd;
lastRightSideCell _ NIL;
IF typeDeclContents = NIL THEN typeDeclContents _ Rope.Cat[nonTermName, modifier] ELSE typeDeclContents _ 
Rope.Cat[typeDeclContents, ", ", nonTermName, modifier];
prodIndex _ prodIndex+1;
END;

CasabaRightSide: PROC[item: ROPE, itemPosition: INT] =
BEGIN
newRightSideItem: RightSideChainCell _ NEW[RightSideChainCellBody_[item, itemPosition, NIL]];
IF lastRightSideCell # NIL THEN lastRightSideCell.next _ newRightSideItem ELSE lastProd.rightSide _ newRightSideItem;
lastRightSideCell _ newRightSideItem;
END;

typeDeclContents _ NIL;

<<first we build the structure using OneCasabaFormat1>>
allowConflicts _ OneCasabaFormat1[sourceStream, ut, gt, n, CasabaLeftSide, CasabaRightSide];

<<Now we generate the items in the proper order for BuildAGrammar>>
FOR prodCell: ProdChainCell _ prodChain, prodCell.next WHILE prodCell # NIL DO
l[prodCell.index, prodCell.leftSide
! GetErrorInfo => RESUME[GetErrorInfo[].stream, prodCell.position]];
FOR rightSideCell: RightSideChainCell _ prodCell.rightSide, rightSideCell.next WHILE rightSideCell # NIL DO
r[rightSideCell.item
! GetErrorInfo => RESUME[GetErrorInfo[].stream, rightSideCell.position]];
ENDLOOP;
ENDLOOP;

RETURN[typeDeclContents, allowConflicts];
END;

<<This procedure reads the OneCasabaFormat, but cannot be supplied as an argument to BuildAGrammar, because BuildAGrammar requests 
that all declarations occur before use, but we do not wish to impose that restriction on OneCasabaFormat.>>
OneCasabaFormat1: PROC[stream: STREAM, ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[ROPE, ROPE, INT], r: 
PROC[ROPE, INT]] RETURNS[allowConflicts: BOOLEAN] =
BEGIN
position: INT _ 0;
nextFlagged: BOOLEAN _ FALSE;
currentKind: IO.TokenKind;
currentToken: Rope.ROPE;

BEGIN
ENABLE GetErrorInfo => RESUME[GetErrorInfo[].stream, position];

NextToken: PROC = 
BEGIN
charsSkipped: INT;
IF nextFlagged THEN nextFlagged _ FALSE ELSE
BEGIN
WHILE TRUE DO
position _ position + Rope.Length[currentToken];
[currentKind, currentToken, charsSkipped] _ GetCedarTokenRope[stream, FALSE];
position _ position+charsSkipped;
IF currentKind # tokenCOMMENT THEN EXIT;
ENDLOOP;
END;
END;

Error: PROC[expecting: Rope.ROPE] = 
BEGIN
s: IO.STREAM _ GetErrorInfo[].stream;
IO.PutF[s, "\N\Nsyntax error in grammar definition at %g,\N\Twas expecting \"%g\"\N", IO.int[position], IO.rope[expecting]];
KillParserGen[];
END;

StripQuotes: PROC[rope: Rope.ROPE] RETURNS[Rope.ROPE] =
BEGIN
IF Rope.Fetch[rope, 0] # '" THEN ERROR;
IF Rope.Fetch[rope, Rope.Length[rope]-1] # '" THEN ERROR;
RETURN[Rope.Substr[rope, 1, Rope.Length[rope]-2]];
END;

allowConflicts _ FALSE;
NextToken[];
IF Rope.Equal[currentToken, "AllowConflicts"] THEN
{allowConflicts _ TRUE; NextToken[]};
IF NOT Rope.Equal[currentToken, "Begin"] THEN Error["Begin"];

WHILE TRUE DO
NextToken[];
SELECT TRUE FROM
Rope.Equal[currentToken, "{"] =>
BEGIN
WHILE TRUE DO
NextToken[];
IF currentKind = tokenROPE THEN ut[StripQuotes[currentToken], StripQuotes[currentToken]]
 ELSE IF Rope.Equal[currentToken, "}"] THEN EXIT;
ENDLOOP;
NextToken[];
IF NOT Rope.Equal[currentToken, ":"] THEN Error[":"];
NextToken[];
IF NOT Rope.Equal[currentToken, "SimpleTokens"] THEN Error["SimpleTokens"];
END;
currentKind = tokenID =>
BEGIN
id1: Rope.ROPE;
doRightSide: BOOLEAN _ FALSE; -- tentative
IF Rope.Equal[currentToken, "End"] THEN EXIT;
id1 _ currentToken;
NextToken[];
IF Rope.Equal[currentToken, ":"] THEN
BEGIN
NextToken[];
IF Rope.Equal[currentToken, "GenericToken"] THEN
BEGIN
NextToken[];
IF NOT Rope.Equal[currentToken, "="] THEN Error["="];
NextToken[];
IF currentKind # tokenROPE THEN Error["a rope naming an IO.TokenKind"];
gt[id1, StripQuotes[currentToken]];
END
 ELSE IF Rope.Equal[currentToken, "NonTerminal"] THEN
n[id1]
 ELSE Error["GenericToken or NonTerminal"];
END
 ELSE IF Rope.Equal[currentToken, "."] THEN
BEGIN
NextToken[];
IF currentKind # tokenID THEN Error["an Identifier"];
l[id1, currentToken, position];
NextToken[];
IF NOT Rope.Equal[currentToken, "_"] THEN Error["_"];
doRightSide _ TRUE;
END
 ELSE IF Rope.Equal[currentToken, "_"] THEN
{l[id1, "", position]; doRightSide _ TRUE};
IF doRightSide THEN
WHILE TRUE DO
NextToken[];
IF Rope.Equal[currentToken, ";"] OR Rope.Equal[currentToken, "End"] THEN
{nextFlagged _ TRUE; EXIT};
IF currentKind = tokenROPE THEN r[StripQuotes[currentToken], position] ELSE r[currentToken, position];
ENDLOOP; 
END;
ENDCASE => Error["{, identifer, or End"];
NextToken[];
IF Rope.Equal[currentToken, ";"] THEN LOOP;
IF Rope.Equal[currentToken, "End"] THEN EXIT;
Error["; or End"];
ENDLOOP;

END;

END;


GetErrorInfo: PUBLIC SIGNAL RETURNS[stream: STREAM, textPosition: INT] = CODE;
KillParserGen: PUBLIC ERROR = CODE;


-- test driver
-- at the moment this test driver is deactivated
-- it can be reactivated by either
-- executing the following in a CommandTool
-- install GenOneCasabaParser
-- _ Commander.Register["TestLR1", GenOneCasabaParserDriver.TestLR1]
-- or by recompiling without the comment marker in front of
-- Register["TestLR1", TestLR1];

TestLR1: CommandProc =
BEGIN
ENABLE GetErrorInfo => RESUME[cmd.out, -1];

commandLineStream: STREAM _ RIS[cmd.commandLine];

token: ROPE;
token _ GetTokenRope[commandLineStream, IDProc
! EndOfStream => {token _ NIL; CONTINUE}].token;
Close[commandLineStream];
IF token # NIL THEN SELECT TRUE FROM
Equal[token, "0"] => [] _ ProcessOneGrammar[GenExample0, cmd.out, NIL];
Equal[token, "1"] => [] _ ProcessOneGrammar[GenExample1, cmd.out, NIL];
Equal[token, "2"] => [] _ ProcessOneGrammar[GenExample2, cmd.out, NIL];
Equal[token, "3"] => [] _ ProcessOneGrammar[GenExample3, cmd.out, NIL];
Equal[token, "4"] => [] _ ProcessOneGrammar[GenExample4, cmd.out, NIL];
Equal[token, "5"] => [] _ ProcessOneGrammar[GenExample5, cmd.out, NIL];
Equal[token, "6"] => [] _ ProcessOneGrammar[GenExample6, cmd.out, NIL];
Equal[token, "7"] => [] _ ProcessOneGrammar[GenExample7, cmd.out, NIL];
Equal[token, "8"] => [] _ ProcessOneGrammar[GenExample8, cmd.out, NIL];
Equal[token, "9"] => [] _ ProcessOneGrammar[GenExample9, cmd.out, NIL];






ENDCASE => ProcessOnePGSFile[token, cmd.out];

END;

ProcessOnePGSFile: PROC[fileName: ROPE, on: STREAM] =
BEGIN
inStream: STREAM;

GenFromPGSFormat: PROC[ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[CARDINAL, ROPE], r: PROC[ROPE]] 
RETURNS[BOOLEAN] =
{PGSFormat[inStream, ut, gt, n, l, r]; RETURN[FALSE]};

inStream _ FS.StreamOpen[fileName
! FS.Error => IF error.group = user THEN
{PutRope[on, error.explanation]; CONTINUE}];
IF inStream # NIL THEN
BEGIN
outStream: STREAM _ FS.StreamOpen["parseTables", $create];
ProcessOneGrammar[GenFromPGSFormat, on, outStream, FALSE, FALSE, FALSE, FALSE, FALSE];
Close[inStream];
Close[outStream];
END;
END;


-- miscellaneous grammar generators

GenExample0: PROC[ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[CARDINAL, ROPE], r: PROC[ROPE]] 
RETURNS[BOOLEAN] =
BEGIN -- this example is from page 627 of Aho and Ullman
index: CARDINAL _ 0;
Prod: PROC[p: ROPE] = {OneProductionFromRope[index, p, l, r]; index _ index + 1};

GenSimpleTermsFromRope["a b c d", ut];
GenNonTermsFromRope["S' S A", n];

Prod["S' _ S"];
Prod["S _ A a"];
Prod["S _ d A b"];
Prod["S _ c b"];
Prod["S _ d c a"];
Prod["A _ c"];

RETURN[FALSE];
END;

GenExample1: PROC[ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[CARDINAL, ROPE], r: PROC[ROPE]] 
RETURNS[BOOLEAN] =
BEGIN -- this is a canonical non LALR1, but LR1, grammar
index: CARDINAL _ 0;
Prod: PROC[p: ROPE] = {OneProductionFromRope[index, p, l, r]; index _ index + 1};

GenSimpleTermsFromRope["a b z", ut];
GenNonTermsFromRope["S' S A B", n];

Prod["S' _ S"];
Prod["S _ a A a"];
Prod["S _ a B b"];
Prod["S _ b A b"];
Prod["S _ b B a"];
Prod["A _ z"];
Prod["B _ z"];

RETURN[FALSE];
END;

GenExample2: PROC[ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[CARDINAL, ROPE], r: PROC[ROPE]] 
RETURNS[BOOLEAN] =
BEGIN -- this is example 7.27 from page 630 of Aho and Ullman
index: CARDINAL _ 0;
Prod: PROC[p: ROPE] = {OneProductionFromRope[index, p, l, r]; index _ index + 1};

GenSimpleTermsFromRope["a b c d", ut];
GenNonTermsFromRope["S' S A B", n];

Prod["S' _ S"];
Prod["S _ A a"];
Prod["S _ d A b"];
Prod["S _ B b"];
Prod["S _ d B a"];
Prod["A _ c"];
Prod["B _ c"];

RETURN[FALSE];
END;

GenExample3: PROC[ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[CARDINAL, ROPE], r: PROC[ROPE]] 
RETURNS[BOOLEAN] =
BEGIN -- this is example is based on Dan Greens idea
index: CARDINAL _ 0;
Prod: PROC[p: ROPE] = {OneProductionFromRope[index, p, l, r]; index _ index + 1};

GenSimpleTermsFromRope["a b c d e f u v w z", ut];
GenNonTermsFromRope["S' S A B E F1 F2 F3", n];

Prod["S' _ S"];

Prod["S _ a A a"];
Prod["S _ b A b"];
Prod["S _ a B b"];
Prod["S _ b B a"];
Prod["S _ a E c"];
Prod["S _ b E c"];

Prod["S _ d F1 a"];
Prod["S _ d F2 b"];
Prod["S _ d F3 u"];
Prod["S _ e F1 a"];
Prod["S _ e F2 b"];
Prod["S _ e F3 v"];
Prod["S _ f F1 a"];
Prod["S _ f F2 b"];
Prod["S _ f F3 w"];

Prod["F1 _ f A"];
Prod["F2 _ f B"];
Prod["F3 _ f E"];

Prod["A _ z z z z z z"];
Prod["B _ z z z z z z"];
Prod["E _ z z z z z z"];

RETURN[FALSE];
END;

GenExample4: PROC[ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[CARDINAL, ROPE], r: PROC[ROPE]] 
RETURNS[BOOLEAN] =
BEGIN -- a fragment of an expression grammar
index: CARDINAL _ 0;
Prod: PROC[p: ROPE] = {OneProductionFromRope[index, p, l, r]; index _ index + 1};

GenSimpleTermsFromRope["+ - * / [ ] , BEGIN END", ut];
GenGenericTermsFromRope["id tokenID number tokenDECIMAL real tokenREAL", gt];
GenNonTermsFromRope["S' exp S prod term args argSeq", n];

Prod["S' _ exp"];

Prod["exp _ BEGIN S END"];
Prod["exp _ S"];
Prod["S _ S + prod"];
Prod["S _ S - prod"];
Prod["S _ prod"];
Prod["prod _ prod * term"];
Prod["prod _ prod / term"];
Prod["prod _ term"];
Prod["term _ id args"];
Prod["term _ number"];
Prod["term _ real"];
Prod["args _ [ argSeq ]"];
Prod["args _"];
Prod["argSeq _ argSeq , S"];
Prod["argSeq _ S"];

RETURN[FALSE];
END;

GenExample5: PROC[ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[CARDINAL, ROPE], r: PROC[ROPE]] 
RETURNS[BOOLEAN] =
BEGIN -- a fragment of xcedar
index: CARDINAL _ 0;
Prod: PROC[p: ROPE] = {OneProductionFromRope[index, p, l, r]; index _ index + 1};

GenSimpleTermsFromRope[". .. UNSAFE SAFE CHECKED TRUSTED UNCHECKED directory identlist cedar block defhead defbody class arguments 
locks interface tilde public", ut];
GenNonTermsFromRope["GOAL goal module proghead resident safe trusted checked", n];

Prod["GOAL _ goal"];
Prod["goal _ . module ."];
Prod["goal _ . module .."];
Prod["module _ directory identlist cedar proghead trusted checked block"];
Prod["module _ directory identlist cedar defhead defbody"];
Prod["proghead _ resident safe class arguments locks interface tilde public"];
Prod["resident _"];
Prod["safe _"];
Prod["safe _ UNSAFE"];
Prod["safe _ SAFE"];
Prod["trusted _"];
Prod["checked _"];
Prod["checked _ CHECKED"];
Prod["checked _ TRUSTED"];
Prod["checked _ UNCHECKED"];

RETURN[FALSE];
END;

GenExample6: PROC[ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[CARDINAL, ROPE], r: PROC[ROPE]] 
RETURNS[BOOLEAN] =
BEGIN -- a fragment of mesa
index: CARDINAL _ 0;
Prod: PROC[p: ROPE] = {OneProductionFromRope[index, p, l, r]; index _ index + 1};

GenSimpleTermsFromRope["IF THEN ELSE S exp", ut];
GenNonTermsFromRope["GOAL statement elsepart", n];

Prod["GOAL _ statement"];
Prod["statement _ IF exp THEN statement elsepart"];
Prod["statement _ S"];
Prod["elsepart _ ELSE statement"];
Prod["elsepart _"];

RETURN[FALSE];
END;

GenExample7: PROC[ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[CARDINAL, ROPE], r: PROC[ROPE]] 
RETURNS[BOOLEAN] =
BEGIN -- Kristensen-Madsen Example A.1 (pg 46)
index: CARDINAL _ 0;
Prod: PROC[p: ROPE] = {OneProductionFromRope[index, p, l, r]; index _ index + 1};

GenSimpleTermsFromRope["a b c d x y z", ut];
GenNonTermsFromRope["S' S A B", n];

Prod["S' _ S"];
Prod["S _ A a"];
Prod["S _ B b"];
Prod["S _ d A b"];
Prod["S _ d B a"];
Prod["A _ x y z A"];
Prod["A _ x c"];
Prod["B _ x y z B"];
Prod["B _ x c"];

RETURN[FALSE];
END;

GenExample8: PROC[ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[CARDINAL, ROPE], r: PROC[ROPE]] 
RETURNS[BOOLEAN] =
BEGIN -- Kristensen-Madsen Example A.2 (pg 53)
index: CARDINAL _ 0;
Prod: PROC[p: ROPE] = {OneProductionFromRope[index, p, l, r]; index _ index + 1};

GenSimpleTermsFromRope["a b c d x y z", ut];
GenNonTermsFromRope["S' S A B C", n];

Prod["S' _ S"];
Prod["S _ A a"];
Prod["S _ B b"];
Prod["S _ d A b"];
Prod["S _ d B a"];
Prod["A _ x y z A C"];
Prod["A _ x c"];
Prod["B _ x y z B"];
Prod["B _ x c"];
Prod["C _ c"];
Prod["C _"]; -- some confusion in my mind as to whether C_e or C_ empty.  issue is that Kristensen-Madsen use e to represent empty 
string.

RETURN[FALSE];
END;

GenExample9: PROC[ut: PROC[ROPE, ROPE], gt: PROC[ROPE, ROPE], n: PROC[ROPE], l: PROC[CARDINAL, ROPE], r: PROC[ROPE]] 
RETURNS[BOOLEAN] =
BEGIN -- Tentative syntax for mixed productions and recursive function definitions
index: CARDINAL _ 0;
Prod: PROC[p: ROPE] = {OneProductionFromRope[index, p, l, r]; index _ index + 1};

GenSimpleTermsFromRope["for let [ source , ] < > where if then else = ( ) standsForLet", ut];
GenSpelledTermsFromRope["leftArrow _", ut];
GenNonTermsFromRope["Definition ProductionSeq Production RightSideSeq RightSideToken FDefSeq FDef FDefBody Exp ExpSeq CallExp 
WhereSeq WhereItem IdSeq Exp1 Exp0 RelOperator", n];
GenGenericTermsFromRope["Identifier tokenID modifier tokenREAL rope tokenROPE", gt];

Prod["Definition _ ProductionSeq"];
Prod["ProductionSeq _ ProductionSeq Production"];
Prod["ProductionSeq _ Production"];
Prod["Production _ for Identifier leftArrow RightSideSeq FDefSeq"];
Prod["RightSideSeq _"];
Prod["RightSideSeq _ RightSideSeq RightSideToken"];
Prod["RightSideToken _ Identifier"];
Prod["RightSideToken _ Identifier modifier"];
Prod["RightSideToken _ ,"];
Prod["RightSideToken _ ["];
Prod["RightSideToken _ ]"];
Prod["RightSideToken _ leftArrow"];
Prod["RightSideToken _ for"];
Prod["RightSideToken _ standsForLet"];
Prod["RightSideToken _ source"];
Prod["RightSideToken _ where"];
Prod["RightSideToken _ <"];
Prod["RightSideToken _ >"];
Prod["RightSideToken _ if"];
Prod["RightSideToken _ then"];
Prod["RightSideToken _ else"];
Prod["RightSideToken _ ("];
Prod["RightSideToken _ )"];
Prod["RightSideToken _ ="];
Prod["FDefSeq _ FDef"];
Prod["FDefSeq _ FDefSeq FDef"];
Prod["FDef _ let Identifier [ source , IdSeq ] leftArrow FDefBody"];
Prod["FDef _ let Identifier [ source ] leftArrow FDefBody"];
Prod["FDefBody _ Exp"];
Prod["FDefBody _ < ExpSeq >"];
Prod["FDefBody _ Exp WhereSeq"];
Prod["FDefBody _ < ExpSeq > WhereSeq"];
Prod["ExpSeq _ Exp"];
Prod["ExpSeq _ ExpSeq , Exp"];
Prod["WhereSeq _ WhereItem"];
Prod["WhereSeq _ WhereSeq WhereItem"];
Prod["WhereItem _ where < IdSeq > leftArrow CallExp"];
Prod["WhereItem _ where Identifier leftArrow Exp"];
Prod["IdSeq _ Identifier"];
Prod["IdSeq _ IdSeq , Identifier"];
Prod["Exp _ if Exp1 then Exp else Exp"];
Prod["Exp _ Exp1"];
Prod["Exp1 _ Exp1 RelOperator Exp0"];
Prod["Exp1 _ Exp0"];
Prod["Exp0 _ Identifier"];
Prod["Exp0 _ Identifier modifier"];
Prod["Exp0 _ ( Exp )"];
Prod["Exp0 _ CallExp"];
Prod["Exp0 _ rope"];
Prod["CallExp _ Identifier [ ExpSeq ]"];
Prod["RelOperator _ ="];
RETURN[FALSE];
END;



-- main code

--Register["TestLR1", TestLR1];
Register["GenOneCasabaParser", GenOneCasabaParser];


END..