-------------------------------------------------------------------------------
-- (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 Cell_Storage;
with Clists;
with CStacks;
with Debug;
with E_Strings;
with Pile;
with SP_Symbols;
with SystemErrors;

use type SP_Symbols.SP_Symbol;

package body Declarations
--# own State is AttributeList,
--#              BitwiseOpList,
--#              ProcedureExportList,
--#              ReturnSymbol,
--#              RootIntegerUsed,
--#              UsedSymbols;
is

   UsedSymbols         : Cells.Cell := Cells.Null_Cell;
   AttributeList       : Cells.Cell := Cells.Null_Cell;
   BitwiseOpList       : Cells.Cell := Cells.Null_Cell;
   ProcedureExportList : Cells.Cell := Cells.Null_Cell;
   ReturnSymbol        : Cells.Cell := Cells.Null_Cell;
   RootIntegerUsed     : Boolean    := False;

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

   procedure StartProcessing (Heap : in out Cells.Heap_Record)
   --# global in out Statistics.TableUsage;
   --#           out AttributeList;
   --#           out BitwiseOpList;
   --#           out ProcedureExportList;
   --#           out ReturnSymbol;
   --#           out RootIntegerUsed;
   --#           out UsedSymbols;
   --# derives AttributeList,
   --#         BitwiseOpList,
   --#         Heap,
   --#         ProcedureExportList   from Heap &
   --#         ReturnSymbol,
   --#         RootIntegerUsed,
   --#         UsedSymbols           from  &
   --#         Statistics.TableUsage from *,
   --#                                    Heap;
   is
   begin
      UsedSymbols  := Cells.Null_Cell;
      ReturnSymbol := Cells.Null_Cell;
      Cells.Create_Cell (Heap, AttributeList);
      Cells.Create_Cell (Heap, ProcedureExportList);
      Cells.Create_Cell (Heap, BitwiseOpList);
      RootIntegerUsed := False;
   end StartProcessing;

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

   -- New check to ensure that we don't end up with Ada and Implicit
   -- proof functions in list of used symbols
   procedure Add (Heap   : in out Cells.Heap_Record;
                  Symbol : in     Dictionary.Symbol)
   --# global in     Dictionary.Dict;
   --#        in out Statistics.TableUsage;
   --#        in out UsedSymbols;
   --# derives Heap,
   --#         Statistics.TableUsage,
   --#         UsedSymbols           from *,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    Symbol,
   --#                                    UsedSymbols;
   is
   begin
      if not Dictionary.IsQuantifiedVariable (Symbol) then
         Pile.Insert (Heap, Symbol, Cells.Null_Cell, UsedSymbols);
      end if;
   end Add;

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

   procedure AddAttribute (Heap     : in out Cells.Heap_Record;
                           TickCell : in     Cells.Cell)
   --# global in     AttributeList;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in out Statistics.TableUsage;
   --# derives Heap,
   --#         Statistics.TableUsage from *,
   --#                                    AttributeList,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    LexTokenManager.State,
   --#                                    TickCell;
   is
      InsertPtr : Cells.Cell;

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

      function HasBase (TickCell : Cells.Cell) return Boolean
      --# global in Heap;
      is
      begin
         return Cells.Get_Kind (Heap, Cells.Get_A_Ptr (Heap, TickCell)) = Cell_Storage.Op;
      end HasBase;

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

      function PrefixVal (TickCell : Cells.Cell) return Integer
      --# global in Heap;
      is
         PrefixCell : Cells.Cell;
      begin
         PrefixCell := Cells.Get_A_Ptr (Heap, TickCell);
         if Cells.Get_Kind (Heap, PrefixCell) = Cell_Storage.Op then -- Base found
            PrefixCell := Cells.Get_A_Ptr (Heap, PrefixCell);
         end if;
         return Cells.Get_Natural_Value (Heap, PrefixCell);
      end PrefixVal;

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

      function IsEqual (TickCell1, TickCell2 : Cells.Cell) return Boolean
      --# global in Heap;
      --#        in LexTokenManager.State;
      is
      begin
         return PrefixVal (TickCell1) = PrefixVal (TickCell2)
           and then HasBase (TickCell1) = HasBase (TickCell2)
           and then LexTokenManager.Lex_String_Case_Insensitive_Compare
           (Lex_Str1 => Cells.Get_Lex_Str (Heap, Cells.Get_B_Ptr (Heap, TickCell1)),
            Lex_Str2 => Cells.Get_Lex_Str (Heap, Cells.Get_B_Ptr (Heap, TickCell2))) =
           LexTokenManager.Str_Eq
           and then Cells.Get_Assoc_Var (Heap, Cells.Get_B_Ptr (Heap, TickCell1)) =
           Cells.Get_Assoc_Var (Heap, Cells.Get_B_Ptr (Heap, TickCell2));
      end IsEqual;

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

      function IsGreater (TickCell1, TickCell2 : Cells.Cell) return Boolean
      --# global in Dictionary.Dict;
      --#        in Heap;
      --#        in LexTokenManager.State;
      is
         Result     : Boolean;
         Val1, Val2 : Integer;
         Result_Cmp : LexTokenManager.Str_Comp_Result;
      begin
         if HasBase (TickCell1) = HasBase (TickCell2) then
            Val1 := PrefixVal (TickCell1);
            Val2 := PrefixVal (TickCell2);
            if Val1 /= Val2 then
               Result := Val1 > Val2;
            else
               Result_Cmp :=
                 LexTokenManager.Lex_String_Case_Insensitive_Compare
                 (Lex_Str1 => Cells.Get_Lex_Str (Heap     => Heap,
                                                 CellName => Cells.Get_B_Ptr (Heap, TickCell1)),
                  Lex_Str2 => Cells.Get_Lex_Str (Heap     => Heap,
                                                 CellName => Cells.Get_B_Ptr (Heap, TickCell2)));
               if Result_Cmp /= LexTokenManager.Str_Eq then
                  Result := Result_Cmp = LexTokenManager.Str_First;
               else
                  Result :=
                    LexTokenManager.Lex_String_Case_Insensitive_Compare
                    (Lex_Str1 => Dictionary.GetSimpleName
                       (Item => Cells.Get_Assoc_Var (Heap     => Heap,
                                                     CellName => Cells.Get_B_Ptr (Heap, TickCell1))),
                     Lex_Str2 => Dictionary.GetSimpleName
                       (Item => Cells.Get_Assoc_Var (Heap     => Heap,
                                                     CellName => Cells.Get_B_Ptr (Heap, TickCell2)))) =
                    LexTokenManager.Str_First;
               end if;
            end if;
         else
            Result := HasBase (TickCell1);
         end if;
         return Result;
      end IsGreater;

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

      function NextTickCell (CurrentLink : Cells.Cell) return Cells.Cell
      --# global in Heap;
      --pre not Cells.Is_Null_Cell (Cells.Get_A_Ptr (Heap, CurrentLink));
      is
      begin
         return Cells.Get_C_Ptr (Heap, Cells.Get_A_Ptr (Heap, CurrentLink));
      end NextTickCell;

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

      procedure InsertAfter (InsertPoint : in Cells.Cell;
                             TickCell    : in Cells.Cell)
      --# global in out Heap;
      --#        in out Statistics.TableUsage;
      --# derives Heap                  from *,
      --#                                    InsertPoint,
      --#                                    TickCell &
      --#         Statistics.TableUsage from *,
      --#                                    Heap;
      is
         NewLink : Cells.Cell;
      begin
         Cells.Create_Cell (Heap, NewLink);
         Cells.Set_A_Ptr (Heap, NewLink, Cells.Get_A_Ptr (Heap, InsertPoint));
         Cells.Set_A_Ptr (Heap, InsertPoint, NewLink);
         Cells.Set_C_Ptr (Heap, NewLink, TickCell);
      end InsertAfter;

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

   begin --AddAttribute
      if LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Cells.Get_Lex_Str (Heap, Cells.Get_B_Ptr (Heap, TickCell)),
         Lex_Str2 => LexTokenManager.Base_Token) /=
        LexTokenManager.Str_Eq then

         InsertPtr := AttributeList;
         loop
            if Cells.Is_Null_Cell (Cells.Get_A_Ptr (Heap, InsertPtr)) then
               InsertAfter (InsertPtr, TickCell);
               exit;
            end if;

            if IsGreater (TickCell, NextTickCell (InsertPtr)) then
               InsertAfter (InsertPtr, TickCell);
               exit;
            end if;

            if IsEqual (TickCell, NextTickCell (InsertPtr)) then
               exit;
            end if;

            InsertPtr := Cells.Get_A_Ptr (Heap, InsertPtr);
         end loop;
      end if;
   end AddAttribute;

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

   procedure AddBitwiseOp (Heap   : in out Cells.Heap_Record;
                           OpCell : in     Cells.Cell)
   --# global in     BitwiseOpList;
   --#        in     Dictionary.Dict;
   --#        in out Statistics.TableUsage;
   --#        in out UsedSymbols;
   --# derives Heap,
   --#         Statistics.TableUsage from *,
   --#                                    BitwiseOpList,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    OpCell,
   --#                                    UsedSymbols &
   --#         UsedSymbols           from *,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    OpCell;
   is
      InsertPtr : Cells.Cell;

      function IsEqual (OpCell1, OpCell2 : Cells.Cell) return Boolean
      --# global in Heap;
      is
      begin
         return ((Cells.Get_Natural_Value (Heap, OpCell1) = Cells.Get_Natural_Value (Heap, OpCell2))
                 and then (Cells.Get_Op_Symbol (Heap, OpCell1) = Cells.Get_Op_Symbol (Heap, OpCell2)));
      end IsEqual;

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

      function IsGreater (OpCell1, OpCell2 : Cells.Cell) return Boolean
      --# global in Heap;
      is
         Result     : Boolean;
         Val1, Val2 : Integer;
      begin
         Val1 := Cells.Get_Natural_Value (Heap, OpCell1);
         Val2 := Cells.Get_Natural_Value (Heap, OpCell2);
         if Val1 = Val2 then
            Result := Cells.Get_Op_Symbol (Heap, OpCell1) > Cells.Get_Op_Symbol (Heap, OpCell2);
         else
            Result := Val1 > Val2;
         end if;
         return Result;
      end IsGreater;

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

      function NextOpCell (CurrentLink : Cells.Cell) return Cells.Cell
      --# global in Heap;
      --pre not Cells.Is_Null_Cell (Cells.Get_A_Ptr (Heap, CurrentLink));
      is
      begin
         return Cells.Get_C_Ptr (Heap, Cells.Get_A_Ptr (Heap, CurrentLink));
      end NextOpCell;

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

      procedure InsertAfter (InsertPoint : in Cells.Cell;
                             OpCell      : in Cells.Cell)
      --# global in out Heap;
      --#        in out Statistics.TableUsage;
      --# derives Heap                  from *,
      --#                                    InsertPoint,
      --#                                    OpCell &
      --#         Statistics.TableUsage from *,
      --#                                    Heap;
      is
         NewLink : Cells.Cell;
      begin
         Cells.Create_Cell (Heap, NewLink);
         Cells.Set_A_Ptr (Heap, NewLink, Cells.Get_A_Ptr (Heap, InsertPoint));
         Cells.Set_A_Ptr (Heap, InsertPoint, NewLink);
         Cells.Set_C_Ptr (Heap, NewLink, OpCell);
      end InsertAfter;

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

   begin --AddBitwiseOp
      Add (Heap, Cells.Get_Symbol_Value (Heap, OpCell)); -- To get a type declaration
      InsertPtr := BitwiseOpList;
      loop
         if Cells.Is_Null_Cell (Cells.Get_A_Ptr (Heap, InsertPtr)) then
            InsertAfter (InsertPtr, OpCell);
            exit;
         end if;

         if IsGreater (OpCell, NextOpCell (InsertPtr)) then
            InsertAfter (InsertPtr, OpCell);
            exit;
         end if;

         if IsEqual (OpCell, NextOpCell (InsertPtr)) then
            exit;
         end if;

         InsertPtr := Cells.Get_A_Ptr (Heap, InsertPtr);
      end loop;
   end AddBitwiseOp;

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

   procedure AddProcedureExport (Heap       : in out Cells.Heap_Record;
                                 ExportCell : in     Cells.Cell)
   --# global in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     ProcedureExportList;
   --#        in out Statistics.TableUsage;
   --#        in out UsedSymbols;
   --# derives Heap,
   --#         Statistics.TableUsage,
   --#         UsedSymbols           from *,
   --#                                    Dictionary.Dict,
   --#                                    ExportCell,
   --#                                    Heap,
   --#                                    LexTokenManager.State,
   --#                                    ProcedureExportList,
   --#                                    UsedSymbols;
   is
      NewLink : Cells.Cell;

      function AlreadyPresent return Boolean
      --# global in ExportCell;
      --#        in Heap;
      --#        in LexTokenManager.State;
      --#        in ProcedureExportList;
      is
         CurrentCell : Cells.Cell;
         Found       : Boolean;
      begin
         Found       := False;
         CurrentCell := Cells.Get_A_Ptr (Heap, ProcedureExportList);
         while CurrentCell /= Cells.Null_Cell and not Found loop
            Found       := Cells.Get_Symbol_Value (Heap, CurrentCell) = Cells.Get_Symbol_Value (Heap, ExportCell)
              and then LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Cells.Get_Lex_Str (Heap, CurrentCell),
               Lex_Str2 => Cells.Get_Lex_Str (Heap, ExportCell)) =
              LexTokenManager.Str_Eq;
            CurrentCell := Cells.Get_A_Ptr (Heap, CurrentCell);
         end loop;

         return Found;
      end AlreadyPresent;

   begin -- AddProcedureExport
      if not AlreadyPresent then
         Add (Heap, Cells.Get_Symbol_Value (Heap, ExportCell)); -- Ensure we get a type decl

         Cells.Create_Cell (Heap, NewLink);
         -- put in linked list
         Cells.Set_A_Ptr (Heap, NewLink, Cells.Get_A_Ptr (Heap, ProcedureExportList));
         Cells.Set_A_Ptr (Heap, ProcedureExportList, NewLink);
         -- Copy in values to new list element
         Cells.Set_Symbol_Value (Heap, NewLink, Cells.Get_Symbol_Value (Heap, ExportCell));
         Cells.Set_Lex_Str (Heap, NewLink, Cells.Get_Lex_Str (Heap, ExportCell));
      end if;

   end AddProcedureExport;

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

   procedure AddReturnVar (Heap          : in out Cells.Heap_Record;
                           ReturnVarCell : in     Cells.Cell)
   --# global in     Dictionary.Dict;
   --#        in out Statistics.TableUsage;
   --#        in out UsedSymbols;
   --#           out ReturnSymbol;
   --# derives Heap,
   --#         Statistics.TableUsage,
   --#         UsedSymbols           from *,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    ReturnVarCell,
   --#                                    UsedSymbols &
   --#         ReturnSymbol          from ReturnVarCell;
   is
   begin
      Add (Heap, Cells.Get_Symbol_Value (Heap, ReturnVarCell)); -- To get a type declaration
      ReturnSymbol := ReturnVarCell;
   end AddReturnVar;

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

   procedure AddUseOfRootInteger
   --# global out RootIntegerUsed;
   --# derives RootIntegerUsed from ;
   is
   begin
      RootIntegerUsed := True;
   end AddUseOfRootInteger;

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

   procedure Find_DAG_Declarations (Heap : in out Cells.Heap_Record;
                                    Root : in     Cells.Cell)

   --# global in     AttributeList;
   --#        in     BitwiseOpList;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     ProcedureExportList;
   --#        in out ReturnSymbol;
   --#        in out RootIntegerUsed;
   --#        in out Statistics.TableUsage;
   --#        in out UsedSymbols;
   --# derives Heap,
   --#         ReturnSymbol,
   --#         RootIntegerUsed,
   --#         Statistics.TableUsage,
   --#         UsedSymbols           from *,
   --#                                    AttributeList,
   --#                                    BitwiseOpList,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    LexTokenManager.State,
   --#                                    ProcedureExportList,
   --#                                    Root,
   --#                                    UsedSymbols;

   is
      P, Parenthesis_Cell, Sq_Bracket_Cell : Cells.Cell;
      Parenthesis_Form                     : SP_Symbols.SP_Symbol;
      Par_Reqd                             : Boolean;
      S                                    : CStacks.Stack;

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

      function Is_Leaf (Node : Cells.Cell) return Boolean
      --# global in Heap;
      is
      begin
         return Cells.Is_Null_Cell (Cells.Get_B_Ptr (Heap, Node));
      end Is_Leaf;

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

      procedure Parenthesise
        (V                : in     Cells.Cell;
         Left_Tree        : in     Boolean;
         Par_Reqd         :    out Boolean;
         Parenthesis_Form :    out SP_Symbols.SP_Symbol)
      --# global in Heap;
      --# derives Parenthesis_Form from Heap,
      --#                               V &
      --#         Par_Reqd         from Heap,
      --#                               Left_Tree,
      --#                               V;
      is

         V_Precedence, W_Precedence : Natural;
         Operand, W                 : Cells.Cell;
         V_Kind                     : Cells.Cell_Kind;

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

         function Precedence_Value (C : Cells.Cell) return Natural
         --# global in Heap;
         is
            Prec_Val : Natural;
         begin
            if Cells.Get_Kind (Heap, C) = Cell_Storage.FDL_Div_Op then
               Prec_Val := 5;
            else
               case Cells.Get_Op_Symbol (Heap, C) is
                  when SP_Symbols.RWand            |
                    SP_Symbols.RWor             |
                    SP_Symbols.RWandthen        |
                    SP_Symbols.RWorelse         |
                    SP_Symbols.implies          |
                    SP_Symbols.RWnot            |
                    SP_Symbols.is_equivalent_to =>
                     Prec_Val := 1;
                  when SP_Symbols.equals           |
                    SP_Symbols.not_equal        |
                    SP_Symbols.less_than        |
                    SP_Symbols.less_or_equal    |
                    SP_Symbols.greater_than     |
                    SP_Symbols.greater_or_equal =>
                     Prec_Val := 2;
                  when SP_Symbols.plus | SP_Symbols.minus | SP_Symbols.ampersand =>
                     Prec_Val := 3;
                  when SP_Symbols.multiply | SP_Symbols.divide | SP_Symbols.RWmod =>
                     Prec_Val := 5;
                  when SP_Symbols.double_star =>
                     Prec_Val := 6;
                  when others =>
                     Prec_Val := 7;
               end case;
            end if;
            return Prec_Val;
         end Precedence_Value;

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

      begin -- Parenthesise;
         Par_Reqd         := False;
         Parenthesis_Form := SP_Symbols.left_paren;
         V_Kind           := Cells.Get_Kind (Heap, V);
         if (V_Kind = Cell_Storage.Declared_Function) or
           (V_Kind = Cell_Storage.Proof_Function) or
           (V_Kind = Cell_Storage.Attrib_Function) or
           (V_Kind = Cell_Storage.Field_Access_Function) or
           (V_Kind = Cell_Storage.Mk_Aggregate) or
           (V_Kind = Cell_Storage.List_Function) or
           (V_Kind = Cell_Storage.Element_Function) or
           (V_Kind = Cell_Storage.Update_Function) or
           (V_Kind = Cell_Storage.Pred_Function) or
           (V_Kind = Cell_Storage.Succ_Function) or
           (V_Kind = Cell_Storage.Abs_Function) or
           (V_Kind = Cell_Storage.Trunc_Function) or
           (V_Kind = Cell_Storage.Field_Update_Function) or
           (V_Kind = Cell_Storage.Bitwise_Op) then
            Par_Reqd := True;
            if (V_Kind = Cell_Storage.List_Function) then
               Parenthesis_Form := SP_Symbols.square_open;
            end if;
         elsif ((V_Kind = Cell_Storage.Op)
                -- TEMPORARY FIX until right_paren given its own kind
                and then ((Cells.Get_Op_Symbol (Heap, V) /= SP_Symbols.right_paren)
                          -- END OF TEMPORARY FIX
                          and
                            (Cells.Get_Op_Symbol (Heap, V) /= SP_Symbols.comma)))
           or else (V_Kind = Cell_Storage.FDL_Div_Op) then

            if Cells.Is_Null_Cell (Cells.Get_A_Ptr (Heap, V)) then
               -- V is a monadic operator;
               Operand := Cells.Get_B_Ptr (Heap, V);
               if not Is_Leaf (Node => Operand) then
                  Par_Reqd := True;
               end if;
            else
               if Left_Tree then
                  W := Cells.Get_A_Ptr (Heap, V);
               else
                  W := Cells.Get_B_Ptr (Heap, V);
               end if;
               if not Cells.Is_Null_Cell (W) then
                  if (Cells.Get_Kind (Heap, W) = Cell_Storage.Op)
                    or else (Cells.Get_Kind (Heap, W) = Cell_Storage.FDL_Div_Op) then

                     V_Precedence := Precedence_Value (C => V);
                     W_Precedence := Precedence_Value (C => W);

                     -- general rule for constructing unambiguous expressions:
                     Par_Reqd := (V_Precedence > W_Precedence) or ((V_Precedence = W_Precedence) and not Left_Tree);

                     -- supplementary rules, to improve clarity:
                     if (V_Precedence = 1) or        -- v is a logical operation;
                       (W_Precedence = 2) then      -- subtree is a relation;
                        Par_Reqd := True;
                     end if;
                  end if;
               end if;
            end if;
         end if;
      end Parenthesise;

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

      procedure Find_Cell_Contents_Declarations (Heap      : in out Cells.Heap_Record;
                                                 Cell_Name : in     Cells.Cell)
      --# global in     AttributeList;
      --#        in     BitwiseOpList;
      --#        in     Dictionary.Dict;
      --#        in     LexTokenManager.State;
      --#        in     ProcedureExportList;
      --#        in out ReturnSymbol;
      --#        in out RootIntegerUsed;
      --#        in out Statistics.TableUsage;
      --#        in out UsedSymbols;
      --# derives Heap,
      --#         Statistics.TableUsage from *,
      --#                                    AttributeList,
      --#                                    BitwiseOpList,
      --#                                    Cell_Name,
      --#                                    Dictionary.Dict,
      --#                                    Heap,
      --#                                    LexTokenManager.State,
      --#                                    ProcedureExportList,
      --#                                    UsedSymbols &
      --#         ReturnSymbol,
      --#         RootIntegerUsed       from *,
      --#                                    Cell_Name,
      --#                                    Heap &
      --#         UsedSymbols           from *,
      --#                                    Cell_Name,
      --#                                    Dictionary.Dict,
      --#                                    Heap,
      --#                                    LexTokenManager.State,
      --#                                    ProcedureExportList;
      is

         Id_Ref : Dictionary.Symbol;

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

         procedure Find_Manifest_Constant_Cell_Declarations (Cell_Name : in Cells.Cell)
         --# global in     Dictionary.Dict;
         --#        in     LexTokenManager.State;
         --#        in out Heap;
         --#        in out Statistics.TableUsage;
         --#        in out UsedSymbols;
         --# derives Heap,
         --#         Statistics.TableUsage,
         --#         UsedSymbols           from *,
         --#                                    Cell_Name,
         --#                                    Dictionary.Dict,
         --#                                    Heap,
         --#                                    LexTokenManager.State,
         --#                                    UsedSymbols;
         is
            Ex_String : E_Strings.T;
            L_Str     : LexTokenManager.Lex_String;
         begin --FindManifestConstantCell
            L_Str     := Cells.Get_Lex_Str (Heap, Cell_Name);
            Ex_String := LexTokenManager.Lex_String_To_String (Lex_Str => L_Str);
            if E_Strings.Get_Element (E_Str => Ex_String,
                                      Pos   => 1) = ''' then --character literal
               Add (Heap, Dictionary.GetPredefinedCharacterType);

            elsif E_Strings.Get_Element (E_Str => Ex_String,
                                         Pos   => 1) = '"' then --string literal
               Add (Heap, Dictionary.GetPredefinedCharacterType);
               Add (Heap, Dictionary.GetPredefinedStringType);

            else -- should be a numeric
               null;
            end if;
         end Find_Manifest_Constant_Cell_Declarations;

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

      begin -- Find_Cell_Contents_Declarations
         case Cells.Get_Kind (Heap, Cell_Name) is

            when Cell_Storage.Manifest_Const =>
               Find_Manifest_Constant_Cell_Declarations (Cell_Name => Cell_Name);

            when Cell_Storage.Op =>
               if Cells.Get_Op_Symbol (Heap, Cell_Name) = SP_Symbols.apostrophe then
                  AddAttribute (Heap, Cell_Name);
               end if;

            when Cell_Storage.Return_Var =>
               AddReturnVar (Heap, Cell_Name);

            when Cell_Storage.Named_Const =>
               Id_Ref := Cells.Get_Symbol_Value (Heap, Cell_Name);
               Add (Heap, Id_Ref);

            when Cell_Storage.Declared_Function              |
              Cell_Storage.Proof_Function                 |
              Cell_Storage.Modified_Op                    |
              Cell_Storage.Reference                      |
              Cell_Storage.Constraining_Index             |
              Cell_Storage.Fixed_Var                      |
              Cell_Storage.Mk_Aggregate                   |
              Cell_Storage.Unconstrained_Attribute_Prefix =>

               Id_Ref := Cells.Get_Symbol_Value (Heap, Cell_Name);

               if Cells.Get_Kind (Heap, Cell_Name) = Cell_Storage.Mk_Aggregate and then Dictionary.IsSubtype (Id_Ref) then
                  Id_Ref := Dictionary.GetRootType (Id_Ref);
               end if;

               Add (Heap, Id_Ref);

            when Cell_Storage.Root_Integer =>
               AddUseOfRootInteger;

            when Cell_Storage.Bitwise_Op =>
               if Dictionary.TypeIsArray (Cells.Get_Symbol_Value (Heap, Cell_Name)) then
                  AddBitwiseOp (Heap, Cell_Name);
               end if;

            when Cell_Storage.Procedure_Export =>
               AddProcedureExport (Heap, Cell_Name);

            when others =>
               null;

         end case;
      end Find_Cell_Contents_Declarations;

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

   begin -- Find_DAG_Declarations
         -- Algorithm of D.E. Knuth, Fundamental Algorithms, p.317;
      CStacks.CreateStack (S);
      Cells.Create_Cell (Heap, Parenthesis_Cell);
      Cells.Set_Kind (Heap, Parenthesis_Cell, Cell_Storage.Op);
      Cells.Set_Op_Symbol (Heap, Parenthesis_Cell, SP_Symbols.left_paren);
      Cells.Create_Cell (Heap, Sq_Bracket_Cell);
      Cells.Set_Op_Symbol (Heap, Sq_Bracket_Cell, SP_Symbols.square_open);
      P := Root;
      loop
         loop
            exit when Cells.Is_Null_Cell (P);
            CStacks.Push (Heap, P, S);
            if Is_Leaf (Node => P) then
               P := Cells.Null_Cell;
            else
               if (not Cells.Is_Null_Cell (Cells.Get_A_Ptr (Heap, P))) then
                  Parenthesise (V                => P,
                                Left_Tree        => True,
                                Par_Reqd         => Par_Reqd,
                                Parenthesis_Form => Parenthesis_Form);
                  if Par_Reqd then
                     if Parenthesis_Form = SP_Symbols.left_paren then
                        CStacks.Push (Heap, Parenthesis_Cell, S);
                     else
                        CStacks.Push (Heap, Sq_Bracket_Cell, S);
                     end if;
                  end if;
               end if;
               P := Cells.Get_A_Ptr (Heap, P);
            end if;
         end loop;
         exit when CStacks.IsEmpty (S);
         P := CStacks.Top (Heap, S);
         CStacks.Pop (Heap, S);

         Find_Cell_Contents_Declarations (Heap      => Heap,
                                          Cell_Name => P);

         if Is_Leaf (Node => P) then
            P := Cells.Null_Cell;
            loop
               exit when not ((Cells.Are_Identical (CStacks.Top (Heap, S), Parenthesis_Cell)) or
                                (Cells.Are_Identical (CStacks.Top (Heap, S), Sq_Bracket_Cell)));
               CStacks.Pop (Heap, S);
            end loop;
         else
            Parenthesise (V                => P,
                          Left_Tree        => False,
                          Par_Reqd         => Par_Reqd,
                          Parenthesis_Form => Parenthesis_Form);
            if Par_Reqd then
               if Parenthesis_Form = SP_Symbols.left_paren then
                  CStacks.Push (Heap, Parenthesis_Cell, S);
               else
                  CStacks.Push (Heap, Sq_Bracket_Cell, S);
               end if;
            end if;
            P := Cells.Get_B_Ptr (Heap, P);
         end if;
      end loop;
   end Find_DAG_Declarations;

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

   procedure FindVCFormulaDeclarations
     (Heap                   : in out Cells.Heap_Record;
      PredicatePair          : in     Pairs.Pair;
      IgnoreTriviallyTrueVCs : in     Boolean)
   --# global in     AttributeList;
   --#        in     BitwiseOpList;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     ProcedureExportList;
   --#        in out ReturnSymbol;
   --#        in out RootIntegerUsed;
   --#        in out Statistics.TableUsage;
   --#        in out UsedSymbols;
   --# derives Heap,
   --#         ReturnSymbol,
   --#         RootIntegerUsed,
   --#         Statistics.TableUsage,
   --#         UsedSymbols           from *,
   --#                                    AttributeList,
   --#                                    BitwiseOpList,
   --#                                    Dictionary.Dict,
   --#                                    Heap,
   --#                                    IgnoreTriviallyTrueVCs,
   --#                                    LexTokenManager.State,
   --#                                    PredicatePair,
   --#                                    ProcedureExportList,
   --#                                    UsedSymbols;
   is
      ConclusionRoot, HypothesisRoot : Cells.Cell;

      -- GAA duplicated code from DAG_IO.ADB
      function IsTriviallyTrue (DAG : Cells.Cell) return Boolean
      --# global in Dictionary.Dict;
      --#        in Heap;
      is
         CurrentCell : Cells.Cell;
         Result      : Boolean := True;

         function IsTrueCell (TheCell : Cells.Cell) return Boolean
         --# global in Dictionary.Dict;
         --#        in Heap;
         is
         begin
            return Cells.Get_Kind (Heap, TheCell) = Cell_Storage.Named_Const
              and then Dictionary.IsEnumerationLiteral (Cells.Get_Symbol_Value (Heap, TheCell))
              and then Dictionary.Enumeration_Literals_Are_Equal
              (Left_Symbol  => Cells.Get_Symbol_Value (Heap, TheCell),
               Right_Symbol => Dictionary.GetTrue);
         end IsTrueCell;

         function AppropriateBinaryOperator (OpSym : SP_Symbols.SP_Symbol) return Boolean is
         begin
            return OpSym = SP_Symbols.RWand
              or else OpSym = SP_Symbols.RWandthen
              or else OpSym = SP_Symbols.RWor
              or else OpSym = SP_Symbols.RWorelse
              or else OpSym = SP_Symbols.equals
              or else OpSym = SP_Symbols.implies
              or else OpSym = SP_Symbols.is_equivalent_to;
         end AppropriateBinaryOperator;

      begin --IsTriviallyTrue
         CurrentCell := DAG;
         loop
            exit when IsTrueCell (CurrentCell); --success condition

            --some expression other than an operator - fail
            if Cells.Get_Kind (Heap, CurrentCell) /= Cell_Storage.Op then
               Result := False;
               exit;
            end if;

            --inappropriate operator - fail
            if not AppropriateBinaryOperator (Cells.Get_Op_Symbol (Heap, CurrentCell)) then
               Result := False;
               exit;
            end if;

            --thing on left of operator is not true - fail
            if not IsTrueCell (Cells.Get_A_Ptr (Heap, CurrentCell)) then
               Result := False;
               exit;
            end if;

            --move down right hand chain of tree to get next sub-expression
            CurrentCell := Cells.Get_B_Ptr (Heap, CurrentCell);

            --fallen off the end - fail - (I think this check is redundant but safe)
            if Cells.Is_Null_Cell (CurrentCell) then
               Result := False;
               exit;
            end if;

         end loop;
         return Result;
      end IsTriviallyTrue;

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

      procedure FindLogicalExpnDeclarations (Heap : in out Cells.Heap_Record;
                                             Root : in     Cells.Cell)
      --# global in     AttributeList;
      --#        in     BitwiseOpList;
      --#        in     Dictionary.Dict;
      --#        in     LexTokenManager.State;
      --#        in     ProcedureExportList;
      --#        in out ReturnSymbol;
      --#        in out RootIntegerUsed;
      --#        in out Statistics.TableUsage;
      --#        in out UsedSymbols;
      --# derives Heap,
      --#         ReturnSymbol,
      --#         RootIntegerUsed,
      --#         Statistics.TableUsage,
      --#         UsedSymbols           from *,
      --#                                    AttributeList,
      --#                                    BitwiseOpList,
      --#                                    Dictionary.Dict,
      --#                                    Heap,
      --#                                    LexTokenManager.State,
      --#                                    ProcedureExportList,
      --#                                    Root,
      --#                                    UsedSymbols;
      is
         SubExpnList : Cells.Cell;

         procedure Partition
         --# global in     Root;
         --#        in     SubExpnList;
         --#        in out Heap;
         --#        in out Statistics.TableUsage;
         --# derives Heap,
         --#         Statistics.TableUsage from *,
         --#                                    Heap,
         --#                                    Root,
         --#                                    SubExpnList;
         is
            P, SubExpn : Cells.Cell;
            S          : CStacks.Stack;
         begin
            CStacks.CreateStack (S);
            P := Root;
            loop
               loop
                  exit when Cells.Is_Null_Cell (P);
                  CStacks.Push (Heap, P, S);
                  if (Cells.Get_Kind (Heap, P) = Cell_Storage.Op)
                    and then ((Cells.Get_Op_Symbol (Heap, P) = SP_Symbols.RWand) or
                                (Cells.Get_Op_Symbol (Heap, P) = SP_Symbols.RWandthen)) then
                     P := Cells.Get_A_Ptr (Heap, P);
                  else
                     Cells.Create_Cell (Heap, SubExpn);
                     Cells.Set_B_Ptr (Heap, SubExpn, P);
                     Clists.AppendCell (Heap, SubExpn, SubExpnList);
                     P := Cells.Null_Cell;
                  end if;
               end loop;
               exit when CStacks.IsEmpty (S);
               P := CStacks.Top (Heap, S);
               CStacks.Pop (Heap, S);
               if (Cells.Get_Kind (Heap, P) = Cell_Storage.Op)
                 and then ((Cells.Get_Op_Symbol (Heap, P) = SP_Symbols.RWand) or
                             (Cells.Get_Op_Symbol (Heap, P) = SP_Symbols.RWandthen)) then
                  P := Cells.Get_B_Ptr (Heap, P);
               else
                  P := Cells.Null_Cell;
               end if;
            end loop;
         end Partition;

         procedure FindListOfExpnsDeclarations
         --# global in     AttributeList;
         --#        in     BitwiseOpList;
         --#        in     Dictionary.Dict;
         --#        in     LexTokenManager.State;
         --#        in     ProcedureExportList;
         --#        in     SubExpnList;
         --#        in out Heap;
         --#        in out ReturnSymbol;
         --#        in out RootIntegerUsed;
         --#        in out Statistics.TableUsage;
         --#        in out UsedSymbols;
         --# derives Heap,
         --#         ReturnSymbol,
         --#         RootIntegerUsed,
         --#         Statistics.TableUsage,
         --#         UsedSymbols           from *,
         --#                                    AttributeList,
         --#                                    BitwiseOpList,
         --#                                    Dictionary.Dict,
         --#                                    Heap,
         --#                                    LexTokenManager.State,
         --#                                    ProcedureExportList,
         --#                                    SubExpnList,
         --#                                    UsedSymbols;
         is
            ListMember : Cells.Cell;
         begin
            -- This looks like the place to suppress multiple Trues in hypotheses
            -- and do something with trues in conclusions
            ListMember := Clists.FirstCell (Heap, SubExpnList);
            loop
               Find_DAG_Declarations (Heap => Heap,
                                      Root => Cells.Get_B_Ptr (Heap, ListMember));
               ListMember := Clists.NextCell (Heap, ListMember);
               exit when Cells.Is_Null_Cell (ListMember);
            end loop;
         end FindListOfExpnsDeclarations;

      begin -- FindLogicalExpnDeclarations
         Clists.CreateList (Heap, SubExpnList);
         Partition;
         FindListOfExpnsDeclarations;
         Clists.DisposeOfList (Heap, SubExpnList);
      end FindLogicalExpnDeclarations;

   begin --FindVCFormulaDeclarations
      HypothesisRoot := Cells.Get_B_Ptr (Heap, Pairs.PairHead (PredicatePair));
      ConclusionRoot := Cells.Get_C_Ptr (Heap, Pairs.PairHead (PredicatePair));

      if IgnoreTriviallyTrueVCs and then IsTriviallyTrue (ConclusionRoot) then
         null;
      else
         FindLogicalExpnDeclarations (Heap, HypothesisRoot);
         FindLogicalExpnDeclarations (Heap, ConclusionRoot);
      end if;
   end FindVCFormulaDeclarations;

   procedure Initialize (It : out UsedSymbolIterator)
   --# global in UsedSymbols;
   --# derives It from UsedSymbols;
   is
   begin
      It := UsedSymbolIterator'(It => UsedSymbols);
   end Initialize;

   function CurrentNode (It : in UsedSymbolIterator) return Cells.Cell is
   begin
      return It.It;
   end CurrentNode;

   function NextNode (Heap : in Cells.Heap_Record;
                      It   : in UsedSymbolIterator) return UsedSymbolIterator is
   begin
      return UsedSymbolIterator'(It => Cells.Get_A_Ptr (Heap, It.It));
   end NextNode;

   function IsNullIterator (It : in UsedSymbolIterator) return Boolean is
   begin
      return It = NullIterator;
   end IsNullIterator;

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

   procedure PrintDeclarationTail (File : in SPARK_IO.File_Type) is
   begin
      SPARK_IO.New_Line (File, 1);
      SPARK_IO.Put_Line (File, "end;", 0);
   end PrintDeclarationTail;

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

   procedure OutputDeclarations
     (Heap        : in out Cells.Heap_Record;
      File        : in     SPARK_IO.File_Type;
      Rule_File   : in     SPARK_IO.File_Type;
      Scope       : in     Dictionary.Scopes;
      Write_Rules : in     Boolean;
      EndPosition : in     LexTokenManager.Token_Position)
   --# global in     AttributeList;
   --#        in     BitwiseOpList;
   --#        in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     ProcedureExportList;
   --#        in     ReturnSymbol;
   --#        in     RootIntegerUsed;
   --#        in     UsedSymbols;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --# derives ErrorHandler.Error_Context from *,
   --#                                         AttributeList,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         EndPosition,
   --#                                         File,
   --#                                         Heap,
   --#                                         LexTokenManager.State,
   --#                                         Rule_File,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         UsedSymbols,
   --#                                         Write_Rules &
   --#         Heap,
   --#         Statistics.TableUsage      from *,
   --#                                         AttributeList,
   --#                                         Dictionary.Dict,
   --#                                         Heap,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         UsedSymbols,
   --#                                         Write_Rules &
   --#         SPARK_IO.File_Sys          from *,
   --#                                         AttributeList,
   --#                                         BitwiseOpList,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         EndPosition,
   --#                                         ErrorHandler.Error_Context,
   --#                                         File,
   --#                                         Heap,
   --#                                         LexTokenManager.State,
   --#                                         ProcedureExportList,
   --#                                         ReturnSymbol,
   --#                                         RootIntegerUsed,
   --#                                         Rule_File,
   --#                                         Scope,
   --#                                         UsedSymbols,
   --#                                         Write_Rules;
      is separate;

end Declarations;
