-------------------------------------------------------------------------------
-- (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.Command_Line;
with SPARK.Ada.Command_Line.Unbounded_String;
with SPARK.Ada.Text_IO;
with Fatal;

package body Command_Line_Options
--# own State is Debug,
--#              Dump_Mem,
--#              File_Name,
--#              Multi_Comp,
--#              Parser,
--#              Self_Pack,
--#              Verbose;
is

   type Debug_T is array (Debug_Level_Range) of Boolean;

   File_Name  : SPARK.Ada.Strings.Unbounded.Unbounded_String;
   Verbose    : Boolean;
   Debug      : Debug_T; -- DEBUG FLAGS
   Dump_Mem   : Boolean; -- FLAG FOR FINAL MEMORY DUMPING
   Parser     : Boolean;
   Self_Pack  : Boolean;
   Multi_Comp : Boolean;

   procedure Get_Options
   --# global in out SPARK.Ada.Command_Line.State;
   --#        in out SPARK.Ada.Text_IO.The_Standard_Error;
   --#           out Debug;
   --#           out Dump_Mem;
   --#           out File_Name;
   --#           out Multi_Comp;
   --#           out Parser;
   --#           out Self_Pack;
   --#           out Verbose;
   --# derives Debug,
   --#         Dump_Mem,
   --#         File_Name,
   --#         Multi_Comp,
   --#         Parser,
   --#         Self_Pack,
   --#         SPARK.Ada.Command_Line.State,
   --#         Verbose                              from SPARK.Ada.Command_Line.State &
   --#         SPARK.Ada.Text_IO.The_Standard_Error from *,
   --#                                                   SPARK.Ada.Command_Line.State;
   is

      Len_Cmd_Line : constant := 255; -- length of a command line string

      type Status_T is (Found, Missing, Invalid);
      subtype Cmd_Line_Range is Positive range 1 .. Len_Cmd_Line;

      Status        : Status_T;
      Switch        : SPARK.Ada.Strings.Unbounded.Unbounded_String;
      Cmd_Line_Pntr : Cmd_Line_Range;

      -- Get next parameter from command line and return it in conformant array 'String_Var'.
      -- Returns status which indicates result of operation in 'Status'.
      -- Pointer 'Cmd_Line_Pntr' is left pointing to next paramter to be read or last parameter in
      -- the command line.
      -- Where possible an syntactically invalid parameter is skipped so that subsequent
      -- calls to this procedure corectly return subsequent command line parameters.
      procedure Cl_Next_Param
        (Cmd_Line_Pntr : in out Cmd_Line_Range;
         String_Var    :    out SPARK.Ada.Strings.Unbounded.Unbounded_String;
         Status        :    out Status_T)
      --# global in SPARK.Ada.Command_Line.State;
      --# derives Cmd_Line_Pntr,
      --#         Status,
      --#         String_Var    from Cmd_Line_Pntr,
      --#                            SPARK.Ada.Command_Line.State;
      is
      begin
         if Cmd_Line_Pntr <= SPARK.Ada.Command_Line.Argument_Count then
            String_Var    := SPARK.Ada.Command_Line.Unbounded_String.Argument (Cmd_Line_Pntr);
            Status        := Found;
            Cmd_Line_Pntr := Cmd_Line_Pntr + 1;
         else
            String_Var := SPARK.Ada.Strings.Unbounded.Null_Unbounded_String;
            Status     := Missing;
         end if;
      end Cl_Next_Param;

      -- Checks if the command line has any unread parameters on it, returns True if yes,
      -- False if not. May be called at any time after a call to CL_Read.
      -- Does not affect the value of Cmd_Line_Pntr.
      function Cl_Empty (Cmd_Line_Pntr : in Cmd_Line_Range) return Boolean
      --# global in SPARK.Ada.Command_Line.State;
      is
      begin
         return Cmd_Line_Pntr > SPARK.Ada.Command_Line.Argument_Count;
      end Cl_Empty;

      procedure Cl_File_Name
        (Cmd_Line_Pntr : in out Cmd_Line_Range;
         File_Name     :    out SPARK.Ada.Strings.Unbounded.Unbounded_String;
         Status        :    out Status_T)
      --# global in SPARK.Ada.Command_Line.State;
      --# derives Cmd_Line_Pntr,
      --#         File_Name,
      --#         Status        from Cmd_Line_Pntr,
      --#                            SPARK.Ada.Command_Line.State;
      is

         -- Checks 'File_Name' for correct syntax
         procedure Check_File_Name (File_Name : in     SPARK.Ada.Strings.Unbounded.Unbounded_String;
                                    Status    : in out Status_T)
         --# derives Status from *,
         --#                     File_Name;
         is
            C : Character;
         begin
            if Status = Found then -- check File_Name characters are valid
               for I in Positive range 1 .. SPARK.Ada.Strings.Unbounded.Get_Length (Source => File_Name) loop
                  C := SPARK.Ada.Strings.Unbounded.Get_Element (Source => File_Name,
                                                                Index  => I);
                  if (I = 1 and then not (C in 'a' .. 'z' or else C in 'A' .. 'Z' or else C in '0' .. '9'))
                    or else (I /= 1 and then not (C in 'a' .. 'z' or else C in 'A' .. 'Z' or else C in '0' .. '9' or else C = '_'))
                  then
                     Status := Invalid;
                  end if;
               end loop;
            end if;
         end Check_File_Name;

      begin -- Cl_File_Name
         Cl_Next_Param (Cmd_Line_Pntr, File_Name, Status);
         Check_File_Name (File_Name, Status);
      end Cl_File_Name;

      procedure Cl_Switch
        (Cmd_Line_Pntr : in out Cmd_Line_Range;
         Switch        :    out SPARK.Ada.Strings.Unbounded.Unbounded_String;
         Status        :    out Status_T)
      --# global in SPARK.Ada.Command_Line.State;
      --# derives Cmd_Line_Pntr,
      --#         Status,
      --#         Switch        from Cmd_Line_Pntr,
      --#                            SPARK.Ada.Command_Line.State;
      is

         -- Checks Switch string for correct syntax
         procedure Check_Switch (Switch : in     SPARK.Ada.Strings.Unbounded.Unbounded_String;
                                 Status : in out Status_T)
         --# derives Status from *,
         --#                     Switch;
         is
            C : Character;
         begin
            if Status = Found then -- check Switch characters are valid
               for I in Positive range 1 .. SPARK.Ada.Strings.Unbounded.Get_Length (Source => Switch) loop
                  C := SPARK.Ada.Strings.Unbounded.Get_Element (Source => Switch,
                                                                Index  => I);
                  if not (C in 'a' .. 'z' or else C in 'A' .. 'Z' or else C = '-') then
                     Status := Invalid;
                  end if;
               end loop;
            end if;
         end Check_Switch;

      begin -- Cl_Switch
         Cl_Next_Param (Cmd_Line_Pntr, Switch, Status);
         Check_Switch (Switch, Status);
      end Cl_Switch;

   begin -- Get_Options
      Verbose       := False;
      Debug         := Debug_T'(others => False);
      Dump_Mem      := False;
      Parser        := False;
      Self_Pack     := False;
      Multi_Comp    := False;
      Cmd_Line_Pntr := 1;
      Cl_File_Name (Cmd_Line_Pntr, File_Name, Status);
      case Status is
         when Missing =>
            SPARK.Ada.Text_IO.Put_Line_Error (Item => "No grammar file name supplied");
            SPARK.Ada.Command_Line.Set_Exit_Status (SPARK.Ada.Command_Line.Failure);
            Fatal.Stop_With_Command_Line_Exception;
         when Invalid =>
            SPARK.Ada.Text_IO.Put_Line_Error (Item => "Grammar file name contains invalid characters");
            SPARK.Ada.Command_Line.Set_Exit_Status (SPARK.Ada.Command_Line.Failure);
            Fatal.Stop_With_Command_Line_Exception;
         when Found =>
            null;
      end case;
      while not Cl_Empty (Cmd_Line_Pntr) loop
         Cl_Switch (Cmd_Line_Pntr, Switch, Status);
         case Status is
            when Missing =>
               null;
            when Invalid =>
               SPARK.Ada.Text_IO.Put_Line_Error (Item => "Switch name contains invalid characters");
               SPARK.Ada.Command_Line.Set_Exit_Status (SPARK.Ada.Command_Line.Failure);
               Fatal.Stop_With_Command_Line_Exception;
            when Found =>
               if SPARK.Ada.Strings.Unbounded.Get_Length (Switch) > 1 then
                  case SPARK.Ada.Strings.Unbounded.Get_Element (Source => Switch,
                                                                Index  => 2) is
                     when 'v' =>
                        Verbose := True;
                     when 's' =>
                        Self_Pack := True;
                     when 'm' =>
                        Multi_Comp := True;
                     when 'd' =>
                        if SPARK.Ada.Strings.Unbounded.Get_Length (Switch) > 2 then
                           case SPARK.Ada.Strings.Unbounded.Get_Element (Source => Switch,
                                                                         Index  => 3) is
                              when 'a' =>
                                 Debug (1) := True;
                              when 'b' =>
                                 Debug (2) := True;
                              when 'c' =>
                                 Debug (3) := True;
                              when 'd' =>
                                 Debug (4) := True;
                              when 'e' =>
                                 Debug (5) := True;
                              when 'f' =>
                                 Debug (6) := True;
                              when 'g' =>
                                 Debug (7) := True;
                              when 'h' =>
                                 Debug (8) := True;
                              when 'i' =>
                                 Debug (9) := True;
                              when 'u' =>
                                 Dump_Mem := True;
                              when others =>
                                 SPARK.Ada.Text_IO.Put_Line_Error (Item => "Invalid switch");
                                 SPARK.Ada.Command_Line.Set_Exit_Status (SPARK.Ada.Command_Line.Failure);
                                 Fatal.Stop_With_Command_Line_Exception;
                           end case;
                        else
                           SPARK.Ada.Text_IO.Put_Line_Error (Item => "Invalid switch");
                           SPARK.Ada.Command_Line.Set_Exit_Status (SPARK.Ada.Command_Line.Failure);
                           Fatal.Stop_With_Command_Line_Exception;
                        end if;
                     when 'p' =>
                        Parser := True;
                     when others =>
                        SPARK.Ada.Text_IO.Put_Line_Error (Item => "Invalid switch");
                        SPARK.Ada.Command_Line.Set_Exit_Status (SPARK.Ada.Command_Line.Failure);
                        Fatal.Stop_With_Command_Line_Exception;
                  end case;
               else
                  SPARK.Ada.Text_IO.Put_Line_Error (Item => "Invalid switch");
                  SPARK.Ada.Command_Line.Set_Exit_Status (SPARK.Ada.Command_Line.Failure);
                  Fatal.Stop_With_Command_Line_Exception;
               end if;
         end case;
      end loop;
   end Get_Options;

   function Get_File_Name return  SPARK.Ada.Strings.Unbounded.Unbounded_String
   --# global in File_Name;
   is
   begin
      return File_Name;
   end Get_File_Name;

   function Get_Verbose return Boolean
   --# global in Verbose;
   is
   begin
      return Verbose;
   end Get_Verbose;

   function Get_Debug_Level (Level : in Debug_Level_Range) return Boolean
   --# global in Debug;
   is
   begin
      return Debug (Level);
   end Get_Debug_Level;

   function Get_Dump_Mem return Boolean
   --# global in Dump_Mem;
   is
   begin
      return Dump_Mem;
   end Get_Dump_Mem;

   function Get_Parser return Boolean
   --# global in Parser;
   is
   begin
      return Parser;
   end Get_Parser;

   function Get_Self_Pack return Boolean
   --# global in Self_Pack;
   is
   begin
      return Self_Pack;
   end Get_Self_Pack;

   function Get_Multi_Comp return Boolean
   --# global in Multi_Comp;
   is
   begin
      return Multi_Comp;
   end Get_Multi_Comp;

end Command_Line_Options;
