
    <<ProtoParser.mesa - Cedar/Mesa parser with error recovery>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, May 27, 1986 9:53:25 am PDT>>
        <<Paul Rovner, September 7, 1983 3:20 pm>>
        <<Russ Atkinson (RRA) March 6, 1985 10:35:18 pm PST>>

    DIRECTORY
        IO: TYPE USING [char, int, Put, PutChar, PutRope, rope, STREAM],
        P1: TYPE USING [
            ActionSeq, AssignDescriptors, ErrorContext, Index, InstallScanTable,
            LinkSeq,  LinkStack, NextToken, nullValue, ProcessQueue, ResetScanIndex,
            ScanInit, ScanReset, ScanStats, StateSeq, StateStack,
            Token, TokenValue, Value, ValueSeq, ValueStack],
        ParseTable: TYPE USING [
            ActionEntry, ActionTag, defaultMarker, endMarker, finalState, initialState,
            initialSymbol, NActionsRef, NLengthsRef, NStartsRef, NSymbolsRef, NTDefaultsRef,
            NTIndex, NTState, NTSymbol, ProdDataRef, State, TableRef, TActionsRef, TIndex,
            TLengthsRef, TStartsRef, TSymbol, TSymbolsRef];

    ParserImpl: PROGRAM
          IMPORTS IO, P1 
          EXPORTS P1 = {
        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: P1.Index;
        inputValue: P1.Value;

        lastToken: P1.Token;
        nullSymbol: TSymbol = 0;

        s: P1.StateStack;
        l: P1.LinkStack;
        v: REF  P1.ValueSeq;
        top: CARDINAL;

        q: REF P1.ActionSeq;
        qI: CARDINAL;


    <<initialization/termination>>

        InputLoc: PUBLIC PROC RETURNS[P1.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: PROC = INLINE {
                P1.ScanInit[source, logger];
                s _ NIL;  q _ NIL;  ExpandStack[500];  q _ NIL;  ExpandQueue[250];
                scanBuffer _ NIL};

            ParseReset: PROC = INLINE {
                EraseQueue[];  EraseStack[];
                IF scanBuffer  # NIL THEN FREE[@scanBuffer];
                P1.ScanReset[]};

            ParseInit[];

            BEGIN    -- ENABLE scope
            ENABLE UNWIND => {ParseReset[]};
            Input _ P1.NextToken;
            nErrors _ 0;  complete _ TRUE;
            i _ top _ valid _ 0;  qI _ 0;
            s[0] _ currentState _ initialState;  lastToken.class _ nullSymbol;
            inputSymbol _ initialSymbol;  inputValue _ P1.nullValue;  inputLoc _ 0;

            UNTIL currentState = finalState AND (prefixOk OR (inputSymbol = endMarker)) 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.ScanStats[]).nErrors;
            END;    -- of ENABLE scope

            ParseReset[];
            RETURN};


        ExpandStack: PROC[delta: NAT] = {
            oldSize: NAT = (IF s = NIL THEN 0 ELSE s.length);
            newSize: NAT = oldSize + delta;
            newS: P1.StateStack = NEW[P1.StateSeq[newSize]];
            newL: P1.LinkStack = NEW[P1.LinkSeq[newSize]];
            newV: P1.ValueStack = 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]};

        EraseStack: PROC = {
            IF s # NIL THEN {FREE[@v];  FREE[@l];  FREE[@s]}};

        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;
            q _ newQ;
            P1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData]};

        EraseQueue: PROC = {IF q # NIL THEN FREE[@q]};


    -- * * * * 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.Put[IO.char['\t], IO.int[n]];
                    errorStream.Put[IO.char['\t], IO.int[tree[n].father]]; 
                    errorStream.Put[IO.char['\t], IO.int[tree[n].last]];
                    errorStream.Put[IO.char['\t], IO.int[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;
            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] = 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 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 {
                    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: P1.Token] = {
                IF insertCount <= insertLimit THEN {
                    token _ newText[insertCount];
                    IF (insertCount _ insertCount+1) > insertLimit THEN FREE[@newText]}
                ELSE {
                    token _ scanBuffer[scanBase];
                    IF (scanBase _ scanBase+1) = scanLimit THEN {
                        FREE[@scanBuffer]; Input _ P1.NextToken}};
                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] = INLINE {
                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[row: RowHandle] = {
                r: RowHandle _ NIL;
                UNTIL  r = NIL DO
                    next: RowHandle = r.next;
                    FREE[@r];  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];
                    IF track THEN DisplayNode[newLeaf];
                    stop _ RightScan[newLeaf]};
                RETURN};


            GrowTree: PROC[p: Position, n: Length] RETURNS[stop: BOOL] = {
                rowList: RowHandle _ NIL;
                IF track THEN {
                    errorStream.Put[IO.rope["::generating length: "], IO.int[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;
                        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 _ FreeRowList[rowList]};
                    REPEAT
                        found => stop _ TRUE;
                        FINISHED => stop _ FALSE;
                    ENDLOOP;
                rowList _ FreeRowList[rowList];  RETURN};

            CheckTree: PROC[p: Position, n: Length] RETURNS[stop: BOOL] = {
                IF track THEN {
                    errorStream.Put[IO.rope["::checking length: "], IO.int[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;
                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 {
                    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 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]];
                errorStream.PutChar[' ];
                IF sym IN [1..endMarker) THEN
                    FOR i: NAT IN [tablePtr[t.vocabIndex][sym-1]..tablePtr[t.vocabIndex][sym]) DO
                        errorStream.PutChar[vocab[i]] ENDLOOP
                ELSE errorStream.Put[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;
                                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] = {

            Inner: PROC[log: IO.STREAM] = {
                errorStream _ log;
                IF abort THEN {
                    P1.ErrorContext[errorStream, "syntax error", inputLoc];
                    errorStream.PutRope["... parse abandoned."];  errorStream.PutChar['\n];
                    success _ FALSE}
                ELSE {
                    scanBuffer _ NEW[Buffer];
                    newText _ NEW[Insert];
                    tree _ NEW[TreeSpace];
                    hashTable _ NEW[HashSpace];
                    Recover[ ! TreeFull => {CONTINUE}];
                    FREE[@hashTable];
                    P1.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."];
                        FREE[@newText];  FREE[@scanBuffer]};
                    FREE[@tree];
                    errorStream.PutChar['\n]};
                errorStream.PutChar['\n];  errorStream _ NIL;
                RETURN};

            logger[Inner];
            RETURN};

        }.

