DIRECTORY
IO: TYPE USING [char, int, Put, PutChar, PutRope, rope, STREAM],
P1: TYPE USING [
ActionSeq, AssignDescriptors, ErrorContext, Index, InstallScanTable,
LinkSeq,  LinkStack, NextToken, nullValue, ProcessQueue, ResetScanIndex,
ScanInit, ScanReset, ScanStats, StateSeq, StateStack,
Token, TokenValue, Value, ValueSeq, ValueStack],
ParseTable: TYPE USING [
ActionEntry, ActionTag, defaultMarker, endMarker, finalState, initialState,
initialSymbol, NActionsRef, NLengthsRef, NStartsRef, NSymbolsRef, NTDefaultsRef,
NTIndex, NTState, NTSymbol, ProdDataRef, State, TableRef, TActionsRef, TIndex,
TLengthsRef, TStartsRef, TSymbol, TSymbolsRef];

ParserImpl: PROGRAM
  IMPORTS IO, P1 
  EXPORTS P1 = {
OPEN ParseTable;


tablePtr: ParseTable.TableRef;


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


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


prodData: ProdDataRef;


InstallParseTable: PUBLIC PROC [base: ParseTable.TableRef] = {
tablePtr _ base;
tStart _ @tablePtr[tablePtr.parseTable.tStart];
tLength _ @tablePtr[tablePtr.parseTable.tLength];
tSymbol _ @tablePtr[tablePtr.parseTable.tSymbol];
tAction _ @tablePtr[tablePtr.parseTable.tAction];
nStart _ @tablePtr[tablePtr.parseTable.nStart];
nLength _ @tablePtr[tablePtr.parseTable.nLength];
nSymbol _ @tablePtr[tablePtr.parseTable.nSymbol];
nAction _ @tablePtr[tablePtr.parseTable.nAction];
ntDefaults _ @tablePtr[tablePtr.parseTable.ntDefaults];
prodData _ @tablePtr[tablePtr.parseTable.prodData];
P1.InstallScanTable[base]};



errorLimit: NAT = 25;

scanTag: ActionTag = [FALSE, 0];

inputSymbol: TSymbol;

Input: PROC RETURNS [token: P1.Token];
inputLoc: P1.Index;
inputValue: P1.Value;

lastToken: P1.Token;
nullSymbol: TSymbol = 0;

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

q: REF P1.ActionSeq;
qI: CARDINAL;



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


-- * * * *  Main Parsing Procedures * * * * --

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

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

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

ParseInit[];

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

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

action _ tAction[tI]; 
IF ~action.tag.reduce THEN {	-- scan or scan reduce entry
IF qI > 0 THEN {
FOR k: CARDINAL IN (valid..i] DO s[k] _ s[top+(k-valid)] ENDLOOP;
P1.ProcessQueue[qI, top];  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)];
BEGIN
lhs: NTSymbol = prodData[action.transition].lhs;
IF currentState <= NTState.LAST THEN {
nI: 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;
END;
i _ i+1;
ENDLOOP;
IF (m _ top+(i-valid)) >= s.length THEN ExpandStack[256];
s[m] _ currentState _ action.transition;
EXITS
SyntaxError => {
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};
END;
ENDLOOP;

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

ParseReset[];
RETURN};


ExpandStack: PROC [delta: NAT] = {
oldSize: NAT = (IF s = NIL THEN 0 ELSE s.length);
newSize: NAT = oldSize + delta;
newS: P1.StateStack = NEW[P1.StateSeq[newSize]];
newL: P1.LinkStack = NEW[P1.LinkSeq[newSize]];
newV: P1.ValueStack = NEW[P1.ValueSeq[newSize]];
FOR i: NAT IN [0..oldSize) DO
newS[i] _ s[i]; newL[i] _ l[i]; newV[i] _ v[i] ENDLOOP;
EraseStack[];
s _ newS;  l _ newL;  v _ newV;
P1.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 P1.ActionSeq = NEW[P1.ActionSeq[newSize]];
FOR i: NAT IN [0..oldSize) DO newQ[i] _ q[i] ENDLOOP;
q _ newQ;
P1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData]};

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


-- * * * * Error Recovery Section * * * * --


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:  State,
symbol: TSymbol,
aLeaf, bLeaf: BOOL,
link: NodeIndex];

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


Allocate: PROC [parent, pred: NodeIndex, terminal: TSymbol, stateNo: 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;  RETURN};


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

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

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

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: State _ stack.extension;
s2: 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: 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};
RETURN};

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



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

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


GetNTEntry: PROC [state: State, lhs: NTSymbol] RETURNS [ActionEntry] = {
IF state <= NTState.LAST THEN {
nI: 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: ActionEntry, nScanned: [0..1]]
RETURNS [StackRep] = {
currentNode, thread: NodeIndex _ stack.leaf;
count: NAT _ nScanned;
currentState: 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: TSymbol] RETURNS [StackRep] = {
currentState: State _ (IF stack.extension = nullState
THEN tree[stack.leaf].state
ELSE stack.extension);
scanned: BOOL _ FALSE;
UNTIL scanned OR currentState = finalState DO
action: ActionEntry;
count: [0..1];
tI: TIndex _ tStart[currentState];
FOR tI IN [tI..tI+tLength[currentState]) DO
SELECT tSymbol[tI] FROM  input, 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 P1.Token;
newText: REF Insert;
insertCount: NAT;

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


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: P1.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 _ P1.NextToken}};
RETURN};



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

RightScan: PROC [node: NodeIndex] RETURNS [stop: BOOL] = {
savedNextNode: NodeIndex = nextNode;
savedMode: ParsingMode = parseMode;
savedLimit: NAT = treeLimit;
stack: StackRep _ [leaf:node, extension:nullState];
state: State _ tree[node].state;
nAccepted: NAT _ 0;
parseMode _ $checking;  treeLimit _ treeSize;
FOR i: NAT IN [scanBase .. scanLimit) DO
IF state = finalState THEN {
nAccepted _ (IF (scanBuffer[i].class = 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] = {
t: TSymbol;
row _ NIL;
FOR r: RowHandle _ list, r.next UNTIL r = NIL DO
IF r.index < r.limit THEN {
s: TSymbol = tSymbol[r.index];
IF row = NIL OR s < t THEN {row _ r; t _ s}};
ENDLOOP;
RETURN};

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, levelEnd: ARRAY Position OF ARRAY Length OF NodeIndex;


AddLeaf: PROC [stack: StackRep, s: 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]};
RETURN};


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: State _ tree[i].state;
r: RowHandle;
DO
tI: 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] # 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];  RETURN};

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;
RETURN};


Accept: PROC RETURNS [success: BOOL] = {
s: 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] _ P1.Token[s, P1.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 _ P1.ResetScanIndex[scanBuffer[scanBase+best.nAccepted].index]
ELSE success _ TRUE;
scanLimit _ scanBase + best.nAccepted;
Input _ RecoverInput};

TypeSym: PROC [sym: TSymbol] = {
OPEN t: tablePtr.scanTable;
vocab: LONG STRING = LOOPHOLE[@tablePtr[t.vocabBody]];
errorStream.PutChar[' ];
IF sym IN [1..endMarker) THEN
FOR i: NAT IN [tablePtr[t.vocabIndex][sym-1]..tablePtr[t.vocabIndex][sym]) DO
errorStream.PutChar[vocab[i]] ENDLOOP
ELSE errorStream.Put[IO.int[sym]]};


rTop: NodeIndex;


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] _ P1.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] = {

Inner: PROC [log: IO.STREAM] = {
errorStream _ log;
IF abort THEN {
P1.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];
P1.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;
RETURN};

logger[Inner];
RETURN};

}.

ήProtoParser.mesa - Cedar/Mesa parser with error recovery
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Satterthwaite, April 21, 1986 4:33:18 pm PST
Maxwell, August 11, 1983 2:02 pm
Paul Rovner, September 7, 1983 3:20 pm
Russ Atkinson (RRA) March 6, 1985 10:35:18 pm PST
table installation
transition tables for terminal input symbols
transition tables for nonterminal input symbols
production information
parser state
initialization/termination
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
ΚΙ˜
codeš
œ8™8Kšœ
Οm
œ1™<Kš
œ,™,K™ K™&K™1—K˜š
Οk	˜	Kšžœžœ
žœ*žœ˜@šœžœ
žœ˜Kš
œD˜DKš
œH˜HKš
œ5˜5Kš
œ0˜0—šœžœ
žœ˜Kš
œK˜KKš
œP˜PKš
œN˜NKš
œ/˜/—K˜—šœž˜Kšž	œ
žœ˜Kšž	œ˜Kšžœ˜K˜—Kš
œ™˜K˜K˜Kš
œ,™,K˜K˜K˜K˜K˜K˜Kš
œ/™/K˜K˜K˜K˜K˜K˜K˜Kš
œ™K˜K˜K˜K˜šΟnœžœ
žœ ˜>K˜K˜/K˜1K˜1K˜1K˜/K˜1K˜1K˜1K˜7K˜3K˜K˜K˜——Kš
œ™˜Kšœžœ˜K˜Kšœžœ˜ K˜K˜K˜Kšœžœ
žœ˜&Kš
œ˜K˜K˜K˜K˜K˜Kš
œ˜Kš
œ˜Kšœžœ˜Kšœžœ
˜K˜Kšœžœ˜Kšœžœ
˜
K˜K˜—Kš
œ™˜Kš
Ÿœžœ
žœ
žœžœ
˜?K˜K˜—Kš
Οc.˜.˜šŸœžœ
žœ˜Kšœžœ
žœ
˜Kš	œžœžœžœ
žœ˜)Kšœžœ
˜Kšž
œžœžœ˜6K˜Kšœ
žœ ˜)K˜K˜šŸ	œžœžœ˜Kš
œ˜Kšœžœžœžœ˜BKšœ
žœ˜K˜—šŸ
œžœžœ˜Kš
œ˜Kšžœžœ
žœ
žœ˜,Kš
œ˜K˜—K˜K˜Kšžœ
 ˜Kšžœ
žœ˜ K˜Kšœžœ
˜K˜K˜BK˜GK˜šžœžœžœž˜NKš
ž˜K˜"šžœžœ$ž˜/Kšžœ
žœžœ
žœ
˜Cš
ž˜Kšžœžœ
žœ
˜—Kšžœ
˜K˜—K˜šžœžœ ˜9šžœžœ˜Kš
žœžœ
žœžœžœ
˜AK˜#—Kšžœ%žœ˜=K˜BK˜2K˜—šžœž˜Kšžœžœ˜(K˜K˜šœžœžœžœ˜CKš
ž˜K˜0šžœžœ
žœ˜&K˜#šžœžœ ž˜+Kšžœžœžœ
žœ	˜?Kšžœ˜	——K˜š
ž˜Kšœ
žœ
˜—Kšžœ
˜—K˜Kšžœ
˜—Kšžœ!žœ˜9K˜(š
ž˜˜K˜4K˜K˜@K˜8K˜K˜0Kšžœžœ
žœ˜——Kšžœ
˜—Kšžœ
˜K˜K˜K˜BKšžœ ˜K˜K˜
Kšžœ˜K˜K˜—šŸœžœ	žœ˜"Kšœ	žœžœžœ
žœžœ˜1Kšœ	žœ˜Kšœžœ˜0Kšœžœ˜.Kšœžœ˜0šžœžœ
žœž˜Kšœ/žœ
˜7—K˜
Kš
œ˜K˜5K˜—šŸ
œžœ˜Kšžœžœ
žœžœžœžœ˜2K˜—šŸœžœ	žœ˜"Kšœ	žœžœžœ
žœžœ˜1Kšœ	žœ˜Kšœžœžœ˜4Kš
žœžœ
žœžœžœ
˜5Kš
œ	˜	K˜5K˜—šŸ
œžœžœžœ
žœ
žœ˜.K˜—K˜—Kš
 ,˜,˜Kš
œ™˜Kšœ
žœ
žœžœ
˜K˜Kšœžœ˜Kšœžœ˜Kšœ
žœ˜Kšœžœ˜Kšœ
žœ˜Kšœžœ˜,K˜K˜—Kš
œ	™	˜Kšœžœžœ
˜K˜šŸœžœ˜$šžœžœ˜Kš
œ$˜$Kšœžœžœ	˜)Kšœžœžœ˜7Kšœžœžœ˜4Kšœžœžœ˜5Kš
œ2˜2Kš
œ˜—š
œ˜K˜K˜———Kš
œ™˜Kšœžœžœ˜$K˜K˜šœžœžœ
˜K˜K˜K˜K˜Kšœžœ
˜K˜K˜—Kšœžœžœžœ˜3Kšœžœ˜Kšœ
žœ˜K˜Kšœžœ˜Kšœ
žœžœ
˜K˜K˜šŸœžœ=˜KKšžœ˜Kšžœ!žœ
žœ˜9Kšœ
žœ˜˜K˜K˜K˜K˜Kšœžœ	žœ
˜K˜—Kšœžœ˜ K˜K˜—Kšœ
žœ !˜6Kšœžœ˜ Kšœžœžœžœ˜/Kšœžœ˜K˜šŸ	œžœžœžœ˜9Kšžœžœ˜K˜—Kšœ
žœ˜-K˜K˜šŸœžœ˜!K˜.K˜<K˜—šŸ
œžœ˜#K˜.K˜šžœ1žœž˜JKšžœžœ
žœ
žœ˜K˜š
ž˜˜	Kšžœžœ"˜7Kšžœ˜!——Kšžœ˜	K˜——šŸœžœžœ˜EK˜Kšœžœ
˜šžœž˜Kšœžœ
˜Kšœžœ
˜Kšžœžœ
˜—K˜%šžœ1žœž˜Jš
žœžœžœžœžœ˜:K˜K˜K˜K˜š
ž˜Kšžœ	žœ
žœ
˜Kšžœ	žœ
žœ˜K˜*K˜,Kšžœ˜	——Kšžœ
˜—Kšžœ˜K˜—šŸœžœ+žœ˜WK˜@šžœžœ˜K˜+šžœž˜Kšœžœ˜6Kšœžœ˜6Kšžœžœ˜——Kšžœ˜K˜—šŸœžœ˜'šžœž˜Kšœ,žœ˜5K˜K˜———Kš
œ™˜Kšœ
žœ
žœ
žœ˜/Kšœžœ
˜$K˜šœ
žœžœ
˜K˜K˜K˜K˜—šŸ
œžœžœ˜Hšžœžœ
žœ˜K˜šžœžœž˜$Kšžœžœ
žœžœ˜8——Kšžœ˜K˜—šŸ
œžœ9˜IKšžœ˜K˜,Kšœžœ˜K˜Kšžœžœ'˜JKšžœ5˜9šžœž˜šžœžœ ˜;K˜:K˜—šžœž˜#Kšœ:žœ
˜B—K˜3K˜CKšžœ
˜—Kšžœžœ;˜LK˜?Kšžœ
˜K˜K˜—šŸ	œžœ#žœ˜Hšœžœ˜5Kšžœ˜Kšžœ˜—Kšœ	žœžœ
˜šžœ	žœž˜-K˜K˜K˜"šžœžœ ž˜+Kšžœ
žœžœžœ
˜?š
ž˜Kšžœžœ˜,—Kšžœ
˜—K˜Kšžœžœžœ ˜OKšžœ˜K˜)K˜Kšžœ
˜—Kšžœ
˜K˜K˜——Kš
œ™˜Kšœžœžœžœ
˜6Kšœ	žœ˜Kšœ
žœ
˜K˜Kšœžœžœ2žœ
˜RKšœžœ˜Kšœžœ
˜K˜K˜KšŸœžœ>˜KK˜šŸœžœ˜šžœžœ˜Kš
œ-˜-K˜@—K˜K˜—šŸ	œžœ˜K˜šžœžœ˜Kš
œ-˜-K˜AK˜——šŸœžœ
žœ˜0šžœžœ˜$K˜Kšžœ-žœ
žœ˜C—šžœ˜K˜šžœ%žœ˜-Kšžœž
œ˜*——Kšžœ˜K˜K˜——Kš
œ™˜šœžœ˜Kšœžœ
˜K˜K˜K˜Kšœžœ˜K˜—šŸ	œžœžœžœ˜:K˜$K˜#Kšœžœ
˜K˜3K˜ Kšœžœ˜K˜-šžœžœ
žœž˜(šžœžœ˜šœ
žœ"˜1Kšžœ˜Kšžœ˜—Kšžœ˜—K˜.Kšžœžœ
žœ
˜$K˜4Kšžœ
˜—K˜1šžœž˜#˜	šžœ/ž˜5K˜0——˜	šžœ+ž˜1K˜.——Kšžœ
˜—Kšžœ˜$K˜K˜——Kš
œ™˜šœžœžœ˜Kšœžœ
˜K˜K˜K˜—Kšœžœžœ˜ K˜šŸœžœžœ˜<K˜Kšœžœ
˜
šžœžœžœ
ž˜0šžœžœ˜K˜Kšžœžœ
žœžœ˜-—Kšžœ
˜—Kšžœ˜K˜—šŸœžœžœ˜@Kšœžœ
˜šžœžœ
ž˜Kš
œ˜Kšžœ˜Kšžœ
˜—Kšžœžœ˜K˜—Kšœ
žœ˜!Kšœžœžœ˜$K˜Kš	œžœ
žœ
žœžœ˜BK˜K˜šŸœžœ1˜>Kšžœžœ˜K˜#K˜šžœžœ*žœ˜LKšœžœ˜&—šžœ˜K˜Fšžœž˜Kšœ žœ
˜%Kšœ žœ
˜%Kšžœžœ
˜—K˜Kšžœžœ˜#K˜—Kšžœ˜K˜K˜—šŸœžœžœžœ˜@Kšœžœ
˜šžœžœ˜Kšœžœ žœ	˜=Kšœžœ
žœžœ!˜P—šžœžœ*ž˜?šžœžœžœ˜%Kšžœ
žœ%˜2K˜0K˜K˜
š
ž˜K˜Kšœžœ˜"Kšœžœ˜K˜BK˜Kšžœ
žœ#žœ
žœ
˜>K˜K˜0K˜Kšžœ
˜—šžœžœ
ž˜%Kšžœ'žœ
žœ
žœ˜:K˜Kšžœ
˜—K˜ —š
ž˜Kšœžœ
˜Kšžœžœ
˜—Kšžœ
˜—Kšœ!žœ˜)K˜—šŸ	œžœžœžœ˜Ašžœžœ˜Kšœžœžœ	˜;Kšœžœ
žœžœ!˜P—šžœžœ&ž˜;Kš
œ
˜
Kšžœžœ˜Kšžœžœ
žœ
žœ˜!K˜
š
ž˜Kšœžœ
˜Kšžœžœ
˜—Kšžœ
˜—Kšžœ˜K˜K˜—šŸœžœ
žœžœ˜(K˜Kšœ
žœ˜ K˜šžœ(žœ
ž˜<šžœžœ˜"K˜K˜@—Kšžœ
˜—K˜šžœžœ˜Kš
œ)˜)šžœžœ
žœž˜&K˜>Kšžœ˜	——šžœžœ˜$Kšžœžœ˜8Kš
œ*˜*šžœžœ
žœž˜-Kšœžœ˜#——KšžœžœE˜\Kšžœžœ
žœ˜1šžœ'ž˜-K˜F—Kšžœžœ
˜K˜&K˜K˜—šŸœžœ˜ Kšžœ˜Kšœžœ
žœžœ˜6K˜šžœžœž˜šžœžœ
žœ>ž˜MKšœž˜%——Kšžœžœ˜#K˜K˜———š
œ™K˜K˜K˜šŸœžœ˜Kšœ	žœ
žœ ˜:K˜K˜K˜!Kšœ
žœ˜K˜*K˜K˜;K˜K˜<K˜Kšžœžœžœ
˜1šžœžœ
žœž˜K˜%Kšžœžœ˜ Kšžœ
˜—K˜K˜=Kšœžœ
˜K˜ K˜K˜EK˜3K˜$Kšœ&žœ
˜+K˜>Kšžœžœ˜ K˜šžœžœžœž˜*šžœžœ
ž˜"K˜Kšžœžœ
˜$Kš
œ$™$K˜$Kš
žœ&žœžœ
žœ
žœ˜DK˜"Kš
œ-™-šžœž˜Kšœžœžœ
žœ
žœžœ
˜?—K˜
Kšžœžœ˜!šžœ
žœ
žœž˜#Kš
žœžœ
žœ
žœžœ
˜6—Kš
œ™Kšžœžœ
žœ
˜*Kšžœžœ˜"Kšžœ
˜—š
ž˜Kšœ	žœ
˜šžœ˜
Kšœžœ!˜/Kšžœžœžœžœ
˜9šžœž˜ Kšžœžœ
žœ
žœ˜0K˜
šžœ
žœ
žœž˜šžœžœ
ž˜"K˜Kšžœžœ
˜$Kšžœžœ
žœ
žœ˜.Kšžœžœ˜"Kšžœ
˜—Kšžœ
˜—K˜
Kšœžœžœ
žœ˜Kš
ž˜Kšœ	žœ
˜šžœ˜Kšžœžœ(˜M——Kšžœ˜	———Kšžœ˜	K˜——šŸœžœ˜Kšœžœžœžœ
žœžœžœžœ˜IK˜šŸœžœžœ
žœ˜ K˜šžœžœ˜K˜7Kš
œG˜GKšœ
žœ
˜—šžœ˜Kšœ
žœ	˜Kšœ
žœ	˜Kšœžœ˜Kšœžœ˜Kšœžœ˜#Kšžœ
˜˜,Kšœžœžœžœ˜5—šžœ,žœžœ˜BKš
œ*˜*Kšžœ
žœ˜$—Kšžœ˜K˜—Kšœ)žœ
˜-Kšžœ˜K˜—K˜Kšžœ˜K˜—K˜K˜——…—NΔjk