-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

separate (Dictionary)
procedure Add_Subprogram_Parameter
  (Name           : in LexTokenManager.Lex_String;
   The_Subprogram : in RawDict.Subprogram_Info_Ref;
   Type_Mark      : in RawDict.Type_Info_Ref;
   Type_Reference : in Location;
   Mode           : in Modes;
   Comp_Unit      : in ContextManager.UnitDescriptors;
   Specification  : in Location) is
   The_Subprogram_Parameter          : RawDict.Subprogram_Parameter_Info_Ref;
   The_Previous_Subprogram_Parameter : RawDict.Subprogram_Parameter_Info_Ref;

   --------------------------------------------------------------------------------

   procedure WriteSubprogramParameterSpecification
     (The_Subprogram_Parameter : in RawDict.Subprogram_Parameter_Info_Ref;
      Specification            : in Location)
   --# global in     Dict;
   --#        in     LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --# derives SPARK_IO.File_Sys from *,
   --#                                Dict,
   --#                                LexTokenManager.State,
   --#                                Specification,
   --#                                The_Subprogram_Parameter;
   is
   begin
      if SPARK_IO.Is_Open (Dict.TemporaryFile) then
         Write_String (Dict.TemporaryFile, "specification of ");
         Write_Name (File => Dict.TemporaryFile,
                     Item => RawDict.Get_Subprogram_Parameter_Symbol (The_Subprogram_Parameter));
         Write_String (Dict.TemporaryFile, " is at ");
         Write_Location (File => Dict.TemporaryFile,
                         Loc  => Specification);
         Write_Line (Dict.TemporaryFile, " ;");
      end if;
   end WriteSubprogramParameterSpecification;

   --------------------------------------------------------------------------------

   procedure AddConstraintSymbolsIfNeeded
     (Type_Mark                : in RawDict.Type_Info_Ref;
      The_Subprogram_Parameter : in RawDict.Subprogram_Parameter_Info_Ref;
      Comp_Unit                : in ContextManager.UnitDescriptors;
      Specification            : in Location)
   --# global in out Dict;
   --# derives Dict from *,
   --#                   Comp_Unit,
   --#                   Specification,
   --#                   The_Subprogram_Parameter,
   --#                   Type_Mark;
   is
      Number_Of_Dimensions : Positive;

      procedure AddConstraintSymbol
        (The_Subprogram_Parameter : in RawDict.Subprogram_Parameter_Info_Ref;
         Comp_Unit                : in ContextManager.UnitDescriptors;
         Specification            : in Location;
         Dimension                : in Positive)
      --# global in out Dict;
      --# derives Dict from *,
      --#                   Comp_Unit,
      --#                   Dimension,
      --#                   Specification,
      --#                   The_Subprogram_Parameter;
      is
         The_Parameter_Constraint : RawDict.Parameter_Constraint_Info_Ref;
      begin
         RawDict.Create_Parameter_Constraint
           (The_Subprogram_Parameter => The_Subprogram_Parameter,
            Dimension                => Dimension,
            Comp_Unit                => Comp_Unit,
            Loc                      => Specification.Start_Position,
            The_Parameter_Constraint => The_Parameter_Constraint);
         -- Now link new constraint to subprogram parameter - list ends up in dimension order
         RawDict.Set_Next_Parameter_Constraint
           (The_Parameter_Constraint => The_Parameter_Constraint,
            Next                     => RawDict.Get_Subprogram_Parameter_Index_Constraints (The_Subprogram_Parameter => The_Subprogram_Parameter));
         RawDict.Set_Subprogram_Parameter_Index_Constraints
           (The_Subprogram_Parameter => The_Subprogram_Parameter,
            The_Index_Constraints    => The_Parameter_Constraint);
      end AddConstraintSymbol;

   begin -- AddConstraintSymbolsIfNeeded
      if Is_Unconstrained_Array_Type (Type_Mark => Type_Mark) then
         Number_Of_Dimensions := Get_Number_Of_Dimensions (Type_Mark => Type_Mark);
         for I in reverse Positive range 1 .. Number_Of_Dimensions loop
            AddConstraintSymbol
              (The_Subprogram_Parameter => The_Subprogram_Parameter,
               Comp_Unit                => Comp_Unit,
               Specification            => Specification,
               Dimension                => I);
         end loop;
      end if;
   end AddConstraintSymbolsIfNeeded;

begin -- Add_Subprogram_Parameter
   RawDict.Create_Subprogram_Parameter
     (Name                     => Name,
      The_Subprogram           => The_Subprogram,
      Type_Mark                => Type_Mark,
      Mode                     => Mode,
      Comp_Unit                => Comp_Unit,
      Loc                      => Specification.Start_Position,
      The_Subprogram_Parameter => The_Subprogram_Parameter);

   The_Previous_Subprogram_Parameter := RawDict.Get_Subprogram_Last_Parameter (The_Subprogram => The_Subprogram);

   if The_Previous_Subprogram_Parameter = RawDict.Null_Subprogram_Parameter_Info_Ref then
      RawDict.Set_Subprogram_First_Parameter
        (The_Subprogram           => The_Subprogram,
         The_Subprogram_Parameter => The_Subprogram_Parameter);
   else
      RawDict.Set_Next_Subprogram_Parameter
        (The_Subprogram_Parameter => The_Previous_Subprogram_Parameter,
         Next                     => The_Subprogram_Parameter);
   end if;

   RawDict.Set_Subprogram_Last_Parameter (The_Subprogram           => The_Subprogram,
                                          The_Subprogram_Parameter => The_Subprogram_Parameter);

   AddConstraintSymbolsIfNeeded
     (Type_Mark                => Type_Mark,
      The_Subprogram_Parameter => The_Subprogram_Parameter,
      Comp_Unit                => Comp_Unit,
      Specification            => Specification);

   if Type_Mark /= Get_Unknown_Type_Mark then
      AddOtherReference (RawDict.Get_Type_Symbol (Type_Mark), RawDict.Get_Subprogram_Symbol (The_Subprogram), Type_Reference);
   end if;

   WriteSubprogramParameterSpecification (The_Subprogram_Parameter, Specification);
end Add_Subprogram_Parameter;
