-- file PackParser.mesa
-- last modified by Satterthwaite, July 28, 1980 12:18 PM
-- last modified by Schmidt, September 23, 1980 8:31 PM
-- last modified by Lewis on 2-Apr-81 17:52:01
-- last modified by Levin and Satterthwaite on July 6, 1982 4:31 pm
DIRECTORY
CharIO: TYPE USING [CR, TAB, PutChar, PutDecimal, PutString],
P1: FROM "PackParseDefs" USING [
Token,
AssignDescriptors, Atom, ErrorContext, ProcessQueue, ResetScanIndex,
ScanInit, ScanReset, TokenValue],
ParseTable USING [
ActionEntry, ActionTag, DefaultMarker, EndMarker, FinalState,
InitialState, InitialSymbol, NTIndex, NTState, NTSymbol,
Production, ProductionInfo, State, TableRef, TIndex, TSymbol],
Storage: TYPE USING [Free, FreeWords, Node, Words],
Streams: TYPE USING [Handle];
Parser: PROGRAM
IMPORTS CharIO, Storage, P1
EXPORTS P1 =
BEGIN -- Mesa parser with error recovery
OPEN ParseTable;
ErrorLimit: CARDINAL = 25;
Scan: ActionTag = [FALSE, 0];
inputSymbol: TSymbol;
input: PROC RETURNS [token: P1.Token];
inputLoc: CARDINAL;
inputValue: UNSPECIFIED;
lastToken: P1.Token;
NullSymbol: TSymbol = 0;
errorStream: Streams.Handle;
s: DESCRIPTOR FOR ARRAY OF State;
l: DESCRIPTOR FOR ARRAY OF CARDINAL;
v: DESCRIPTOR FOR ARRAY OF UNSPECIFIED;
top: CARDINAL;
q: DESCRIPTOR FOR ARRAY OF ActionEntry;
qI: CARDINAL;
lalrTable: ParseTable.TableRef;
-- transition tables for terminal input symbols
tStart: LONG POINTER TO ARRAY State OF TIndex;
tLength: LONG POINTER TO ARRAY State OF CARDINAL;
tSymbol: LONG POINTER TO ARRAY TIndex OF TSymbol;
tAction: LONG POINTER TO ARRAY TIndex OF ActionEntry;
-- transition tables for nonterminal input symbols
nStart: LONG POINTER TO ARRAY NTState OF NTIndex;
nLength: LONG POINTER TO ARRAY NTState OF CARDINAL;
nSymbol: LONG POINTER TO ARRAY NTIndex OF NTSymbol;
nAction: LONG POINTER TO ARRAY NTIndex OF ActionEntry;
ntDefaults: LONG POINTER TO ARRAY NTSymbol OF ActionEntry;
-- production information
prodData: LONG POINTER TO ARRAY Production OF ProductionInfo;
-- initialization/termination
ParseInit: PROC [
sourceStream: Streams.Handle,
messageStream: Streams.Handle,
tablePtr: ParseTable.TableRef] = {
errorStream ← messageStream; lalrTable ← tablePtr; -- for error reporting
P1.ScanInit[sourceStream, messageStream, tablePtr];
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];
s ← NIL; q ← NIL; ExpandStack[512]; ExpandQueue[256]};
InputLoc: PUBLIC PROC RETURNS [CARDINAL] = {RETURN [inputLoc]};
-- * * * * Main Parsing Procedures * * * * --
Parse: PUBLIC PROC [
sourceStream: Streams.Handle,
messageStream: Streams.Handle,
table: ParseTable.TableRef]
RETURNS [complete: BOOLEAN, nTokens, nErrors: CARDINAL] = {
currentState: State;
i, valid, m: CARDINAL; -- stack pointers
action: ActionEntry;
ParseInit[sourceStream, messageStream, table]; input ← P1.Atom;
nErrors ← 0; complete ← TRUE;
i ← top ← valid ← 0; qI ← 0;
s[0] ← currentState ← InitialState; lastToken.class ← NullSymbol;
inputSymbol ← InitialSymbol; inputValue ← 0; 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 -- scan or scan reduce entry
THEN {
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) >= LENGTH[s] THEN ExpandStack[256];
lastToken.class ← inputSymbol; v[i] ← inputValue; l[i] ← inputLoc;
[[inputSymbol, inputValue, inputLoc]] ← input[]};
WHILE action.tag # Scan
DO
IF qI >= LENGTH[q] 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 <= LAST[NTState]
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)) >= LENGTH[s] THEN ExpandStack[256];
s[m] ← currentState ← action.transition;
EXITS
SyntaxError => {
lastToken.value ← v[top]; 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];
EraseQueue[]; EraseStack[];
{n: CARDINAL; [nTokens, n] ← P1.ScanReset[]; nErrors ← nErrors + n};
RETURN};
ExpandStack: PROC [delta: CARDINAL] = {
newS: DESCRIPTOR FOR ARRAY OF State;
newL: DESCRIPTOR FOR ARRAY OF CARDINAL;
newV: DESCRIPTOR FOR ARRAY OF UNSPECIFIED;
newSize: CARDINAL = LENGTH[s] + delta;
newS ← DESCRIPTOR[Storage.Words[newSize*SIZE[State]], newSize];
newL ← DESCRIPTOR[Storage.Words[newSize*SIZE[CARDINAL]], newSize];
newV ← DESCRIPTOR[Storage.Words[newSize*SIZE[UNSPECIFIED]], newSize];
FOR i: CARDINAL IN [0..LENGTH[s])
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 {
Storage.FreeWords[BASE[v]]; Storage.FreeWords[BASE[l]]; Storage.FreeWords[BASE[s]]}};
ExpandQueue: PROC [delta: CARDINAL] = {
newQ: DESCRIPTOR FOR ARRAY OF ActionEntry;
newSize: CARDINAL = LENGTH[q] + delta;
newQ ← DESCRIPTOR[Storage.Words[newSize*SIZE[ActionEntry]], newSize];
FOR i: CARDINAL IN [0..LENGTH[q]) DO newQ[i] ← q[i] ENDLOOP;
EraseQueue[];
q ← newQ;
P1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData]};
EraseQueue: PROC = {IF q # NIL THEN Storage.FreeWords[BASE[q]]};
-- * * * * Error Recovery Section * * * * --
-- parameters of error recovery
MinScanLimit: CARDINAL = 4;
MaxScanLimit: CARDINAL = 12;
InsertLimit: CARDINAL = 2;
DiscardLimit: CARDINAL = 10;
TreeSize: CARDINAL = 256;
CheckSize: CARDINAL = MaxScanLimit+InsertLimit+2;
-- debugging
ParserID: PUBLIC PROC RETURNS [STRING] = {RETURN [NIL]};
track: BOOLEAN = FALSE;
DisplayNode: PROC [n: NodeIndex] = {
IF track
THEN {
OPEN CharIO;
PutString[errorStream, "::new node::"L];
PutChar[errorStream, TAB]; PutDecimal[errorStream, n];
PutChar[errorStream, TAB]; PutDecimal[errorStream, tree[n].father];
PutChar[errorStream, TAB]; PutDecimal[errorStream, tree[n].last];
PutChar[errorStream, TAB]; PutDecimal[errorStream, tree[n].state];
PutChar[errorStream, TAB]; TypeSym[tree[n].symbol]; NewLine[]}};
-- tree management
NodeIndex: TYPE = CARDINAL [0..TreeSize);
NullIndex: NodeIndex = 0;
StackNode: TYPE = RECORD[
father: NodeIndex,
last: NodeIndex,
state: State,
symbol: TSymbol,
aLeaf, bLeaf: BOOLEAN,
link: NodeIndex];
tree: POINTER TO ARRAY [0..TreeSize) OF StackNode;
nextNode: NodeIndex;
maxNode: NodeIndex;
treeLimit: CARDINAL;
TreeFull: SIGNAL = CODE;
Allocate: PROC [parent, pred: NodeIndex, terminal: TSymbol, stateNo: State]
RETURNS [index: NodeIndex] = {
IF (index ← nextNode) >= treeLimit THEN SIGNAL 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: INTEGER = 256; -- should depend on state count ?
hashTable: POINTER TO ARRAY [0..HashSize) OF NodeIndex;
ParsingMode: TYPE = {ATree, BTree, Checking};
parseMode: ParsingMode;
LinkHash: PROC [n: NodeIndex] = {
htIndex: [0..HashSize) = tree[n].state MOD HashSize;
tree[n].link ← hashTable[htIndex]; hashTable[htIndex] ← n};
ExistingConfiguration: PROC [stack: StackRep] RETURNS [NodeIndex] = {
n, n1, n2: NodeIndex;
s1, s2: State;
htIndex: [0..HashSize);
aTree: BOOLEAN;
SELECT parseMode FROM
ATree => aTree ← TRUE;
BTree => aTree ← FALSE;
ENDCASE => RETURN [NullIndex];
htIndex ← stack.extension MOD HashSize;
FOR n ← hashTable[htIndex], tree[n].link UNTIL n = NullIndex
DO
IF (IF aTree THEN tree[n].aLeaf ELSE tree[n].bLeaf)
THEN {
s1 ← stack.extension; s2 ← tree[n].state;
n1 ← stack.leaf; n2 ← tree[n].father;
DO
IF s1 # s2 THEN EXIT;
IF n1 = n2 THEN RETURN [n];
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};
-- parsing simulation
ExtState: TYPE = [FIRST[State] .. LAST[State]+1];
NullState: ExtState = LAST[ExtState];
StackRep: TYPE = RECORD[
leaf: NodeIndex,
extension: ExtState];
GetNTEntry: PROC [state: State, lhs: NTSymbol] RETURNS [ActionEntry] = {
IF state <= LAST[NTState]
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: CARDINAL ← nScanned;
currentState: State;
IF stack.extension = NullState
THEN currentState ← tree[currentNode].state
ELSE {currentState ← stack.extension; count ← count + 1};
UNTIL action.tag = Scan
DO
IF count > action.tag.pLength -- can be one greater
THEN {
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: BOOLEAN ← 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: POINTER TO Insert;
insertCount: CARDINAL;
Buffer: TYPE =
ARRAY [0 .. 1 + DiscardLimit + (MaxScanLimit+InsertLimit)) OF P1.Token;
sourceText: POINTER TO Buffer;
scanBase, scanLimit: CARDINAL;
Advance: PROC = {sourceText[scanLimit] ← input[]; scanLimit ← scanLimit+1};
Discard: PROC = {
IF track
THEN {
CharIO.PutString[errorStream, "::discarding symbol: "L];
TypeSym[sourceText[scanBase].class]; NewLine[]};
scanBase ← scanBase+1};
UnDiscard: PROC = {
scanBase ← scanBase-1;
IF track
THEN {
CharIO.PutString[errorStream, "::recovering symbol: "L];
TypeSym[sourceText[scanBase].class]; NewLine[]}};
RecoverInput: PROC RETURNS [token: P1.Token] = {
IF insertCount <= InsertLimit
THEN {
token ← newText[insertCount];
IF (insertCount ← insertCount+1) > InsertLimit THEN Storage.Free[newText]}
ELSE {
token ← sourceText[scanBase];
IF (scanBase ← scanBase+1) = scanLimit
THEN {Storage.Free[sourceText]; input ← P1.Atom}};
RETURN};
-- acceptance checking
best: RECORD [
nAccepted: CARDINAL,
nPassed: [0..1],
node: NodeIndex,
mode: ParsingMode,
nDiscards: CARDINAL];
RightScan: PROC [node: NodeIndex] RETURNS [stop: BOOLEAN] = {
savedNextNode: NodeIndex = nextNode;
savedMode: ParsingMode = parseMode;
savedLimit: CARDINAL = treeLimit;
stack: StackRep ← [leaf:node, extension:NullState];
state: State ← tree[node].state;
nAccepted: CARDINAL ← 0;
parseMode ← Checking; treeLimit ← TreeSize;
FOR i: CARDINAL IN [scanBase .. scanLimit)
DO
IF state = FinalState
THEN {
nAccepted ← IF (sourceText[i].class = EndMarker)
THEN scanLimit-scanBase
ELSE 0;
EXIT};
stack ← ParseStep[stack, sourceText[i].class];
IF stack.leaf = NullIndex THEN EXIT;
nAccepted ← nAccepted + 1; state ← stack.extension;
ENDLOOP;
nextNode ← 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: CARDINAL,
stack: StackRep,
next: RowHandle];
RowHandle: TYPE = POINTER TO 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] = {
r, next: RowHandle;
FOR r ← list, next UNTIL r = NIL DO next ← r.next; Storage.Free[r] ENDLOOP};
Position: TYPE = {after, before};
Length: TYPE = CARDINAL [0..InsertLimit];
levelStart, levelEnd: ARRAY Position OF ARRAY Length OF NodeIndex;
AddLeaf: PROC [stack: StackRep, s: TSymbol, thread: NodeIndex]
RETURNS [stop: BOOLEAN] = {
saveNextNode: NodeIndex = nextNode;
stack ← ParseStep[stack, s];
IF stack.leaf = NullIndex OR ExistingConfiguration[stack] # NullIndex
THEN {nextNode ← 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: BOOLEAN] = {
tI, tLimit: TIndex;
stack: StackRep;
state: State;
rowList, r: RowHandle;
s: TSymbol;
IF track
THEN {
CharIO.PutString[errorStream, "::generating length: "L];
CharIO.PutDecimal[errorStream, n];
CharIO.PutChar[errorStream, IF p = before THEN 'B ELSE 'A]; NewLine[]};
rowList ← 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 => FreeRowList[rowList];
rowList ← NIL;
stack ← [leaf:i, extension:NullState]; state ← tree[i].state;
DO
tI ← tStart[state]; tLimit ← tI + tLength[state];
s ← tSymbol[tLimit-1];
r ← Storage.Node[SIZE[RowRecord]];
r↑ ← RowRecord[index:tI, limit:tLimit, stack:stack, next:rowList];
rowList ← r;
IF s # 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};
REPEAT
found => stop ← TRUE;
FINISHED => stop ← FALSE;
ENDLOOP;
FreeRowList[rowList]; rowList ← NIL; RETURN};
CheckTree: PROC [p: Position, n: Length] RETURNS [stop: BOOLEAN] = {
IF track
THEN {
CharIO.PutString[errorStream, "::checking length: "L];
CharIO.PutDecimal[errorStream, n];
CharIO.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 = {
s: TSymbol;
discardBase: CARDINAL = 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 {
CharIO.PutString[errorStream, "Text deleted is: "L];
FOR j: CARDINAL IN [1 .. best.nDiscards]
DO
TypeSym[sourceText[scanBase].class]; scanBase ← scanBase + 1;
ENDLOOP};
IF insertCount <= InsertLimit
THEN {
IF scanBase # discardBase THEN NewLine[];
CharIO.PutString[errorStream, "Text inserted is: "L];
FOR j: CARDINAL IN [insertCount .. InsertLimit]
DO TypeSym[newText[j].class] ENDLOOP};
IF discardBase = 1
THEN {insertCount ← insertCount-1; newText[insertCount] ← sourceText[0]};
IF insertCount > InsertLimit THEN Storage.Free[newText];
IF scanBase + best.nAccepted < scanLimit
THEN P1.ResetScanIndex[sourceText[scanBase+best.nAccepted].index];
scanLimit ← scanBase + best.nAccepted;
input ← RecoverInput};
TypeSym: PROC [sym: TSymbol] = {
OPEN CharIO, t: lalrTable.scanTable;
vocab: LONG STRING = LOOPHOLE[@lalrTable[t.vocabBody], LONG STRING];
PutChar[errorStream, ' ];
IF ~(sym IN [1..EndMarker))
THEN PutDecimal[errorStream, sym]
ELSE
FOR i: CARDINAL IN [lalrTable[t.vocabIndex][sym-1]..lalrTable[t.vocabIndex][sym])
DO PutChar[errorStream, vocab[i]] ENDLOOP};
--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;
sourceText[0] ← lastToken;
sourceText[1] ← P1.Token[inputSymbol, inputValue, inputLoc];
scanBase ← 1; scanLimit ← 2;
THROUGH [1 .. MaxScanLimit) DO Advance[] ENDLOOP;
FOR i: CARDINAL 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 .. LAST[Length]]
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: CARDINAL 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: CARDINAL ← (MinScanLimit+MaxScanLimit)/2;
THROUGH [1..LAST[Length]] DO Discard[]; Advance[] ENDLOOP;
UNTIL scanBase > DiscardLimit
DO
IF best.nAccepted >= threshold THEN GO TO found;
Discard[];
FOR inserts: CARDINAL 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: BOOLEAN] RETURNS [success: BOOLEAN] = {
IF abort
THEN {
P1.ErrorContext["Syntax Error"L, inputLoc];
CharIO.PutString[errorStream, "... Parse abandoned."L]; NewLine[];
success ← FALSE}
ELSE {
sourceText ← Storage.Node[SIZE[Buffer]];
newText ← Storage.Node[SIZE[Insert]];
tree ← Storage.Words[TreeSize*SIZE[StackNode]];
hashTable ← Storage.Words[HashSize*SIZE[NodeIndex]];
Recover[ ! TreeFull => CONTINUE];
Storage.FreeWords[hashTable];
P1.ErrorContext["Syntax Error"L,
sourceText[IF best.mode=BTree THEN 0 ELSE 1].index];
IF (success ← best.nAccepted >= MinScanLimit)
THEN Accept[]
ELSE {
CharIO.PutString[errorStream, "No recovery found."L];
Storage.Free[newText]; Storage.Free[sourceText]};
Storage.FreeWords[tree];
NewLine[]};
NewLine[]; RETURN};
NewLine: PROC = {CharIO.PutChar[errorStream, CharIO.CR]};
END.