-- file CtoSParserImpl.mesa
-- should be merged with SMParserImpl.mesa when new modeller permits
-- derived from ProtoParser.mesa
-- last modified by Satterthwaite, July 29, 1983 9:47 am
DIRECTORY
IO: TYPE USING [card, Put, PutChar, STREAM, string],
CtoSP1: TYPE --P1-- USING [
ActionSeq, ActionStack, Index, LinkSeq, LinkStack, TValue, StateSeq, StateStack,
Token, Value, ValueSeq, ValueStack, nullNTValue, nullTValue,
AssignDescriptors, Atom, ErrorContext, InstallScanTable, ProcessQueue,
ResetScanIndex, ScanInit, ScanReset, TokenValue],
CtoSParseTable: TYPE ParseTable USING [
ActionEntry, ActionTag, NActionsRef, NLengthsRef, NStartsRef, NSymbolsRef,
NTDefaultsRef, NTIndex, NTState, NTSymbol, ProdDataRef, State, TableRef,
TActionsRef, TIndex, TLengthsRef, TStartsRef, TSymbol, TSymbolsRef,
defaultMarker, endMarker, initialState, finalState, initialSymbol],
SMOps: TYPE USING [MS];
CtoSParserImpl: PROGRAM
IMPORTS IO, CtoSP1
EXPORTS CtoSP1 = {
-- Cedar/Mesa parser with error recovery
OPEN CtoSParseTable, P1~~CtoSP1;
-- table installation
tablePtr: TableRef;
-- transition tables for terminal input symbols
tStart: TStartsRef;
tLength: TLengthsRef;
tSymbol: TSymbolsRef;
tAction: TActionsRef;
-- transition tables for nonterminal input symbols
nStart: NStartsRef;
nLength: NLengthsRef;
nSymbol: NSymbolsRef;
nAction: NActionsRef;
ntDefaults: NTDefaultsRef;
-- production information
prodData: ProdDataRef;
InstallParseTable: PUBLIC SAFE PROC [base: TableRef] = TRUSTED {
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]};
-- parser state
cm: SMOps.MS;
errorLimit: NAT = 25;
scanTag: ActionTag = [FALSE, 0];
inputSymbol: TSymbol;
Input: PROC RETURNS [token: P1.Token];
inputLoc: P1.Index;
inputValue: P1.TValue;
lastToken: P1.Token;
nullSymbol: TSymbol = 0;
zone: ZONE ← NIL;
s: P1.StateStack ← NIL;
l: P1.LinkStack ← NIL;
v: P1.ValueStack ← NIL;
top: CARDINAL;
q: P1.ActionStack ← NIL;
qI: CARDINAL;
-- initialization/termination
ParseInit: PROC [scratchZone: ZONE] = INLINE {
zone ← scratchZone;
s ← NIL; q ← NIL; ExpandStack[500]; ExpandQueue[250];
scanBuffer ← NIL};
ParseReset: PROC = INLINE {
EraseQueue[]; EraseStack[];
IF scanBuffer # NIL THEN zone.FREE[@scanBuffer];
zone ← NIL};
InputLoc: PUBLIC SAFE PROC RETURNS [P1.Index] = CHECKED {
RETURN [inputLoc]};
-- * * * * Main Parsing Procedures * * * * --
Parse: PUBLIC PROC [model: SMOps.MS, source: IO.STREAM, prefix: BOOL]
RETURNS [complete: BOOL, nTokens, nErrors: NAT] = {
currentState: State;
i, valid, m: CARDINAL; -- stack pointers
action: ActionEntry;
cm ← model;
ParseInit[cm.z];
P1.ScanInit[cm, source]; Input ← P1.Atom;
nErrors ← 0; complete ← TRUE;
i ← top ← valid ← 0; qI ← 0;
s[0] ← currentState ← initialState; lastToken.class ← nullSymbol;
inputSymbol ← initialSymbol; inputValue ← P1.nullTValue; inputLoc ← 0;
UNTIL currentState = finalState 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] ← [t~inputValue, n~P1.nullNTValue]; 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].t; lastToken.index ← l[top];
top ← top - 1;
complete ← SyntaxError[(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.ScanReset[]).nErrors;
ParseReset[];
RETURN};
ExpandStack: PROC [delta: NAT] = {
oldSize: NAT = (IF s = NIL THEN 0 ELSE s.length);
newSize: NAT = oldSize + delta;
newS: P1.StateStack = zone.NEW[P1.StateSeq[newSize]];
newL: P1.LinkStack = zone.NEW[P1.LinkSeq[newSize]];
newV: P1.ValueStack = zone.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, model~cm]};
EraseStack: PROC = {
IF s # NIL THEN {zone.FREE[@v]; zone.FREE[@l]; zone.FREE[@s]}};
ExpandQueue: PROC [delta: NAT] = {
oldSize: NAT = (IF q = NIL THEN 0 ELSE q.length);
newSize: NAT = oldSize + delta;
newQ: P1.ActionStack = zone.NEW[P1.ActionSeq[newSize]];
FOR i: NAT IN [0..oldSize) DO newQ[i] ← q[i] ENDLOOP;
EraseQueue[];
q ← newQ;
P1.AssignDescriptors[qd~q, vd~v, ld~l, pp~prodData, model~cm]};
EraseQueue: PROC = {IF q # NIL THEN zone.FREE[@q]};
-- * * * * Error Recovery Section * * * * --
-- parameters of error recovery
minScanLimit: NAT = 4;
maxScanLimit: NAT = 12;
insertLimit: NAT = 2;
discardLimit: NAT = 10;
treeSize: NAT = 250;
checkSize: NAT = maxScanLimit+insertLimit+2;
-- tree management
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};
-- parsing simulation
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;
WHILE ~scanned 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]};
-- text buffer management
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 = INLINE {scanBase ← scanBase+1};
UnDiscard: PROC = INLINE {scanBase ← scanBase-1};
RecoverInput: PROC RETURNS [token: P1.Token] = {
IF insertCount <= insertLimit THEN {
token ← newText[insertCount];
IF (insertCount ← insertCount+1) > insertLimit THEN zone.FREE[@newText]}
ELSE {
token ← scanBuffer[scanBase];
IF (scanBase ← scanBase+1) = scanLimit THEN {
zone.FREE[@scanBuffer]; Input ← P1.Atom}};
RETURN};
-- acceptance checking
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]};
-- strategy management
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 [RowHandle] = {
r: RowHandle ← list;
UNTIL r = NIL DO
next: RowHandle = r.next;
zone.FREE[@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];
stop ← RightScan[newLeaf]};
RETURN};
GrowTree: PROC [p: Position, n: Length] RETURNS [stop: BOOL] = {
rowList: RowHandle ← NIL;
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 ← zone.NEW[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] = {
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 {
cm.out.Put[IO.string["Text deleted is: "L]];
FOR j: NAT IN [1 .. best.nDiscards] DO
TypeSym[scanBuffer[scanBase].class]; scanBase ← scanBase + 1;
ENDLOOP};
IF insertCount <= insertLimit THEN {
IF scanBase # discardBase THEN cm.out.PutChar['\n];
cm.out.Put[IO.string["Text inserted is: "L]];
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 zone.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]];
cm.out.PutChar[' ];
IF sym IN [1..endMarker) THEN
FOR i: NAT IN [tablePtr[t.vocabIndex][sym-1]..tablePtr[t.vocabIndex][sym]) DO
cm.out.PutChar[vocab[i]] ENDLOOP
ELSE cm.out.Put[IO.card[sym]]};
--stack node indices
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]];
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;
FOR level: Length IN [1 .. Length.LAST] DO
FOR place: Position IN Position DO
parseMode ← ModeMap[place];
IF place = $before THEN UnDiscard[];
-- try simple insertion (inserts=level)
levelStart[place][level] ← nextNode;
IF GrowTree[place, level ! TreeFull => {CONTINUE}] THEN GO TO found;
levelEnd[place][level] ← nextNode;
-- try discards followed by 0 or more insertions
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;
-- undo discards at this level
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 [abort: BOOL] RETURNS [success: BOOL] = {
IF abort THEN {
P1.ErrorContext["Syntax Error", inputLoc];
cm.out.Put[IO.string["... Parse abandoned.\n"L]];
success ← FALSE}
ELSE {
scanBuffer ← zone.NEW[Buffer];
newText ← zone.NEW[Insert];
tree ← zone.NEW[TreeSpace];
hashTable ← zone.NEW[HashSpace];
Recover[ ! TreeFull => {CONTINUE}];
zone.FREE[@hashTable];
P1.ErrorContext["Syntax Error",
scanBuffer[IF best.mode=$bTree THEN 0 ELSE 1].index];
IF ~(success ← best.nAccepted >= minScanLimit AND Accept[]) THEN {
cm.out.Put[IO.string["No recovery found."L]];
zone.FREE[@newText]; zone.FREE[@scanBuffer]};
zone.FREE[@tree];
cm.out.PutChar['\n]};
cm.out.PutChar['\n];
RETURN};
}.