-- ParserGraphAlgorithmsImpl.mesa
-- last edit     February 21, 1985 5:35:00 pm PST
-- Sturgis, April 1, 1986 9:34:27 am PST
DIRECTORY
GrammarBasic USING[GenAllSymbols, GenTerminalSymbols, GetLeftSideSymbol, GetLength, GetProductionIndex, GetStartProduction, 
GetSymbolText, GetTerminalSpelling, GetTerminalClass, GetTerminalVariety, Grammar, Production, Symbol, TerminalVariety, 
TestIfTerminal],
TerminalSequences USING[CreateEmptyTerminalSeqSet, InsertTerminalSeqInSet, TerminalSeqSet, TerminalSeq, GenTerminalSeqsFromSet, 
GetEmptyTerminalSeq, GetOneSymbolTerminalSeq, GetSymbolFromTerminalSeq, TestIfTerminalSeqSetEmpty],
LR0ItemSetsBasic USING[LR0Item, ClearLR0ItemSetsAssociatedNodes, GetLR0AssociatedNode, CreateEmptyTentativeLR0ItemSet, 
FreezeTentativeLR0ItemSet, InsertItemInTentativeLR0ItemSet, LR0ItemSet, NarrowLR0ItemSet, NarrowTentativeLR0ItemSet, 
SetLR0AssociatedNode, TentativeLR0ItemSet],
LR1ItemSetsBasic USING[CheckAnLR1ItemSet, CompareTwoLR1ItemSets, LR1ItemSet, LR1ItemSubset, ClearLR1ItemSetsAssociatedNodes, 
CreateEmptyLR1ItemSet, FreezeLR1ItemSet, GenerateSubsetsFromLR1ItemSet, GetLR1AssociatedNode, InsertSubsetInLR1ItemSet, 
NarrowLR1ItemSet, SetLR1AssociatedNode, TestIfLR1ItemSetFrozen],
LR0ItemSets USING[CreateV0EpsilonKernel, GenKernelGoToLR0ItemsFromKernel],
LR1ItemSets USING[CreateV1EpsilonKernel, GenKernelGoTo1ItemSubsetsFromKernel, GenKernelGoTo1ItemSubsetsFromDirtyKernelItems, 
GenReductionRulesFromKernel, InsertV1EpsilonKernelItems],
ParserGraphAlgorithms USING[Event],
ParserGraphs USING[AppendAnArc, ClearAllUpperNodePointers, CreateEmptyGraph, CreateTentativeStage1Node, FollowSymbol, 
GenerateAllNodes, GenerateArcs, GetAnyDirtyNode, GetAnyStage1Node, GetAssociatedSet, GetBaseNode, GetGrammar, GetGraph, 
GetNodeIndex, GetRingNumber, GetSplittingMark, GetStartNode, GetUpperNode, Graph, IndexTheNodes, InstallStage1Node, MarkAsStage2, 
MarkNodeDirty, NarrowNode, Node, ResetArcTarget, SetAssociatedSet, SetRingNumber, SetUpperNode],
ParserDisplay USING[StartShowingSignals, SignalLR0ItemSet, SignalLR1ItemSet],
Rope USING[ROPE];


ParserGraphAlgorithmsImpl: CEDAR PROGRAM IMPORTS GrammarBasic, TerminalSequences, LR0ItemSetsBasic, LR0ItemSets, LR1ItemSetsBasic, 
LR1ItemSets, ParserDisplay, ParserGraphs EXPORTS ParserGraphAlgorithms  =

BEGIN OPEN GrammarBasic, TerminalSequences, LR0ItemSetsBasic, LR1ItemSetsBasic, LR0ItemSets, LR1ItemSets, ParserGraphs, 
ParserDisplay, ParserGraphAlgorithms, Rope;


-- note: September 11, 1984 8:57:27 am PDT: this LR0 code has been modified to work with kernels of sets, rather than complete 
sets.  The time to build the LR0ParserGraph for the xmesa grammar was about 12 minutes before this change.  This reduced to 30 
seconds.  Eventually the LR0 set code will also be modified so that when generating a closure from a kernel, a given symbol will be 
investigated only once.  At the moment, however, this is not the dominant cost for the xmesa grammar.
CreateLR0CanonicalParser: PUBLIC PROC[grammar: Grammar, noteEvent: PROC[Event]] RETURNS[Graph] = 
BEGIN
LR0Parser: Graph _ CreateEmptyGraph[grammar, LR0];

-- clear any previously constructed associations (there shouldn't be any unless this is a repeat run)

ClearLR0ItemSetsAssociatedNodes[grammar];

-- insert the start node

BEGIN
start: Node _ CreateTentativeStage1Node[LR0Parser, NIL, NIL];
InstallStage1Node[start, TRUE];
SetAssociatedSet[start, CreateV0EpsilonKernel[grammar], NIL];
noteEvent[freezingNewSet];
END;


-- now begin the iteration

FOR stage1Node: Node _ GetAnyStage1Node[LR0Parser],
  GetAnyStage1Node[LR0Parser]
  WHILE stage1Node # NIL DO
sourceSet: LR0ItemSet _ NarrowLR0ItemSet[GetAssociatedSet[stage1Node]];

LookAtOneLR0Item: PROC[s: Symbol, item: LR0Item] =
BEGIN
targetNode: Node _ FollowSymbol[stage1Node, s];
tentativeTargetSet: TentativeLR0ItemSet;

IF targetNode = NIL THEN
BEGIN
tentativeTargetSet _ CreateEmptyTentativeLR0ItemSet[grammar];
targetNode _ CreateTentativeStage1Node[LR0Parser, tentativeTargetSet, NIL];
AppendAnArc[stage1Node, s, targetNode];
END
 ELSE tentativeTargetSet _ NarrowTentativeLR0ItemSet[GetAssociatedSet[targetNode]];

[] _ InsertItemInTentativeLR0ItemSet[tentativeTargetSet, item];
noteEvent[propagatingItem];
END;

FreezeTarget: PROC[s: Symbol, targetNode: Node] RETURNS[--continue-- BOOLEAN] =
BEGIN
tentativeTargetSet: TentativeLR0ItemSet _ NarrowTentativeLR0ItemSet[GetAssociatedSet[targetNode]];
frozenTargetSet: LR0ItemSet _ FreezeTentativeLR0ItemSet[tentativeTargetSet];
existingTarget: Node _ NarrowNode[GetLR0AssociatedNode[frozenTargetSet]];

IF existingTarget = NIL THEN
BEGIN -- this is a genuinely new node
SetLR0AssociatedNode[frozenTargetSet, targetNode];
SetAssociatedSet[targetNode, frozenTargetSet, tentativeTargetSet];
InstallStage1Node[targetNode, FALSE];
noteEvent[freezingNewSet];
END
ELSE
BEGIN -- this target already existed
existingSet: LR0ItemSet _ NarrowLR0ItemSet[GetAssociatedSet[existingTarget]];
ResetArcTarget[stage1Node, s, existingTarget];
IF existingSet # frozenTargetSet THEN ERROR;
noteEvent[freezingOldSet];
END;

RETURN[TRUE];
END;

noteEvent[choosingStage1Node];

-- first build up the tentative target sets
GenKernelGoToLR0ItemsFromKernel[sourceSet, LookAtOneLR0Item];

-- now freeze these sets, possibly getting previously existing sets
GenerateArcs[stage1Node, FreezeTarget];

-- done with this source node
MarkAsStage2[stage1Node];
ENDLOOP;


-- all done
IndexTheNodes[LR0Parser];
RETURN[LR0Parser];
END;

Hi: SIGNAL = CODE;

CreateLALR1Parser: PUBLIC PROC[LR0Parser: Graph, noteEvent: PROC[Event]] RETURNS[Graph] = 
BEGIN
grammar: Grammar _ GetGrammar[LR0Parser];
baseStart: Node _ GetStartNode[LR0Parser];
LALR1Parser: Graph _ CreateEmptyGraph[grammar, LALR1];

CreateOneNewNode: PROC[baseNode: Node] RETURNS[--continue--BOOLEAN] =
BEGIN
newNode: Node _ CreateTentativeStage1Node[LALR1Parser, CreateEmptyLR1ItemSet[grammar], baseNode];
InstallStage1Node[newNode, baseNode=baseStart];
SetUpperNode[baseNode, newNode];
RETURN[TRUE];
END;

FreezeOneLR1ItemSet: PROC[node: Node]  RETURNS[--continue--BOOLEAN] =
BEGIN
tentativeSet: LR1ItemSet _ NarrowLR1ItemSet[GetAssociatedSet[node]];
frozenSet: LR1ItemSet _ FreezeLR1ItemSet[tentativeSet, FALSE];
existingTarget: Node _ NarrowNode[GetLR1AssociatedNode[frozenSet]];
IF existingTarget = NIL THEN
BEGIN -- this is a genuinely new node
SetLR1AssociatedNode[frozenSet, node];
SetAssociatedSet[node, frozenSet, tentativeSet];
noteEvent[freezingNewSet];
CheckLALR1Node[node];
END
ELSE
BEGIN -- this target already existed, which is impossible
ERROR;
END;
RETURN[TRUE];
END;


-- first clean up any set associations

ClearLR1ItemSetsAssociatedNodes[grammar];


-- next, we copy the structure of the given LR0Parser graph

GenerateAllNodes[LR0Parser, CreateOneNewNode];

FOR stage1Node: Node _ GetAnyStage1Node[LALR1Parser],
  GetAnyStage1Node[LALR1Parser]
  WHILE stage1Node # NIL DO
baseSourceNode: Node _ GetBaseNode[stage1Node];

InstallNewArc: PROC[s: Symbol, baseArcTarget: Node]RETURNS[--continue-- BOOLEAN] =
BEGIN
target: Node _ GetUpperNode[baseArcTarget];
IF GetBaseNode[target] # baseArcTarget THEN ERROR;
AppendAnArc[stage1Node, s, target];
RETURN[TRUE];
END;

noteEvent[choosingStage1Node];
GenerateArcs[baseSourceNode, InstallNewArc];
MarkAsStage2[stage1Node];
ENDLOOP;

-- now we initialize the tentative item set associated with the start node

BEGIN
start: Node _ GetStartNode[LALR1Parser];
InsertV1EpsilonKernelItems[grammar, NarrowLR1ItemSet[GetAssociatedSet[start]]];
MarkNodeDirty[start];
noteEvent[nodeBecomesDirty];
END;


-- now we iteratively add to the existing tentative item sets until there is no change

FOR dirtyNode: Node _ GetAnyDirtyNode[LALR1Parser], GetAnyDirtyNode[LALR1Parser]
WHILE dirtyNode # NIL DO
sourceSet: LR1ItemSet _ NarrowLR1ItemSet[GetAssociatedSet[dirtyNode]];

InsertCloseOfOneLR1ItemSubset: PROC[s: Symbol, subset: LR1ItemSubset] =
BEGIN
targetNode: Node _ FollowSymbol[dirtyNode, s];
targetSet: LR1ItemSet _ NarrowLR1ItemSet[GetAssociatedSet[targetNode]];
IF InsertSubsetInLR1ItemSet[subset, targetSet] THEN
BEGIN
MarkNodeDirty[targetNode];
noteEvent[nodeBecomesDirty];
END;
END;

noteEvent[choosingDirtyNode];
GenKernelGoTo1ItemSubsetsFromDirtyKernelItems[sourceSet, InsertCloseOfOneLR1ItemSubset];
ENDLOOP;

-- now we freeze the tentative item sets

GenerateAllNodes[LALR1Parser, FreezeOneLR1ItemSet];


-- now we are done
IndexTheNodes[LALR1Parser];
RETURN[LALR1Parser];
END;


MarkRingNumbers: PUBLIC PROC[LALR1Parser: Graph] RETURNS[maxRingNumber: CARDINAL] =  -- LAST[CARDINAL] if consistent.
BEGIN
ringSize: CARDINAL _ 1; -- initialize to 1 in order to get the loop started
ringNumber: CARDINAL _ 0; -- holds the ring number of the ring just inside the current ring being constructed


RingCheck: PROCEDURE[state: Node] RETURNS[BOOLEAN] = 
BEGIN
inRing: BOOLEAN _ FALSE;
CheckOneArc: PROCEDURE[s: Symbol, nextState: Node] RETURNS[BOOLEAN] =
BEGIN
IF GetRingNumber[nextState] = ringNumber THEN inRing _ TRUE;
RETURN[TRUE]
END;
IF GetRingNumber[state] <= ringNumber THEN RETURN[TRUE];
GenerateArcs[state, CheckOneArc];
IF inRing THEN
BEGIN
ringSize _ ringSize + 1;
SetRingNumber[state, ringNumber+1];
maxRingNumber _ ringNumber+1;
END;
RETURN[TRUE]
END;



InitializeRingNumber: PROC[n: Node] RETURNS[--continue--BOOLEAN] = 
BEGIN
IF TestConsistencyOfNode[n] THEN
SetRingNumber[n, LAST[CARDINAL]]
ELSE {SetRingNumber[n, 0]; maxRingNumber _ 0};
RETURN[TRUE]
END;

GenerateAllNodes[LALR1Parser, InitializeRingNumber];

maxRingNumber _ LAST[CARDINAL]; -- value to be returned if all is consistent

WHILE ringSize # 0 DO 
ringSize _ 0;
GenerateAllNodes[LALR1Parser, RingCheck];
ringNumber _ ringNumber + 1; -- tricky
ENDLOOP;


RETURN[maxRingNumber];
END;


SplitUpToRing: PUBLIC PROC[LALR1Parser: Graph, ring: CARDINAL, noteEvent: PROC[Event]] RETURNS[Graph] =
BEGIN
TestRingNumb: PROC[node: Node] RETURNS[BOOLEAN] =
{RETURN[GetRingNumber[node] < ring]};
RETURN[SplitGraph[LALR1Parser, TestRingNumb, noteEvent]];
END;


SplitMarkedNodes: PUBLIC PROC[LALR1Parser: Graph, noteEvent: PROC[Event]] RETURNS[Graph] =
{RETURN[SplitGraph[LALR1Parser, GetSplittingMark, noteEvent]]};


-- some comments about this procedure.  The fundamental algorithm for converting a stage-1 node to a stage-2 node is to find the 
corresponding node in the LALR(1) graph, find all of its outgoing arcs, and create an outgoing arc for each such arc.  This leads 
to scanning the associated LR(1) set as many times as there are outgoing arcs.  Instead, we proceed in two steps.  We first scan 
the outgoing arcs of the base node (the corresponding node in the LALR(1) graph) and for arcs to non splitting nodes, we build a 
corrsponding arc from the stage-1 node to the appropriate previously constructed node.  If the arc is to a splitting node, then we 
build an arc to a tentative node holding an empty tentative set.  If there are such tentative arcs, then we scan the associated 
LR(1) set once, and for every item that leads to a tentative node, we install assorted items in the appropriate tentative set.  
Finally, we freeze these tentative sets, and see if they already existed, if so we re-direct the tentative arcs.  I assert that 
this computes the same GoTo1 Sets as does the fundamental algorithm.
   
SplitGraph: PUBLIC PROC[LALR1Parser: Graph, TestNode: PROC[Node] RETURNS[BOOLEAN], noteEvent: PROC[Event]] RETURNS[Graph] = 
BEGIN
grammar: Grammar _ GetGrammar[LALR1Parser];
splitNodeGraph: Graph _ CreateEmptyGraph[grammar, SplitNode];
baseStartNode: Node _ GetStartNode[LALR1Parser];

InstallNonSplitNodes: PROCEDURE[base: Node] RETURNS[--continue-- BOOLEAN] =
BEGIN
IF NOT TestNode[base] THEN
BEGIN
newNode: Node _ CreateTentativeStage1Node[splitNodeGraph, NARROW[GetAssociatedSet[base]], base];
InstallStage1Node[newNode, base=baseStartNode];
SetUpperNode[base, newNode];
END;
RETURN[TRUE];
END;

ClearLR1ItemSetsAssociatedNodes[grammar];

ClearAllUpperNodePointers[LALR1Parser];

GenerateAllNodes[LALR1Parser, InstallNonSplitNodes];

IF TestNode[baseStartNode] THEN
BEGIN
s: LR1ItemSet _ CreateV1EpsilonKernel[grammar];
InstallStage1Node[CreateTentativeStage1Node[splitNodeGraph, s, baseStartNode], TRUE];
END;


FOR stage1Node: Node _ GetAnyStage1Node[splitNodeGraph],
  GetAnyStage1Node[splitNodeGraph]
  WHILE stage1Node # NIL DO
baseSourceNode: Node _ GetBaseNode[stage1Node];
sourceSet: LR1ItemSet _ NarrowLR1ItemSet[GetAssociatedSet[stage1Node]];

CreateATentativeArc: PROC[s: Symbol, baseTarget: Node] RETURNS[--continue-- BOOLEAN] =
BEGIN
IF TestNode[baseTarget] THEN
BEGIN -- target is a splitting node, so create a tentative target
targetSet: LR1ItemSet _ CreateEmptyLR1ItemSet[grammar];
target: Node _ CreateTentativeStage1Node[splitNodeGraph, targetSet, baseTarget];
AppendAnArc[stage1Node, s, target];
END
 ELSE
BEGIN -- target is a non splitting node
target: Node _ GetUpperNode[baseTarget];
AppendAnArc[stage1Node, s, target];
END;
RETURN[TRUE];
END;

PossiblyCloseOneLR1ItemSubset: PROC[s: Symbol, subset: LR1ItemSubset] =
BEGIN
target: Node _ FollowSymbol[stage1Node, s];
baseTarget: Node _ FollowSymbol[baseSourceNode, s];

noteEvent[propagatingItem];

IF TestNode[baseTarget] THEN
BEGIN -- target is a splitting node
targetSet: LR1ItemSet;

IF target = NIL THEN ERROR;
targetSet _ NarrowLR1ItemSet[GetAssociatedSet[target]];
[] _ InsertSubsetInLR1ItemSet[subset, targetSet];
END
 ELSE
BEGIN -- target is a non splitting node
IF target = NIL THEN ERROR;
IF baseTarget # GetBaseNode[target] THEN ERROR;
IF target # GetUpperNode[baseTarget] THEN ERROR;
END;
END;

FreezeIfTentative: PROC[s: Symbol, target: Node] RETURNS[--continue--BOOLEAN] =
BEGIN
baseTarget: Node _ GetBaseNode[target];

IF TestNode[baseTarget] THEN
BEGIN -- target is a splitting node
tentativeTargetSet: LR1ItemSet _ NarrowLR1ItemSet[GetAssociatedSet[target]];
frozenTargetSet: LR1ItemSet _ FreezeLR1ItemSet[tentativeTargetSet, TRUE];
existingTarget: Node _ NarrowNode[GetLR1AssociatedNode[frozenTargetSet]];

IF existingTarget = NIL THEN
BEGIN -- this is a genuinely new node
InstallStage1Node[target, FALSE];
SetLR1AssociatedNode[frozenTargetSet, target];
SetAssociatedSet[target, frozenTargetSet, tentativeTargetSet];
noteEvent[freezingNewSet];
END
ELSE
BEGIN -- this target already existed
existingSet: LR1ItemSet _ NarrowLR1ItemSet[GetAssociatedSet[existingTarget]];
ResetArcTarget[stage1Node, s, existingTarget];
IF existingSet # frozenTargetSet THEN ERROR;
noteEvent[freezingOldSet];
END;
END;
RETURN[TRUE];
END;

noteEvent[choosingStage1Node];


-- first create the  arcs to the existing non split nodes, and tentative arcs to tentative nodes for splitting nodes
GenerateArcs[baseSourceNode, CreateATentativeArc];

-- now build the tentative sets for the split node targets
GenKernelGoTo1ItemSubsetsFromKernel[sourceSet, PossiblyCloseOneLR1ItemSubset];

-- now freeze the tentative sets, possibly redirecting the arcs
GenerateArcs[stage1Node, FreezeIfTentative];

-- done with this stage 1 node
MarkAsStage2[stage1Node];
ENDLOOP;

-- all done
IndexTheNodes[splitNodeGraph];
RETURN[splitNodeGraph];
END;

TestSplitNodeGraphConsistency: PUBLIC PROC[splitGraph: Graph] RETURNS[consistent: BOOLEAN] =
BEGIN

CheckOneNode: PROC[node: Node] RETURNS[--continue-- BOOLEAN] =
BEGIN
baseNode: Node _ GetBaseNode[node];
ring: CARDINAL _ GetRingNumber[baseNode];
IF ring = LAST[CARDINAL] THEN RETURN[TRUE]; -- this is not a version of a ring 0 node, hence consistent
IF NOT TestConsistencyOfNode[node] THEN  -- we have found one inconsistent node
{consistent _ FALSE; RETURN[FALSE]};
RETURN[TRUE];
END;

consistent _ TRUE; -- tentative
GenerateAllNodes[splitGraph, CheckOneNode];
END;


-- note: we could directly test the consistency of the associated set, but that would involve much of the calculation that created 
the arcs.  So we use the following procedure.
-- the node is inconsistent if any terminal seq leads to both a shift and some reduction, and it is inconsistent if there are two 
reductions provoked by the same terminal sequence.
-- Since the associated set is mearly the Kernel of the actual associated set, there is a danger that the same <production, 
terminalSeq> pair will be generated.  As a matter of fact, only productions outside the Kernel are in danger of being generated 
more than once, and only empty productions can be outside the Kernel.  So we keep a record of the pairs of empty productions and 
terminal sequences.  Otherwise, seeing the same terminal sequence twice means inconsistency.

ProdTermSeqCell: TYPE = REF ProdTermSeqCellBody;
ProdTermSeqCellBody: TYPE = RECORD[
termSeq: TerminalSeq,
production: Production,
next: ProdTermSeqCell];

TestConsistencyOfNode: PUBLIC PROCEDURE[node: Node] RETURNS[--consistent-- BOOLEAN] =
BEGIN
consistent: BOOLEAN _ TRUE; -- tentative
grammar: Grammar _ GetGrammar[GetGraph[node]];
terminals: TerminalSeqSet _ CreateEmptyTerminalSeqSet[grammar];
pairsSeen: ProdTermSeqCell _ NIL;

NoteTheOutgoingArcs: PROC[s: Symbol, target: Node] RETURNS[--continue--BOOLEAN] =
BEGIN
IF TestIfTerminal[s] THEN
[] _ InsertTerminalSeqInSet[terminals, GetOneSymbolTerminalSeq[s]];
RETURN[TRUE];
END;

NoteTheReductionRules: PROC[terminalSeq: TerminalSeq, production: Production] =
BEGIN
IF GetLength[production] # 0 THEN
{IF NOT InsertTerminalSeqInSet[terminals, terminalSeq] THEN consistent _ FALSE}
 ELSE
BEGIN
-- we are dealing with an empty production, so there is danger of seeing the same <production, terminalSeq> pair more than once.
FOR cell: ProdTermSeqCell _ pairsSeen, cell.next WHILE cell # NIL DO
IF cell.termSeq = terminalSeq AND cell.production = production THEN RETURN; -- we have seen this pair before
ENDLOOP;
IF NOT InsertTerminalSeqInSet[terminals, terminalSeq] THEN consistent _ FALSE;
pairsSeen _ NEW[ProdTermSeqCellBody_[terminalSeq, production, pairsSeen]];
END;
END;

-- first, record the terminals labeling the outgoing arcs
GenerateArcs[node, NoteTheOutgoingArcs];

-- now, check against reduction rules.
GenReductionRulesFromKernel[NarrowLR1ItemSet[GetAssociatedSet[node]], NoteTheReductionRules];

RETURN[consistent];
END;

GenerateParseActions: PUBLIC PROC[graph: Graph,
symbol: PROC[text: ROPE],
uniqueToken: PROC[name: ROPE, spelling: ROPE],
genericToken: PROC[name: ROPE, class: ROPE],
shift: PROC[state: CARDINAL, terminalSeq: ROPE, newState: CARDINAL],
reduction: PROC[state: CARDINAL, terminalSeq: ROPE, leftSide: ROPE, ruleNumber: CARDINAL, ruleSize: CARDINAL],
acceptance: PROC[state: CARDINAL, terminalSeq: ROPE],
start: PROC[state: CARDINAL]] =
BEGIN
HandleOneSymbol: PROC[s: Symbol] =
{symbol[GetSymbolText[s]]};
HandleOneTerminal: PROC[s: Symbol] =
BEGIN
variety: TerminalVariety _ GetTerminalVariety[s];
IF variety = unique THEN uniqueToken[GetSymbolText[s], GetTerminalSpelling[s]]
 ELSE IF variety = generic THEN genericToken[GetSymbolText[s], GetTerminalClass[s]]
 ELSE ERROR;
END;
HandleOneNode: PROC[node: Node] RETURNS[--continue--BOOLEAN] =
{GenParseActionsForOneNode[node, shift, reduction, acceptance]; RETURN[TRUE]};
GenAllSymbols[GetGrammar[graph], HandleOneSymbol];
GenTerminalSymbols[GetGrammar[graph], HandleOneTerminal];
GenerateAllNodes[graph, HandleOneNode];
start[GetNodeIndex[GetStartNode[graph]]];
END;

-- 1) syntax checks each set associated with a node,
-- 2) by a crude n squared algorithm, looks for two nodes with the same base and the same LR1 set of items.  This produces a check 
on low level code which is supposed to always notice when a new LR1 item set is the same as an old frozen one. (turned off for now)
-- 3) checks ring numbers
CheckAGraph: PUBLIC PROC[graph: Graph] =
BEGIN
SeeNode1: PROC[node1: Node] RETURNS[BOOLEAN] =
BEGIN
leastRingSeen: CARDINAL _ LAST[CARDINAL];
set1: LR1ItemSet _ NarrowLR1ItemSet[GetAssociatedSet[node1]];
SeeNode2: PROC[node2: Node] RETURNS[BOOLEAN] =
BEGIN
IF node1 = node2 THEN RETURN[TRUE];
IF GetBaseNode[node1] # GetBaseNode[node2] THEN
{IF GetAssociatedSet[node1] = GetAssociatedSet[node2] THEN ERROR}
 ELSE 
{IF CompareTwoLR1ItemSets[set1, GetAssociatedSet[node2]] THEN ERROR};
RETURN[TRUE];
END;
SeeOneTargetNode: PROC[s: Symbol, target: Node] RETURNS[BOOLEAN] =
BEGIN
targetRing: CARDINAL _ GetRingNumber[GetBaseNode[target]];
IF targetRing < leastRingSeen THEN leastRingSeen _ targetRing; 
RETURN[TRUE];
END;
CheckAnLR1ItemSet[set1];

IF NOT TestConsistencyOfNode[GetBaseNode[node1]] THEN
{IF GetRingNumber[GetBaseNode[node1]] # 0 THEN ERROR}
 ELSE
BEGIN
GenerateArcs[node1, SeeOneTargetNode];
SELECT TRUE FROM
leastRingSeen = LAST[CARDINAL] => IF GetRingNumber[GetBaseNode[node1]] # LAST[CARDINAL] THEN ERROR;
leastRingSeen < LAST[CARDINAL] => IF GetRingNumber[GetBaseNode[node1]] # leastRingSeen+1 THEN ERROR;
ENDCASE => ERROR;
END;

-- GenerateAllNodes[graph, SeeNode2];
RETURN[TRUE];
END;
GenerateAllNodes[graph, SeeNode1];
END;


-- support code

CheckLALR1Node: PROC[node: Node] =
BEGIN
grammar: Grammar _ GetGrammar[GetGraph[node]];
lr1KernelCore: TentativeLR0ItemSet _ CreateEmptyTentativeLR0ItemSet[grammar];
lr1Set: LR1ItemSet _ NarrowLR1ItemSet[GetAssociatedSet[node]];
frozenKernelCore: LR0ItemSet;
lr0Set: LR0ItemSet _ NarrowLR0ItemSet[GetAssociatedSet[GetBaseNode[node]]];
oneSubsetEmpty: BOOLEAN _ FALSE; -- tentative

SeeOneSubset: PROC[subset: LR1ItemSubset] =
BEGIN
thisSubsetEmpty: BOOLEAN _ TRUE; -- tentative
SeeOneSeq: PROC[TerminalSeq] = {thisSubsetEmpty _ FALSE};
[] _ InsertItemInTentativeLR0ItemSet[lr1KernelCore, subset.lr0Item];
GenTerminalSeqsFromSet[subset.terminals, SeeOneSeq];
IF TestIfTerminalSeqSetEmpty[subset.terminals] THEN oneSubsetEmpty _ TRUE;
IF thisSubsetEmpty THEN oneSubsetEmpty _ TRUE;
END;

ShowLR1Precurser: PROC[precurser: Node] =
BEGIN
SignalLR1ItemSet["\N\Nan LR1 precurser\N", NarrowLR1ItemSet[GetAssociatedSet[precurser]]];
END;

ShowLR0Precurser: PROC[precurser: Node] =
BEGIN
SignalLR0ItemSet["\N\Nan LR0 precurser\N", NarrowLR0ItemSet[GetAssociatedSet[precurser]]];
END;

CheckLR1Precurser: PROC[precurser: Node] =
BEGIN
IF NOT TestIfLR1ItemSetFrozen[NarrowLR1ItemSet[GetAssociatedSet[precurser]]] THEN
CheckLALR1Node[precurser];
END;

GenerateSubsetsFromLR1ItemSet[lr1Set, SeeOneSubset, TRUE];
frozenKernelCore _ FreezeTentativeLR0ItemSet[lr1KernelCore];
IF frozenKernelCore # lr0Set THEN
StartShowingSignals["\N\N\NLALR1 node kernel core does not match LR0 set at base node"];
IF oneSubsetEmpty THEN 
StartShowingSignals["\N\N\NLALR1 node kernel core has an empty subset"];
IF frozenKernelCore # lr0Set OR oneSubsetEmpty THEN
BEGIN
SignalLR0ItemSet["\NLALR1 node kernel core\N", frozenKernelCore];
SignalLR0ItemSet["\NLR0 set at base node\N", lr0Set];
GenPrecurserNodes[node, ShowLR1Precurser];
GenPrecurserNodes[GetBaseNode[node], ShowLR0Precurser];
GenPrecurserNodes[node, CheckLR1Precurser];
ERROR;
END;
END;

GenPrecurserNodes: PROC[wanted: Node, for: PROC[Node]] =
BEGIN
CheckOneNode: PROC[possible: Node] RETURNS[--continue-- BOOLEAN] =
BEGIN
CheckOneArc: PROC[s: Symbol, target: Node] RETURNS[--continue-- BOOLEAN] =
BEGIN
IF target = wanted THEN {for[possible]; RETURN[FALSE]}
ELSE RETURN[TRUE];
END;
GenerateArcs[possible, CheckOneArc];
RETURN[TRUE]
END;
GenerateAllNodes[GetGraph[wanted], CheckOneNode];
END;

GenParseActionsForOneNode: PROC[node: Node,
shift: PROC[state: CARDINAL, terminalSeq: ROPE, newState: CARDINAL],
reduction: PROC[state: CARDINAL, terminalSeq: ROPE, leftSide: ROPE, ruleNumber: CARDINAL, ruleSize: CARDINAL],
acceptance: PROC[state: CARDINAL, terminalSeq: ROPE]] =
BEGIN
fromState: CARDINAL _  GetNodeIndex[node];
grammar: Grammar _ GetGrammar[GetGraph[node]];
startProduction: Production _ GetStartProduction[grammar];
emptySeq: TerminalSeq _ GetEmptyTerminalSeq[grammar];
pairsSeen: ProdTermSeqCell _ NIL;

NoteTheOutgoingArcs: PROC[s: Symbol, target: Node] RETURNS[--continue--BOOLEAN] =
{shift[fromState, GetSymbolText[s], GetNodeIndex[target]]; RETURN[TRUE]};

NoteTheReductionRules: PROC[terminalSeq: TerminalSeq, production: Production] =
BEGIN
symbol: Symbol _ GetSymbolFromTerminalSeq[terminalSeq];
terminalSeqText: ROPE _ IF symbol # NIL THEN GetSymbolText[symbol] ELSE NIL;
IF GetLength[production] # 0 THEN -- we will only see this one once, but it might be the accepting situation
BEGIN
IF production = startProduction THEN
BEGIN
IF terminalSeq # emptySeq THEN ERROR;
acceptance[fromState, terminalSeqText];
END
 ELSE reduction[fromState, terminalSeqText, GetSymbolText[GetLeftSideSymbol[production]], GetProductionIndex[production], 
GetLength[production]]
END
 ELSE -- we may see this pair several times, but only want to generate it once
BEGIN
FOR cell: ProdTermSeqCell _ pairsSeen, cell.next WHILE cell # NIL DO
IF cell.termSeq = terminalSeq AND cell.production = production THEN RETURN; -- we have seen this pair before
ENDLOOP;
pairsSeen _ NEW[ProdTermSeqCellBody_[terminalSeq, production, pairsSeen]];
reduction[fromState, terminalSeqText, GetSymbolText[GetLeftSideSymbol[production]], GetProductionIndex[production], 
GetLength[production]]
END;
END;

GenerateArcs[node, NoteTheOutgoingArcs];
GenReductionRulesFromKernel[NarrowLR1ItemSet[GetAssociatedSet[node]], NoteTheReductionRules];
END;
 
END..

-- RTE: November 1, 1984 1:54:27 pm PST: the test for node consistency was faulty, even though the corresponding code to generate 
node actions was correct.  The error was in handling reductions to empty productions, and the efforts to avoid the same same pair, 
<terminalSeq, production> occuring more than once, thus causing a false inconsistency report.  Unfortunately, the way it was coded, 
it didn't detect a shift/reduce conflict, when the reduction was to an empty production.
-- RTE: November 1, 1984 5:36:32 pm PST: the split node algorithm installed each stage1 node immediately, rather than wait to see 
if it had a new set attached.  Thus, we got into a loop whenever the splitting nodes formed a loop.
-- RTE: November 6, 1984 2:21:48 pm PST: MarkRingNumbers was using a bad algorithm that tended to put a node into a ring closerto 0 
than it should.  When it came to a node that had an arc to an already marked node, it would put the node into the ring currently 
being constructed, but this could be a node that belongs in the next outer ring, which is seeing a node just placed in the current 
ring!
-- RTE: February 21, 1985 5:35:09 pm PST: MarkRingNumbers did not initilaize MaxRingNumber (the return value) to LAST[CARDINAL], 
thus, sometimes, event though consistent, it would return a value that suggested the parser graph was inconsistent.