-------------------------------------------------------------------------------
-- (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_Record_Component
  (Name                   : in LexTokenManager.Lex_String;
   Comp_Unit              : in ContextManager.UnitDescriptors;
   Declaration            : in Location;
   The_Record_Type        : in RawDict.Type_Info_Ref;
   The_Component_Type     : in RawDict.Type_Info_Ref;
   InheritedField         : in Boolean;
   ComponentTypeReference : in Location) is
   The_Record_Component, Previous : RawDict.Record_Component_Info_Ref;

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

   function Is_Record_Private (The_Record_Type, The_Component_Type : RawDict.Type_Info_Ref) return TriState
   --# global in Dict;
   is
      Is_Component_Private, Result : TriState;

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

      function Is_Private (Type_Mark : RawDict.Type_Info_Ref;
                           Scope     : Scopes) return TriState
      --# global in Dict;
      is
         Result : TriState;
      begin
         case RawDict.Get_Type_Private (Type_Mark => Type_Mark) is
            when Never =>
               Result := Never;
            when Sometimes =>
               if IsLocal (Scope, Get_Type_Scope (Type_Mark => Type_Mark)) then
                  Result := Sometimes;
               else
                  Result := Always;
               end if;
            when Always =>
               Result := Always;
         end case;
         return Result;
      end Is_Private;

   begin -- Is_Record_Private
      Is_Component_Private :=
        Is_Private (Type_Mark => The_Component_Type,
                    Scope     => Get_Type_Scope (Type_Mark => The_Record_Type));
      case RawDict.Get_Type_Private (Type_Mark => The_Record_Type) is
         when Never =>
            Result := Is_Component_Private;
         when Sometimes =>
            case Is_Component_Private is
               when Never | Sometimes =>
                  Result := Sometimes;
               when Always =>
                  Result := Always;
            end case;
         when Always =>
            Result := Always;
      end case;
      return Result;
   end Is_Record_Private;

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

   function Is_Record_Limited (The_Record_Type, The_Component_Type : RawDict.Type_Info_Ref) return TriState
   --# global in Dict;
   is
      Is_Component_Limited, Result : TriState;

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

      function Is_Limited (Type_Mark : RawDict.Type_Info_Ref;
                           Scope     : Scopes) return TriState
      --# global in Dict;
      is
         Result : TriState;
      begin
         case RawDict.Get_Type_Limited (Type_Mark => Type_Mark) is
            when Never =>
               Result := Never;
            when Sometimes =>
               if IsLocal (Scope, Get_Type_Scope (Type_Mark => Type_Mark)) then
                  Result := Sometimes;
               else
                  Result := Always;
               end if;
            when Always =>
               Result := Always;
         end case;
         return Result;
      end Is_Limited;

   begin -- Is_Record_Limited
      Is_Component_Limited :=
        Is_Limited (Type_Mark => The_Component_Type,
                    Scope     => Get_Type_Scope (Type_Mark => The_Record_Type));
      case RawDict.Get_Type_Limited (Type_Mark => The_Record_Type) is
         when Never =>
            Result := Is_Component_Limited;
         when Sometimes =>
            case Is_Component_Limited is
               when Never | Sometimes =>
                  Result := Sometimes;
               when Always =>
                  Result := Always;
            end case;
         when Always =>
            Result := Always;
      end case;
      return Result;
   end Is_Record_Limited;

begin -- Add_Record_Component
   RawDict.Create_Record_Component
     (Name                 => Name,
      Record_Type          => The_Record_Type,
      Component_Type       => The_Component_Type,
      Inherited_Field      => InheritedField,
      Comp_Unit            => Comp_Unit,
      Loc                  => Declaration.Start_Position,
      The_Record_Component => The_Record_Component);

   Previous := RawDict.Get_Type_Last_Record_Component (Type_Mark => The_Record_Type);
   if Previous = RawDict.Null_Record_Component_Info_Ref then
      RawDict.Set_Type_First_Record_Component (Type_Mark        => The_Record_Type,
                                               Record_Component => The_Record_Component);
   else
      RawDict.Set_Next_Record_Component (The_Record_Component => Previous,
                                         Next                 => The_Record_Component);
   end if;

   RawDict.Set_Type_Last_Record_Component (Type_Mark        => The_Record_Type,
                                           Record_Component => The_Record_Component);

   RawDict.Set_Type_Private
     (Type_Mark  => The_Record_Type,
      Is_Private => Is_Record_Private (The_Record_Type    => The_Record_Type,
                                       The_Component_Type => The_Component_Type));
   RawDict.Set_Type_Limited
     (Type_Mark  => The_Record_Type,
      Is_Limited => Is_Record_Limited (The_Record_Type    => The_Record_Type,
                                       The_Component_Type => The_Component_Type));
   RawDict.Set_Type_Equality_Defined
     (Type_Mark        => The_Record_Type,
      Equality_Defined => RawDict.Get_Type_Equality_Defined (Type_Mark => The_Record_Type)
        and then RawDict.Get_Type_Equality_Defined (Type_Mark => The_Component_Type));
   RawDict.Set_Type_Contains_Float
     (Type_Mark      => The_Record_Type,
      Contains_Float => RawDict.Get_Type_Contains_Float (Type_Mark => The_Record_Type)
        or else RawDict.Get_Type_Contains_Float (Type_Mark => The_Component_Type));

   if The_Component_Type /= Get_Unknown_Type_Mark then
      AddOtherReference
        (RawDict.Get_Type_Symbol (The_Component_Type),
         GetRegion (Get_Type_Scope (Type_Mark => The_Record_Type)),
         ComponentTypeReference);
   end if;
end Add_Record_Component;
