<<>> <> <> <> <> 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; <> <> vocabIndex: IndexTableRef ¬ NIL; vocabBody: VocabularyRef ¬ NIL; <> tStart: TStartsRef ¬ NIL; tLength: TLengthsRef ¬ NIL; tSymbol: TSymbolsRef ¬ NIL; tAction: TActionsRef ¬ NIL; <> nStart: NStartsRef ¬ NIL; nLength: NLengthsRef ¬ NIL; nSymbol: NSymbolsRef ¬ NIL; nAction: NActionsRef ¬ NIL; ntDefaults: NTDefaultsRef ¬ NIL; <> 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[]; }; }; <> 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; <> 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 * * * *>> <> errorStream: IO.STREAM ¬ NIL; minScanLimit: NAT = 4; maxScanLimit: NAT = 12; insertLimit: NAT = 2; discardLimit: NAT = 10; treeSize: NAT = 250; checkSize: NAT = maxScanLimit+insertLimit+2; <> 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]; }; }; <> 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; 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}; }; 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 ¬ 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 { <> 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 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; }; }; }; <> 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 ¬ 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; DO 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]]]; }; <> 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[]; <> 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 { 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 = { <> 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]; }.