-------------------------------------------------------------------------------
-- (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 SPARK_Ada_Integer_Text_IO;
with Sparklalr_Char_Class;

use type Sparklalr_Char_Class.Char_Class;

package body Sparklalr_Error
--# own State is Blank_Line,
--#              Error_Set,
--#              Err_Ptr,
--#              Line_Out,
--#              Prod_Err,
--#              Sequenced,
--#              Tail_Ptr;
is

   Error_Table_Size : constant := 100;

   type Error_Set_T is array (Error_Range) of Boolean;

   Error_Set_False_Const : constant Error_Set_T := Error_Set_T'(others => False);

   subtype Pt_Error_Type is Natural range 0 .. Error_Table_Size;
   subtype Err_Array_Range is Positive range 1 .. Error_Table_Size;
   type Error_Type is record
      Used     : Boolean;
      Err_Col  : Err_Col_T;
      Error_No : Error_Range;
      Next     : Pt_Error_Type;
   end record;
   type Err_Array_T is array (Err_Array_Range) of Error_Type;

   subtype Line_Array_Range is Positive range 1 .. Sparklalr_Common.Line_Length;
   subtype Line_Array is String (Line_Array_Range);

   Err_Ptr    : Err_Array_T;
   Tail_Ptr   : Pt_Error_Type;
   Error_Set  : Error_Set_T;
   Prod_Err   : Boolean;
   Sequenced  : Boolean;
   Line_Out   : Line_Array;
   Blank_Line : Line_Array;

   -- Local procedures/functions
   procedure Skip_Seqno (F : in out SPARK.Ada.Text_IO.File_Type)
   --# global in Sequenced;
   --#        in Sparklalr_Char_Class.Charmap;
   --# derives F from *,
   --#                Sequenced,
   --#                Sparklalr_Char_Class.Charmap;
   is
      C           : Character;
      End_Of_Line : Boolean;
      I           : Integer;
   begin
      --# accept F, 10, End_Of_Line, "Ineffective assignment here expected";
      SPARK.Ada.Text_IO.Look_Ahead_File (File        => F,
                                         Item        => C,
                                         End_Of_Line => End_Of_Line);
      --# end accept;
      if Sequenced and then (Sparklalr_Char_Class.Get_Charmap (C) = Sparklalr_Char_Class.Digit) then
         --# accept F, 10, I, "Ineffective assignment here expected";
         SPARK_Ada_Integer_Text_IO.Get_File (File  => F,
                                             Item  => I,
                                             Width => 0);
         --# end accept;
         --# accept F, 10, End_Of_Line, "Ineffective assignment here expected";
         SPARK.Ada.Text_IO.Look_Ahead_File (File        => F,
                                            Item        => C,
                                            End_Of_Line => End_Of_Line);
         --# end accept;
         if C = ' ' then
            --# accept F, 10, C, "Skipping whitespace, so value is discarded OK";
            SPARK.Ada.Text_IO.Get_Character_File (File => F,
                                                  Item => C);
            --# end accept;
         end if;
      end if;
      --# accept F, 33, End_Of_Line, "Unused OK" &
      --#        F, 33, I, "Unused OK";
   end Skip_Seqno;

   procedure List_Errors (F : in out SPARK.Ada.Text_IO.File_Type)
   --# global in     Error_Set;
   --#        in out Err_Ptr;
   --#        in out SPARK.Ada.Text_IO.The_Standard_Output;
   --# derives Err_Ptr                               from * &
   --#         F,
   --#         SPARK.Ada.Text_IO.The_Standard_Output from *,
   --#                                                    Error_Set,
   --#                                                    Err_Ptr;
   is

      procedure Eprint (F : in out SPARK.Ada.Text_IO.File_Type)
      --# global in out Err_Ptr;
      --#        in out SPARK.Ada.Text_IO.The_Standard_Output;
      --# derives Err_Ptr,
      --#         F,
      --#         SPARK.Ada.Text_IO.The_Standard_Output from *,
      --#                                                    Err_Ptr;
      is
         T           : Pt_Error_Type;
         Min_Err_Col : Err_Col_T;
         Continue    : Boolean;
         Err_Head    : Pt_Error_Type;
         Column      : Err_Col_T;
      begin
         Err_Head := 1;
         Column   := 0;
         Continue := True;
         while Continue loop
            while Err_Head /= 0 loop
               if Err_Ptr (Err_Head).Err_Col < Column then
                  Err_Head := Err_Ptr (Err_Head).Next;
               else
                  Sparklalr_Common.Put_N_Chars
                    (Std_Out => True,
                     F       => F,
                     C       => '^',
                     N       => (Err_Ptr (Err_Head).Err_Col - Column) + 1);
                  SPARK_Ada_Integer_Text_IO.Put_Output (Item  => Err_Ptr (Err_Head).Error_No,
                                                        Width => 2,
                                                        Base  => 10);
                  SPARK.Ada.Text_IO.Put_Character_Output (Item => ' ');
                  Sparklalr_Common.Put_N_Chars
                    (Std_Out => False,
                     F       => F,
                     C       => '^',
                     N       => (Err_Ptr (Err_Head).Err_Col - Column) + 1);
                  SPARK_Ada_Integer_Text_IO.Put_File (File  => F,
                                                      Item  => Err_Ptr (Err_Head).Error_No,
                                                      Width => 2,
                                                      Base  => 10);
                  SPARK.Ada.Text_IO.Put_Character_File (File => F,
                                                        Item => ' ');
                  Column      := Err_Ptr (Err_Head).Err_Col + 4;
                  T           := Err_Head;
                  Err_Head    := Err_Ptr (Err_Head).Next;
                  Err_Ptr (T) := Error_Type'(Used     => False,
                                             Err_Col  => 0,
                                             Error_No => 0,
                                             Next     => 0);
               end if;
            end loop;
            SPARK.Ada.Text_IO.New_Line_Output (Spacing => 1);
            SPARK.Ada.Text_IO.New_Line_File (File    => F,
                                             Spacing => 1);
            Column := 0;

            Min_Err_Col := Sparklalr_Common.Line_Length;
            Continue    := False;
            for I in Err_Array_Range loop
               if Err_Ptr (I).Used then
                  if Min_Err_Col > Err_Ptr (I).Err_Col then
                     Min_Err_Col := Err_Ptr (I).Err_Col;
                     Err_Head    := I;
                  end if;
                  Continue := True;
               end if;
            end loop;
         end loop;
      end Eprint;

      procedure Emessages (Std_Out : in     Boolean;
                           F       : in out SPARK.Ada.Text_IO.File_Type)
      --# global in     Error_Set;
      --#        in out SPARK.Ada.Text_IO.The_Standard_Output;
      --# derives F,
      --#         SPARK.Ada.Text_IO.The_Standard_Output from *,
      --#                                                    Error_Set,
      --#                                                    Std_Out;
      is
      begin
         for I in Error_Range loop
            if Error_Set (I) then
               Sparklalr_Common.Put_File_Output (Std_Out => Std_Out,
                                                 File    => F,
                                                 Item    => "**ERROR**  :");
               Sparklalr_Common.Put_Integer_File_Output (Std_Out => Std_Out,
                                                         File    => F,
                                                         Item    => I,
                                                         Width   => 3);
               Sparklalr_Common.Put_File_Output (Std_Out => Std_Out,
                                                 File    => F,
                                                 Item    => "  ");
               case I is
                  when 0 =>
                     Sparklalr_Common.Put_Line_File_Output (Std_Out => Std_Out,
                                                            File    => F,
                                                            Item    => "LINE TOO LONG - TRUNCATED");
                  when 2 =>
                     Sparklalr_Common.Put_Line_File_Output (Std_Out => Std_Out,
                                                            File    => F,
                                                            Item    => "& NOT FOLLOWED BY KNOWN KEYWORD");
                  when 3 =>
                     Sparklalr_Common.Put_Line_File_Output
                       (Std_Out => Std_Out,
                        File    => F,
                        Item    => "UNEXPECTED SYMBOL - SKIPPING FORWARD");
                  when 4 =>
                     Sparklalr_Common.Put_Line_File_Output (Std_Out => Std_Out,
                                                            File    => F,
                                                            Item    => "NO ACTION FOLLOWING ""=""");
                  when 5 =>
                     Sparklalr_Common.Put_Line_File_Output (Std_Out => Std_Out,
                                                            File    => F,
                                                            Item    => "UNEXPECTED SYMBOL ON RHS");
                  when 6 =>
                     Sparklalr_Common.Put_Line_File_Output (Std_Out => Std_Out,
                                                            File    => F,
                                                            Item    => "COLON EXPECTED ON LHS");
                  when 7 =>
                     Sparklalr_Common.Put_Line_File_Output (Std_Out => Std_Out,
                                                            File    => F,
                                                            Item    => "LHS IDENTIFIER EXPECTED");
                  when 8 =>
                     Sparklalr_Common.Put_Line_File_Output (Std_Out => Std_Out,
                                                            File    => F,
                                                            Item    => "BAD TERM SECTION SYNTAX");
                  when 9 =>
                     Sparklalr_Common.Put_Line_File_Output (Std_Out => Std_Out,
                                                            File    => F,
                                                            Item    => "UNEXPECTED && - SKIPPED");
                  when 10 =>
                     Sparklalr_Common.Put_Line_File_Output (Std_Out => Std_Out,
                                                            File    => F,
                                                            Item    => "INVALID SYMBOL ENCOUNTERED");
                  when 12 =>
                     Sparklalr_Common.Put_Line_File_Output
                       (Std_Out => Std_Out,
                        File    => F,
                        Item    => "IDENTIFIER NOT FOUND AFTER &PREC");
                  when 13 =>
                     Sparklalr_Common.Put_Line_File_Output (Std_Out => Std_Out,
                                                            File    => F,
                                                            Item    => "NON-TERMINAL FOUND AFTER &PREC");
                  when 14 =>
                     Sparklalr_Common.Put_Line_File_Output
                       (Std_Out => Std_Out,
                        File    => F,
                        Item    => "TERMINAL SYMBOL ON LHS OF PRODUCTION");
                  when 15 =>
                     Sparklalr_Common.Put_Line_File_Output (Std_Out => Std_Out,
                                                            File    => F,
                                                            Item    => "TOO MANY NON-TERMINAL SYMBOLS");
                  when 16 =>
                     Sparklalr_Common.Put_Line_File_Output (Std_Out => Std_Out,
                                                            File    => F,
                                                            Item    => "TOO MANY TERMINAL SYMBOLS");
                  when 17 =>
                     Sparklalr_Common.Put_Line_File_Output (Std_Out => Std_Out,
                                                            File    => F,
                                                            Item    => "INVALID SYMBOL AFTER ""\"" ");
                  when 18 =>
                     Sparklalr_Common.Put_Line_File_Output
                       (Std_Out => Std_Out,
                        File    => F,
                        Item    => """\"" Substitution is not allowed in this version");
                  when others =>
                     null;
               end case;
            end if;
         end loop;
      end Emessages;

   begin -- List_Errors
      Eprint (F);
      Emessages (Std_Out => True,
                 F       => F);
      Emessages (Std_Out => False,
                 F       => F);
   end List_Errors;

   procedure List_Line (Std_Out : in     Boolean;
                        F       : in out SPARK.Ada.Text_IO.File_Type;
                        Col     : in     Err_Col_T)
   --# global in     Line_Out;
   --#        in out SPARK.Ada.Text_IO.The_Standard_Output;
   --# derives F,
   --#         SPARK.Ada.Text_IO.The_Standard_Output from *,
   --#                                                    Col,
   --#                                                    Line_Out,
   --#                                                    Std_Out;
   is
   begin
      Sparklalr_Common.Put_Character_File_Output (Std_Out => Std_Out,
                                                  File    => F,
                                                  Item    => ' ');
      if Col > 0 then
         for I in Integer range 1 .. Col loop
            Sparklalr_Common.Put_Character_File_Output (Std_Out => Std_Out,
                                                        File    => F,
                                                        Item    => Line_Out (I));
         end loop;
      end if;
      Sparklalr_Common.New_Line_File_Output (Std_Out => Std_Out,
                                             File    => F);
   end List_Line;
   -- End local procedures/functions

   procedure Initialise (F : in out SPARK.Ada.Text_IO.File_Type)
   --# global in     Sparklalr_Char_Class.Charmap;
   --#           out Blank_Line;
   --#           out Error_Set;
   --#           out Err_Ptr;
   --#           out Line_Out;
   --#           out Prod_Err;
   --#           out Sequenced;
   --#           out Tail_Ptr;
   --# derives Blank_Line,
   --#         Error_Set,
   --#         Err_Ptr,
   --#         Line_Out,
   --#         Prod_Err,
   --#         Tail_Ptr   from  &
   --#         F,
   --#         Sequenced  from F,
   --#                         Sparklalr_Char_Class.Charmap;
   is
      C           : Character;
      End_Of_Line : Boolean;
   begin
      Err_Ptr    := Err_Array_T'(others => Error_Type'(Used     => False,
                                                       Err_Col  => 0,
                                                       Error_No => 0,
                                                       Next     => 0));
      Tail_Ptr   := 0;
      Error_Set  := Error_Set_T'(others => False);
      Prod_Err   := False;
      Blank_Line := Line_Array'(others => ' ');
      Line_Out   := Blank_Line;
      Sequenced  := True;
      Skip_Seqno (F);
      --# accept F, 10, End_Of_Line, "Ineffective assignment here expected";
      SPARK.Ada.Text_IO.Look_Ahead_File (File        => F,
                                         Item        => C,
                                         End_Of_Line => End_Of_Line);
      --# end accept;
      Sequenced := Sparklalr_Char_Class.Get_Charmap (C) = Sparklalr_Char_Class.Digit;
      --# accept F, 33, End_Of_Line, "Unused OK";
   end Initialise;

   procedure Syn_Error (Error_Num : in Error_Range;
                        Col       : in Err_Col_T)
   --# global in out Error_Set;
   --#        in out Err_Ptr;
   --#        in out Tail_Ptr;
   --#           out Prod_Err;
   --# derives Error_Set from *,
   --#                        Error_Num &
   --#         Err_Ptr   from *,
   --#                        Col,
   --#                        Error_Num,
   --#                        Tail_Ptr &
   --#         Prod_Err  from  &
   --#         Tail_Ptr  from *;
   is
      T : Pt_Error_Type;
   begin
      Prod_Err    := True;
      T           := Tail_Ptr + 1;
      Err_Ptr (T) := Error_Type'(Used     => True,
                                 Err_Col  => Col,
                                 Error_No => Error_Num,
                                 Next     => 0);
      if Tail_Ptr /= 0 then
         Err_Ptr (Tail_Ptr).Next := T;
      end if;
      Tail_Ptr              := T;
      Error_Set (Error_Num) := True;
   end Syn_Error;

   procedure Error (F : in out SPARK.Ada.Text_IO.File_Type;
                    N : in     Integer)
   --# global in out SPARK.Ada.Text_IO.The_Standard_Output;
   --#           out Prod_Err;
   --# derives F,
   --#         SPARK.Ada.Text_IO.The_Standard_Output from *,
   --#                                                    N &
   --#         Prod_Err                              from ;
   is

      procedure Err_List (Std_Out : in     Boolean;
                          F       : in out SPARK.Ada.Text_IO.File_Type;
                          N       : in     Integer)
      --# global in out SPARK.Ada.Text_IO.The_Standard_Output;
      --# derives F,
      --#         SPARK.Ada.Text_IO.The_Standard_Output from *,
      --#                                                    N,
      --#                                                    Std_Out;
      is
      begin
         Sparklalr_Common.Put_File_Output (Std_Out => Std_Out,
                                           File    => F,
                                           Item    => "***ERROR***");
         Sparklalr_Common.Put_Integer_File_Output (Std_Out => Std_Out,
                                                   File    => F,
                                                   Item    => N,
                                                   Width   => 4);
         Sparklalr_Common.Put_File_Output (Std_Out => Std_Out,
                                           File    => F,
                                           Item    => "  ");

         --# accept W, 303, "when others covers all cases here";
         case N is
            when 0 =>
               Sparklalr_Common.Put_Line_File_Output
                 (Std_Out => Std_Out,
                  File    => F,
                  Item    => "LLAMA TERMINATED BEFORE END OF INPUT GRAMMAR FILE");
            when 1 =>
               Sparklalr_Common.Put_Line_File_Output
                 (Std_Out => Std_Out,
                  File    => F,
                  Item    => "NO GRAMMAR SPECIFICATIONS IN INPUT FILE");
            when 30 =>
               Sparklalr_Common.Put_File_Output (Std_Out => Std_Out,
                                                 File    => F,
                                                 Item    => "UNDEFINED NONTERMINAL SYMBOL -");
            when 32 | 36 | 50 =>
               Sparklalr_Common.Put_Line_File_Output
                 (Std_Out => Std_Out,
                  File    => F,
                  Item    => "INTERNAL LLAMA ERROR - CONSISTENCY CHECK");
            when others =>
               null;
         end case;
         --# end accept;
      end Err_List;

   begin -- Error
      Prod_Err := True;
      Err_List (Std_Out => False,
                F       => F,
                N       => N);
      Err_List (Std_Out => True,
                F       => F,
                N       => N);
   end Error;

   procedure Write_The_Line (F, Echo : in out SPARK.Ada.Text_IO.File_Type;
                             Col     : in out Err_Col_T)
   --# global in     Line_Out;
   --#        in     Sequenced;
   --#        in     Sparklalr_Char_Class.Charmap;
   --#        in out Error_Set;
   --#        in out Err_Ptr;
   --#        in out Prod_Err;
   --#        in out SPARK.Ada.Text_IO.The_Standard_Output;
   --#        in out Tail_Ptr;
   --# derives Col,
   --#         Error_Set                             from  &
   --#         Echo,
   --#         SPARK.Ada.Text_IO.The_Standard_Output from *,
   --#                                                    Col,
   --#                                                    Error_Set,
   --#                                                    Err_Ptr,
   --#                                                    Line_Out,
   --#                                                    Tail_Ptr &
   --#         Err_Ptr                               from *,
   --#                                                    Col,
   --#                                                    Error_Set,
   --#                                                    Tail_Ptr &
   --#         F                                     from *,
   --#                                                    Sequenced,
   --#                                                    Sparklalr_Char_Class.Charmap &
   --#         Prod_Err,
   --#         Tail_Ptr                              from *,
   --#                                                    Col;
   is
   begin
      if Col = Sparklalr_Common.Line_Length then
         Syn_Error (0, Col);
      end if;
      List_Line (Std_Out => False,
                 F       => Echo,
                 Col     => Col);
      if Error_Set /= Error_Set_False_Const then
         List_Line (Std_Out => True,
                    F       => Echo,
                    Col     => Col);
         List_Errors (Echo);
      end if;
      Error_Set := Error_Set_False_Const;
      Col       := 0;
      SPARK.Ada.Text_IO.Skip_Line_File (File    => F,
                                        Spacing => 1);
      if Sequenced then
         Skip_Seqno (F);
      end if;
   end Write_The_Line;

   procedure Set_Line_Out (I : in Err_Col_T;
                           C : in Character)
   --# global in out Line_Out;
   --# derives Line_Out from *,
   --#                       C,
   --#                       I;
   is
   begin
      Line_Out (I) := C;
   end Set_Line_Out;

   procedure List_Line_Errors (F   : in out SPARK.Ada.Text_IO.File_Type;
                               Col : in     Err_Col_T)
   --# global in     Error_Set;
   --#        in     Line_Out;
   --#        in out Err_Ptr;
   --#        in out SPARK.Ada.Text_IO.The_Standard_Output;
   --# derives Err_Ptr                               from *,
   --#                                                    Error_Set &
   --#         F,
   --#         SPARK.Ada.Text_IO.The_Standard_Output from *,
   --#                                                    Col,
   --#                                                    Error_Set,
   --#                                                    Err_Ptr,
   --#                                                    Line_Out;

   is
   begin
      if Error_Set /= Error_Set_False_Const then
         List_Line (Std_Out => False,
                    F       => F,
                    Col     => Col);
         List_Errors (F);
      end if;
   end List_Line_Errors;

   function Get_Prod_Err return Boolean
   --# global in Prod_Err;
   is
   begin
      return Prod_Err;
   end Get_Prod_Err;

end Sparklalr_Error;
