[Indigo]<Cedar>Compiler>ProtoParser.mesa!1

file ProtoParser.mesa

last modified by Satterthwaite, January 7, 1983 4:50 pm

Last Edited by: Maxwell, August 11, 1983 2:02 pm

Last Edited by: Paul Rovner, September 7, 1983 3:20 pm

DIRECTORY

IO: TYPE USING [char, int, Put, PutChar, PutRope, rope, STREAM, TAB],

P1: TYPE USING [

ActionSeq, LinkSeq, StateSeq, Token,

Value, ValueSeq, nullValue,

AssignDescriptors, Atom, ErrorContext, InstallScanTable, ProcessQueue,

ResetScanIndex, ScanInit, ScanReset, TokenValue],

ParseTable: TYPE 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],

Rope: TYPE USING [ROPE];

Parser: PROGRAM

IMPORTS IO, P1

EXPORTS P1 = {

Cedar/Mesa parser with error recovery

OPEN ParseTable;

table installation

tablePtr: ParseTable.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 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]};

parser state

errorLimit: NAT = 25;

scanTag: ActionTag = [FALSE, 0];

inputSymbol: TSymbol;

Input: PROC RETURNS [token: P1.Token];

inputLoc: CARDINAL;

inputValue: P1.Value;

lastToken: P1.Token;

nullSymbol: TSymbol = 0;

s: REF P1.StateSeq;

l: LONG POINTER TO P1.LinkSeq;

lREF: REF P1.LinkSeq; -- NOTE sharing with l

v: LONG POINTER TO P1.ValueSeq;

vREF: REF P1.ValueSeq; -- NOTE sharing with v

top: CARDINAL;

q: LONG POINTER TO P1.ActionSeq;

qREF: REF P1.ActionSeq; -- NOTE sharing with q

qI: CARDINAL;

initialization/termination

ParseInit: PROC = INLINE {

s ← NIL; q ← NIL; qREF ← NIL; q ← NIL; ExpandStack[500]; ExpandQueue[250];

scanBuffer ← NIL};

ParseReset: PROC = INLINE {

qREF ← NIL; q ← NIL; EraseStack[];

scanBuffer ← NIL};

InputLoc: PUBLIC PROC RETURNS [CARDINAL] = {RETURN [inputLoc]};

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

Parse: PUBLIC PROC [

source: IO.STREAM,

logger: PROC [PROC [log: IO.STREAM]]]

RETURNS [complete: BOOL, nTokens, nErrors: NAT] = {

currentState: State;

i, valid, m: CARDINAL; -- stack pointers

action: ActionEntry;

ParseInit[];

P1.ScanInit[source, logger]; Input ← P1.Atom;

nErrors ← 0; complete ← TRUE;

i ← top ← valid ← 0; qI ← 0;

s[0] ← currentState ← initialState; lastToken.class ← nullSymbol;

inputSymbol ← initialSymbol; inputValue ← P1.nullValue; inputLoc ← 0;

WHILE 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] ← 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.ScanReset[]).nErrors;

ParseReset[];

RETURN};

ExpandStack: PROC [delta: NAT] = {

oldSize: NAT = IF s = NIL THEN 0 ELSE s.length;

newSize: NAT = oldSize + delta;

newS: REF P1.StateSeq = NEW[P1.StateSeq[newSize]];

newL: REF P1.LinkSeq = NEW[P1.LinkSeq[newSize]];

newV: REF P1.ValueSeq = 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;

lREF ← newL; l ← LOOPHOLE[lREF, LONG POINTER TO P1.LinkSeq];

vREF ← newV; v ← LOOPHOLE[vREF, LONG POINTER TO P1.ValueSeq];

P1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData]};

EraseStack: PROC = {

IF s # NIL THEN {vREF ← NIL; v ← NIL; lREF ← NIL; l ← NIL; s ← NIL}};

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;

qREF ← newQ;

q ← LOOPHOLE[qREF, LONG POINTER TO P1.ActionSeq];

P1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData];

};

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

parameters of error recovery

errorStream: IO.STREAM ← NIL;

minScanLimit: NAT = 4;

maxScanLimit: NAT = 12;

insertLimit: NAT = 2;

discardLimit: NAT = 10;

treeSize: NAT = 250;

checkSize: NAT = maxScanLimit+insertLimit+2;

debugging

ParserID: PUBLIC PROC RETURNS [Rope.ROPE] = {RETURN [NIL]};

track: BOOL = FALSE;

DisplayNode: PROC [n: NodeIndex] = {

IF track THEN {

OPEN IO;

PutRope[errorStream, "::new node::"];

Put[errorStream, IO.char[IO.TAB], IO.int[n]];

Put[errorStream, IO.char[IO.TAB], IO.int[tree[n].father]];

Put[errorStream, IO.char[IO.TAB], IO.int[tree[n].last]];

Put[errorStream, IO.char[IO.TAB], IO.int[tree[n].state]];

Put[errorStream, IO.char[IO.TAB]]; TypeSym[tree[n].symbol]; NewLine[]}};

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 = {

IF track THEN {

IO.PutRope[errorStream, "::discarding symbol: "];

TypeSym[scanBuffer[scanBase].class]; NewLine[]};

scanBase ← scanBase+1};

UnDiscard: PROC = {

scanBase ← scanBase-1;

IF track THEN {

IO.PutRope[errorStream, "::recovering symbol: "];

TypeSym[scanBuffer[scanBase].class]; NewLine[]}};

RecoverInput: PROC RETURNS [token: P1.Token] = {

IF insertCount <= insertLimit THEN {

token ← newText[insertCount];

IF (insertCount ← insertCount+1) > insertLimit THEN newText ← NIL}

ELSE {

token ← scanBuffer[scanBase];

IF (scanBase ← scanBase+1) = scanLimit THEN {

scanBuffer ← NIL; 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};

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 {

IO.Put[errorStream, IO.rope["::generating length: "], IO.int[n]];

IO.PutChar[errorStream, IF p = $before THEN 'B ELSE 'A]; NewLine[]};

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 ← NIL};

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 ← NIL};

REPEAT

found => stop ← TRUE;

FINISHED => stop ← FALSE;

ENDLOOP;

rowList ← NIL; RETURN};

CheckTree: PROC [p: Position, n: Length] RETURNS [stop: BOOL] = {

IF track THEN {

IO.Put[errorStream, IO.rope["::checking length: "], IO.int[n]];

IO.PutChar[errorStream, IF p = $before THEN 'B ELSE 'A]; NewLine[]};

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 {

IO.PutRope[errorStream, "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 NewLine[];

IO.PutRope[errorStream, "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 newText ← NIL;

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 IO, t: tablePtr.scanTable;

vocab: LONG STRING = LOOPHOLE[@tablePtr[t.vocabBody]];

PutChar[errorStream, ' ];

IF sym IN [1..endMarker) THEN

FOR i: NAT IN [tablePtr[t.vocabIndex][sym-1]..tablePtr[t.vocabIndex][sym]) DO

PutChar[errorStream, vocab[i]] ENDLOOP

ELSE Put[errorStream, IO.int[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]];

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[];

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;

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

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];

IO.PutRope[errorStream, "... Parse abandoned."]; NewLine[];

success ← FALSE}

ELSE {

scanBuffer ← NEW[Buffer];

newText ← NEW[Insert];

tree ← NEW[TreeSpace];

hashTable ← NEW[HashSpace];

Recover[ ! TreeFull => {CONTINUE}];

hashTable ← NIL;

P1.ErrorContext[errorStream, "Syntax Error",

scanBuffer[IF best.mode=$bTree THEN 0 ELSE 1].index];

IF ~(success ← best.nAccepted >= minScanLimit AND Accept[]) THEN {

IO.PutRope[errorStream, "No recovery found."];

newText ← NIL; scanBuffer ← NIL};

tree ← NIL;

NewLine[]};

NewLine[]; errorStream ← NIL;

RETURN};

logger[Inner];

RETURN};

NewLine: PROC = {IO.PutChar[errorStream, '\n]};

}.