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

MobParser: PROGRAM
  IMPORTS IO, MobP1, MobParseTable 
  EXPORTS MobP1 = {
OPEN MobParseTable;


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


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


prodData: ProdDataRef;


InstallMobParseTable: PUBLIC PROC[] = {
tStart ฌ MobParseTable.InitTStarts[];
tLength ฌ MobParseTable.InitTLengths[];
tSymbol ฌ MobParseTable.InitTSymbols[];
tAction ฌ MobParseTable.InitTActions[];
nStart ฌ MobParseTable.InitNStarts[];
nLength ฌ MobParseTable.InitNLengths[];
nSymbol ฌ MobParseTable.InitNSymbols[];
nAction ฌ MobParseTable.InitNActions[];
ntDefaults ฌ MobParseTable.InitNTDefaults[];
prodData ฌ MobParseTable.InitProdData[];
MobP1.InstallScanTable[]};



errorLimit: NAT = 25;

scanTag: ActionTag = [FALSE, 0];

inputSymbol: TSymbol;

Input: PROC RETURNS[token: MobP1.Token];
inputLoc: MobP1.Index ฌ 0;
inputValue: MobP1.Value;

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

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

q: REF MobP1.ActionSeq;
qI: CARDINAL;



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



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 = {
MobP1.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];
MobP1.ScanReset[]};

ParseInit[];

BEGIN	-- ENABLE scope
ENABLE UNWIND => {ParseReset[]};
Input ฌ MobP1.NextToken;
nErrors ฌ 0;  complete ฌ TRUE;
i ฌ top ฌ valid ฌ 0;  qI ฌ 0;
s[0] ฌ currentState ฌ initialState;  lastToken.class ฌ nullSymbol;
inputSymbol ฌ initialSymbol;  inputValue ฌ MobP1.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;
MobP1.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;

MobP1.ProcessQueue[qI, top];
nErrors ฌ nErrors + ([nTokens: nTokens] ฌ MobP1.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: MobP1.StateStack = NEW[MobP1.StateSeq[newSize]];
newL: MobP1.LinkStack = NEW[MobP1.LinkSeq[newSize]];
newV: MobP1.ValueStack = NEW[MobP1.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;
MobP1.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 MobP1.ActionSeq = NEW[MobP1.ActionSeq[newSize]];
FOR i: NAT IN [0..oldSize) DO newQ[i] ฌ q[i] ENDLOOP;
q ฌ newQ;
MobP1.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;

WriteCR: PROC[] = {
errorStream.PutChar['\012]};



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]; MobP1.TypeSym[errorStream, tree[n].symbol];
WriteCR[]}
};



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] ฌ 0;
maxNode: NodeIndex ฌ 0;
treeLimit: NAT [0..treeSize] ฌ 0;
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] = {
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: 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 MobP1.Token;
newText: REF Insert;
insertCount: NAT ฌ 0;

Buffer: TYPE = ARRAY [0 .. 1+discardLimit+(maxScanLimit+insertLimit)) OF MobP1.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: "];
MobP1.TypeSym[errorStream, scanBuffer[scanBase].class];  WriteCR[]};
scanBase ฌ scanBase+1};

UnDiscard: PROC = {
scanBase ฌ scanBase-1;
IF track THEN {
errorStream.PutRope["::recovering symbol: "];
MobP1.TypeSym[errorStream, scanBuffer[scanBase].class];  WriteCR[]}
};

RecoverInput: PROC RETURNS[token: MobP1.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 ฌ MobP1.NextToken}};
RETURN};



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: 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 ฌ TSymbol.FIRST;
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: 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: 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];  WriteCR[]};
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];  WriteCR[]};
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] ฌ MobP1.Token[s, MobP1.TokenValue[s], inputLoc]};
ENDLOOP;
scanBase ฌ discardBase;
IF best.nDiscards # 0 THEN {
errorStream.PutRope["Text deleted is: "];
FOR j: NAT IN [1 .. best.nDiscards] DO
MobP1.TypeSym[errorStream, scanBuffer[scanBase].class];  scanBase ฌ scanBase + 1;
ENDLOOP};
IF insertCount <= insertLimit THEN {
IF scanBase # discardBase THEN WriteCR[];
errorStream.PutRope["Text inserted is: "];
FOR j: NAT IN [insertCount .. insertLimit] DO
MobP1.TypeSym[errorStream, 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 ฌ MobP1.ResetScanIndex[scanBuffer[scanBase+best.nAccepted].index]
ELSE success ฌ TRUE;
scanLimit ฌ scanBase + best.nAccepted;
Input ฌ RecoverInput};


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] ฌ MobP1.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 {
MobP1.ErrorContext[errorStream, "syntax error", inputLoc];
errorStream.PutRope["... parse abandoned."];  WriteCR[];
success ฌ FALSE}
ELSE {
scanBuffer ฌ NEW[Buffer];
newText ฌ NEW[Insert];
tree ฌ NEW[TreeSpace];
hashTable ฌ NEW[HashSpace];
Recover[ ! TreeFull => {CONTINUE}];
FREE[@hashTable];
MobP1.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];
WriteCR[]};
WriteCR[];  errorStream ฌ NIL;
RETURN};

logger[Inner];
RETURN};

}.

P
MobParser.mesa - Cedar/Mesa parser with error recovery
Copyright ำ 1985, 1989, 1991 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 6, 1985 10:35:18 pm PST
Andy Litman May 5, 1988 8:53:39 pm PDT
JKF July 22, 1989 3:39:19 pm PDT
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
สา–
(cedarcode) style•NewlineDelimiter

™
codeš
œ6™6Kšœ
ฯe
œ=™HKšฯy'ะky™*Kš
ž&™&Kšœฯkœ ™1Kšž#Ÿ™&Kš œ™ —K˜š
 	˜	Kš œ
 œ* œ˜:šœ œ˜
Kš
œD˜DKš
œH˜HKš
œ>˜>Kš
œ0˜0—šœ œ˜Kš
œ˜—K˜—šฯn	œ ˜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˜'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˜—Kš
œ™˜Kš
กœ œ
 œ
 œ œ˜@K˜K˜—Kš
œ+™+˜šกœ œ
 œ
˜Kšœ œ
 œ
˜Kš	œ œ
 œ œ
 œ˜'Kšœ œ
˜Kšœ œ œ œ˜5K˜Kšœ
 œฯc˜)K˜K˜šก	œ œ˜Kš
œ˜Kšœ œ œ œ˜BKšœ
 œ˜K˜—šก
œ œ˜Kš
œ˜Kš œ œ
 œ
 œ˜,Kš
œ˜K˜—K˜K˜Kš œ
ข˜Kš œ
 œ˜ K˜Kšœ œ
˜K˜K˜BK˜JK˜š œ œ œ ˜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˜EKš œข˜K˜K˜
Kš œ˜K˜K˜—šกœ œ œ˜!Kšœ	 œ œ œ
 œ œ˜1Kšœ	 œ˜Kšœ œ˜6Kšœ œ˜4Kšœ œ˜6š œ œ
 œ ˜Kšœ/ œ
˜7—K˜
Kš
œ˜K˜8K˜—šก
œ œ˜Kš œ œ
 œ œ œ œ˜2K˜—šกœ œ œ˜!Kšœ	 œ œ œ
 œ œ˜1Kšœ	 œ˜Kšœ œ œ˜:Kš
 œ œ
 œ œ œ
˜5Kš
œ	˜	K˜8K˜—šก
œ œ œ œ
 œ
 œ˜.K˜—K˜—Kš
œ)™)˜Kš
œ™˜Kšœ
 œ
 œ œ
˜K˜Kšœ œ˜Kšœ œ˜Kšœ
 œ˜Kšœ œ˜Kšœ
 œ˜Kšœ œ˜,K˜šกœ œ˜Kš
œ˜—K˜K˜—Kš
œ	™	˜Kšœ œ œ
˜K˜šกœ œ˜#š œ œ˜Kš
œ$˜$Kšœ œ œ	˜)Kšœ œ œ˜7Kšœ œ œ˜4Kšœ œ œ˜5Kš
œE˜EKš
œ
˜
—š
œ˜K˜K˜———Kš
œ™˜Kšœ œ œ˜$K˜K˜šœ œ œ
˜K˜K˜K˜K˜Kšœ œ
˜K˜K˜—Kšœ œ œ œ˜3Kšœ œ˜Kšœ
 œ˜ K˜Kšœ œ˜!Kšกœ œ œ
˜K˜K˜šกœ œ<˜JKšœ œ˜ Kš œ! œ
 œ˜9Kšœ
 œ˜˜K˜K˜K˜K˜Kšœ œ	 œ
˜K˜—Kšœ œ˜ K˜K˜—Kšœ
 œข!˜6Kšœ œ˜ Kšœ œ œ œ˜/Kšœ œ˜K˜šก	œ œ œ˜0Kš œ œ˜K˜—Kšœ
 œ˜-Kš
œ"˜"K˜šกœ œ˜ K˜.K˜<K˜—šก
œ œ˜"K˜.K˜š œ1 œ ˜JKš œ œ
 œ
 œ˜K˜š
 ˜˜	Kš œ œ"˜7Kš œ˜!——Kš
 ˜—š
œ˜K˜——šกœ œ œ˜CK˜Kšœ œ
˜š œ ˜Kšœ œ
˜Kšœ œ
˜Kš œ œ
˜—K˜%š œ1 œ ˜Jš
 œ œ œ œ œ˜:K˜K˜K˜K˜š
 ˜Kš œ	 œ
 œ
˜Kš œ	 œ
 œ˜K˜*K˜,Kš œ˜	——Kš œ
˜—Kš œ˜K˜—šกœ œ* œ˜UK˜@š œ œ˜K˜+š œ ˜Kšœ œ˜6Kšœ œ˜6Kš œ œ˜——Kš œ˜K˜—šกœ œ˜&š œ ˜Kšœ, ˜3—š
œ˜K˜K˜———Kš
œ™˜Kšœ
 œ
 œ
 œ˜/Kšœ œ
˜$K˜šœ
 œ œ
˜K˜K˜K˜K˜—šก
œ œ œ˜Gš œ œ
 œ˜K˜š œ œ ˜$Kš œ œ
 œ œ˜7——Kš œ˜K˜—šก
œ œ8˜HKšœ œ˜K˜,Kšœ œ˜K˜Kš œ œ'˜JKš œ5˜9š œ ˜š œ œข˜;K˜:K˜—š œ ˜#Kšœ: œ
˜B—K˜3K˜CKš œ
˜—Kš œ œ;˜LK˜?Kš œ	˜K˜K˜—šก	œ œ" œ˜Fšœ œ˜5Kš œ˜Kš œ˜—Kšœ	 œ œ
˜š œ	 œ ˜-K˜K˜K˜"š œ œ  ˜+Kš œ
 œ œ œ
˜?š
 ˜Kš œ œ˜+—Kš œ
˜—K˜Kš œ œ œข˜OKš œ˜K˜)K˜Kš œ
˜—Kš œ	˜K˜K˜——Kš
œ™˜Kšœ œ œ œ
˜9Kšœ	 œ˜Kšœ
 œ
˜K˜Kšœ œ œ2 œ
˜UKšœ œ˜Kšœ œ
˜K˜K˜Kšกœ œ>˜KK˜šกœ œ˜š œ œ˜Kš
œ-˜-Kš
œD˜D—K˜K˜—šก	œ œ˜K˜š œ œ˜Kš
œ-˜-Kš
œC˜C—˜K˜——šกœ œ
 œ˜2š œ œ˜$K˜Kš œ- œ
 œ˜C—š œ˜K˜š œ% œ˜-Kš œ)˜-——Kš œ˜K˜K˜——Kš
œ™˜šœ œ˜Kšœ œ
˜K˜K˜K˜Kšœ œ˜K˜—šก	œ œ œ œ˜8K˜$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š
œ œ
 œ
 œ œ œ œ˜KKš
œ
 œ
 œ
 œ œ œ œ˜IK˜K˜šกœ œ1 œ œ˜UK˜#K˜š œ œ* œ˜LKšœ œ˜&—š œ˜K˜Fš œ ˜Kšœ  œ
˜%Kšœ  œ
˜%Kš œ œ
˜—K˜Kš œ œ˜#K˜—Kš œ˜K˜K˜—šกœ œ œ œ˜>Kšœ œ
˜š œ œ˜Kšœ œ  œ	˜=Kšœ œ
 œ œ˜A—š œ œ* ˜?š œ œ œ˜%Kš œ
 œ%˜2K˜0K˜K˜
š
 ˜K˜Kšœ œ˜"Kšœ œ˜K˜BK˜Kš œ
 œ# œ
 œ
˜>K˜K˜0K˜Kš œ
˜—š œ œ
 ˜%Kš œ' œ
 œ
 œ˜:K˜Kš œ
˜—K˜ —š
 ˜Kšœ œ
˜Kš œ œ
˜—Kš œ
˜—Kšœ! œ˜)K˜—šก	œ œ œ œ˜?š œ œ˜Kšœ œ œ	˜;Kšœ œ
 œ œ˜A—š œ œ& ˜;Kš
œ
˜
Kš œ œ˜Kš œ œ
 œ
 œ˜!K˜
š
 ˜Kšœ œ
˜Kš œ œ
˜—Kš œ
˜—Kš œ˜K˜K˜—šกœ œ
 œ
 œ˜'K˜Kšœ
 œ˜ K˜š œ( œ
 ˜<š œ œ˜"K˜K˜F—Kš œ
˜—K˜š œ œ˜Kš
œ)˜)š œ œ
 œ ˜&Kš
œQ˜QKš œ˜	——š œ œ˜$Kš œ œ˜)Kš
œ*˜*š œ œ
 œ ˜-Kšœ- œ˜6——Kš œ œE˜\Kš œ œ
 œ˜1š œ' ˜-K˜I—Kš œ œ
˜K˜&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šœ œ
 œ
 œ
 œ œ œ
 œ˜NK˜šกœ œ œ
 œ˜K˜š œ œ˜K˜:Kš
œ8˜8Kšœ
 œ
˜—š œ˜Kšœ
 œ	˜Kšœ
 œ	˜Kšœ œ˜Kšœ œ˜Kšœ œ˜#Kš œ
˜˜/Kšœ œ œ œ˜5—š œ, œ œ˜BKš
œ*˜*Kš œ
 œ˜$—Kš œ˜K˜—Kšœ œ
˜Kš œ˜K˜—K˜Kš œ˜K˜—K˜K˜——…—M์j