-- PPParser.Mesa
-- derived from Compiler>Parser.Mesa
-- Satterthwaite, January 12, 1981  12:58 PM
-- Russ Atkinson, November 12, 1982 2:44 pm

DIRECTORY
  PPUtil USING
    [AcquireTable, ReleaseTable,
     ShowChar, ShowDecimal, ShowRope],
  PPP1 USING [
    Token, Value, ValueSeq, ValueStack, NullValue,
    AssignDescriptors, Atom, ErrorContext, ProcessQueue, ResetScanIndex,
    ScanInit, ScanReset, TokenValue],
  PPParseTable USING [
    ActionEntry, ActionTag, Handle, NTIndex, NTState, NTSymbol,
    ProdDataHandle, State, TIndex, TSymbol,
    DefaultMarker, EndMarker, InitialState, FinalState, InitialSymbol],
  Rope USING [ROPE],
  UnsafeStorage USING [NewUObject, NewUZone];

PPParser: PROGRAM
    IMPORTS PPUtil, P1: PPP1, UnsafeStorage
    EXPORTS PPP1 =
  BEGIN OPEN PPParseTable, PPUtil, Rope;

  uz: UNCOUNTED ZONE _ UnsafeStorage.NewUZone[1000];
  Node: PROC [n: NAT] RETURNS [lp: LONG POINTER] = {
    lp _ UnsafeStorage.NewUObject[n, uz]};
  Free: PROC [lp: LONG POINTER] = {
    uz.FREE[@lp]};

  ErrorLimit: CARDINAL = 10;

  Scan: ActionTag = [FALSE, 0];

  inputSymbol: TSymbol;

  input: PROC RETURNS [token: P1.Token];
  inputLoc: INT;
  inputValue: P1.Value;

  lastToken: P1.Token;
  NullSymbol: TSymbol = 0;
  
  firstInit: BOOL _ TRUE;

  s: LONG DESCRIPTOR FOR ARRAY OF State _ NIL;
  l: LONG DESCRIPTOR FOR ARRAY OF INT _ NIL;
  v: P1.ValueStack _ NIL;
  top: CARDINAL _ 0;

  q: LONG DESCRIPTOR FOR ARRAY OF ActionEntry _ NIL;
  qI: CARDINAL;

  tablePtr: Handle;

  -- transition tables for terminal input symbols

  tStart: LONG POINTER TO ARRAY State OF TIndex _ NIL;
  tLength: LONG POINTER TO ARRAY State OF CARDINAL _ NIL;
  tSymbol: LONG POINTER TO ARRAY TIndex OF TSymbol _ NIL;
  tAction: LONG POINTER TO ARRAY TIndex OF ActionEntry _ NIL;

  -- transition tables for nonterminal input symbols

  nStart: LONG POINTER TO ARRAY NTState OF NTIndex _ NIL;
  nLength: LONG POINTER TO ARRAY NTState OF CARDINAL _ NIL;
  nSymbol: LONG POINTER TO ARRAY NTIndex OF NTSymbol _ NIL;
  nAction: LONG POINTER TO ARRAY NTIndex OF ActionEntry _ NIL;
  ntDefaults: LONG POINTER TO ARRAY NTSymbol OF ActionEntry _ NIL;

  -- production information

  prodData: ProdDataHandle _ NIL;

-- initialization/termination

  ParseInit: PROC = {
    tablePtr _ PPUtil.AcquireTable[parse];
    P1.ScanInit[tablePtr];
    tStart _ @tablePtr.parseTable.tStart;
    tLength _ @tablePtr.parseTable.tLength;
    tSymbol _ @tablePtr.parseTable.tSymbol;
    tAction _ @tablePtr.parseTable.tAction;
    nStart _ @tablePtr.parseTable.nStart;
    nLength _ @tablePtr.parseTable.nLength;
    nSymbol _ @tablePtr.parseTable.nSymbol;
    nAction _ @tablePtr.parseTable.nAction;
    ntDefaults _ @tablePtr.parseTable.ntDefaults;
    prodData _ @tablePtr.parseTable.prodData;
    IF firstInit THEN 
       {ExpandStack[64];
        ExpandQueue[64];
        firstInit _ FALSE};
    };

  ParseReset: PROC = {
    PPUtil.ReleaseTable[parse]};


  InputLoc: PUBLIC SAFE PROC RETURNS [INT] = TRUSTED {RETURN [inputLoc]};


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

  Parse: PUBLIC SAFE PROC
    RETURNS [complete: BOOLEAN, nTokens, nErrors: CARDINAL] = TRUSTED {
    currentState: State;
    i, valid, m: CARDINAL;                -- stack pointers
    action: ActionEntry;

    ParseInit[];  input _ P1.Atom;
    nErrors _ 0;  complete _ TRUE;
    i _ top _ valid _ 0;  qI _ 0;
    s[0] _ currentState _ InitialState;  lastToken.class _ NullSymbol;
    inputSymbol _ InitialSymbol;  inputValue _ P1.NullValue;  inputLoc _ 0;

    WHILE currentState # FinalState DO
      BEGIN
      tI: TIndex _ tStart[currentState];
      FOR tI IN [tI .. tI + tLength[currentState]) 
        DO
        SELECT tSymbol[tI] FROM  inputSymbol, DefaultMarker => EXIT  ENDCASE;
        REPEAT
          FINISHED => GO TO SyntaxError;
        ENDLOOP;

      action _ tAction[tI]; 
      IF ~action.tag.reduce        -- 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[64];
          lastToken.class _ inputSymbol; v[i] _ inputValue; l[i] _ inputLoc;
          [[inputSymbol, inputValue, inputLoc]]  _ input[]};

      WHILE action.tag # Scan 
        DO
        IF qI >= LENGTH[q] THEN ExpandQueue[64];
        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[64];
      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];
    {n: CARDINAL;  [nTokens, n] _ P1.ScanReset[];  nErrors _ nErrors + n};
    ParseReset[];
    RETURN};


  ExpandStack: PROC [delta: CARDINAL] = {
    newS: LONG DESCRIPTOR FOR ARRAY OF State;
    newL: LONG DESCRIPTOR FOR ARRAY OF INT;
    newV: P1.ValueStack _ NIL;
    newSize: CARDINAL = LENGTH[s] + delta;
    newS _ DESCRIPTOR[Node[newSize*SIZE[P1.Value]], newSize];
    newL _ DESCRIPTOR[Node[newSize*SIZE[INT]], newSize];
    newV _ IF v # NIL AND v.length >= newSize
              THEN v
              ELSE NEW[P1.ValueSeq[newSize]];
    FOR i: CARDINAL IN [0..LENGTH[s])
      DO  newS[i] _ s[i];  newL[i] _ l[i];  newV[i] _ v[i]  ENDLOOP;
    IF LENGTH[s] > 0 THEN {Free[BASE[l]]; Free[BASE[s]]};
    s _ newS;  l _ newL;  v _ newV;
    P1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData]};

  ExpandQueue: PROC [delta: CARDINAL] = {
    newQ: LONG DESCRIPTOR FOR ARRAY OF ActionEntry;
    newSize: CARDINAL = LENGTH[q] + delta;
    newQ _ DESCRIPTOR[Node[newSize*SIZE[ActionEntry]], newSize];
    FOR i: CARDINAL IN [0..LENGTH[q])  DO  newQ[i] _ q[i]  ENDLOOP;
    IF LENGTH[q] > 0 THEN Free[BASE[q]];
    q _ newQ;
    P1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData]};

-- * * * * 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 SAFE PROC RETURNS [ROPE] = TRUSTED {RETURN ["Flako!"]};

 -- 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: LONG 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 = 64;        -- should depend on state count ?
  hashTable: LONG 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: LONG POINTER TO Insert;
  insertCount: CARDINAL;

  Buffer: TYPE =
   ARRAY [0 .. 1 + DiscardLimit + (MaxScanLimit+InsertLimit)) OF P1.Token;
  sourceText: LONG POINTER TO Buffer;
  scanBase, scanLimit: CARDINAL;


  Advance: PROC = {sourceText[scanLimit] _ input[]; scanLimit _ scanLimit+1};

  Discard: PROC = {scanBase _ scanBase+1};

  UnDiscard: PROC = {scanBase _ scanBase-1};

  RecoverInput: PROC RETURNS [token: P1.Token] = {
    IF insertCount <= InsertLimit 
      THEN {
        token _ newText[insertCount];
        IF (insertCount _ insertCount+1) > InsertLimit
           THEN uz.FREE[@newText]}
      ELSE {
        token _ sourceText[scanBase];
        IF (scanBase _ scanBase+1) = scanLimit
          THEN {uz.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 = LONG 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;  uz.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];
        stop _ RightScan[newLeaf]};
    RETURN};


  GrowTree: PROC [p: Position, n: Length] RETURNS [stop: BOOLEAN] = {
    tI, tLimit: TIndex;
    stack: StackRep;
    state: State;
    rowList, r: RowHandle;
    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];
            r _ uz.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};
      REPEAT
        found => stop _ TRUE;
        FINISHED =>  stop _ FALSE;
      ENDLOOP;
    FreeRowList[rowList];  rowList _ NIL;  RETURN};

  CheckTree: PROC [p: Position, n: Length] RETURNS [stop: BOOLEAN] = {
    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: BOOLEAN] = {
    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 {
        ShowRope["Text deleted is: "];
        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[];
        ShowRope["Text inserted is: "];
        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 uz.FREE[@newText];
    IF scanBase + best.nAccepted < scanLimit
      THEN success _ P1.ResetScanIndex[sourceText[scanBase+best.nAccepted].index]
      ELSE success _ TRUE;
    scanLimit _ scanBase + best.nAccepted;
    input _ RecoverInput};

  TypeSym: PROC [sym: TSymbol] = {
    OPEN tablePtr.scanTable;
    vocab: LONG STRING = LOOPHOLE[@vocabBody];
    ShowChar[' ];
    IF sym NOT IN [1..EndMarker)
      THEN ShowDecimal[sym]
      ELSE
        FOR i: CARDINAL IN [vocabIndex[sym-1]..vocabIndex[sym])
          DO ShowChar[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]] 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;

    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", inputLoc];
        ShowRope["... Parse abandoned."];  NewLine[];
        success _ FALSE}
      ELSE {
        sourceText _ uz.NEW[Buffer];
        newText _ uz.NEW[Insert];
        tree _ Node[TreeSize*SIZE[StackNode]];
        hashTable _ Node[HashSize*SIZE[NodeIndex]];
        Recover[ ! TreeFull => CONTINUE];
        uz.FREE[@hashTable];
        P1.ErrorContext["Syntax Error",
          sourceText[IF best.mode=BTree THEN 0 ELSE 1].index];
        IF ~(success _ best.nAccepted >= MinScanLimit) OR ~Accept[]
          THEN {
            ShowRope["No recovery found."];
            uz.FREE[@newText];  uz.FREE[@sourceText]};
        uz.FREE[@tree];
        NewLine[]};
    NewLine[];
    RETURN};

  NewLine: PROC = {ShowChar[15C]};

END.

Κ~–
"Mesa" style˜IprocšœΟc
œ
Οk	œ
žœPžœ΄
žœΎ
žœžœžœ$žœžœ%žœ
žœ
žœ$ž	œ
žœ#Οnœžœžœžœžœ
žœ3Ÿœžœžœ
žœ
žœžœžœ)žœ
žœ žœ]žœžœžœ
ž
œ
žœ
žœ
žœ	žœžœ
ž
œ
žœ
žœ
žœ
žœžœžœ	žœžœ
ž
œ
žœ
žœ
žœžœžœ0œžœ
žœ
žœ
žœžœ
žœ
žœ
žœ
žœ
žœžœ
žœžœ
žœ
žœ
žœ
žœžœžœ
žœ
žœ
žœ
žœžœžœ3œžœ
žœ
žœ
žœ	žœžœ
žœ
žœ
žœ
žœ	žœ
žœžœ
žœ
žœ
žœ
žœ	žœžœ
žœ
žœ
žœ
žœ	žœžœžœ
žœ
žœ
žœ
žœžœœžœœŸ	œžœ‹žœžœHžœ
Ÿ
œžœ*Ÿœžœ
žœ
žœ
žœžœžœžœ.œŸœžœ
žœ
žœžœžœžœžœ-žœœZžœΌ
žœžœžœ0žœžœ-žœ	žœ
žœ žœžœ
žœžœžœ
žœžœ&žœœžœ
žœžœžœžœ
žœžœžœ>žœžœžœ£
žœžœ	žœžœžœsžœžœžœžœFžœžœžœCžœžœ0žœžœžœžœ
žœžœ1žœžœžœžœžœžœžœGžœάžœžœ
žœ	žœžœ)žœQžœŸœžœ	žœžœ
ž
œ
žœ
žœ
žœžœ
ž
œ
žœ
žœ
žœ
žœžœžœžœž
œžœ"ž
œžœ
žœžœžœ
žœ#žœžœ
žœžœžœ
žœžœžœ4žœžœ
žœžœžœžœhŸœžœ	žœžœ
ž
œ
žœ
žœ
žœžœžœž
œžœžœžœ
žœžœžœžœžœ
žœžœžœO,œ œžœžœžœžœžœžœ!
œŸœžœ
žœ
žœ
žœžœžœžœœžœžœ:žœžœhžœ!žœ
žœ
žœ
žœžœFžœžœžœŸœžœDžœžœ!žœ
žœžœœ
žœ	žœ8žœžœ"œ
žœ
žœ
žœ
žœžœžœ:Ÿœžœ?žœOŸœžœžœežœžœžœžœžœžœžœ,žœžœ&žœžœžœžœžœžœžœzžœ
žœ	žœ
žœžœ	žœ
žœ‚
žœ	žœžœŸœžœ+žœažœžœ?žœžœ*žœ>žœžœžœžœœ
žœžœžœ$žœžœžœ5Ÿ
œžœžœžœ
žœžœ0žœžœ#žœžœžœ
žœžœžœŸ
œžœ@žœLžœ*žœ#žœ/žœ<žœžœžœœžœlžœ$žœ;žœŒ
žœžœžœ„
žœŸ	œžœ#žœ*žœ%žœ žœžœžœžœžœ`žœžœ(žœ	žœ
žœžœžœ
žœžœžœ#žœ$žœžœžœ	œžœhžœžœœžœžœžœžœ
žœ
žœžœ
žœžœ6žœžœ
žœ
žœ žœŸœžœBŸœžœŸ	œžœŸœžœ
žœžœ#žœ1žœ8žœžœžœ1žœ/žœžœ&žœœ	žœžœRžœŸ	œžœžœžœgžœzžœ;žœžœ
žœ žœžœžœžœ/žœ žœžœ>žœžœ
žœCžœ=žœžœžœ9žœHžœ5žœ5žœžœ"œžœžœžœ;žœžœ
žœ
žœŸœžœžœ0žœžœžœžœžœžœžœ6žœžœ
žœžœžœžœŸœžœ3žœžœžœ
žœžœžœžœžœžœ,žœ
žœ
žœžœŸœžœ8žœžœSžœžœ0žœ"žœ	žœZžœžœ*žœ+žœžœžœEžœŸœžœžœžœnžœžœžœ1žœžœžœžœ
žœžœ.žœWžœSžœhžœ
žœ#žœ
žœ“
žœžœžœžœ
žœ'žœ
žœ
žœ7žœ	žœžœ
žœžœžœ'žœžœŸ	œžœžœžœ
žœžœ,žœžœ
žœžœžœ
žœ
žœžœžœ
žœžœžœžœŸœžœ
žœžœ'žœ6žœ(žœžœžœ"žœ{žœ"žœžœ2žœžœ
žœ!žœTžœžœ#žœžœžœ<žœžœ
žœ(žœžœžœžœJžœžœžœžœ-žœNžœžœKŸœžœžœ žœ
žœžœ$žœžœ
žœžœžœ	žœžœ
žœ0žœžœœŸœžœžœ
žœlžœ‚žœžœžœžœžœ
žœžœ&žœqžœ’žœHžœžœžœ
žœžœžœ
žœ-žœžœ(œ5žœ$žœžœ
žœ
žœ;1œžœžœžœžœ
žœ
žœžœžœžœžœ
žœ
žœžœ
žœžœ
žœ
žœžœ
œžœžœ
žœ
žœžœžœžœžœ
žœžœ,žœžœ
žœžœžœ%žœ
žœžœ
žœ
žœ+žœ
žœ
žœžœžœžœžœ=žœžœžœžœ
žœ
žœžœžœžœžœ1žœžœ
žœžœžœžœžœ1žœ4žœ	žœŸœžœ	žœžœžœ
žœ
žœ~žœžœžœžœ'žœ0žœ-žœžœKžœžœžœžœ-žœžœ>žœžœžœ0žœŸœžœžœ˜χ°
—…—Xzdώ