--  Warning: This file is automatically generated by AYACC.
--           It is useless to modify it. Change the ".Y" & ".L" files instead.
%%1 user

   procedure ${YYPARSE}${YYPARSEPARAM} is
%yydecl
      --  Rename User Defined Packages to Internal Names.
%%2 renames

      use yy_tokens, yy_goto_tables, yy_shift_reduce_tables;

%if yyerrok
      procedure yyerrok;
%end
%if yyclearin
      procedure yyclearin;
%end
      procedure handle_error;

%if error
      --   One of the extension of ayacc. Used for
      --   error recovery and error reporting.

      package yyparser_input is
         --
         --  TITLE
         --   yyparser input.
         --
         -- OVERVIEW
         --   In Ayacc, parser get the input directly from lexical scanner.
         --   In the extension, we have more power in error recovery which will
         --   try to replace, delete or insert a token into the input
         --   stream. Since general lexical scanner does not support
         --   replace, delete or insert a token, we must maintain our
         --   own input stream to support these functions. It is the
         --   purpose that we introduce yyparser_input. So parser no
         --   longer interacts with lexical scanner, instead, parser
         --   will get the input from yyparser_input. Yyparser_Input
         --   get the input from lexical scanner and supports
         --   replacing, deleting and inserting tokens.
         --

         type string_ptr is access string;

         type tokenbox is record
          --
          --  OVERVIEW
          --    Tokenbox is the type of the element of the input
          --    stream maintained in yyparser_input. It contains
          --    the value of the token, the line on which the token
          --    resides, the line number on which the token resides.
          --    It also contains the begin and end column of the token.
            token         : yy_tokens.Token;
            lval          : YYSType;
            line          : string_ptr;
            line_number   : Natural := 1;
            token_start   : Natural := 1;
            token_end     : Natural := 1;
         end record;

         type boxed_token is access tokenbox;

         procedure unget(tok : in boxed_token);
         --  push a token back into input stream.

         function get return boxed_token;
         --  get a token from input stream

         procedure reset_peek;
         function peek return boxed_token;
         --  During error recovery, we will lookahead to see the
         --  affect of the error recovery. The lookahead does not
         --  means that we actually accept the input, instead, it
         --  only means that we peek the future input. It is the
         --  purpose of function peek and it is also the difference
         --  between peek and get. We maintain a counter indicating
         --  how many token we have peeked and reset_peek will
         --  reset that counter.

         function tbox (token : yy_tokens.Token ) return boxed_token;
         --  Given the token got from the lexical scanner, tbox
         --  collect other information, such as, line, line number etc.
         --  to construct a boxed_token.

         input_token    : yyparser_input.boxed_token;
         previous_token : yyparser_input.boxed_token;
         --  The current and previous token processed by parser.

      end yyparser_input;

      package yyerror_recovery is
         --
         -- TITLE
         --
         --   Yyerror_Recovery.
         --
         -- OVERVIEW
         --   This package contains all of errro recovery staff,
         --   in addition to those of Ayacc.

         previous_action : Integer;
         -- This variable is used to save the previous action the parser made.

         previous_error_flag : Natural := 0;
         -- This variable is used to save the previous error flag.

         valuing : Boolean := True;
         -- Indicates whether to perform semantic actions. If exception
         -- is raised during semantic action after error recovery, we
         -- set valuing to False which causes no semantic actions to
         -- be invoked any more.

         procedure flag_token ( error : in Boolean := True );
         --  This procedure will point out the position of the
         --  current token.

         procedure finale;
         -- This procedure prepares the final report for error report.

         procedure try_recovery;
         -- It is the main procedure for error recovery.

         line_number : Integer := 0;
         -- Indicates the last line having been outputed to the error file.

         procedure put_new_line;
         -- This procedure outputs the whole line on which input_token
         -- resides along with line number to the file for error reporting.
      end yyerror_recovery;

      use yyerror_recovery;

      package user_defined_errors is
         --
         --  TITLE
         --    User Defined Errors.
         --
         --  OVERVIEW
         --    This package is used to facilite the error reporting.

         procedure parser_error(Message : in String );
         procedure parser_warning(Message : in String );

      end user_defined_errors;

%end
      subtype goto_row is yy_goto_tables.Row;
      subtype reduce_row is yy_shift_reduce_tables.Row;

      package yy is

         --  the size of the value and state stacks
         --  Affects error 'Stack size exceeded on state_stack'
         stack_size : constant Natural := ${YYSTACKSIZE};

         --  subtype rule         is Natural;
         subtype parse_state is Natural;
         --  subtype nonterminal  is Integer;

         --  encryption constants
         default           : constant := -1;
         first_shift_entry : constant := 0;
         accept_code       : constant := -3001;
         error_code        : constant := -3000;

         --  stack data used by the parser
         tos                : Natural := 0;
         value_stack        : array (0 .. stack_size) of yy_tokens.YYSType;
         state_stack        : array (0 .. stack_size) of parse_state;

         --  current input symbol and action the parser is on
         action             : Integer;
         rule_id            : Rule;
         input_symbol       : yy_tokens.Token := ERROR;

         --  error recovery flag
         error_flag : Natural := 0;
         --  indicates  3 - (number of valid shifts after an error occurs)

         look_ahead : Boolean := True;
         index      : reduce_row;

         --  Is Debugging option on or off
%if debug
         debug : constant Boolean := True;
%else
         debug : constant Boolean := False;
%end
      end yy;

      procedure shift_debug (state_id : yy.parse_state; lexeme : yy_tokens.Token);
      procedure reduce_debug (rule_id : Rule; state_id : yy.parse_state);

      function goto_state
         (state : yy.parse_state;
          sym   : Nonterminal) return yy.parse_state;

      function parse_action
         (state : yy.parse_state;
          t     : yy_tokens.Token) return Integer;

      pragma Inline (goto_state, parse_action);

      function goto_state (state : yy.parse_state;
                           sym   : Nonterminal) return yy.parse_state is
         index : goto_row;
      begin
         index := Goto_Offset (state);
         while Goto_Matrix (index).Nonterm /= sym loop
            index := index + 1;
         end loop;
         return Integer (Goto_Matrix (index).Newstate);
      end goto_state;


      function parse_action (state : yy.parse_state;
                             t     : yy_tokens.Token) return Integer is
         index   : reduce_row;
         tok_pos : Integer;
         default : constant Integer := -1;
      begin
         tok_pos := yy_tokens.Token'Pos (t);
         index   := Shift_Reduce_Offset (state);
         while Integer (Shift_Reduce_Matrix (index).T) /= tok_pos
           and then Integer (Shift_Reduce_Matrix (index).T) /= default
         loop
            index := index + 1;
         end loop;
         return Integer (Shift_Reduce_Matrix (index).Act);
      end parse_action;

      --  error recovery stuff

      procedure handle_error is
         temp_action : Integer;
      begin

         if yy.error_flag = 3 then --  no shift yet, clobber input.
            if yy.debug then
               Text_IO.Put_Line ("  -- Ayacc.YYParse: Error Recovery Clobbers "
                                 & yy_tokens.Token'Image (yy.input_symbol));
%if error
-- UMASS CODES :
               yy_error_report.Put_Line ("Ayacc.YYParse: Error Recovery Clobbers "
                                         & yy_tokens.Token'Image (yy.input_symbol));
-- END OF UMASS CODES.
%end
            end if;
            if yy.input_symbol = yy_tokens.END_OF_INPUT then  -- don't discard,
               if yy.debug then
                  Text_IO.Put_Line ("  -- Ayacc.YYParse: Can't discard END_OF_INPUT, quiting...");
%if error
-- UMASS CODES :
                  yy_error_report.Put_Line ("Ayacc.YYParse: Can't discard END_OF_INPUT, quiting...");
-- END OF UMASS CODES.
%end
               end if;
%if error
-- UMASS CODES :
               yyerror_recovery.finale;
-- END OF UMASS CODES.
%end
               raise yy_tokens.Syntax_Error;
            end if;

            yy.look_ahead := True;   --  get next token
            return;                  --  and try again...
         end if;

         if yy.error_flag = 0 then --  brand new error
            yyerror ("Syntax Error");
%if error
-- UMASS CODES :
            yy_error_report.Put_Line ( "Skipping..." );
            yy_error_report.Put_Line ( "" );
-- END OF UMASS CODES.
%end
         end if;

         yy.error_flag := 3;

         --  find state on stack where error is a valid shift --

         if yy.debug then
            Text_IO.Put_Line ("  -- Ayacc.YYParse: Looking for state with error as valid shift");
%if error
-- UMASS CODES :
            yy_error_report.Put_Line("Ayacc.YYParse: Looking for state with error as valid shift");
-- END OF UMASS CODES.
%end
         end if;

         loop
            if yy.debug then
               Text_IO.Put_Line ("  -- Ayacc.YYParse: Examining State "
                                 & yy.parse_state'Image (yy.state_stack (yy.tos)));
%if error
-- UMASS CODES :
               yy_error_report.Put_Line ("Ayacc.YYParse: Examining State "
                                         & yy.parse_state'Image (yy.state_stack (yy.tos)));
-- END OF UMASS CODES.
%end
            end if;
            temp_action := parse_action (yy.state_stack (yy.tos), ERROR);

            if temp_action >= yy.first_shift_entry then
               if yy.tos = yy.stack_size then
                  Text_IO.Put_Line ("  -- Ayacc.YYParse: Stack size exceeded on state_stack");
%if error
-- UMASS CODES :
                  yy_error_report.Put_Line ("Ayacc.YYParse: Stack size exceeded on state_stack");
                  yyerror_recovery.finale;
-- END OF UMASS CODES.
%end
                  raise yy_tokens.Syntax_Error;
               end if;
               yy.tos                  := yy.tos + 1;
               yy.state_stack (yy.tos) := temp_action;
               exit;
            end if;

            if yy.tos /= 0 then
               yy.tos := yy.tos - 1;
            end if;

            if yy.tos = 0 then
               if yy.debug then
                  Text_IO.Put_Line
                     ("  -- Ayacc.YYParse: Error recovery popped entire stack, aborting...");
%if error
-- UMASS CODES :
                  yy_error_report.Put_Line
                     ("Ayacc.YYParse: Error recovery popped entire stack, aborting...");
-- END OF UMASS CODES.
%end
               end if;
%if error
-- UMASS CODES :
               yyerror_recovery.finale;
-- END OF UMASS CODES.
%end
               raise yy_tokens.Syntax_Error;
            end if;
         end loop;

         if yy.debug then
            Text_IO.Put_Line ("  -- Ayacc.YYParse: Shifted error token in state "
                              & yy.parse_state'Image (yy.state_stack (yy.tos)));
%if error
-- UMASS CODES :
            yy_error_report.Put_Line ("Ayacc.YYParse: Shifted error token in state " &
                                      yy.parse_state'Image (yy.state_stack (yy.tos)));
-- END OF UMASS CODES.
%end
         end if;

      end handle_error;

      --  print debugging information for a shift operation
      procedure shift_debug (state_id : yy.parse_state; lexeme : yy_tokens.Token) is
      begin
         Text_IO.Put_Line ("  -- Ayacc.YYParse: Shift "
                           & yy.parse_state'Image (state_id) & " on input symbol "
                           & yy_tokens.Token'Image (lexeme));
%if error
-- UMASS CODES :
         yy_error_report.Put_Line ("Ayacc.YYParse: Shift "& yy.parse_state'Image (state_id)&" on input symbol "&
                                   yy_tokens.Token'Image (lexeme) );
-- END OF UMASS CODES.
%end
      end shift_debug;

      --  print debugging information for a reduce operation
      procedure reduce_debug (rule_id : Rule; state_id : yy.parse_state) is
      begin
         Text_IO.Put_Line ("  -- Ayacc.YYParse: Reduce by rule "
                           & Rule'Image (rule_id) & " goto state "
                           & yy.parse_state'Image (state_id));
%if error
-- UMASS CODES :
         yy_error_report.Put_Line ("Ayacc.YYParse: Reduce by rule " & Rule'Image (rule_id) & " goto state "&
                                   yy.parse_state'Image (state_id));
-- END OF UMASS CODES.
%end
      end reduce_debug;

%if yyerrok
      --  make the parser believe that 3 valid shifts have occured.
      --  used for error recovery.
      procedure yyerrok is
      begin
         yy.error_flag := 0;
      end yyerrok;

%end
%if yyclearin
      --  called to clear input symbol that caused an error.
      procedure yyclearin is
      begin
         --  yy.input_symbol := ${YYLEX};
         yy.look_ahead := True;
      end yyclearin;

%end
%if error
-- UMASS CODES :
   --   Bodies of yyparser_input, yyerror_recovery, user_define_errors.

package body yyparser_input is
   pragma Style_Checks ("-mrlut");

   input_stream_size : constant Integer := 10;
   --  Input_stream_size indicates how many tokens can
   --  be hold in input stream.

   input_stream : array (0 .. input_stream_size - 1) of boxed_token;

   index : Integer := 0;           --  Indicates the position of the next
                                   --  buffered token in the input stream.
   peek_count : Integer := 0;      --  # of tokens seen by peeking in the input stream.
   buffered : Integer := 0;        --  # of buffered tokens in the input stream.

   function tbox(token : yy_tokens.Token) return boxed_token is
     boxed : boxed_token;
     line : string ( 1 .. 1024 );
     line_length : Integer;
   begin
      boxed := new tokenbox;
      boxed.token := token;
      boxed.lval := YYLVal;
      boxed.line_number := yy_line_number;
      yy_get_token_line (line, line_length);
      boxed.line := new String (1 .. line_length);
      boxed.line (1 .. line_length ) := line (1 .. line_length);
      boxed.token_start := yy_begin_column;
      boxed.token_end := yy_end_column;
      return boxed;
   end tbox;

   function get return boxed_token is
      t : boxed_token;
   begin
      if buffered = 0 then
         --  No token is buffered in the input stream
         --  so we get input from lexical scanner and return.
         return tbox (${YYLEX});
      else
         --  return the next buffered token. And remove
         --  it from input stream.
         t := input_stream (index);
         yylval := t.lval;
         --  Increase index and decrease buffered has
         --  the affect of removing the returned token
         --  from input stream.
         index := (index + 1) mod input_stream_size;
         buffered := buffered - 1;
         if peek_count > 0 then
            --  Previously we were peeking the tokens
            --  from index - 1 to index - 1 + peek_count.
            --  But now token at index - 1 is returned
            --  and remove, so this token is no longer
            --  one of the token being peek. So we must
            --  decrease the peek_count. If peek_count
            --  is 0, we remains peeking 0 token, so we
            --  do nothing.
            peek_count := peek_count - 1;
         end if;
         return t;
      end if;
   end get;

   procedure reset_peek is
      --  Make it as if we have not peeked anything.
   begin
      peek_count := 0;
   end reset_peek;

   function peek return boxed_token is
      t : boxed_token;
   begin
      if peek_count = buffered then
         --  We have peeked all the buffered tokens
         --  in the input stream, so next peeked
         --  token should be got from lexical scanner.
         --  Also we must buffer that token in the
         --  input stream. It is the difference between
         --  peek and get.
         t := tbox (${YYLEX});
         input_stream ((index + buffered) mod input_stream_size) := t;
         buffered := buffered + 1;
         if buffered > input_stream_size then
            Text_IO.Put_Line ("Warning : input stream size exceed."
                              & " So token is lost in the input stream." );
         end if;

      else
         --  We have not peeked all the buffered tokens,
         --  so we peek next buffered token.

         t := input_stream ((index+peek_count) mod input_stream_size);
      end if;

      peek_count := peek_count + 1;
      return t;
   end peek;

   procedure unget (tok : in boxed_token) is
   begin
      --  First decrease the index.
      if index = 0 then
         index := input_stream_size - 1;
      else
         index := index - 1;
      end if;
      input_stream (index) := tok;
      buffered := buffered + 1;
      if buffered > input_stream_size then
        Text_IO.Put_Line ("Warning : input stream size exceed."
                          & " So token is lost in the input stream." );
      end if;

      if peek_count > 0 then
         --  We are peeking tokens, so we must increase
         --  peek_count to maintain the correct peeking position.
         peek_count := peek_count + 1;
      end if;
   end unget;

   end yyparser_input;


   package body user_defined_errors is

      procedure parser_error(Message : in String) is
      begin
         yy_error_report.report_continuable_error
            (yyparser_input.input_token.line_number,
             yyparser_input.input_token.token_start,
             yyparser_input.input_token.token_end,
             Message,
             True);
         yy_error_report.total_errors := yy_error_report.total_errors + 1;
      end parser_error;

      procedure parser_warning(Message : in String) is
      begin
         yy_error_report.report_continuable_error
            (yyparser_input.input_token.line_number,
             yyparser_input.input_token.token_start,
             yyparser_input.input_token.token_end,
             Message,
             False);
         yy_error_report.total_warnings := yy_error_report.total_warnings + 1;
      end parser_warning;

    end user_defined_errors;


    package body yyerror_recovery is

    max_forward_moves : constant Integer := 5;
    --  Indicates how many tokens we will peek at most during error recovery.

    type change_type is (replace, insert, delete);
    --  Indicates what kind of change error recovery does to the input stream.

    type correction_type is record
       --  Indicates the correction error recovery does to the input stream.
       change    :   change_type;
       score     :   Integer;
       tokenbox  :   yyparser_input.boxed_token;
    end record;

    procedure put_new_line is
       line_number_string : constant string :=
          Integer'Image (yyparser_input.input_token.line_number);
    begin
       yy_error_report.put (line_number_string);
       for i in 1 .. 5 - Integer (line_number_string'length) loop
          yy_error_report.put (" ");
       end loop;
       yy_error_report.put (yyparser_input.input_token.line.all);
    end put_new_line;


    procedure finale is
    begin
       if yy_error_report.total_errors > 0 then
          yy_error_report.Put_Line ("");
          yy_error_report.put ("Ayacc.YYParse : " & Natural'Image (yy_error_report.total_errors));
          if yy_error_report.total_errors = 1 then
             yy_error_report.Put_Line (" syntax error found.");
          else
             yy_error_report.Put_Line (" syntax errors found.");
          end if;
          yy_error_report.Finish_Output;
          raise yy_error_report.Syntax_Error;
       elsif yy_error_report.total_warnings > 0 then
          yy_error_report.Put_Line ("");
          yy_error_report.put ("Ayacc.YYParse : " & Natural'Image (yy_error_report.total_warnings));
          if yy_error_report.total_warnings = 1 then
             yy_error_report.Put_Line (" syntax warning found.");
          else
             yy_error_report.Put_Line (" syntax warnings found.");
          end if;

          yy_error_report.Finish_Output;
          raise yy_error_report.syntax_warning;
       end if;
       yy_error_report.Finish_Output;
    end finale;

    procedure flag_token (error : in Boolean := True) is
    --
    --  OVERVIEW
    --    This procedure will point out the position of the
    --    current token.
    --
    begin
       if yy.error_flag > 0 then
          --  We have not seen 3 valid shift yet, so we
          --  do not need to report this error.
          return;
       end if;

       if error then
          yy_error_report.put ("Error"); --  5 characters for line number.
       else
          yy_error_report.put("OK   ");
       end if;

       for i in 1 .. yyparser_input.input_token.token_start - 1 loop
          if yyparser_input.input_token.line (i) = Ascii.ht then
             yy_error_report.put (Ascii.ht);
          else
             yy_error_report.put (" ");
          end if;
       end loop;
       yy_error_report.Put_Line ("^");
    end flag_token;


    procedure print_correction_message (correction : in correction_type) is
    --
    --  OVERVIEW
    --    This is a local procedure used to print out the message
    --    about the correction error recovery did.
    --
    begin
       if yy.error_flag > 0 then
          --  We have not seen 3 valid shift yet, so we
          --  do not need to report this error.
          return;
      end if;

      flag_token;
      case correction.change is
         when delete =>
            yy_error_report.put ("token delete " );
            user_defined_errors.parser_error ("token delete " );

         when replace =>
            yy_error_report.put ("token replaced by " &
                                 yy_tokens.Token'Image (correction.tokenbox.Token));
            user_defined_errors.parser_error ("token replaced by " &
                                              yy_tokens.Token'Image (correction.tokenbox.token));

         when insert =>
            yy_error_report.put ("inserted token " &
                                yy_tokens.token'Image (correction.tokenbox.token));
            user_defined_errors.parser_error ("inserted token " &
                                              yy_tokens.Token'Image (correction.tokenbox.token));
      end case;

      if yy.debug then
         yy_error_report.Put_Line ("... Correction Score is"
                                   & Integer'Image (correction.score));
      else
         yy_error_report.Put_Line ("");
      end if;
      yy_error_report.Put_Line ("");
   end print_correction_message;

   procedure install_correction (correction : correction_type) is
       --  This is a local procedure used to install the correction.
   begin
      case correction.change is
         when delete  => null;
                          -- Since error found for current token,
                          -- no state is changed for current token.
                          -- If we resume Parser now, Parser will
                          -- try to read next token which has the
                          -- affect of ignoring current token.
                          -- So for deleting correction, we need to
                          -- do nothing.
         when replace => yyparser_input.unget(correction.tokenbox);
         when insert  => yyparser_input.unget(yyparser_input.input_token);
                         yyparser_input.input_token := null;
                         yyparser_input.unget(correction.tokenbox);
      end case;
   end install_correction;


   function simulate_moves return Integer is
   --
    --  OVERVIEW
    --    This is a local procedure simulating the Parser work to
    --    evaluate a potential correction. It will look at most
    --    max_forward_moves tokens. It behaves very similarly as
    --    the actual Parser except that it does not invoke user
    --    action and it exits when either error is found or
    --    the whole input is accepted. Simulate_moves also
    --    collects and returns the score. Simulate_Moves
    --    do the simulation on the copied state stack to
    --    avoid changing the original one.

       --  the score for each valid shift.
      shift_increment : constant Integer := 20;
      --  the score for each valid reduce.
      reduce_increment : constant Integer := 10;
      --  the score for accept action.
      accept_increment : Integer := 14 * max_forward_moves;
      --  the decrement for error found.
      error_decrement : Integer := -10 * max_forward_moves;

      --  Indicates how many reduces made between last shift
      --  and current shift.
      current_reduces : Integer := 0;

      --  Indicates how many reduces made till now.
      total_reduces : Integer := 0;

      --  Indicates how many tokens seen so far during simulation.
      tokens_seen : Integer := 0;

      score : Integer := 0; -- the score of the simulation.

      The_Copied_Stack : array (0 .. yy.stack_size) of yy.parse_state;
      The_Copied_Tos   : Integer;
      The_Copied_Input_Token : yyparser_input.boxed_token;
      Look_Ahead : Boolean := True;

   begin

      --  First we copy the state stack.
      for i in 0 .. yy.tos loop
         The_Copied_Stack (i) := yy.state_stack (i);
      end loop;
      The_Copied_Tos := yy.tos;
      The_Copied_Input_Token := yyparser_input.input_token;
      --  Reset peek_count because each simulation
      --  starts a new process of peeking.
      yyparser_input.reset_peek;

      --  Do the simulation.
      loop
         --  We peek at most max_forward_moves tokens during simulation.
         exit when tokens_seen = max_forward_moves;

         --  The following codes is very similar the codes in Parser.
         yy.index := Shift_Reduce_Offset (yy.state_stack (yy.tos));
         if Integer (Shift_Reduce_Matrix (yy.index).T) = yy.default then
            yy.action := Integer (Shift_Reduce_Matrix (yy.index).Act);
         else
            if look_ahead then
               look_ahead := False;
               --  Since it is in simulation, we peek the token instead of
               --  get the token.
               The_Copied_Input_Token  := yyparser_input.peek;
            end if;
            yy.action :=
              parse_action (The_Copied_Stack (The_Copied_Tos), The_Copied_Input_Token.token);
         end if;

         if yy.action >= yy.first_shift_entry then  -- SHIFT
            if yy.debug then
               shift_debug (yy.action, The_Copied_Input_Token.token);
            end if;

            --  Enter new state
            The_Copied_Tos := The_Copied_Tos + 1;
            The_Copied_Stack (The_Copied_Tos) := yy.action;

            --  Advance lookahead
            look_ahead := True;

            score := score + shift_increment + current_reduces * reduce_increment;
            current_reduces := 0;
            tokens_seen := tokens_seen + 1;

         elsif yy.action = yy.error_code then       --  ERROR
            score := score - total_reduces * reduce_increment;
            exit; -- exit the loop for simulation.

         elsif yy.action = yy.accept_code then
            score := score + accept_increment;
            exit; -- exit the loop for simulation.

         else --  Reduce Action

            --  Convert action into a rule
            yy.rule_id  := Rule (-1 * yy.action);

            --  Don't Execute User Action

            --  Pop RHS states and goto next state
            The_Copied_Tos      := The_Copied_Tos - Rule_Length (yy.rule_id) + 1;
            The_Copied_Stack (The_Copied_Tos) := goto_state (The_Copied_Stack (The_Copied_Tos - 1) ,
                                 Get_LHS_Rule (yy.rule_id));

            --  Leave value stack alone

            if yy.debug then
               reduce_debug (yy.rule_id,
                  goto_state (The_Copied_Stack (The_Copied_Tos - 1),
                              Get_LHS_Rule (yy.rule_id)));
            end if;

            --  reduces only credited to score when a token can be shifted
            --  but no more than 3 reduces can count between shifts
            current_reduces := current_reduces + 1;
            total_reduces := total_reduces + 1;

         end if;

      end loop; --  loop for simulation;

      yyparser_input.reset_peek;

      return score;
   end simulate_moves;



   procedure primary_recovery (best_correction : in out correction_type;
                               stop_score      : in Integer ) is
    --
    -- OVERVIEW
    --    This is a local procedure used by try_recovery. This
    --    procedure will try the following corrections :
    --      1. Delete current token.
    --      2. Replace current token with any token acceptible
    --         from current state, or,
    --         Insert any one of the tokens acceptible from current state.
    --
      token_code      : Integer;
      new_score       : Integer;
      the_boxed_token : yyparser_input.boxed_token;
   begin

      --  First try to delete current token.
      if yy.debug then
         yy_error_report.Put_Line ("trying to delete "
                                   & yy_tokens.token'Image (yyparser_input.input_token.token));
      end if;

      best_correction.change := delete;
      --  try to evaluate the correction. NOTE : simulating the Parser
      --  from current state has affect of ignoring current token
      --  because error was found for current token and no state
      --  was pushed to state stack.
      best_correction.score := simulate_moves;
      best_correction.tokenbox := null;

      --  If the score is less than stop_score, we try
      --  the 2nd kind of corrections, that is, replace or insert.
      if best_correction.score < stop_score then
         for i in shift_reduce_offset (yy.state_stack (yy.tos)) ..
                 (shift_reduce_offset (yy.state_stack (yy.tos) + 1) - 1) loop
            --  We try to use the acceptible token from current state
            --  to replace current token or try to insert the acceptible token.
            token_code := Integer (Shift_Reduce_Matrix (i).t);
            --  yy.default is not a valid token, we must exit.
            exit when token_code = yy.default;

            the_boxed_token := yyparser_input.tbox (yy_tokens.token'val(token_code));
            for change in replace .. insert loop
               --  We try replacing and the inserting.
               case change is
                  when replace => yyparser_input.unget(the_boxed_token);
                               -- put the_boxed_token into the input stream
                               -- has the affect of replacing current token
                               -- because current token has been retrieved
                               -- but no state was change because of the error.
                               if yy.debug then
                                  yy_error_report.Put_Line ("trying to replace "
                                          & yy_tokens.token'Image
                                             (yyparser_input.input_token.token)
                                          & " with "
                                          & yy_tokens.token'Image (the_boxed_token.token));
                               end if;
                  when insert  => yyparser_input.unget(yyparser_input.input_token);
                               yyparser_input.unget(the_boxed_token);
                               if yy.debug then
                                  yy_error_report.Put_Line ("trying to insert "
                                           & yy_tokens.token'Image (the_boxed_token.token)
                                           & " before "
                                           & yy_tokens.token'Image (
                                                yyparser_input.input_token.token));
                               end if;
               end case;

               -- Evaluate the correction.
               new_score := simulate_moves;

               if new_score > best_correction.score then
                  -- We find a higher score, so we overwrite the old one.
                  best_correction := (change, new_score, the_boxed_token);
               end if;

               -- We have change the input stream when we do replacing or
               -- inserting. So we must undo the affect.
               declare
                  ignore_result : yyparser_input.boxed_token;
               begin
                  case change is
                    when replace => ignore_result := yyparser_input.get;
                    when insert  => ignore_result := yyparser_input.get;
                                    ignore_result := yyparser_input.get;
                  end case;
               end;

               --  If we got a score higher than stop score, we
               --  feel it is good enough, so we exit.
               exit when best_correction.score > stop_score;

            end loop;  --  change in replace .. insert

            --  If we got a score higher than stop score, we
            --  feel it is good enough, so we exit.
            exit when best_correction.score > stop_score;

         end loop;  --  i in shift_reduce_offset...

      end if; --  best_correction.score < stop_score;

   end primary_recovery;


   procedure try_recovery is
    --
    -- OVERVIEW
    --   This is the main procedure doing error recovery.
    --   During the process of error recovery, we use score to
    --   evaluate the potential correction. When we try a potential
    --   correction, we will peek some future tokens and simulate
    --   the work of Parser. Any valid shift, reduce or accept action
    --   in the simulation leading from a potential correction
    --   will increase the score of the potential correction.
    --   Any error found during the simulation will decrease the
    --   score of the potential correction and stop the simulation.
    --   Since we limit the number of tokens being peeked, the
    --   simulation will stop no matter what the correction is.
    --   If the score of a potential correction is higher enough,
    --   we will accept that correction and install and let the Parser
    --   continues. During the simulation, we will do almost the
    --   same work as the actual Parser does, except that we do
    --   not invoke any user actions and we collect the score.
    --   So we will use the state_stack of the Parser. In order
    --   to avoid change the value of state_stack, we will make
    --   a copy of the state_stack and the simulation is done
    --   on the copy. Below is the outline of sequence of corrections
    --   the error recovery algorithm tries:
    --      1. Delete current token.
    --      2. Replace current token with any token acceptible
    --         from current state, or,
    --         Insert any one of the tokens acceptible from current state.
    --      3. If previous parser action is shift, back up one state,
    --         and try the corrections in 1 and 2 again.
    --      4. If none of the scores of the corrections above are highed
    --         enough, we invoke the handle_error in Ayacc.
    --
      correction : correction_type;
      backed_up  : Boolean := False; -- indicates whether or not we backed up
                                     -- during error recovery.
      -- scoring : evaluate a potential correction with a number. high is good
      min_ok_score : constant Integer := 70;       -- will rellluctantly use
      stop_score   : constant Integer := 100;      -- this or higher is best.
   begin

      -- First try recovery without backing up.
      primary_recovery (correction, stop_score);

      if correction.score < stop_score then
         --  The score of the correction is not high enough,
         --  so we try to back up and try more corrections.
         --  But we can back up only if previous Parser action
         --  is shift.
         if previous_action >= yy.first_shift_entry then
            --  Previous action is a shift, so we back up.
            backed_up := True;

            -- we put back the input token and
            -- roll back the state stack and input token.
            yyparser_input.unget (yyparser_input.input_token);
            yyparser_input.input_token := yyparser_input.previous_token;
            yy.tos := yy.tos - 1;

            --  Then we try recovery again
            primary_recovery (correction, stop_score);
         end if;
      end if;  --  correction_score < stop_score

      --  Now we have try all possible correction.
      --  The highest score is in correction.
      if correction.score >= min_ok_score then
         --  We accept this correction.

         --  First, if the input token resides on the different line
         --  of previous token and we have not backed up, we must
         --  output the new line before we printed the error message.
         --  If we have backed up, we do nothing here because
         --  previous line has been output.
         if not backed_up and then
            (line_number <
               yyparser_input.input_token.line_number ) then
            put_new_line;
            line_number := yyparser_input.input_token.line_number;
         end if;

         print_correction_message(correction);
         install_correction(correction);

      else
         --  No score is high enough, we try to invoke handle_error
         --  First, if we backed up during error recovery, we now must
         --  try to undo the affect of backing up.
         if backed_up then
            yyparser_input.input_token := yyparser_input.get;
            yy.tos := yy.tos + 1;
         end if;

         --  Output the new line if necessary because the
         --  new line has not been output yet.
         if line_number <
             yyparser_input.input_token.line_number then
            put_new_line;
            line_number := yyparser_input.input_token.line_number;
         end if;

         if yy.debug then
            if not backed_up then
               yy_error_report.Put_Line ("can't back yp over last token...");
            end if;
            yy_error_report.Put_Line ("1st level recovery failed, going to 2nd level...");
         end if;

         --  Point out the position of the token on which error occurs.
         flag_token;

         --  count it as error if it is a new error. NOTE : if correction is accepted, total_errors
         --  count will be increase during error reporting.
         if yy.error_flag = 0 then --  brand new error
            yy_error_report.total_errors := yy_error_report.total_errors + 1;
         end if;

         --  Goes to 2nd level.
         handle_error;

      end if; --  correction.score >= min_ok_score

      --  No matter what happen, let the parser move forward.
      yy.look_ahead := True;

   end try_recovery;


   end yyerror_recovery;


-- END OF UMASS CODES.
%end
   begin
      --  initialize by pushing state 0 and getting the first input symbol
      yy.state_stack (yy.tos) := 0;
%yyinit
%if error
-- UMASS CODES :
      yy_error_report.Initialize_Output;
      --  initialize input token and previous token
      yyparser_input.input_token := new yyparser_input.tokenbox;
      yyparser_input.input_token.line_number := 0;
-- END OF UMASS CODES.
%end

      loop
         yy.index := Shift_Reduce_Offset (yy.state_stack (yy.tos));
         if Integer (Shift_Reduce_Matrix (yy.index).T) = yy.default then
            yy.action := Integer (Shift_Reduce_Matrix (yy.index).Act);
         else
            if yy.look_ahead then
               yy.look_ahead := False;
%if error
-- UMASS CODES :
               --  Let Parser get the input from yyparser_input instead of lexical
               --  scanner and maintain previous_token and input_token.
               yyparser_input.previous_token := yyparser_input.input_token;
               yyparser_input.input_token := yyparser_input.get;
               yy.input_symbol := yyparser_input.input_token.token;
-- END OF UMASS CODES.
%else
               yy.input_symbol := ${YYLEX};
%end
            end if;
            yy.action := parse_action (yy.state_stack (yy.tos), yy.input_symbol);
         end if;

%if error
-- UMASS CODES :
         --   If input_token is not on the line yyerror_recovery.line_number,
         --   we just get to a new line. So we output the new line to
         --   file of error report. But if yy.action is error, we
         --   will not output the new line because we will do error
         --   recovery and during error recovery, we may back up
         --   which may cause error reported on previous line.
         --   So if yy.action is error, we will let error recovery
         --   to output the new line.
         if (yyerror_recovery.line_number <
             yyparser_input.input_token.line_number ) and then
            yy.action /= yy.error_code then
            put_new_line;
            yyerror_recovery.line_number := yyparser_input.input_token.line_number;
         end if;
-- END OF UMASS CODES.
%end

         if yy.action >= yy.first_shift_entry then  --  SHIFT

            if yy.debug then
               shift_debug (yy.action, yy.input_symbol);
            end if;

            --  Enter new state
            if yy.tos = yy.stack_size then
               Text_IO.Put_Line (" Stack size exceeded on state_stack");
               raise yy_tokens.Syntax_Error;
            end if;
            yy.tos                  := yy.tos + 1;
            yy.state_stack (yy.tos) := yy.action;
%if error
-- UMASS CODES :
            --   Set value stack only if valuing is True.
            if yyerror_recovery.valuing then
-- END OF UMASS CODES.
%end
            yy.value_stack (yy.tos) := YYLVal;
%if error
-- UMASS CODES :
            end if;
-- END OF UMASS CODES.
%end

            if yy.error_flag > 0 then  --  indicate a valid shift
               yy.error_flag := yy.error_flag - 1;
            end if;

            --  Advance lookahead
            yy.look_ahead := True;

         elsif yy.action = yy.error_code then       -- ERROR
%if error
-- UMASS CODES :
            try_recovery;
-- END OF UMASS CODES.
%else
            handle_error;
%end

         elsif yy.action = yy.accept_code then
            if yy.debug then
               Text_IO.Put_Line ("  --  Ayacc.YYParse: Accepting Grammar...");
%if error
-- UMASS CODES :
               yy_error_report.Put_Line ("Ayacc.YYParse: Accepting Grammar...");
-- END OF UMASS CODES.
%end
            end if;
            exit;

         else --  Reduce Action

            --  Convert action into a rule
            yy.rule_id := Rule (-1 * yy.action);

            --  Execute User Action
            --  user_action(yy.rule_id);
%if error
-- UMASS CODES :

            --   Only invoke semantic action if valuing is True.
            --   And if exception is raised during semantic action
            --   and total_errors is not zero, we set valuing to False
            --   because we assume that error recovery causes the exception
            --   and we no longer want to invoke any semantic action.
            if yyerror_recovery.valuing then
               begin
-- END OF UMASS CODES.
%end
            case yy.rule_id is
               pragma Style_Checks (Off);
%%4 rules
               pragma Style_Checks (On);

               when others => null;
            end case;

%if error
-- UMASS CODES :
            --   Corresponding to the codes above.
            exception
               when others =>
                  if yy_error_report.total_errors > 0 then
                     yyerror_recovery.valuing := False;
                     --  We no longer want to invoke any semantic action.
                  else
                     --  this exception is not caused by syntax error,
                     --  so we reraise anyway.
                     yy_error_report.Finish_Output;
                     raise;
                  end if;
            end;
            end if;

-- END OF UMASS CODES.
%end
            --  Pop RHS states and goto next state
            yy.tos := yy.tos - Rule_Length (yy.rule_id) + 1;
            if yy.tos > yy.stack_size then
               Text_IO.Put_Line (" Stack size exceeded on state_stack");
%if error
-- UMASS CODES :
               yy_error_report.Put_Line (" Stack size exceeded on state_stack");
               yyerror_recovery.finale;
-- END OF UMASS CODES.
%end
               raise yy_tokens.Syntax_Error;
            end if;
            yy.state_stack (yy.tos) := goto_state (yy.state_stack (yy.tos - 1),
                                                   Get_LHS_Rule (yy.rule_id));
%if error
-- UMASS CODES :
            --   Set value stack only if valuing is True.
            if yyerror_recovery.valuing then
-- END OF UMASS CODES.
%end

            yy.value_stack (yy.tos) := YYVal;
%if error
-- UMASS CODES :
            end if;
-- END OF UMASS CODES.
%end
            if yy.debug then
               reduce_debug (yy.rule_id,
                  goto_state (yy.state_stack (yy.tos - 1),
                              Get_LHS_Rule (yy.rule_id)));
            end if;

         end if;
%if error
-- UMASS CODES :

        --  If the error flag is set to zero at current token,
        --  we flag current token out.
        if yyerror_recovery.previous_error_flag > 0 and then
           yy.error_flag = 0 then
           yyerror_recovery.flag_token (error => False);
        end if;

        --   save the action made and error flag.
        yyerror_recovery.previous_action := yy.action;
        yyerror_recovery.previous_error_flag := yy.error_flag;
-- END OF UMASS CODES.
%end
      end loop;

   end ${YYPARSE};
