[_CDCSL_93-16_]<1>Cedar>release>MimosaOnly>MimParserImpl.mesa

MimParserImpl.mesa

Satterthwaite, May 27, 1986 9:53:25 am PDT

Russ Atkinson (RRA) June 21, 1989 12:38:54 pm PDT

DIRECTORY

IO USING [Put, Put1, PutChar, PutRope, STREAM],

MimP1 USING [ActionSeq, AssignDescriptors, ErrorContext, Index, InstallScanTable, LinkSeq, LinkStack, NextToken, nullValue, ProcessQueue, ResetScanIndex, ScanInit, ScanReset, ScanStats, StateSeq, StateStack, Token, TokenValue, Value, ValueSeq, ValueStack],

MimZones USING [RegisterForReset, tempZone],

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

MimParserImpl: PROGRAM

IMPORTS IO, MimZones, MimP1, ParseTable

EXPORTS MimP1 = {

OPEN ParseTable;

table installation

stuff for TypeSym

vocabIndex: IndexTableRef Ź NIL;

vocabBody: VocabularyRef Ź NIL;

transition tables for terminal input symbols

tStart: TStartsRef Ź NIL;

tLength: TLengthsRef Ź NIL;

tSymbol: TSymbolsRef Ź NIL;

tAction: TActionsRef Ź NIL;

transition tables for nonterminal input symbols

nStart: NStartsRef Ź NIL;

nLength: NLengthsRef Ź NIL;

nSymbol: NSymbolsRef Ź NIL;

nAction: NActionsRef Ź NIL;

ntDefaults: NTDefaultsRef Ź NIL;

production information

prodData: ProdDataRef Ź NIL;

InstallParseTable: PUBLIC PROC = {

IF prodData = NIL THEN {

tStart Ź InitTStarts[];

tLength Ź InitTLengths[];

tSymbol Ź InitTSymbols[];

tAction Ź InitTActions[];

nStart Ź InitNStarts[];

nLength Ź InitNLengths[];

nSymbol Ź InitNSymbols[];

nAction Ź InitNActions[];

ntDefaults Ź InitNTDefaults[];

prodData Ź InitProdData[];

MimP1.InstallScanTable[];

};

parser state

errorLimit: NAT = 25;

scanTag: ActionTag = [FALSE, 0];

inputSymbol: TSymbol Ź TSymbol.FIRST;

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

inputLoc: MimP1.Index Ź 0;

inputValue: MimP1.Value Ź [scalar[FALSE, 0]];

nullToken: MimP1.Token Ź [TSymbol.FIRST, inputValue, 0];

lastToken: MimP1.Token Ź nullToken;

nullSymbol: TSymbol = 0;

s: MimP1.StateStack Ź NIL;

l: MimP1.LinkStack Ź NIL;

v: REF MimP1.ValueSeq Ź NIL;

top: CARDINAL Ź 0;

q: REF MimP1.ActionSeq Ź NIL;

qI: CARDINAL Ź 0;

initialization/termination

InputLoc: PUBLIC PROC RETURNS [MimP1.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[source, logger];

{

ENABLE UNWIND => {ParseReset[]};

Input Ź MimP1.NextToken;

nErrors Ź 0; complete Ź TRUE;

i Ź top Ź valid Ź 0; qI Ź 0;

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

inputSymbol Ź initialSymbol; inputValue Ź MimP1.nullValue; inputLoc Ź 0;

UNTIL currentState = finalState AND (prefixOk OR (inputSymbol = endMarker)) DO

{

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;

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

};

ENDLOOP;

MimP1.ProcessQueue[qI, top];

nErrors Ź nErrors + ([nTokens: nTokens] Ź MimP1.ScanStats[]).nErrors;

};

ParseReset[];

};

ExpandStack: PROC [delta: NAT] = {

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

newSize: NAT = oldSize + delta;

newS: MimP1.StateStack = MimZones.tempZone.NEW[MimP1.StateSeq[newSize]];

newL: MimP1.LinkStack = MimZones.tempZone.NEW[MimP1.LinkSeq[newSize]];

newV: MimP1.ValueStack = MimZones.tempZone.NEW[MimP1.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;

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

};

EraseStack: PROC = {

MimZones.tempZone.FREE[@v];

MimZones.tempZone.FREE[@l];

MimZones.tempZone.FREE[@s];

};

ExpandQueue: PROC [delta: NAT] = {

oldSize: NAT = (IF q = NIL THEN 0 ELSE q.length);

newSize: NAT = oldSize + delta;

newQ: REF MimP1.ActionSeq = MimZones.tempZone.NEW[MimP1.ActionSeq[newSize]];

FOR i: NAT IN [0..oldSize) DO newQ[i] Ź q[i] ENDLOOP;

q Ź newQ;

MimP1.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

track: BOOL = FALSE;

DisplayNode: PROC [n: NodeIndex] = {

IF track THEN {

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

errorStream.PutChar['\t]; errorStream.Put1[[integer[n]]];

errorStream.PutChar['\t]; errorStream.Put1[[integer[tree[n].father]]];

errorStream.PutChar['\t]; errorStream.Put1[[integer[tree[n].last]]];

errorStream.PutChar['\t]; errorStream.Put1[[integer[tree[n].state]]];

errorStream.PutChar['\t]; TypeSym[tree[n].symbol];

errorStream.PutChar['\n];

};

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 Ź NIL;

nextNode: NodeIndex Ź 0;

maxNode: NodeIndex Ź 0;

treeLimit: NodeIndex Ź 0;

TreeFull: ERROR = CODE;

Allocate: PROC [parent, pred: NodeIndex, terminal: TSymbol, stateNo: State]
RETURNS [index: NodeIndex] = {

IF nextNode >= treeLimit THEN ERROR TreeFull[];

index Ź nextNode;

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 Ź NIL;

HashValue: PROC [s: 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: State Ź stack.extension;

s2: State Ź tree[i].state;

n1: NodeIndex Ź stack.leaf;

n2: NodeIndex Ź tree[i].father;

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

};

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 Ź 0,

extension: ExtState Ź ExtState.FIRST

];

GetNTEntry: PROC [state: State, lhs: NTSymbol] RETURNS [ActionEntry] = INLINE {

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

};

text buffer management

Insert: TYPE = ARRAY [0 .. 1+insertLimit) OF MimP1.Token;

newText: REF Insert Ź NIL;

insertCount: NAT Ź 0;

Buffer: TYPE = ARRAY [0 .. 1+discardLimit+(maxScanLimit+insertLimit)) OF MimP1.Token;

scanBuffer: REF Buffer Ź NIL;

scanBase: NAT Ź 0;

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: MimP1.Token] = {

IF insertCount <= insertLimit

THEN {

token Ź newText[insertCount];

IF (insertCount Ź insertCount+1) > insertLimit THEN

MimZones.tempZone.FREE[@newText];

}

ELSE {

token Ź scanBuffer[scanBase];

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

MimZones.tempZone.FREE[@scanBuffer];

Input Ź MimP1.NextToken;

};

acceptance checking

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

};

strategy management

RowRecord: TYPE = RECORD [

index, limit: NAT Ź 0,

stack: StackRep Ź [],

next: RowHandle Ź NIL] Ź [];

RowHandle: TYPE = REF RowRecord;

NextRow: PROC [list: RowHandle] RETURNS [row: RowHandle] = INLINE {

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;

};

FreeRowList: PROC [list: RowHandle] RETURNS [row: RowHandle] = {

r: RowHandle Ź NIL;

UNTIL r = NIL DO

next: RowHandle = r.next;

MimZones.tempZone.FREE[@r];

r Ź next;

ENDLOOP;

RETURN [NIL];

};

Position: TYPE = {after, before};

Length: TYPE = NAT [0..insertLimit];

levelStart: ARRAY Position OF ARRAY Length OF NodeIndex Ź ALL[ALL[0]];

levelEnd: ARRAY Position OF ARRAY Length OF NodeIndex Ź ALL[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];

};

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

rowList: RowHandle Ź NIL;

IF track THEN {

errorStream.Put[[rope["::generating length: "]], [integer[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 Ź NIL;

tI: TIndex = tStart[state];

tLimit: NAT = tI + tLength[state];

r Ź MimZones.tempZone.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];

};

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

IF track THEN {

errorStream.Put[[rope["::checking length: "]], [integer[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: 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] Ź MimP1.Token[s, MimP1.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 MimZones.tempZone.FREE[@newText];

IF scanBase + best.nAccepted < scanLimit

THEN

success Ź MimP1.ResetScanIndex[scanBuffer[scanBase+best.nAccepted].index]

ELSE

success Ź TRUE;

scanLimit Ź scanBase + best.nAccepted;

Input Ź RecoverInput;

};

TypeSym: PROC [sym: TSymbol] = {

errorStream.PutChar[' ];

IF sym IN [1..endMarker)

THEN {

IF vocabIndex = NIL THEN vocabIndex Ź InitIndexTable[];

IF vocabBody = NIL THEN vocabBody Ź InitVocabulary[];

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

errorStream.PutChar[vocabBody[i]];

ENDLOOP;

}

ELSE errorStream.Put1[[integer[sym]]];

};

stack node indices

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] Ź MimP1.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;

};

ENDLOOP;

};

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

Inner: PROC [log: IO.STREAM] = {

errorStream Ź log;

IF abort

THEN {

MimP1.ErrorContext[errorStream, "syntax error", inputLoc];

errorStream.PutRope["... parse abandoned.\n"];

success Ź FALSE;

}

ELSE {

scanBuffer Ź MimZones.tempZone.NEW[Buffer];

newText Ź MimZones.tempZone.NEW[Insert];

tree Ź MimZones.tempZone.NEW[TreeSpace];

hashTable Ź MimZones.tempZone.NEW[HashSpace];

Recover[ ! TreeFull => {CONTINUE}];

MimZones.tempZone.FREE[@hashTable];

MimP1.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."];

MimZones.tempZone.FREE[@newText];

MimZones.tempZone.FREE[@scanBuffer];

};

MimZones.tempZone.FREE[@tree];

errorStream.PutChar['\n];

};

errorStream.PutChar['\n];

errorStream Ź NIL;

};

logger[Inner];

};

ParseReset: PROC = {

This proc is called to free all of the temporary storage. This is called at initialization time (to ensure a clean world), at exit time (unless we blow it), and whenever the tempZone is about to be reclaimed (just in case).

MimZones.tempZone.FREE[@q];

EraseStack[];

MimZones.tempZone.FREE[@scanBuffer];

MimZones.tempZone.FREE[@newText];

MimZones.tempZone.FREE[@hashTable];

MimZones.tempZone.FREE[@tree];

MimP1.ScanReset[];

};

ParseInit: PROC [source: IO.STREAM, logger: PROC [PROC [log: IO.STREAM]]] = {

ParseReset[];

ExpandStack[500];

ExpandQueue[250];

MimP1.ScanInit[source, logger];

};

MimZones.RegisterForReset[ParseReset];