DIRECTORY
IO USING [char, int, Put, PutChar, PutRope, rope, STREAM],
NPGS1 USING [ActionSeq, AssignDescriptors, ErrorContext, Index, InstallScanTable, LinkSeq,  LinkStack, NextToken, nullValue, ProcessQueue, ResetScanIndex, ScanInit, ScanReset, ScanStats, StateSeq, StateStack, Token, TokenValue, Value, ValueSeq, ValueStack],
NPGSParseTable USING [ActionEntry, ActionTag, defaultMarker, endMarker, finalState, IndexTableRef, initialState, initialSymbol, InitIndexTable, InitNActions, InitNLengths, InitNStarts, InitNSymbols, InitNTDefaults, InitProdData, InitTActions, InitTLengths, InitTStarts, InitTSymbols, InitVocabulary, NActionsRef, NLengthsRef, NStartsRef, NSymbolsRef, NTDefaultsRef, NTIndex, NTState, NTSymbol, ProdDataRef, State, TActionsRef, TIndex, TLengthsRef, TStartsRef, TSymbol, TSymbolsRef, VocabularyRef];

NPGSParser: CEDAR PROGRAM 
IMPORTS IO, NPGS1, NPGSParseTable
EXPORTS NPGS1
= { 



vocabIndex: NPGSParseTable.IndexTableRef _ NIL;
vocabBody: NPGSParseTable.VocabularyRef _ NIL;


tStart: NPGSParseTable.TStartsRef;
tLength: NPGSParseTable.TLengthsRef;
tSymbol: NPGSParseTable.TSymbolsRef;
tAction: NPGSParseTable.TActionsRef;


nStart: NPGSParseTable.NStartsRef;
nLength: NPGSParseTable.NLengthsRef;
nSymbol: NPGSParseTable.NSymbolsRef;
nAction: NPGSParseTable.NActionsRef;
ntDefaults: NPGSParseTable.NTDefaultsRef;


prodData: NPGSParseTable.ProdDataRef;

InstallParseTable: PUBLIC PROC = {
IF prodData = NIL THEN {
tStart _ NPGSParseTable.InitTStarts[];
tLength _ NPGSParseTable.InitTLengths[];
tSymbol _ NPGSParseTable.InitTSymbols[];
tAction _ NPGSParseTable.InitTActions[];
nStart _ NPGSParseTable.InitNStarts[];
nLength _ NPGSParseTable.InitNLengths[];
nSymbol _ NPGSParseTable.InitNSymbols[];
nAction _ NPGSParseTable.InitNActions[];
ntDefaults _ NPGSParseTable.InitNTDefaults[];
prodData _ NPGSParseTable.InitProdData[];
NPGS1.InstallScanTable[];
};
};

errorLimit: NAT = 25;

scanTag: NPGSParseTable.ActionTag = [FALSE, 0];

inputSymbol: NPGSParseTable.TSymbol;

Input: PROC RETURNS [token: NPGS1.Token];
inputLoc: NPGS1.Index _ 0;
inputValue: NPGS1.Value;

lastToken: NPGS1.Token;
nullSymbol: NPGSParseTable.TSymbol = 0;

s: NPGS1.StateStack;
l: NPGS1.LinkStack;
v: REF  NPGS1.ValueSeq;
top: CARDINAL;

q: REF NPGS1.ActionSeq;
qI: CARDINAL;


InputLoc: PUBLIC PROC RETURNS[NPGS1.Index] = {RETURN[inputLoc]};

Parse: PUBLIC PROC[
source: IO.STREAM,
logger: PROC[PROC[log: IO.STREAM]],
prefixOk: BOOL, cusp: BOOL]
RETURNS[complete: BOOL, nTokens, nErrors: NAT] = {
currentState: NPGSParseTable.State;
i, valid, m: CARDINAL;		-- stack pointers
action: NPGSParseTable.ActionEntry;

ParseInit: PROC = {
NPGS1.ScanInit[source, logger];
s _ NIL;
q _ NIL;
ExpandStack[500];
q _ NIL;
ExpandQueue[250];
scanBuffer _ NIL;
};

ParseReset: PROC = {
EraseQueue[];
EraseStack[];
IF scanBuffer # NIL THEN FREE[@scanBuffer];
NPGS1.ScanReset[];
};

ParseInit[];

{	-- ENABLE scope
ENABLE UNWIND => {ParseReset[]};
Input _ NPGS1.NextToken;
nErrors _ 0;  complete _ TRUE;
i _ top _ valid _ 0;  qI _ 0;
s[0] _ currentState _ NPGSParseTable.initialState;
lastToken.class _ nullSymbol;
inputSymbol _ NPGSParseTable.initialSymbol;
inputValue.s _ NPGS1.nullValue;
inputLoc _ 0;

UNTIL currentState = NPGSParseTable.finalState AND (prefixOk OR (inputSymbol = NPGSParseTable.endMarker)) DO
{
tI: NPGSParseTable.TIndex _ tStart[currentState];
FOR tI IN [tI .. tI + tLength[currentState]) DO
SELECT tSymbol[tI] FROM inputSymbol, NPGSParseTable.defaultMarker => EXIT ENDCASE;
REPEAT
FINISHED => GO TO SyntaxError;
ENDLOOP;

action _ tAction[tI]; 
IF ~action.tag.reduce THEN TRUSTED { -- scan or scan reduce entry
IF qI > 0 THEN {
FOR k: CARDINAL IN (valid..i] DO s[k] _ s[top+(k-valid)] ENDLOOP;
NPGS1.ProcessQueue[qI, top, cusp];  qI _ 0
};
IF (top _ valid _ i _ i+1) >= s.length THEN ExpandStack[256];
lastToken.class _ inputSymbol; v[i] _ inputValue; l[i] _ inputLoc;
[[inputSymbol, inputValue, inputLoc]]  _ Input[]
};

WHILE action.tag # scanTag DO
IF qI >= q.length THEN ExpandQueue[256];
q[qI] _ action;  qI _ qI + 1;
i _ i-action.tag.pLength;
currentState _ s[IF i > valid THEN top+(i-valid) ELSE (valid _ i)]; {
lhs: NPGSParseTable.NTSymbol = prodData[action.transition].lhs;
IF currentState <= NPGSParseTable.NTState.LAST THEN {
nI: NPGSParseTable.NTIndex _ nStart[currentState];
FOR nI IN [nI..nI+nLength[currentState]) DO
IF lhs = nSymbol[nI] THEN {action _ nAction[nI]; GO TO nFound};
ENDLOOP
};
action _ ntDefaults[lhs];
EXITS
nFound => NULL;
};
i _ i+1;
ENDLOOP;
IF (m _ top+(i-valid)) >= s.length THEN ExpandStack[256];
s[m] _ currentState _ action.transition;
EXITS
SyntaxError => TRUSTED {
lastToken.value _ v[top];  lastToken.index _ l[top];
top _ top - 1;
complete _ SyntaxError[logger, (nErrors_nErrors+1)>errorLimit]; 
i _ valid _ top;  qI _ 0;  lastToken.class _ nullSymbol;
currentState _ s[i];
[[inputSymbol, inputValue, inputLoc]] _ Input[];
IF ~complete THEN EXIT
};
};
ENDLOOP;

NPGS1.ProcessQueue[qI, top, cusp];
nErrors _ nErrors + ([nTokens: nTokens] _ NPGS1.ScanStats[]).nErrors;
};	-- of ENABLE scope

ParseReset[];
};


ExpandStack: PROC[delta: NAT] = {
oldSize: NAT = (IF s = NIL THEN 0 ELSE s.length);
newSize: NAT = oldSize + delta;
newS: NPGS1.StateStack = NEW[NPGS1.StateSeq[newSize]];
newL: NPGS1.LinkStack = NEW[NPGS1.LinkSeq[newSize]];
newV: NPGS1.ValueStack = NEW[NPGS1.ValueSeq[newSize]];
FOR i: NAT IN [0..oldSize) DO TRUSTED {
newS[i] _ s[i]; newL[i] _ l[i]; newV[i] _ v[i]
};
ENDLOOP;
EraseStack[];
s _ newS;  l _ newL;  v _ newV;
NPGS1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData];
};

EraseStack: PROC = {
IF s # NIL THEN {FREE[@v];  FREE[@l];  FREE[@s]};
};

ExpandQueue: PROC[delta: NAT] = {
oldSize: NAT = (IF q = NIL THEN 0 ELSE q.length);
newSize: NAT = oldSize + delta;
newQ: REF NPGS1.ActionSeq = NEW[NPGS1.ActionSeq[newSize]];
FOR i: NAT IN [0..oldSize) DO newQ[i] _ q[i] ENDLOOP;
q _ newQ;
NPGS1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData];
};

EraseQueue: PROC = {IF q # NIL THEN FREE[@q]};


errorStream: IO.STREAM _ NIL;

minScanLimit: NAT = 4;
maxScanLimit: NAT = 12;
insertLimit: NAT = 2;
discardLimit: NAT = 10;
treeSize: NAT = 250;
checkSize: NAT = maxScanLimit+insertLimit+2;


track: BOOL = FALSE;

DisplayNode: PROC[n: NodeIndex] = {
IF track THEN {
errorStream.PutRope["::new node::"];
errorStream.Put[IO.char['\t], IO.int[n]];
errorStream.Put[IO.char['\t], IO.int[tree[n].father]]; 
errorStream.Put[IO.char['\t], IO.int[tree[n].last]];
errorStream.Put[IO.char['\t], IO.int[tree[n].state]];
errorStream.PutChar['\t]; TypeSym[tree[n].symbol];
errorStream.PutChar['\n];
};
};


NodeIndex: TYPE = NAT [0..treeSize);
nullIndex: NodeIndex = 0;

StackNode: TYPE = RECORD[
father: NodeIndex,
last: NodeIndex,
state:  NPGSParseTable.State,
symbol: NPGSParseTable.TSymbol,
aLeaf, bLeaf: BOOL,
link: NodeIndex];

TreeSpace: TYPE = ARRAY [0..treeSize) OF StackNode;
tree: REF TreeSpace;
nextNode: NAT [0..treeSize] _ 0;
maxNode: NodeIndex _ 0;
treeLimit: NAT [0..treeSize] _ 0;
TreeFull: ERROR = CODE;

Allocate: PROC[parent, pred: NodeIndex, terminal: NPGSParseTable.TSymbol, stateNo: NPGSParseTable.State]
RETURNS [index: NodeIndex] = {
IF (index _ nextNode) >= treeLimit THEN ERROR TreeFull[];
maxNode _ MAX[index, maxNode];
tree[index] _ StackNode[
father: parent,
last: pred,
state: stateNo,
symbol: terminal,
aLeaf: FALSE, bLeaf: FALSE,
link: nullIndex];
nextNode _ nextNode+1;
};

hashSize: NAT = 250;	-- should depend on state count ?
HashIndex: TYPE = [0..hashSize);
HashSpace: TYPE = ARRAY HashIndex OF NodeIndex;
hashTable: REF HashSpace;

HashValue: PROC[s: NPGSParseTable.State] RETURNS[HashIndex] = INLINE {
RETURN[s MOD hashSize];
};

ParsingMode: TYPE = {aTree, bTree, checking};
parseMode: ParsingMode _ checking;

LinkHash: PROC[n: NodeIndex] = {
htIndex: HashIndex = HashValue[tree[n].state];
tree[n].link _ hashTable[htIndex];
hashTable[htIndex] _ n;
};

DelinkHash: PROC[n: NodeIndex] = {
htIndex: HashIndex = HashValue[tree[n].state];
p: NodeIndex _ nullIndex;
FOR i: NodeIndex _ hashTable[htIndex], tree[i].link UNTIL i = nullIndex DO
IF i = n THEN GO TO delete;
p _ i;
REPEAT
delete =>
IF p = nullIndex THEN hashTable[htIndex] _ tree[n].link
ELSE tree[p].link _ tree[n].link;
ENDLOOP
};

ExistingConfiguration: PROC[stack: StackRep] RETURNS[NodeIndex] = {
htIndex: HashIndex;
aTree: BOOL;
SELECT parseMode FROM
$aTree => aTree _ TRUE;
$bTree => aTree _ FALSE;
ENDCASE => RETURN [nullIndex];
htIndex _ HashValue[stack.extension];
FOR i: NodeIndex _ hashTable[htIndex], tree[i].link UNTIL i = nullIndex DO
IF (IF aTree THEN tree[i].aLeaf ELSE tree[i].bLeaf) THEN {
s1: NPGSParseTable.State _ stack.extension;
s2: NPGSParseTable.State _ tree[i].state;
n1: NodeIndex _ stack.leaf;
n2: NodeIndex _ tree[i].father;
DO
IF s1 # s2 THEN EXIT;
IF n1 = n2 THEN RETURN [i];
s1 _ tree[n1].state;  s2 _ tree[n2].state;
n1 _ tree[n1].father;  n2 _ tree[n2].father;
ENDLOOP
};
ENDLOOP;
RETURN [nullIndex];
};

FindNode: PROC[parent, pred: NodeIndex, stateNo: NPGSParseTable.State] RETURNS[index: NodeIndex] = {
index _ ExistingConfiguration[[leaf:parent, extension:stateNo]];
IF index = nullIndex THEN {
index _ Allocate[parent, pred, 0, stateNo];
SELECT parseMode FROM
$aTree => {tree[index].aLeaf _ TRUE; LinkHash[index]};
$bTree => {tree[index].bLeaf _ TRUE; LinkHash[index]};
ENDCASE => NULL
};
};

TrimTree: PROC[newNext: NodeIndex] = {
WHILE nextNode > newNext DO
nextNode _ nextNode-1; DelinkHash[nextNode] ENDLOOP
};


ExtState: TYPE = [NPGSParseTable.State.FIRST .. NPGSParseTable.State.LAST+1];
nullState: ExtState = ExtState.LAST;

StackRep: TYPE = RECORD[
leaf: NodeIndex,
extension: ExtState];

GetNTEntry: PROC[state: NPGSParseTable.State, lhs: NPGSParseTable.NTSymbol] RETURNS[NPGSParseTable.ActionEntry] = INLINE {
IF state <= NPGSParseTable.NTState.LAST THEN {
nI: NPGSParseTable.NTIndex _ nStart[state];
FOR nI IN [nI..nI+nLength[state]) DO
IF lhs = nSymbol[nI] THEN RETURN[nAction[nI]] ENDLOOP
};
RETURN[ntDefaults[lhs]];
};

ActOnStack: PROC[stack: StackRep, action: NPGSParseTable.ActionEntry, nScanned: [0..1]]
RETURNS[StackRep] = {
currentNode, thread: NodeIndex _ stack.leaf;
count: NAT _ nScanned;
currentState: NPGSParseTable.State;
IF stack.extension = nullState THEN currentState _ tree[currentNode].state
ELSE {currentState _ stack.extension; count _ count + 1};
UNTIL action.tag = scanTag DO
IF count > action.tag.pLength THEN {  -- can be one greater
currentNode _ FindNode[currentNode, thread, currentState];
count _ count - 1
};
UNTIL count = action.tag.pLength DO
currentNode _ tree[currentNode].father; count _ count + 1 ENDLOOP;
currentState _ tree[currentNode].state;  count _ 1;
action _ GetNTEntry[currentState, prodData[action.transition].lhs];
ENDLOOP;
IF count > 1 THEN currentNode _ FindNode[currentNode, thread, currentState];
stack.leaf _ currentNode;  stack.extension _ action.transition;
RETURN[stack];
};

ParseStep: PROC[stack: StackRep, input: NPGSParseTable.TSymbol] RETURNS[StackRep] = {
currentState: NPGSParseTable.State _ (IF stack.extension = nullState
THEN tree[stack.leaf].state
ELSE stack.extension);
scanned: BOOL _ FALSE;
UNTIL scanned OR currentState = NPGSParseTable.finalState DO
action: NPGSParseTable.ActionEntry;
count: [0..1];
tI: NPGSParseTable.TIndex _ tStart[currentState];
FOR tI IN [tI..tI+tLength[currentState]) DO
SELECT tSymbol[tI] FROM  input, NPGSParseTable.defaultMarker => EXIT  ENDCASE;
REPEAT
FINISHED => RETURN[[nullIndex, nullState]];
ENDLOOP;
action _ tAction[tI];
IF ~action.tag.reduce THEN {count _ 1; scanned _ TRUE}	-- shift or shift reduce
ELSE count _ 0;
stack _ ActOnStack[stack, action, count];
currentState _ stack.extension;
ENDLOOP;
RETURN[stack];
};


Insert: TYPE = ARRAY [0 .. 1+insertLimit) OF NPGS1.Token;
newText: REF Insert;
insertCount: NAT _ 0;

Buffer: TYPE = ARRAY [0 .. 1+discardLimit+(maxScanLimit+insertLimit)) OF NPGS1.Token;
scanBuffer: REF Buffer;
scanBase, scanLimit: NAT _ 0;

Advance: PROC = {scanBuffer[scanLimit] _ Input[]; scanLimit _ scanLimit+1};

Discard: PROC = {
IF track THEN {
errorStream.PutRope["::discarding symbol: "];
TypeSym[scanBuffer[scanBase].class];
errorStream.PutChar['\n];
};
scanBase _ scanBase+1;
};

UnDiscard: PROC = {
scanBase _ scanBase-1;
IF track THEN {
errorStream.PutRope["::recovering symbol: "];
TypeSym[scanBuffer[scanBase].class];
errorStream.PutChar['\n];
};
};

RecoverInput: PROC RETURNS [token: NPGS1.Token] = {
IF insertCount <= insertLimit
THEN {
token _ newText[insertCount];
IF (insertCount _ insertCount+1) > insertLimit THEN FREE[@newText];
}
ELSE {
token _ scanBuffer[scanBase];
IF (scanBase _ scanBase+1) = scanLimit THEN {
FREE[@scanBuffer];
Input _ NPGS1.NextToken;
};
};
};



best: RECORD [
nAccepted: NAT _ 0,
nPassed: [0..1] _ 0,
node: NodeIndex _ 0,
mode: ParsingMode _ checking,
nDiscards: NAT _ 0];

RightScan: PROC[node: NodeIndex] RETURNS[stop: BOOL] = {
savedNextNode: NodeIndex = nextNode;
savedMode: ParsingMode = parseMode;
savedLimit: NAT = treeLimit;
stack: StackRep _ [leaf:node, extension:nullState];
state: NPGSParseTable.State _ tree[node].state;
nAccepted: NAT _ 0;
parseMode _ $checking;  treeLimit _ treeSize;
FOR i: NAT IN [scanBase .. scanLimit) DO
IF state = NPGSParseTable.finalState THEN {
nAccepted _ (IF (scanBuffer[i].class = NPGSParseTable.endMarker)
THEN scanLimit-scanBase
ELSE 0);
EXIT
};
stack _ ParseStep[stack, scanBuffer[i].class];
IF stack.leaf = nullIndex THEN EXIT;
nAccepted _ nAccepted + 1;  state _ stack.extension;
ENDLOOP;
TrimTree[savedNextNode];  treeLimit _ savedLimit;
SELECT (parseMode _ savedMode) FROM
$aTree =>
IF nAccepted + 1 > best.nAccepted + best.nPassed THEN
best _ [nAccepted, 1, node, $aTree, scanBase-1];
$bTree =>
IF nAccepted > best.nAccepted + best.nPassed THEN
best _ [nAccepted, 0, node, $bTree, scanBase];
ENDCASE;
RETURN [nAccepted >= maxScanLimit];
};



RowRecord: TYPE = RECORD [
index, limit: NAT,
stack: StackRep,
next: RowHandle];

RowHandle: TYPE = REF RowRecord;

NextRow: PROC[list: RowHandle] RETURNS[row: RowHandle] = INLINE {
t: NPGSParseTable.TSymbol _ NPGSParseTable.TSymbol.FIRST;
row _ NIL;
FOR r: RowHandle _ list, r.next UNTIL r = NIL DO
IF r.index < r.limit THEN {
s: NPGSParseTable.TSymbol = tSymbol[r.index];
IF row = NIL OR s < t THEN {row _ r; t _ s}
};
ENDLOOP;
};

FreeRowList: PROC[list: RowHandle] RETURNS[row: RowHandle] = {
r: RowHandle _ NIL;
UNTIL  r = NIL DO
next: RowHandle = r.next;
FREE[@r];  r _ r.next;
ENDLOOP;
RETURN [NIL];
};

Position: TYPE = {after, before};
Length: TYPE = NAT [0..insertLimit];

levelStart: ARRAY Position OF ARRAY Length OF NodeIndex _  [ALL[0], ALL[0]];
levelEnd: ARRAY Position OF ARRAY Length OF NodeIndex _  [ALL[0], ALL[0]];

AddLeaf: PROC[stack: StackRep, s: NPGSParseTable.TSymbol, thread: NodeIndex] RETURNS[stop: BOOL] = {
saveNextNode: NodeIndex = nextNode;
stack _ ParseStep[stack, s];
IF stack.leaf = nullIndex OR ExistingConfiguration[stack] # nullIndex
THEN {
TrimTree[saveNextNode];
stop _ FALSE;
} 
ELSE {
newLeaf: NodeIndex = Allocate[stack.leaf, thread, s, stack.extension];
SELECT parseMode FROM
$aTree => tree[newLeaf].aLeaf _ TRUE;
$bTree => tree[newLeaf].bLeaf _ TRUE;
ENDCASE => ERROR;
LinkHash[newLeaf];
IF track THEN DisplayNode[newLeaf];
stop _ RightScan[newLeaf];
};
};


GrowTree: PROC[p: Position, n: Length] RETURNS[stop: BOOL] = {
rowList: RowHandle _ NIL;
IF track THEN {
errorStream.Put[IO.rope["::generating length: "], IO.int[n]];
errorStream.PutChar[IF p = $before THEN 'B ELSE 'A];  errorStream.PutChar['\n]
};
FOR i: NodeIndex IN [levelStart[p][n-1] .. levelEnd[p][n-1]) DO
IF tree[i].symbol # 0 OR n = 1 THEN {
ENABLE UNWIND => {rowList _ FreeRowList[rowList]};
stack: StackRep _ [leaf:i, extension:nullState];
state: NPGSParseTable.State _ tree[i].state;
r: RowHandle;
DO
tI: NPGSParseTable.TIndex = tStart[state];
tLimit: NAT = tI + tLength[state];
r _ NEW[RowRecord];
r^ _ RowRecord[index:tI, limit:tLimit, stack:stack, next:rowList];
rowList _ r;
IF tI = tLimit OR tSymbol[tLimit-1] # NPGSParseTable.defaultMarker THEN EXIT;
r.limit _ r.limit - 1;
stack _ ActOnStack[stack, tAction[tLimit-1], 0];
state _ stack.extension;
ENDLOOP;
UNTIL (r _ NextRow[rowList]) = NIL DO
IF AddLeaf[r.stack, tSymbol[r.index], i] THEN GO TO found;
r.index _ r.index + 1;
ENDLOOP;
rowList _ FreeRowList[rowList]
};
REPEAT
found => stop _ TRUE;
FINISHED => stop _ FALSE;
ENDLOOP;
rowList _ FreeRowList[rowList];
};

CheckTree: PROC[p: Position, n: Length] RETURNS[stop: BOOL] = {
IF track THEN {
errorStream.Put[IO.rope["::checking length: "], IO.int[n]];
errorStream.PutChar[IF p = $before THEN 'B ELSE 'A];  errorStream.PutChar['\n]
};
FOR i: NodeIndex IN [levelStart[p][n] .. levelEnd[p][n]) DO
{
ENABLE TreeFull => {CONTINUE};
IF RightScan[i] THEN GO TO found;
}
REPEAT
found => stop _ TRUE;
FINISHED => stop _ FALSE;
ENDLOOP;
};


Accept: PROC RETURNS[success: BOOL] = {
s: NPGSParseTable.TSymbol;
discardBase: NAT = best.nPassed;
insertCount _ 1+insertLimit;
FOR p: NodeIndex _ best.node, tree[p].last WHILE p > rTop DO
IF (s _ tree[p].symbol) # 0 THEN {
insertCount _ insertCount-1;
newText[insertCount] _ NPGS1.Token[s, NPGS1.TokenValue[s], inputLoc]
};
ENDLOOP;
scanBase _ discardBase;
IF best.nDiscards # 0 THEN {
errorStream.PutRope["Text deleted is: "];
FOR j: NAT IN [1 .. best.nDiscards] DO
TypeSym[scanBuffer[scanBase].class];  scanBase _ scanBase + 1;
ENDLOOP
};
IF insertCount <= insertLimit THEN {
IF scanBase # discardBase THEN errorStream.PutChar['\n];
errorStream.PutRope["Text inserted is: "];
FOR j: NAT IN [insertCount .. insertLimit] DO
TypeSym[newText[j].class] ENDLOOP
};
IF discardBase = 1 THEN {insertCount _ insertCount-1; newText[insertCount] _ scanBuffer[0]};
IF insertCount > insertLimit THEN FREE[@newText];
IF scanBase + best.nAccepted < scanLimit THEN
success _ NPGS1.ResetScanIndex[scanBuffer[scanBase+best.nAccepted].index]
ELSE success _ TRUE;
scanLimit _ scanBase + best.nAccepted;
Input _ RecoverInput;
};

TypeSym: PROC [sym: NPGSParseTable.TSymbol] = {
errorStream.PutChar[' ];
IF sym IN [1..NPGSParseTable.endMarker)
THEN {
IF vocabIndex = NIL THEN vocabIndex _ NPGSParseTable.InitIndexTable[];
IF vocabBody = NIL THEN vocabBody _ NPGSParseTable.InitVocabulary[];
FOR i: NAT IN [vocabIndex[sym-1]..vocabIndex[sym]) DO
errorStream.PutChar[vocabBody[i]];
ENDLOOP;
}
ELSE errorStream.Put[[integer[sym]]];
};


rTop: NodeIndex _ 0;

Recover: PROC = {
ModeMap: ARRAY Position OF ParsingMode = [$aTree, $bTree];
stack: StackRep;

treeLimit _ treeSize - checkSize;
hashTable^ _ ALL[nullIndex];
rTop _ nullIndex;  nextNode _ maxNode _ 1;

best.nAccepted _ 0;  best.nPassed _ 1;  best.mode _ $aTree;
scanBuffer[0] _ lastToken;
scanBuffer[1] _ NPGS1.Token[inputSymbol, inputValue, inputLoc];
scanBase _ 1;  scanLimit _ 2;
THROUGH [1 .. maxScanLimit) DO Advance[] ENDLOOP;
FOR i: NAT IN [0 .. top) DO
rTop _ Allocate[rTop, rTop, 0, s[i]];
IF track THEN DisplayNode[rTop];
ENDLOOP;
parseMode _ $bTree;
levelStart[$before][0] _ rTop _ FindNode[rTop, rTop, s[top]];
tree[rTop].bLeaf _ TRUE;
levelEnd[$before][0] _ nextNode;
parseMode _ $aTree;
stack _ ParseStep[[leaf:rTop, extension:nullState], lastToken.class];
rTop _ FindNode[stack.leaf, rTop, stack.extension];
tree[rTop].symbol _ lastToken.class;
tree[rTop].aLeaf _ tree[rTop].bLeaf _ TRUE;
levelStart[$after][0] _ rTop;  levelEnd[$after][0] _ nextNode;
IF track THEN DisplayNode[rTop];

FOR level: Length IN [1 .. Length.LAST] DO
FOR place: Position IN Position DO
parseMode _ ModeMap[place];
IF place = $before THEN UnDiscard[];
levelStart[place][level] _ nextNode;
IF GrowTree[place, level ! TreeFull => {CONTINUE}] THEN GO TO found;
levelEnd[place][level] _ nextNode;
THROUGH [1 .. level) DO
Discard[]; IF CheckTree[place, level] THEN GO TO found ENDLOOP;
Discard[];
IF place = $after THEN Advance[];
FOR inserts: NAT IN [0 .. level] DO
IF CheckTree[place, inserts] THEN GO TO found ENDLOOP;
THROUGH [1..level] DO UnDiscard[] ENDLOOP;
IF place = $before THEN Discard[];
ENDLOOP;
REPEAT
found => NULL;
FINISHED => {
threshold: NAT _ (minScanLimit+maxScanLimit)/2;
THROUGH [1..Length.LAST] DO Discard[]; Advance[] ENDLOOP;
UNTIL scanBase > discardLimit DO
IF best.nAccepted >= threshold THEN GO TO found;
Discard[];
FOR inserts: NAT IN Length DO
FOR place: Position IN Position DO
parseMode _ ModeMap[place];
IF place = $before THEN UnDiscard[];
IF CheckTree[place, inserts] THEN GO TO found;
IF place = $before THEN Discard[];
ENDLOOP;
ENDLOOP;
Advance[];
threshold _ IF threshold > minScanLimit THEN threshold-1 ELSE minScanLimit;
REPEAT
found => NULL;
FINISHED =>
IF best.nAccepted < minScanLimit THEN {best.mode _ $aTree; best.nPassed _ 1};
ENDLOOP
};
ENDLOOP;
};

SyntaxError: PROC[
logger: PROC[PROC[IO.STREAM]], abort: BOOL] RETURNS [success: BOOL _ FALSE] = {

Inner: PROC[log: IO.STREAM] = {
errorStream _ log;
IF abort
THEN {
NPGS1.ErrorContext[errorStream, "syntax error", inputLoc];
errorStream.PutRope["... parse abandoned."];  errorStream.PutChar['\n];
success _ FALSE;
}
ELSE {
scanBuffer _ NEW[Buffer];
newText _ NEW[Insert];
tree _ NEW[TreeSpace];
hashTable _ NEW[HashSpace];
Recover[ ! TreeFull => {CONTINUE}];
FREE[@hashTable];
NPGS1.ErrorContext[errorStream, "syntax error",
scanBuffer[IF best.mode=$bTree THEN 0 ELSE 1].index];
IF ~(success _ best.nAccepted >= minScanLimit AND Accept[]) THEN {
errorStream.PutRope["No recovery found."];
FREE[@newText];
FREE[@scanBuffer];
};
FREE[@tree];
errorStream.PutChar['\n];
};
errorStream.PutChar['\n];
errorStream _ NIL;
};

logger[Inner];
};

}.

R
NPGSParser.mesa - Cedar/Mesa parser with error recovery
Copyright Σ 1985, 1988, 1990 by Xerox Corporation.  All rights reserved.
Satterthwaite, May 27, 1986 9:53:25 am PDT
Paul Rovner, September 7, 1983 3:20 pm
Russ Atkinson (RRA) March 17, 1988 10:13:05 am PST
JKF May 24, 1990 10:58:18 am PDT

table installation
stuff for TypeSym
transition tables for terminal input symbols
transition tables for nonterminal input symbols
production information
parser state
initialization/termination
* * * *  Main Parsing Procedures * * * * --
* * * * Error Recovery Section * * * * --
parameters of error recovery
debugging
tree management
parsing simulation
text buffer management
acceptance checking
strategy management
stack node indices
try simple insertion (inserts=level)
try discards followed by 0 or more insertions
undo discards at this level
ΚΪ–

"cedar" style•NewlineDelimiter

™š
œ7™7Jš
œH™HJš
œ*™*Jš
œ&™&Jš
œ2™2Jš
œ ™ J™—š
Οk	˜	Jšœ
œ*œ˜:Jšœ
œφ
˜Jšœœέ˜ρ—J˜šΟn
œœ
œ
˜Jšœ
œœ˜!Jšœ
˜
J˜J˜Jš
œ™J˜Jš
œ™J˜Jšœ+œ
˜/Jšœ*œ
˜.J˜Jš
œ,™,J˜J˜"J˜$J˜$J˜$J˜Jš
œ/™/J˜J˜"J˜$J˜$J˜$J˜)J˜Jš
œ™J˜J˜%J˜šžœœ
œ˜"šœœ
œ˜J˜&J˜(J˜(J˜(J˜&J˜(J˜(J˜(J˜-J˜)Jšœ˜J˜—J˜—J˜Jš
œ™Jšœœ˜J˜Jšœ%œ˜/J˜J˜$J˜Jšžœœ
œ	œ˜)Jšœ
œ˜Jšœœ˜J˜Jšœœ˜J˜'J˜Jšœœ˜Jšœœ˜Jšœœœ
˜Jšœœ
˜J˜Jšœœ
œ˜Jšœœ
˜
J˜J˜Jš
œ™Jšžœœ
œ
œ
œœ˜@J˜Jš
œ+™+šžœœ
œ
˜Jšœœ
œ
˜Jš	œœ
œœ
œ˜#Jšœ
œ
˜—šœœœ˜2J˜#Jšœ
œΟc˜)J˜#J˜šž	œœ˜Jšœ˜Jšœœ
˜Jšœœ
˜J˜Jšœœ
˜J˜Jšœ
œ
˜J˜—J˜šž
œœ˜J˜
J˜
Jšœœ
œ
œ˜+Jšœ
˜J˜—J˜J˜J˜šœŸ˜Jšœ
œ˜ Jšœœ˜Jšœœ
˜J˜J˜2J˜J˜+Jšœœ˜J˜
J˜šœ*œœ+˜l˜
J˜1šœœ$˜/Jšœ
œ.œ
œ
˜RJš
˜Jšœœ
œ
˜Jšœ
˜—J˜J˜šœœ
œŸ˜Ašœœ˜Jš
œœ
œœœ
˜AJšœ%˜*J˜—Jšœ%œ˜=J˜BJ˜0J˜—J˜šœ˜Jšœœ˜(J˜J˜šœœœœ˜EJ˜?šœ(œ
œ˜5J˜2šœœ ˜+Jšœœœ
œ	˜?Jš
˜—J˜—J˜Jš
˜Jšœ
œ
˜J˜—J˜Jšœ
˜—Jšœ!œ˜9J˜(Jš
˜šœœ˜J˜4J˜J˜@J˜8J˜J˜0Jšœœ
˜J˜—J˜—Jšœ
˜—J˜Jšœ˜"Jšœ*œ˜EJšœŸ˜—J˜J˜
J˜—J˜J˜šžœœœ˜!Jšœ	œœœ
œœ˜1Jšœ	œ˜Jšœœœ
œ˜6Jšœœ
œ
œ˜4Jšœœœ
œ˜6š
œœ
œœ
œ˜'J˜.J˜Jšœ
˜—J˜
J˜Jšœ2˜7J˜—J˜šž
œœ˜Jšœœ
œœœœ˜1J˜—J˜šžœœœ˜!Jšœ	œœœ
œœ˜1Jšœ	œ˜Jš	œœ
œ
œ
œ˜:Jš
œœ
œœœ
˜5J˜	Jšœ2˜7J˜—J˜Jšž
œœœœ
œ
œ˜.J˜Jš
œ)™)Jš
œ™J˜Jšœ
œ
œœ
˜J˜Jšœœ˜Jšœœ˜Jšœ
œ˜Jšœœ˜Jšœ
œ˜Jšœœ˜,J˜Jš
œ	™	J˜Jšœœœ
˜J˜šžœœ˜#šœœ˜J˜$Jšœœœ	˜)Jšœœœ˜7Jšœœœ˜4Jšœœœ˜5J˜2J˜J˜—J˜—J˜Jš
œ™J˜Jšœœœ˜$J˜J˜šœœœ
˜J˜J˜J˜J˜Jšœœ
˜J˜—J˜Jšœœœœ˜3Jšœœ˜Jšœ
œ˜ J˜Jšœœ˜!Jšžœœœ
˜J˜JšžœœZ˜hšœ˜Jšœ!œ
œ˜9Jšœ
œ˜˜J˜J˜J˜J˜Jšœœ	œ
˜J˜—J˜J˜—J˜Jšœ
œŸ!˜6Jšœœ˜ Jšœœœœ˜/Jšœœ˜J˜šž	œœœœ˜FJšœœ˜J˜—J˜Jšœ
œ˜-Jš
œ"˜"J˜šžœœ˜ J˜.J˜"J˜J˜—J˜šž
œœ˜"J˜.J˜šœ1œ˜JJšœœ
œ
œ˜J˜Jš
˜J˜	šœœ"˜7Jšœ˜!—Jš
˜—J˜—J˜šžœœœ˜CJ˜Jšœœ
˜šœ˜Jšœœ
˜Jšœœ
˜Jšœœ
˜—J˜%šœ1œ˜Jš
œœœœœ˜:J˜+J˜)J˜J˜š
˜Jšœ	œ
œ
˜Jšœ	œ
œ˜J˜*J˜,Jš
˜—J˜—Jšœ
˜—Jšœ
˜J˜—J˜šžœœ9œ˜dJ˜@šœœ˜J˜+šœ˜Jšœœ˜6Jšœœ˜6Jšœ˜—J˜—J˜—J˜šžœœ˜&šœ˜Jšœ,˜3—J˜—J˜Jš
œ™J˜Jšœ
œ7œ˜MJšœœ
˜$J˜šœ
œœ
˜J˜J˜—J˜šž
œœ<œœ˜zšœ!œ
œ˜.J˜+šœœ˜$Jšœœ
œ˜5—J˜—Jšœ˜J˜—J˜Jšž
œœG˜Wšœ˜J˜,Jšœœ˜J˜#šœœ'˜JJšœ5˜9—šœ˜šœœŸ˜;J˜:J˜J˜—šœ˜#Jšœ:œ
˜B—J˜3J˜CJšœ
˜—Jšœœ;˜LJ˜?Jšœ˜J˜—J˜šž	œœ1œ˜Ušœ&œ˜DJšœ˜Jšœ˜—Jšœ	œœ
˜šœ	œ*˜<J˜#J˜J˜1šœœ ˜+Jšœ
œ)œœ
˜NJš
˜Jšœœ˜+Jšœ
˜—J˜JšœœœŸ˜OJšœ˜J˜)J˜Jšœ
˜—Jšœ˜J˜—J˜Jš
œ™J˜Jš	œœœœ
œ˜9Jšœ	œ˜Jšœ
œ
˜J˜Jš	œœœ2œ
œ˜UJšœœ˜Jšœœ
˜J˜Jšžœœ>˜KJ˜šžœœ˜šœœ˜J˜-J˜$J˜J˜—J˜J˜—J˜šž	œœ˜J˜šœœ˜J˜-J˜$J˜J˜—J˜—J˜šžœœ
œ	œ˜3Jšœ˜šœ˜J˜Jšœ-œ
œ˜CJ˜
—šœ˜J˜šœ%œ˜-Jšœ˜Jšœœ˜J˜—J˜—J˜—J˜J˜Jš
œ™J˜šœœ˜Jšœœ
˜J˜J˜J˜Jšœœ˜—J˜šž	œœœœ˜8J˜$J˜#Jšœœ
˜J˜3J˜/Jšœœ˜J˜-šœœ
œ˜(šœ#œ˜+šœ
œ1˜@Jšœ˜Jšœ˜—Jš
˜J˜—J˜.Jšœœ
œ
˜$J˜4Jšœ
˜—J˜1šœ˜#J˜	Jšœ/˜5J˜0J˜	Jšœ+˜1J˜.Jšœ
˜—Jšœ˜#J˜—J˜J˜Jš
œ™J˜šœœœ˜Jšœœ
˜J˜J˜—J˜Jšœœœ˜ J˜šžœœœœ˜AJšœ3œ
˜9Jšœœ
˜
šœœœ
˜0šœœ˜J˜-Jšœœ
œœ˜+J˜—Jšœ
˜—J˜—J˜šžœœœ˜>Jšœœ
˜šœœ
˜J˜Jšœ˜Jšœ
˜—Jšœœ˜
J˜—J˜Jšœ
œ˜!Jšœœœ˜$J˜Jš
œœ
œ
œœœœ˜LJš
œ
œ
œ
œœœœ˜JJ˜šžœœ@œœ˜dJ˜#J˜Jšœœ)˜Ešœ˜J˜Jšœœ
˜
J˜—šœ˜J˜Fšœ˜Jšœ œ
˜%Jšœ œ
˜%Jšœœ
˜—J˜Jšœœ˜#J˜J˜—J˜—J˜J˜šžœœœœ˜>Jšœœ
˜šœœ˜Jšœœ œ	˜=Jšœœ
œœ˜NJ˜—šœœ*˜?šœœœ˜%Jšœ
œ%˜2J˜0J˜,J˜
š
˜J˜*Jšœœ˜"Jšœœ˜J˜BJ˜Jšœ
œ2œ
œ
˜MJ˜J˜0J˜Jšœ
˜—šœœ
˜%Jšœ'œ
œ
œ˜:J˜Jšœ
˜—J˜J˜—Jš
˜Jšœœ
˜Jšœœ
˜Jšœ
˜—J˜J˜—J˜šž	œœœœ˜?šœœ˜Jšœœœ	˜;Jšœœ
œœ˜NJ˜—šœœ&˜;˜
Jšœœ˜Jšœœ
œ
œ˜!J˜
—Jš
˜Jšœœ
˜Jšœœ
˜Jšœ
˜—J˜—J˜J˜šžœœ
œ
œ˜'J˜Jšœ
œ˜ J˜šœ(œ
˜<šœœ˜"J˜—Jšœœ
œ˜DJ˜Jšœ
˜—J˜šœœ˜J˜)šœœ
œ˜&J˜>Jš
˜—J˜—šœœ˜$Jšœœ˜8J˜*šœœ
œ˜-Jšœ˜!—J˜—JšœœE˜\Jšœœ
œ˜1Jšœ'˜-šœ
œ:˜IJšœœ
˜—J˜&J˜J˜—J˜šžœœ"˜/J˜Jšœœ˜'šœ˜Jšœœ
œ.˜FJšœ
œ
œ-˜Dšœœ
œ&˜5J˜"Jšœ
˜—J˜
—Jšœ!˜%J˜—J˜Jš
œ™J˜J˜J˜šžœœ˜Jšžœœ
œ ˜:J˜J˜J˜!Jšœ
œ˜J˜*J˜J˜;J˜Jšœœ*˜?J˜Jšœœœ
˜1šœœ
œ˜J˜%Jšœœ˜ Jšœ
˜—J˜J˜=Jšœœ
˜J˜ J˜J˜EJ˜3J˜$Jšœ&œ
˜+J˜>Jšœœ˜ J˜šœœœ˜*šœœ
˜"J˜Jšœœ
˜$Jš
œ$™$J˜$Jš
œ&œœ
œ
œ˜DJ˜"Jš
œ-™-šœ˜Jšœœœ
œ
œœ
˜?—J˜
Jšœœ˜!šœ
œ
œ˜#Jš
œœ
œ
œœ
˜6—Jš
œ™Jšœœ
œ
˜*Jšœœ˜"Jšœ
˜—Jš
˜Jšœ	œ
˜šœ˜
Jšœœ!˜/Jšœœœœ
˜9šœ˜ Jšœœ
œ
œ˜0J˜
šœ
œ
œ˜šœœ
˜"J˜Jšœœ
˜$Jšœœ
œ
œ˜.Jšœœ˜"Jšœ
˜—Jšœ
˜—J˜
Jšœœœ
œ˜KJš
˜Jšœ	œ
˜Jšœ˜Jšœœ(˜MJš
˜—J˜—Jšœ
˜—J˜—J˜šžœœ
˜Jšœœ
œ
œ
œœœ
œ˜OJ˜šžœœœ
œ˜J˜Jšœ˜šœ˜Jšœ5˜:J˜GJšœ
œ
˜J˜
—šœ˜Jšœ
œ	˜Jšœ
œ	˜Jšœœ˜Jšœœ˜Jšœœ˜#Jšœ
˜šœ*˜/Jšœœœœ˜5—šœ,œœ˜BJ˜*Jšœ˜Jšœ˜J˜—Jšœ˜J˜J˜—J˜Jšœœ
˜J˜—J˜J˜J˜—J˜J˜—J˜—…—S˜pΔ