-------------------------------------------------------------------------------
-- (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 (Declarations.OutputDeclarations.GenerateDeclarations)
procedure GenerateSuccessors
  (Heap          : in out Cells.Heap_Record;
   Symbol        : in     Dictionary.Symbol;
   Scope         : in     Dictionary.Scopes;
   SuccessorList :    out Cells.Cell)
is

   SuccList : Cells.Cell;

   procedure AddSymbol (Sym  : in     Dictionary.Symbol;
                        List : in out Cells.Cell)
   --# global in     Dictionary.Dict;
   --#        in out Heap;
   --#        in out Statistics.TableUsage;
   --# derives Heap,
   --#         List,
   --#         Statistics.TableUsage from *,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    List,
   --#                                    Sym;
   is
   begin
      -- Boolean is predefined in FDL, so never need to add it here.
      -- Also, don't add Universal types, since we're only interested in
      -- adding successors which are named types at this stage.
      -- Add everything else to make sure the Pile contains all
      -- needed declarations.  Pile.Insert makes sure there are no
      -- duplicate entries.
      if not Dictionary.TypeIsBoolean (Sym)
        and then not Dictionary.IsUniversalIntegerType (Sym)
        and then not Dictionary.IsUniversalRealType (Sym)
        and then not Dictionary.IsUniversalFixedType (Sym) then
         Pile.Insert (Heap, Sym, Cells.Null_Cell, List);
      end if;
   end AddSymbol;

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

   procedure HandleObject (Sym  : in     Dictionary.Symbol;
                           List : in out Cells.Cell)
   --# global in     Dictionary.Dict;
   --#        in     Scope;
   --#        in out Heap;
   --#        in out Statistics.TableUsage;
   --# derives Heap,
   --#         List,
   --#         Statistics.TableUsage from *,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    List,
   --#                                    Scope,
   --#                                    Sym;
   is
      It      : Dictionary.Iterator;
      TypeSym : Dictionary.Symbol;
   begin
      -- If the Sym is an own variable, local to this package
      -- which has refinement constituents we need to get the types of the
      -- constituents in the list of required symbols so that we can print an
      -- fdl record type declaration
      if IsLocalOwnVariableWithRefinement (Sym, Scope) then
         It := Dictionary.FirstConstituent (Sym);
         while not Dictionary.IsNullIterator (It) loop
            AddSymbol (Dictionary.GetRootType (Dictionary.GetType (Dictionary.CurrentSymbol (It))), List);
            It := Dictionary.NextSymbol (It);
         end loop;
      end if;
      TypeSym := Dictionary.GetRootType (Dictionary.GetType (Sym));
      if Dictionary.IsOwnVariable (Sym) then
         TypeSym := Dictionary.GetRootType (Dictionary.GetOwnVariableTypeHere (Sym, Scope));
      end if;
      AddSymbol (TypeSym, List);
   end HandleObject;

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

   procedure HandleType (Sym  : in     Dictionary.Symbol;
                         List : in out Cells.Cell)
   --# global in     AttributeList;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     Scope;
   --#        in out Heap;
   --#        in out Statistics.TableUsage;
   --# derives Heap,
   --#         List,
   --#         Statistics.TableUsage from *,
   --#                                    AttributeList,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    LexTokenManager.State,
   --#                                    List,
   --#                                    Scope,
   --#                                    Sym;
   is

      Typ : Dictionary.Symbol;

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

      -- Creates a prexix cell, of provided type.
      procedure CreatePrefixCell (Typ        : in     Dictionary.Symbol;
                                  PrefixCell :    out Cells.Cell)
      --# global in out Heap;
      --#        in out Statistics.TableUsage;
      --# derives Heap                  from *,
      --#                                    Typ &
      --#         PrefixCell            from Heap &
      --#         Statistics.TableUsage from *,
      --#                                    Heap;
      is
         LocalPrefixCell : Cells.Cell;
      begin
         Cells.Create_Cell (Heap, LocalPrefixCell);
         Cells.Set_Kind (Heap, LocalPrefixCell, Cell_Storage.Fixed_Var);
         Cells.Set_Symbol_Value (Heap, LocalPrefixCell, Typ);
         PrefixCell := LocalPrefixCell;
      end CreatePrefixCell;

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

      -- Creates an attribute cell, of provided token.
      procedure CreateAttributeCell (AttributeToken : in     LexTokenManager.Lex_String;
                                     AttributeCell  :    out Cells.Cell)
      --# global in out Heap;
      --#        in out Statistics.TableUsage;
      --# derives AttributeCell         from Heap &
      --#         Heap                  from *,
      --#                                    AttributeToken &
      --#         Statistics.TableUsage from *,
      --#                                    Heap;
      is
         LocalAttributeCell : Cells.Cell;
      begin
         Cells.Create_Cell (Heap, LocalAttributeCell);
         Cells.Set_Kind (Heap, LocalAttributeCell, Cell_Storage.Attrib_Value);
         Cells.Set_Lex_Str (Heap, LocalAttributeCell, AttributeToken);
         AttributeCell := LocalAttributeCell;
      end CreateAttributeCell;

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

      -- Creates a tick cell.
      procedure CreateTickCell (TickCell : out Cells.Cell)
      --# global in out Heap;
      --#        in out Statistics.TableUsage;
      --# derives Heap,
      --#         Statistics.TableUsage from *,
      --#                                    Heap &
      --#         TickCell              from Heap;
      is
         LocalTickCell : Cells.Cell;
      begin
         Cells.Create_Cell (Heap, LocalTickCell);
         Cells.Set_Kind (Heap, LocalTickCell, Cell_Storage.Op);
         Cells.Set_Op_Symbol (Heap, LocalTickCell, SP_Symbols.apostrophe);
         TickCell := LocalTickCell;
      end CreateTickCell;

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

      -- This procedure re-factored and made visible here, so can be
      -- called from HandleRecordType below.
      procedure AddSizeAttribute (Typ : in Dictionary.Symbol)
      --# global in     AttributeList;
      --#        in     Dictionary.Dict;
      --#        in     LexTokenManager.State;
      --#        in out Heap;
      --#        in out Statistics.TableUsage;
      --# derives Heap,
      --#         Statistics.TableUsage from *,
      --#                                    AttributeList,
      --#                                    Dictionary.Dict,
      --#                                    Heap,
      --#                                    LexTokenManager.State,
      --#                                    Typ;
      is
         PrefixCell, AttributeCell, TickCell : Cells.Cell;
      begin
         -- Generate and add cell for: <prefix>'size
         CreatePrefixCell (Typ, PrefixCell);
         CreateAttributeCell (LexTokenManager.Size_Token, AttributeCell);
         CreateTickCell (TickCell);
         Cells.Set_A_Ptr (Heap, TickCell, PrefixCell);
         Cells.Set_B_Ptr (Heap, TickCell, AttributeCell);
         AddAttribute (Heap, TickCell);
      end AddSizeAttribute;

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

      -- Adds the type and the root type of each field of the given record type
      procedure HandleRecordType (Typ  : in     Dictionary.Symbol;
                                  List : in out Cells.Cell)
      --# global in     Dictionary.Dict;
      --#        in out Heap;
      --#        in out Statistics.TableUsage;
      --# derives Heap,
      --#         List,
      --#         Statistics.TableUsage from *,
      --#                                    Dictionary.Dict,
      --#                                    Heap,
      --#                                    List,
      --#                                    Typ;
      is
         ComponentIt : Dictionary.Iterator;
      begin
         ComponentIt := Dictionary.FirstRecordComponent (Typ);
         while not Dictionary.IsNullIterator (ComponentIt) loop
            AddSymbol (Dictionary.GetRootType (Dictionary.GetType (Dictionary.CurrentSymbol (ComponentIt))), List);
            AddSymbol (Dictionary.GetType (Dictionary.CurrentSymbol (ComponentIt)), List);
            ComponentIt := Dictionary.NextSymbol (ComponentIt);
         end loop;
      end HandleRecordType;

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

      -- Adds the type and the root type of each index of the given array type, followed
      -- by the type and the root type of the array element.
      procedure HandleArrayType (Typ  : in     Dictionary.Symbol;
                                 List : in out Cells.Cell)
      --# global in     Dictionary.Dict;
      --#        in out Heap;
      --#        in out Statistics.TableUsage;
      --# derives Heap,
      --#         List,
      --#         Statistics.TableUsage from *,
      --#                                    Dictionary.Dict,
      --#                                    Heap,
      --#                                    List,
      --#                                    Typ;
      is
         IndexIt : Dictionary.Iterator;
      begin
         IndexIt := Dictionary.FirstArrayIndex (Typ);
         while not Dictionary.IsNullIterator (IndexIt) loop
            AddSymbol (Dictionary.GetRootType (Dictionary.CurrentSymbol (IndexIt)), List);
            AddSymbol (Dictionary.CurrentSymbol (IndexIt), List);
            IndexIt := Dictionary.NextSymbol (IndexIt);
         end loop;
         AddSymbol (Dictionary.GetRootType (Dictionary.GetArrayComponent (Typ)), List);
         AddSymbol (Dictionary.GetArrayComponent (Typ), List);
      end HandleArrayType;

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

      -- The following adds Typ'First and Typ'Last of the given scalar type
      -- into the AttributeList so that we get fdl constant declarations
      -- and rules for them later on (even if they don't appear in the VC file
      -- itself.  For Modular types, Typ'Modulus is also added. For base types,
      -- Typ'Base'First and Typ'Base'Last are added.
      procedure AddScalarTypeToGetBoundsAttributes (Typ : in Dictionary.Symbol)
      --# global in     AttributeList;
      --#        in     Dictionary.Dict;
      --#        in     LexTokenManager.State;
      --#        in out Heap;
      --#        in out Statistics.TableUsage;
      --# derives Heap,
      --#         Statistics.TableUsage from *,
      --#                                    AttributeList,
      --#                                    Dictionary.Dict,
      --#                                    Heap,
      --#                                    LexTokenManager.State,
      --#                                    Typ;
      is
         PrefixCell, BasePrefixCell, AttributeCell, TickCell : Cells.Cell;

         -- Creates a base prexix cell, of provided type.
         -- Base types are indicated with a prefix cell of the correct type that
         -- has a A part that points to a prefix cell of the same type. Here
         -- the base prexix cell, is calculated from and makes use of the provided
         -- prefix cell.
         procedure CreateBasePrefixCell (PrefixCell     : in     Cells.Cell;
                                         BasePrefixCell :    out Cells.Cell)
         --# global in out Heap;
         --#        in out Statistics.TableUsage;
         --# derives BasePrefixCell        from Heap &
         --#         Heap                  from *,
         --#                                    PrefixCell &
         --#         Statistics.TableUsage from *,
         --#                                    Heap;
         is
            Typ                 : Dictionary.Symbol;
            LocalBasePrefixCell : Cells.Cell;
         begin
            -- Get the type of the prefix cell.
            Typ := Cells.Get_Symbol_Value (Heap, PrefixCell);

            Cells.Create_Cell (Heap, LocalBasePrefixCell);
            Cells.Set_Kind (Heap, LocalBasePrefixCell, Cell_Storage.Op);
            Cells.Set_Symbol_Value (Heap, LocalBasePrefixCell, Typ);

            -- Join to prefix cell.
            Cells.Set_A_Ptr (Heap, LocalBasePrefixCell, PrefixCell);

            BasePrefixCell := LocalBasePrefixCell;
         end CreateBasePrefixCell;

      begin

         -- All of the attributes added are for the same type, and thus may
         -- share the same prefix cell.
         CreatePrefixCell (Typ, PrefixCell);

         -- Generate and add cell for: <prefix>'first
         CreateAttributeCell (LexTokenManager.First_Token, AttributeCell);
         CreateTickCell (TickCell);
         Cells.Set_A_Ptr (Heap, TickCell, PrefixCell);
         Cells.Set_B_Ptr (Heap, TickCell, AttributeCell);
         AddAttribute (Heap, TickCell);

         -- Generate and add cell for: <prefix>'last
         CreateAttributeCell (LexTokenManager.Last_Token, AttributeCell);
         CreateTickCell (TickCell);
         Cells.Set_A_Ptr (Heap, TickCell, PrefixCell);
         Cells.Set_B_Ptr (Heap, TickCell, AttributeCell);
         AddAttribute (Heap, TickCell);

         -- As all of the base attributes are of the same type, they may
         -- share the same base prefix cell.
         CreateBasePrefixCell (PrefixCell, BasePrefixCell);

         -- Generate and add cell for: <prefix>'base'first
         CreateAttributeCell (LexTokenManager.First_Token, AttributeCell);
         CreateTickCell (TickCell);
         Cells.Set_A_Ptr (Heap, TickCell, BasePrefixCell);
         Cells.Set_B_Ptr (Heap, TickCell, AttributeCell);
         AddAttribute (Heap, TickCell);

         -- Generate and add cell for: <prefix>'base'first
         CreateAttributeCell (LexTokenManager.Last_Token, AttributeCell);
         CreateTickCell (TickCell);
         Cells.Set_A_Ptr (Heap, TickCell, BasePrefixCell);
         Cells.Set_B_Ptr (Heap, TickCell, AttributeCell);
         AddAttribute (Heap, TickCell);

         -- If this is a modular type, also add 'modulus
         if Dictionary.TypeIsModular (Typ) then
            -- Generate and add cell for: <prefix>'modulus
            CreateAttributeCell (LexTokenManager.Modulus_Token, AttributeCell);
            CreateTickCell (TickCell);
            Cells.Set_A_Ptr (Heap, TickCell, PrefixCell);
            Cells.Set_B_Ptr (Heap, TickCell, AttributeCell);
            AddAttribute (Heap, TickCell);
         end if;

      end AddScalarTypeToGetBoundsAttributes;

   begin -- HandleType;
      if Dictionary.IsPrivateType (Sym, Scope) then

         -- For a private type Sym, we normally produce no successors, other
         -- than Sym'Size and the case of a private tagged extension, where we need
         -- to produce a declaration of the type of the inherited component
         -- only.

         AddSizeAttribute (Sym);

         if Dictionary.TypeIsExtendedTagged (Sym) then
            AddSymbol (Dictionary.GetRootOfExtendedType (Sym), List);
         end if;
      elsif not Dictionary.IsUnknownTypeMark (Sym) and then not Dictionary.TypeIsOwnAbstractHere (Sym, Scope) then
         -- if not abstract view of own variable type,
         -- then produce successors
         Typ := Dictionary.GetRootType (Sym);
         if Dictionary.IsScalarTypeMark (Typ, Scope) then
            AddScalarTypeToGetBoundsAttributes (Typ);
            AddSymbol (Typ, List);
            AddSizeAttribute (Typ);

            -- If Sym denotes a scalar subtype, then we need attributes
            -- for it as well.
            if Sym /= Typ then
               AddScalarTypeToGetBoundsAttributes (Sym);
               AddSymbol (Sym, List);
               AddSizeAttribute (Sym);
            end if;
         elsif Dictionary.TypeIsAbstractProof (Typ) then
            AddSymbol (Typ, List);
         elsif Dictionary.IsRecordTypeMark (Typ, Scope) then
            HandleRecordType (Typ, List);
            AddSizeAttribute (Typ);

            -- If Sym denotes a subtype, then add a Size attribute for
            -- it as well.
            if Typ /= Sym then
               AddSizeAttribute (Sym);
            end if;
         elsif Dictionary.IsArrayTypeMark (Typ, Scope) then
            HandleArrayType (Typ, List);
            -- If Sym denotes a subtype, then add a Size attribute for
            -- it as well.
            if Typ /= Sym then
               AddSizeAttribute (Sym);
            end if;
         end if;
      end if;
   end HandleType;

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

   procedure HandleSubprogram (Sym  : in     Dictionary.Symbol;
                               List : in out Cells.Cell)
   --# global in     Dictionary.Dict;
   --#        in     Scope;
   --#        in out Heap;
   --#        in out Statistics.TableUsage;
   --# derives Heap,
   --#         List,
   --#         Statistics.TableUsage from *,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    List,
   --#                                    Scope,
   --#                                    Sym;
   is
      ParameterIt : Dictionary.Iterator;
      ParamSym    : Dictionary.Symbol;
   begin
      if Dictionary.IsFunction (Sym) then
         AddSymbol (Dictionary.GetRootType (Dictionary.GetType (Sym)), List);
      end if;
      ParameterIt := Dictionary.FirstSubprogramParameter (Sym);
      while not Dictionary.IsNullIterator (ParameterIt) loop
         ParamSym := Dictionary.CurrentSymbol (ParameterIt);

         if Dictionary.Is_Variable (ParamSym) and then Dictionary.IsOwnVariable (ParamSym) then
            AddSymbol (Dictionary.GetRootType (Dictionary.GetOwnVariableTypeHere (ParamSym, Scope)), List);
         else
            AddSymbol (Dictionary.GetRootType (Dictionary.GetType (ParamSym)), List);
         end if;
         ParameterIt := Dictionary.NextSymbol (ParameterIt);
      end loop;
   end HandleSubprogram;

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

   procedure HandleRecordComponent (Sym  : in     Dictionary.Symbol;
                                    List : in out Cells.Cell)
   --# global in     Dictionary.Dict;
   --#        in out Heap;
   --#        in out Statistics.TableUsage;
   --# derives Heap,
   --#         List,
   --#         Statistics.TableUsage from *,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    List,
   --#                                    Sym;
   is
   begin
      AddSymbol (Dictionary.GetRecordType (Sym), List);
   end HandleRecordComponent;

begin -- GenerateSuccessors;

   SuccList := Cells.Null_Cell;
   if Dictionary.Is_Variable (Symbol)
     or else Dictionary.Is_Constant (Symbol)
     or else Dictionary.IsEnumerationLiteral (Symbol)
     or else Dictionary.IsKnownDiscriminant (Symbol) then

      HandleObject (Symbol, SuccList);

   elsif Dictionary.IsTypeMark (Symbol) then
      HandleType (Symbol, SuccList);

   elsif Dictionary.IsProcedure (Symbol) or Dictionary.IsFunction (Symbol) then

      HandleSubprogram (Symbol, SuccList);

   elsif Dictionary.IsRecordComponent (Symbol) then

      HandleRecordComponent (Symbol, SuccList);
   end if;
   SuccessorList := SuccList;
end GenerateSuccessors;
