-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
-- Public License for more details. You should have received a copy of the GNU
-- General Public License distributed with the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

with ErrorHandler;
with ExaminerConstants;
with LexTokenManager;
with SparkLex;
with SP_Expected_Symbols;
with SP_Parser_Actions;
with SP_Parser_Goto;
with SP_Productions;
with SP_Relations;
with SP_Symbols;
with STree;
with SystemErrors;

use type STree.SyntaxNode;
use type SP_Parser_Actions.SP_Parse_Act;
use type SP_Parser_Actions.SP_Action_Kind;
use type SP_Productions.SP_State;
use type SP_Symbols.SP_Symbol;

package body SPParser is

   procedure Put_Symbol (File : in SPARK_IO.File_Type;
                         Item : in SP_Symbols.SP_Symbol)
   --# global in out SPARK_IO.File_Sys;
   --# derives SPARK_IO.File_Sys from *,
   --#                                File,
   --#                                Item;
   is
      --# hide Put_Symbol; -- hidden since uses 'Image
   begin
      if SPARK_IO.Valid_File (File) then
         SPARK_IO.Put_String (File, SP_Symbols.SP_Symbol'Image (Item), 0);
      end if;
   end Put_Symbol;

   procedure SPParse (ProgText     : in     SPARK_IO.File_Type;
                      MaxStackSize :    out Natural;
                      FileEnd      :    out Boolean) is
      --# inherit ErrorHandler,
      --#         ExaminerConstants,
      --#         SP_Productions,
      --#         SP_Symbols,
      --#         STree,
      --#         SystemErrors;
      package SPStackManager
      --# own SPStack    : SPStackStruct;
      --#     SPStackPtr : SPStackPtrVal;
      --# initializes SPStack,
      --#             SPStackPtr;
      is
         subtype SPStackPtrVal is Natural range 0 .. ExaminerConstants.SPStackSize;

         type SPStackEntry is record
            StateNo : SP_Productions.SP_State;
            SPSym   : SP_Symbols.SP_Symbol;
            Node    : STree.SyntaxNode;
         end record;

         SPStackPtr : SPStackPtrVal;

         procedure SPPush (St   : in SP_Productions.SP_State;
                           Sym  : in SP_Symbols.SP_Symbol;
                           Node : in STree.SyntaxNode);
         --# global in out SPStack;
         --#        in out SPStackPtr;
         --# derives SPStack    from *,
         --#                         Node,
         --#                         SPStackPtr,
         --#                         St,
         --#                         Sym &
         --#         SPStackPtr from *;

         procedure SPTop (Top : out SPStackEntry);
         --# global in SPStack;
         --#        in SPStackPtr;
         --# derives Top from SPStack,
         --#                  SPStackPtr;

         procedure SPPop (Top    :    out SPStackEntry;
                          PopOff : in     SP_Productions.SP_Right);
         --# global in     SPStack;
         --#        in out SPStackPtr;
         --# derives SPStackPtr from *,
         --#                         PopOff &
         --#         Top        from PopOff,
         --#                         SPStack,
         --#                         SPStackPtr;

         procedure SPLook (StackEntry :    out SPStackEntry;
                           Pos        : in     SPStackPtrVal);
         --# global in SPStack;
         --#        in SPStackPtr;
         --# derives StackEntry from Pos,
         --#                         SPStack,
         --#                         SPStackPtr;

         procedure SPRemove (NoStates : in SPStackPtrVal);
         --# global in out SPStackPtr;
         --# derives SPStackPtr from *,
         --#                         NoStates;

      end SPStackManager;

      --# inherit ErrorHandler,
      --#         LexTokenManager,
      --#         SPARK_IO,
      --#         SPStackManager,
      --#         SP_Parser_Actions,
      --#         SP_Parser_Goto,
      --#         SP_Productions,
      --#         SP_Symbols,
      --#         STree;
      package SPActions is

         procedure ShiftAction
           (State     : in SP_Productions.Valid_States;
            Sym       : in SP_Symbols.SP_Terminal;
            LexVal    : in LexTokenManager.Lex_Value;
            PuncToken : in Boolean);
         --# global in out SPStackManager.SPStack;
         --#        in out SPStackManager.SPStackPtr;
         --#        in out STree.Table;
         --# derives SPStackManager.SPStack    from *,
         --#                                        PuncToken,
         --#                                        SPStackManager.SPStackPtr,
         --#                                        State,
         --#                                        STree.Table,
         --#                                        Sym &
         --#         SPStackManager.SPStackPtr from * &
         --#         STree.Table               from *,
         --#                                        LexVal,
         --#                                        PuncToken,
         --#                                        Sym;

         procedure ReduceAction (ReduceSymbol : in SP_Symbols.SP_Non_Terminal;
                                 ReduceBy     : in SP_Productions.SP_Right);
         --# global in out SPStackManager.SPStack;
         --#        in out SPStackManager.SPStackPtr;
         --#        in out STree.Table;
         --# derives SPStackManager.SPStack,
         --#         STree.Table               from ReduceBy,
         --#                                        ReduceSymbol,
         --#                                        SPStackManager.SPStack,
         --#                                        SPStackManager.SPStackPtr,
         --#                                        STree.Table &
         --#         SPStackManager.SPStackPtr from *,
         --#                                        ReduceBy;
      end SPActions;

      --# inherit CommandLineData,
      --#         Dictionary,
      --#         ErrorHandler,
      --#         ExaminerConstants,
      --#         LexTokenManager,
      --#         SPActions,
      --#         SparkLex,
      --#         SPARK_IO,
      --#         SPStackManager,
      --#         SP_Parser_Actions,
      --#         SP_Parser_Goto,
      --#         SP_Productions,
      --#         SP_Relations,
      --#         SP_Symbols,
      --#         STree;
      package SPErrorRecovery is

         procedure SPRecover
           (ProgText      : in     SPARK_IO.File_Type;
            CurrentToken  : in     SP_Symbols.SP_Symbol;
            CurrentLexVal : in     LexTokenManager.Lex_Value;
            PuncToken     : in     Boolean;
            Halt          :    out Boolean);
         --# global in     CommandLineData.Content;
         --#        in     Dictionary.Dict;
         --#        in out ErrorHandler.Error_Context;
         --#        in out LexTokenManager.State;
         --#        in out SparkLex.Curr_Line;
         --#        in out SPARK_IO.File_Sys;
         --#        in out SPStackManager.SPStack;
         --#        in out SPStackManager.SPStackPtr;
         --#        in out STree.Table;
         --# derives ErrorHandler.Error_Context,
         --#         LexTokenManager.State,
         --#         SparkLex.Curr_Line,
         --#         SPARK_IO.File_Sys          from CommandLineData.Content,
         --#                                         CurrentLexVal,
         --#                                         CurrentToken,
         --#                                         Dictionary.Dict,
         --#                                         ErrorHandler.Error_Context,
         --#                                         LexTokenManager.State,
         --#                                         ProgText,
         --#                                         SparkLex.Curr_Line,
         --#                                         SPARK_IO.File_Sys,
         --#                                         SPStackManager.SPStack,
         --#                                         SPStackManager.SPStackPtr,
         --#                                         STree.Table &
         --#         Halt,
         --#         SPStackManager.SPStack,
         --#         SPStackManager.SPStackPtr,
         --#         STree.Table                from CommandLineData.Content,
         --#                                         CurrentLexVal,
         --#                                         CurrentToken,
         --#                                         Dictionary.Dict,
         --#                                         ErrorHandler.Error_Context,
         --#                                         LexTokenManager.State,
         --#                                         ProgText,
         --#                                         PuncToken,
         --#                                         SparkLex.Curr_Line,
         --#                                         SPARK_IO.File_Sys,
         --#                                         SPStackManager.SPStack,
         --#                                         SPStackManager.SPStackPtr,
         --#                                         STree.Table;

      end SPErrorRecovery;

      SPCurrentSym : SP_Symbols.SP_Symbol;
      SPCurrState  : SP_Productions.SP_State;
      SPHaltCalled : Boolean;
      LexVal       : LexTokenManager.Lex_Value;
      PuncToken    : Boolean;

      NoOfTerminals, NoOfNonTerminals : SP_Expected_Symbols.SP_Ess_Sym_Range;
      TerminalList, NonTerminalList   : SP_Expected_Symbols.SP_Exp_Sym_List;

      SPStackTop : SPStackManager.SPStackEntry;

      SPAct : SP_Parser_Actions.SP_Parse_Act;

      package body SPStackManager is
         subtype SPStackIndex is Positive range 1 .. ExaminerConstants.SPStackSize;
         type SPStackStruct is array (SPStackIndex) of SPStackEntry;

         SPStack : SPStackStruct;

         procedure SPPush (St   : in SP_Productions.SP_State;
                           Sym  : in SP_Symbols.SP_Symbol;
                           Node : in STree.SyntaxNode) is
         begin
            if SPStackPtr < SPStackIndex'Last then
               SPStackPtr           := SPStackPtr + 1;
               SPStack (SPStackPtr) := SPStackEntry'(St, Sym, Node);
            else
               SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Parse_Stack_Overflow,
                                         Msg     => "");
            end if;
         end SPPush;

         procedure SPTop (Top : out SPStackEntry) is
         begin
            Top := SPStack (SPStackPtr);
         end SPTop;

         procedure SPPop (Top    :    out SPStackEntry;
                          PopOff : in     SP_Productions.SP_Right) is
         begin
            if SPStackPtr > Natural (PopOff) then
               SPStackPtr := SPStackPtr - Natural (PopOff);
               Top        := SPStack (SPStackPtr);
            else
               SPStackPtr := 0;
               Top        := SPStackEntry'(SP_Productions.No_State, SP_Symbols.SPDEFAULT, STree.NullNode);
            end if;
         end SPPop;

         procedure SPLook (StackEntry :    out SPStackEntry;
                           Pos        : in     SPStackPtrVal) is
         begin
            if SPStackPtr > Pos then
               StackEntry := SPStack (SPStackPtr - Pos);
            else
               StackEntry := SPStackEntry'(SP_Productions.No_State, SP_Symbols.SPDEFAULT, STree.NullNode);
            end if;
         end SPLook;

         procedure SPRemove (NoStates : in SPStackPtrVal) is
         begin
            if SPStackPtr > NoStates then
               SPStackPtr := SPStackPtr - NoStates;
            else
               SPStackPtr := 0;
            end if;
         end SPRemove;

      begin
         SPStackPtr := 0;
         --# accept F, 31, SPStack,
         --#        "Only the stack pointer needs to be initialized" &
         --#        F, 32, SPStack,
         --#        "Only the stack pointer needs to be initialized";
      end SPStackManager; -- flow error SPStack undefined expected

      package body SPActions is

         procedure ShiftAction
           (State     : in SP_Productions.Valid_States;
            Sym       : in SP_Symbols.SP_Terminal;
            LexVal    : in LexTokenManager.Lex_Value;
            PuncToken : in Boolean)
         is
            Node : STree.SyntaxNode;
         begin
            if not PuncToken then
               STree.NewTerminal (Terminal    => Sym,
                                  TerminalVal => LexVal,
                                  Node        => Node);
            else
               Node := STree.NullNode;
            end if;
            SPStackManager.SPPush (State, Sym, Node);
         end ShiftAction;

         procedure ReduceAction (ReduceSymbol : in SP_Symbols.SP_Non_Terminal;
                                 ReduceBy     : in SP_Productions.SP_Right) is
            Node      : STree.SyntaxNode;
            SPElement : SPStackManager.SPStackEntry;

            SPCurrState  : SP_Productions.SP_State;
            StackPointer : SPStackManager.SPStackPtrVal;
         begin
            STree.NewProduction (ReduceSymbol, Node);
            StackPointer := SPStackManager.SPStackPtrVal (ReduceBy);
            loop
               exit when StackPointer = 0;
               StackPointer := StackPointer - 1;
               SPStackManager.SPLook (SPElement, StackPointer);
               if SPElement.Node /= STree.NullNode then
                  STree.AddDerivative (SPElement.Node);
               end if;
            end loop;
            SPStackManager.SPPop (SPElement, ReduceBy);
            SPCurrState := SP_Parser_Goto.SP_Goto (SPElement.StateNo, ReduceSymbol);
            SPStackManager.SPPush (SPCurrState, ReduceSymbol, Node);
         end ReduceAction;
      end SPActions;

      package body SPErrorRecovery is

         procedure SPRecover
           (ProgText      : in     SPARK_IO.File_Type;
            CurrentToken  : in     SP_Symbols.SP_Symbol;
            CurrentLexVal : in     LexTokenManager.Lex_Value;
            PuncToken     : in     Boolean;
            Halt          :    out Boolean)
         is

            type BufIndex is range 0 .. ExaminerConstants.SPErrLookahead;
            --# assert BufIndex'Base is Short_Short_Integer; -- for GNAT

            type TokenBuffer is array (BufIndex) of SP_Symbols.SP_Terminal;
            type LexBuffer is array (BufIndex) of LexTokenManager.Lex_Value;
            type TypeBuffer is array (BufIndex) of Boolean;

            type LocalRecoverySuccess is (NoSuccess, WrongToken, MissingToken, ExtraToken);

            TokenList               : TokenBuffer;
            LexValList              : LexBuffer;
            TokenTypes              : TypeBuffer;
            HigherEntry, LowerEntry : SPStackManager.SPStackEntry;
            StackDepth, Pos         : SPStackManager.SPStackPtrVal;
            Node                    : STree.SyntaxNode;
            LocalSuccess            : LocalRecoverySuccess;
            Success, Stop, Done     : Boolean;

            SymListSize                 : Natural;
            SymList                     : ErrorHandler.Err_Sym_List;
            ReplacementSym, RecoverySym : SP_Symbols.SP_Symbol;
            CurrState                   : SP_Productions.SP_State;
            Index, LastBufIndex         : BufIndex;

            SPElement : SPStackManager.SPStackEntry;
            SPAct     : SP_Parser_Actions.SP_Parse_Act;

            LexToken      : SP_Symbols.SP_Terminal;
            LexTokenValue : LexTokenManager.Lex_Value;
            LexTokenType  : Boolean;

            procedure CheckFollowingTokens
              (Tokens                : in     TokenBuffer;
               StartIndex, LastIndex : in     BufIndex;
               StackPos              : in     SPStackManager.SPStackPtrVal;
               NextState             : in     SP_Productions.SP_State;
               RecoveryOK            :    out Boolean)
            --# global in SPStackManager.SPStack;
            --#        in SPStackManager.SPStackPtr;
            --# derives RecoveryOK from LastIndex,
            --#                         NextState,
            --#                         SPStackManager.SPStack,
            --#                         SPStackManager.SPStackPtr,
            --#                         StackPos,
            --#                         StartIndex,
            --#                         Tokens;
            is
               type RecoveryStackIndex is range 0 .. ExaminerConstants.SPErrLookahead * 2 + 1;
               --# assert RecoveryStackIndex'Base is Short_Short_Integer; -- for GNAT

               -- times two to allow for reduction by 0
               type RecoveryStack is array (RecoveryStackIndex) of SP_Productions.SP_State;

               LocalStack    : RecoveryStack;
               LocalStackPtr : RecoveryStackIndex;
               ParseStackptr : SPStackManager.SPStackPtrVal;
               CurrState     : SP_Productions.SP_State;
               SPAct         : SP_Parser_Actions.SP_Parse_Act;
               SPElement     : SPStackManager.SPStackEntry;
               Index         : BufIndex;
               Done          : Boolean;
            begin
               -- This code could do with refactoring to remove the conditional
               -- flow errors and to render it free from RTE - TJJ.

               --# accept F, 23, LocalStack,
               --#        "The stack pointer is all that is need to determine the extent of the stack" &
               --#        F, 501, LocalStack,
               --#        "The stack pointer is all that is need to determine the extent of the stack" &
               --#        F, 504, LocalStack,
               --#        "The stack pointer is all that is need to determine the extent of the stack" &
               --#        F, 602, RecoveryOK, LocalStack,
               --#        "The stack pointer is all that is need to determine the extent of the stack";

               -- check further tokens so that we do not recover too soon
               RecoveryOK    := True;
               ParseStackptr := StackPos;
               if NextState /= SP_Productions.No_State then
                  LocalStack (1) := NextState;
                  LocalStackPtr  := 1;
               else
                  LocalStackPtr := 0;
               end if;
               if LocalStackPtr > 0 then
                  CurrState := LocalStack (LocalStackPtr);
               else
                  SPStackManager.SPLook (SPElement, ParseStackptr);
                  CurrState := SPElement.StateNo;
               end if;
               Index := StartIndex;
               Done  := False;
               loop
                  --SPARK_IO.Put_String (SPARK_IO.STANDARD_OUTPUT, "state ",0);
                  --SPARK_IO.Put_Integer (SPARK_IO.STANDARD_OUTPUT, Integer (CurrState), 5, 10);
                  SPAct := SP_Parser_Actions.SPA (CurrState, Tokens (Index));
                  --SPARK_IO.Put_String (SPARK_IO.STANDARD_OUTPUT, "trying ",0);
                  --Put_Symbol (SPARK_IO.STANDARD_OUTPUT, Tokens (Index));
                  case SPAct.Act is
                     when SP_Parser_Actions.Shift =>
                        --SPARK_IO.Put_LINE (SPARK_IO.STANDARD_OUTPUT, " - shift",0);
                        CurrState                  := SPAct.State;
                        LocalStackPtr              := LocalStackPtr + 1;
                        LocalStack (LocalStackPtr) := CurrState;
                        if Index < LastIndex then
                           Index := Index + 1;
                        else
                           Done := True;
                        end if;
                     when SP_Parser_Actions.Reduce =>
                        --SPARK_IO.Put_LINE (SPARK_IO.STANDARD_OUTPUT, " - reduce",0);
                        if Integer (LocalStackPtr) > Integer (SPAct.Red_By) then
                           LocalStackPtr := LocalStackPtr - RecoveryStackIndex (SPAct.Red_By);
                           CurrState     := LocalStack (LocalStackPtr);
                        else
                           ParseStackptr := ParseStackptr +
                             SPStackManager.SPStackPtrVal'(Integer (SPAct.Red_By) - Integer (LocalStackPtr));
                           LocalStackPtr := 0;
                           SPStackManager.SPLook (SPElement, ParseStackptr);
                           CurrState := SPElement.StateNo;
                        end if;
                        CurrState                  := SP_Parser_Goto.SP_Goto (CurrState, SPAct.Symbol);
                        LocalStackPtr              := LocalStackPtr + 1;
                        LocalStack (LocalStackPtr) := CurrState;
                     when SP_Parser_Actions.Accpt =>
                        --SPARK_IO.Put_LINE (SPARK_IO.STANDARD_OUTPUT, " - accept",0);
                        if Tokens (Index) = SP_Symbols.SPEND then
                           Done := True;
                        else
                           LocalStackPtr  := 1;
                           LocalStack (1) := 1;  -- First state
                           CurrState      := 1;
                        end if;
                     when SP_Parser_Actions.Error =>
                        --SPARK_IO.Put_LINE (SPARK_IO.STANDARD_OUTPUT, " - error",0);
                        RecoveryOK := False;
                        Done       := True;
                  end case;
                  exit when Done;
               end loop;
            end CheckFollowingTokens;

            procedure FindLocalError
              (StackTop     : in     SPStackManager.SPStackEntry;
               TokenList    : in out TokenBuffer;
               RecoveryPosn :    out BufIndex;
               Success      :    out LocalRecoverySuccess)
            --# global in SPStackManager.SPStack;
            --#        in SPStackManager.SPStackPtr;
            --# derives RecoveryPosn,
            --#         Success,
            --#         TokenList    from SPStackManager.SPStack,
            --#                           SPStackManager.SPStackPtr,
            --#                           StackTop,
            --#                           TokenList;
            is
               RecoveryToken, RecoverySymbol : SP_Symbols.SP_Symbol;
               RecoveryPossible, RecoveryOK  : Boolean;
               RecoveryAct                   : SP_Parser_Actions.SP_Parse_Act;
               Status                        : LocalRecoverySuccess;
               Index                         : SP_Parser_Actions.Action_Index;
               FirstToken                    : SP_Symbols.SP_Terminal;
            begin
               FirstToken       := TokenList (1);
               Index            := SP_Parser_Actions.First_Action_Index;
               Status           := NoSuccess;
               RecoveryPossible := True;
               RecoveryToken    := SP_Symbols.SPDEFAULT;
               -- the initialization of this variable is not strictly
               -- necessary but it avoids conditional data-flow errors.
               loop
                  SP_Parser_Actions.Scan_Action_Table (StackTop.StateNo, Index, RecoveryAct, RecoverySymbol);
                  exit when RecoveryAct = SP_Parser_Actions.Error_Action;

                  --Put_Symbol (SPARK_IO.STANDARD_OUTPUT, RecoverySymbol);
                  if (RecoverySymbol /= SP_Symbols.SPDEFAULT) and (RecoverySymbol /= SP_Symbols.SPEND) then
                     -- check for invalid extra token
                     if RecoverySymbol = TokenList (2) then
                        --SPARK_IO.Put_LINE (SPARK_IO.STANDARD_OUTPUT, "Trying local error - extra token",0);
                        CheckFollowingTokens
                          (TokenList,
                           2,
                           BufIndex (ExaminerConstants.SPLocalErrLookahead),
                           0,
                           SP_Productions.No_State,
                           RecoveryOK);
                        if RecoveryOK then
                           if Status = NoSuccess then
                              Status := ExtraToken;
                           else
                              RecoveryPossible := False;
                           end if;
                        end if;
                     end if;
                     -- check for missing token
                     if RecoveryPossible then
                        -- SPARK_IO.Put_LINE (SPARK_IO.STANDARD_OUTPUT, "Trying local error - missing token",0);
                        TokenList (0) := RecoverySymbol;
                        CheckFollowingTokens
                          (TokenList,
                           0,
                           BufIndex (ExaminerConstants.SPLocalErrLookahead),
                           0,
                           SP_Productions.No_State,
                           RecoveryOK);
                        if RecoveryOK then
                           if Status = NoSuccess then
                              Status        := MissingToken;
                              RecoveryToken := RecoverySymbol;
                           else
                              RecoveryPossible := False;
                           end if;
                        end if;
                     end if;
                     -- wrongly spelt token
                     if RecoveryPossible then
                        if SparkLex.Similar_Tokens (Token1 => RecoverySymbol,
                                                    Token2 => TokenList (1)) then
                           TokenList (1) := RecoverySymbol;
                           -- SPARK_IO.Put_LINE (SPARK_IO.STANDARD_OUTPUT, "Trying local error - wrongly spelt token",0);
                           CheckFollowingTokens
                             (TokenList,
                              1,
                              BufIndex (ExaminerConstants.SPLocalErrLookahead),
                              0,
                              SP_Productions.No_State,
                              RecoveryOK);
                           if RecoveryOK then
                              if Status = NoSuccess then
                                 Status        := WrongToken;
                                 RecoveryToken := RecoverySymbol;
                              else
                                 RecoveryPossible := False;
                              end if;
                           end if;
                           TokenList (1) := FirstToken;
                        end if;
                     end if;
                  end if;
                  exit when not RecoveryPossible;
               end loop;
               if RecoveryPossible then
                  if Status = MissingToken then
                     TokenList (0) := RecoveryToken; -- flow err from non-exec path
                     RecoveryPosn  := 0;
                  elsif Status = WrongToken then
                     TokenList (1) := RecoveryToken; -- flow err from non-exec path
                     RecoveryPosn  := 1;
                  else
                     RecoveryPosn := 2;
                  end if;
                  Success := Status;
               else
                  Success      := NoSuccess;
                  RecoveryPosn := 0;
               end if;
            end FindLocalError;

            procedure FindErrorPhrase
              (HigherEntry : in out SPStackManager.SPStackEntry;
               LowerEntry  : in     SPStackManager.SPStackEntry;
               StackPos    : in     SPStackManager.SPStackPtrVal;
               TokenList   : in     TokenBuffer;
               Success     :    out Boolean)
            --# global in SPStackManager.SPStack;
            --#        in SPStackManager.SPStackPtr;
            --# derives HigherEntry,
            --#         Success     from HigherEntry,
            --#                          LowerEntry,
            --#                          SPStackManager.SPStack,
            --#                          SPStackManager.SPStackPtr,
            --#                          StackPos,
            --#                          TokenList;
            is
               RecoveryOK, RecoveryFound, RecoveryPossible : Boolean;
               RecoverySymbol                              : SP_Symbols.SP_Non_Terminal;
               RecoveryEntry                               : SPStackManager.SPStackEntry;
               RecoveryState, NextState                    : SP_Productions.SP_State;
               Index                                       : SP_Parser_Goto.Goto_Index;
               SPAct                                       : SP_Parser_Actions.SP_Parse_Act;
            begin
               RecoveryEntry    := SPStackManager.SPStackEntry'(SP_Productions.No_State, SP_Symbols.SPDEFAULT, STree.NullNode);
               Index            := SP_Parser_Goto.First_Goto_Index;
               RecoveryPossible := True;
               RecoveryFound    := False;
               loop
                  SP_Parser_Goto.Scan_Goto_Table (LowerEntry.StateNo, Index, RecoveryState, RecoverySymbol);
                  exit when RecoveryState = SP_Productions.No_State;
                  SPAct := SP_Parser_Actions.SPA (RecoveryState, TokenList (1));
                  if SPAct.Act = SP_Parser_Actions.Shift or SPAct.Act = SP_Parser_Actions.Accpt then
                     if HigherEntry.StateNo = SP_Productions.No_State
                       or else RecoverySymbol = HigherEntry.SPSym
                       or else SP_Relations.SP_Left_Corner (RecoverySymbol, HigherEntry.SPSym) then
                        CheckFollowingTokens (TokenList, 1, BufIndex'Last, StackPos, RecoveryState, RecoveryOK);
                        if RecoveryOK then
                           --# accept F, 20, NextState, "NextState is guarded by RecoveryFound";
                           if not RecoveryFound then
                              NextState     := SPAct.State;
                              RecoveryFound := True;
                              RecoveryEntry := SPStackManager.SPStackEntry'(RecoveryState, RecoverySymbol, STree.NullNode);
                           elsif SPAct.State /= NextState then -- expected flow error
                              RecoveryPossible := False;
                           end if;
                        end if;
                     end if;
                  end if;
                  exit when not RecoveryPossible;
               end loop;
               if RecoveryPossible and RecoveryFound then
                  Success     := True;
                  HigherEntry := RecoveryEntry;
               else
                  Success := False;
               end if;
               --# accept F, 602, HigherEntry, NextState,
               --#        "NextState is guarded by RecoveryFound" &
               --#        F, 602, Success, NextState,
               --#        "NextState is guarded by RecoveryFound";
            end FindErrorPhrase;

         begin  --SPRecover
            Stop := False;
            --# accept f, 23, TokenList, "Whole array is initialized." &
            --#        f, 23, LexValList, "Whole array is initialized." &
            --#        f, 23, TokenTypes, "Whole array is initialized.";
            TokenList (1)  := CurrentToken;
            LexValList (1) := CurrentLexVal;
            TokenTypes (1) := PuncToken;
            LexValList (0) :=
              LexTokenManager.Lex_Value'
              (Position  => LexTokenManager.Token_Position'(Start_Line_No => 0,
                                                            Start_Pos     => 0),
               Token_Str => LexTokenManager.Null_String);
            TokenTypes (0) := False;
            for Ix in BufIndex range 2 .. BufIndex (ExaminerConstants.SPLocalErrLookahead) loop
               SparkLex.Examiner_Lex
                 (Prog_Text   => ProgText,
                  Token       => LexToken,
                  Lex_Val     => LexTokenValue,
                  Punct_Token => LexTokenType);
               TokenList (Ix)  := LexToken;
               LexValList (Ix) := LexTokenValue;
               TokenTypes (Ix) := LexTokenType;
            end loop;
            --# end accept;
            Success := False;
            SPStackManager.SPTop (HigherEntry);
            -- try local error recovery
            FindLocalError (HigherEntry, TokenList, Index, LocalSuccess);
            --# accept F, 23, SymList,
            --#        "Access to SymList Elements is guarded by SymListSize";
            if LocalSuccess /= NoSuccess then
               -- produce recovery message
               if LocalSuccess = WrongToken or LocalSuccess = ExtraToken then
                  SymListSize := 1;
                  SymList (1) := CurrentToken;
               else
                  SymListSize := 0;
               end if;
               if LocalSuccess = WrongToken or LocalSuccess = MissingToken then
                  ReplacementSym := TokenList (Index);
               else
                  ReplacementSym := SP_Symbols.SPDEFAULT;
               end if;
               --# accept F, 504, SymList,
               --#        "Access to SymList is guarded by SymListSize";
               ErrorHandler.Syntax_Recovery
                 (Recovery_Posn   => LexValList (1),
                  Replacement_Sym => ReplacementSym,
                  Next_Sym        => SP_Symbols.SPDEFAULT,
                  No_Of_Syms      => SymListSize,
                  Sym_List        => SymList);
               --# end accept;
               -- if LocalSuccess = MissingToken then
               -- SPARK_IO.Put_LINE (SPARK_IO.STANDARD_OUTPUT, "Local error - missing token",0);
               -- elsif LocalSuccess = ExtraToken then
               -- SPARK_IO.Put_LINE (SPARK_IO.STANDARD_OUTPUT, "Local error - extra token",0);
               -- else
               -- SPARK_IO.Put_LINE (SPARK_IO.STANDARD_OUTPUT, "Local error - wrongly spelt token",0);
               -- end if;
               Success      := True;
               LastBufIndex := BufIndex (ExaminerConstants.SPLocalErrLookahead);
            else
               for Ix in BufIndex range BufIndex (ExaminerConstants.SPLocalErrLookahead) + 1 .. BufIndex'Last loop
                  SparkLex.Examiner_Lex
                    (Prog_Text   => ProgText,
                     Token       => LexToken,
                     Lex_Val     => LexTokenValue,
                     Punct_Token => LexTokenType);
                  TokenList (Ix)  := LexToken;
                  LexValList (Ix) := LexTokenValue;
                  TokenTypes (Ix) := LexTokenType;
               end loop;
               RecoverySym := TokenList (1);
               loop
                  SPStackManager.SPTop (LowerEntry);
                  HigherEntry := SPStackManager.SPStackEntry'(SP_Productions.No_State, SP_Symbols.SPDEFAULT, STree.NullNode);
                  StackDepth  := 0;
                  while not Success and StackDepth < SPStackManager.SPStackPtr loop
                     FindErrorPhrase (HigherEntry, LowerEntry, StackDepth, TokenList, Success);
                     if Success then
                        -- produce recovery message
                        -- Put_LINE (STANDARD_OUTPUT, "Non-local error");
                        Pos         := StackDepth;
                        SymListSize := 0;
                        while Pos > 0 and SymListSize < Natural (ErrorHandler.Err_Sym_Range'Last) loop
                           Pos := Pos - 1;
                           SPStackManager.SPLook (SPElement, Pos);
                           SymListSize                                         := SymListSize + 1;
                           SymList (ErrorHandler.Err_Sym_Range (SymListSize))  := SPElement.SPSym;
                        end loop;
                        --# accept F, 41, "Pos is updated in the outer loop.";
                        if Pos /= 0 then  -- expected flow error
                           SymListSize := StackDepth;
                           SPStackManager.SPTop (SPElement);
                           --# accept F, 504, SymList,
                           --#        "Update of element of SymList - Accesses guarded by SymListSize";
                           SymList (ErrorHandler.Err_Sym_Range'Last) := SPElement.SPSym;
                           --# end accept;
                        end if;
                        --# end accept;
                        --# accept F, 504, SymList,
                        --#        "Access to SymList is guarded by SymListSize";
                        ErrorHandler.Syntax_Recovery
                          (Recovery_Posn   => LexValList (1),
                           Replacement_Sym => HigherEntry.SPSym,
                           Next_Sym        => RecoverySym,
                           No_Of_Syms      => SymListSize,
                           Sym_List        => SymList);
                        --# end accept;
                        -- patch stack
                        SPStackManager.SPRemove (StackDepth);
                        STree.NewProduction (HigherEntry.SPSym, Node);
                        SPStackManager.SPPush (HigherEntry.StateNo, HigherEntry.SPSym, Node);
                        Index        := 1;
                        LastBufIndex := BufIndex'Last;
                        exit;
                     end if;
                     HigherEntry := LowerEntry;
                     StackDepth  := StackDepth + 1;
                     SPStackManager.SPLook (LowerEntry, StackDepth);
                  end loop;
                  exit when Success or TokenList (1) = SP_Symbols.SPEND;
                  for Ix in BufIndex range 1 .. BufIndex'Last - 1 loop
                     TokenList (Ix)  := TokenList (Ix + 1);
                     LexValList (Ix) := LexValList (Ix + 1);
                     TokenTypes (Ix) := TokenTypes (Ix + 1);
                  end loop;

                  SparkLex.Examiner_Lex
                    (Prog_Text   => ProgText,
                     Token       => LexToken,
                     Lex_Val     => LexTokenValue,
                     Punct_Token => LexTokenType);
                  TokenList (BufIndex'Last)  := LexToken;
                  LexValList (BufIndex'Last) := LexTokenValue;
                  TokenTypes (BufIndex'Last) := LexTokenType;
                  RecoverySym                := SP_Symbols.SPDEFAULT;

               end loop;
            end if;
            -- perform action on following tokens
            if Success then
               SPStackManager.SPTop (HigherEntry);
               CurrState := HigherEntry.StateNo;
               Done      := False;
               loop
                  SPAct := SP_Parser_Actions.SPA (CurrState, TokenList (Index));
                  case SPAct.Act is
                     when SP_Parser_Actions.Shift =>
                        SPActions.ShiftAction
                          (State     => SPAct.State,
                           Sym       => TokenList (Index),
                           LexVal    => LexValList (Index),
                           PuncToken => TokenTypes (Index));
                        CurrState := SPAct.State;
                        --# accept F, 501, LastBufIndex, "Access guarded by Success.";
                        if Index < LastBufIndex then -- flow error expected
                           Index := Index + 1;
                        else
                           Done := True;
                        end if;
                        --# end accept;
                     when SP_Parser_Actions.Reduce =>
                        SPActions.ReduceAction (SPAct.Symbol, SPAct.Red_By);
                        SPStackManager.SPTop (HigherEntry);
                        CurrState := HigherEntry.StateNo;
                     when SP_Parser_Actions.Accpt =>
                        Stop := True;
                        Done := True;
                     when others => -- doesn't arise
                        Done := True;
                  end case;
                  exit when Done;
               end loop;
            end if;
            Halt := Stop;
            --# accept F, 602, SPARK_IO.File_Sys, TokenList, "Accessed elements are defined." &
            --#        F, 602, SPARK_IO.File_Sys, LexValList, "Accessed elements are defined." &
            --#        F, 602, SPARK_IO.File_Sys, SymList, "Accessed elements are defined." &
            --#        F, 602, LexTokenManager.State, TokenList, "Accessed elements are defined." &
            --#        F, 602, LexTokenManager.State, LexValList, "Accessed elements are defined." &
            --#        F, 602, LexTokenManager.State, SymList, "Accessed elements are defined." &
            --#        F, 602, ErrorHandler.Error_Context, TokenList, "Accessed elements are defined." &
            --#        F, 602, ErrorHandler.Error_Context, LexValList, "Accessed elements are defined." &
            --#        F, 602, ErrorHandler.Error_Context, SymList, "Accessed elements are defined." &
            --#        F, 602, SparkLex.Curr_Line, TokenList, "Accessed elements are defined." &
            --#        F, 602, SparkLex.Curr_Line, LexValList, "Accessed elements are defined." &
            --#        F, 602, SparkLex.Curr_Line, SymList, "Accessed elements are defined." &
            --#        F, 602, STree.Table, TokenList, "Accessed elements are defined." &
            --#        F, 602, STree.Table, LexValList, "Accessed elements are defined." &
            --#        F, 602, STree.Table, SymList, "Accessed elements are defined." &
            --#        F, 602, STree.Table, TokenTypes, "Accessed elements are defined." &
            --#        F, 602, STree.Table, LastBufIndex, "Accesses guarded by Success" &
            --#        F, 602, SPStackManager.SPStack, TokenList, "Accessed elements are defined." &
            --#        F, 602, SPStackManager.SPStack, LexValList, "Accessed elements are defined." &
            --#        F, 602, SPStackManager.SPStack, SymList, "Accessed elements are defined." &
            --#        F, 602, SPStackManager.SPStack, TokenTypes, "Accessed elements are defined." &
            --#        F, 602, SPStackManager.SPStack, LastBufIndex, "Accesses guarded by Success" &
            --#        F, 602, SPStackManager.SPStackPtr, TokenList, "Accessed elements are defined." &
            --#        F, 602, SPStackManager.SPStackPtr, LexValList, "Accessed elements are defined." &
            --#        F, 602, SPStackManager.SPStackPtr, SymList, "Accessed elements are defined." &
            --#        F, 602, SPStackManager.SPStackPtr, TokenTypes, "Accessed elements are defined." &
            --#        F, 602, SPStackManager.SPStackPtr, LastBufIndex, "Accesses guarded by Success" &
            --#        F, 602, Halt, TokenList, "Accessed elements are defined." &
            --#        F, 602, Halt, LexValList, "Accessed elements are defined." &
            --#        F, 602, Halt, SymList, "Accessed elements are defined." &
            --#        F, 602, Halt, TokenTypes, "Accessed elements are defined." &
            --#        F, 602, Halt, LastBufIndex, "Accesses guarded by Success";
         end SPRecover;
      end SPErrorRecovery;

      --  Unused procedure, but leave here for debugging
      procedure SPPrintAction
        (OutputFile   : in SPARK_IO.File_Type;
         SPAct        : in SP_Parser_Actions.SP_Parse_Act;
         SPCurrState  : in SP_Productions.SP_State;
         SPCurrentSym : in SP_Symbols.SP_Symbol)
      --# global in out SPARK_IO.File_Sys;
      --# derives SPARK_IO.File_Sys from *,
      --#                                OutputFile,
      --#                                SPAct,
      --#                                SPCurrentSym,
      --#                                SPCurrState;
      is
      begin
         SPARK_IO.Put_String (OutputFile, " STATE: ", 0);
         SPARK_IO.Put_Integer (OutputFile, Integer (SPCurrState), 5, 10);
         SPARK_IO.Put_String (OutputFile, " SYMBOL: ", 0);
         Put_Symbol (OutputFile, SPCurrentSym);
         SPARK_IO.New_Line (OutputFile, 1);
         case SPAct.Act is
            when SP_Parser_Actions.Shift =>
               SPARK_IO.Put_String (OutputFile, " ACTION : SHIFT ", 0);
               SPARK_IO.Put_Integer (OutputFile, Integer (SPAct.State), 5, 10);
               SPARK_IO.New_Line (OutputFile, 1);
            when SP_Parser_Actions.Reduce =>
               SPARK_IO.Put_String (OutputFile, " ACTION : REDUCE ", 0);
               SPARK_IO.Put_String (OutputFile, " SYMBOL : ", 0);
               Put_Symbol (OutputFile, SPAct.Symbol);
               SPARK_IO.Put_String (OutputFile, "  REDUCE BY : ", 0);
               SPARK_IO.Put_Integer (OutputFile, Integer (SPAct.Red_By), 5, 10);
               SPARK_IO.Put_String (OutputFile, "  PROD NO : ", 0);
               SPARK_IO.Put_Integer (OutputFile, Integer (SPAct.Prod_No), 5, 10);
               SPARK_IO.New_Line (OutputFile, 1);
            when SP_Parser_Actions.Accpt =>
               SPARK_IO.Put_String (OutputFile, " ACTION : ACCEPT", 0);
               SPARK_IO.New_Line (OutputFile, 1);
            when SP_Parser_Actions.Error =>
               SPARK_IO.Put_String (OutputFile, " ACTION : ERROR", 0);
               SPARK_IO.New_Line (OutputFile, 1);
         end case;
      end SPPrintAction;
      pragma Unreferenced (SPPrintAction);

      --  Unused procedure, but leave here for debugging
      procedure SPPrintStack (OutputFile : in SPARK_IO.File_Type)
      --# global in     SPStackManager.SPStack;
      --#        in     SPStackManager.SPStackPtr;
      --#        in out SPARK_IO.File_Sys;
      --# derives SPARK_IO.File_Sys from *,
      --#                                OutputFile,
      --#                                SPStackManager.SPStack,
      --#                                SPStackManager.SPStackPtr;
      is
         SPElement : SPStackManager.SPStackEntry;
      begin
         SPARK_IO.Put_Line (OutputFile, " STACK VALUES :", 0);
         for Ix in reverse SPStackManager.SPStackPtrVal range 0 .. SPStackManager.SPStackPtr loop
            SPStackManager.SPLook (SPElement, Ix);
            SPARK_IO.Put_Integer (OutputFile, Integer (SPElement.StateNo), 5, 10);
            SPARK_IO.Put_String (OutputFile, " SYMBOL: ", 0);
            Put_Symbol (OutputFile, SPElement.SPSym);
            SPARK_IO.New_Line (OutputFile, 1);
         end loop;
      end SPPrintStack;
      pragma Unreferenced (SPPrintStack);

      -- Declarations to write SPPrintStack to a named file
      -- OutputFile : SPARK_IO.File_Type;
      -- Status : SPARK_IO.File_Status;

   begin  --SPParse

      -- SPARK_IO.CREATE (OutputFile, "spark.out", "", Status);
      SPCurrState := 1;
      SparkLex.Examiner_Lex (Prog_Text   => ProgText,
                             Token       => SPCurrentSym,
                             Lex_Val     => LexVal,
                             Punct_Token => PuncToken);
      SPStackManager.SPPush (1, SP_Symbols.SPACCEPT, STree.NullNode);
      SPHaltCalled := False;
      while not SPHaltCalled loop
         SPAct := SP_Parser_Actions.SPA (SPCurrState, SPCurrentSym);
         -- SPPrintAction (OutputFile, SPAct, SPCurrState, SPCurrentSym); -- to write to named dump file
         -- SPPrintAction (SPARK_IO.Standard_Output, SPAct, SPCurrState, SPCurrentSym); -- to dump to screen
         case SPAct.Act is
            when SP_Parser_Actions.Shift =>
               SPCurrState := SPAct.State;
               SPActions.ShiftAction (State     => SPCurrState,
                                      Sym       => SPCurrentSym,
                                      LexVal    => LexVal,
                                      PuncToken => PuncToken);
               SparkLex.Examiner_Lex (Prog_Text   => ProgText,
                                      Token       => SPCurrentSym,
                                      Lex_Val     => LexVal,
                                      Punct_Token => PuncToken);
            when SP_Parser_Actions.Reduce =>
               SPActions.ReduceAction (SPAct.Symbol, SPAct.Red_By);
               SPStackManager.SPTop (SPStackTop);
               SPCurrState := SPStackTop.StateNo;
            when SP_Parser_Actions.Accpt =>
               SPHaltCalled := True;
            when SP_Parser_Actions.Error =>
               -- SPPrintStack (OutputFile);
               SPStackManager.SPTop (SPStackTop);
               SP_Expected_Symbols.Get_Expected_Symbols
                 (SPStackTop.StateNo,
                  NoOfTerminals,
                  TerminalList,
                  NoOfNonTerminals,
                  NonTerminalList);
               ErrorHandler.Syntax_Error
                 (Error_Item          => LexVal,
                  Current_Sym         => SPCurrentSym,
                  Entry_Symbol        => SPStackTop.SPSym,
                  No_Of_Terminals     => NoOfTerminals,
                  No_Of_Non_Terminals => NoOfNonTerminals,
                  Terminal_List       => TerminalList,
                  Non_Terminal_List   => NonTerminalList);
               SPErrorRecovery.SPRecover
                 (ProgText      => ProgText,
                  CurrentToken  => SPCurrentSym,
                  CurrentLexVal => LexVal,
                  PuncToken     => PuncToken,
                  Halt          => SPHaltCalled);
               if not SPHaltCalled then
                  SPStackManager.SPTop (SPStackTop);
                  SPCurrState := SPStackTop.StateNo;
                  SparkLex.Examiner_Lex
                    (Prog_Text   => ProgText,
                     Token       => SPCurrentSym,
                     Lex_Val     => LexVal,
                     Punct_Token => PuncToken);
               end if;
         end case;
      end loop;
      MaxStackSize := 0;
      case SPCurrentSym is
         when SP_Symbols.SPEND =>
            FileEnd := True;
         when others =>
            FileEnd := False;
      end case;
   end SPParse;
end SPParser;
