-------------------------------------------------------------------------------
-- (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 Debug;
with ExaminerConstants;
with E_Strings;
with Labels;
with SeqAlgebra;
with SystemErrors;

separate (DAG)
procedure BuildExpnDAG
  (StartNode          : in     STree.SyntaxNode;
   ExpnScope          : in     Dictionary.Scopes;
   Scope              : in     Dictionary.Scopes;
   LineNmbr           : in     Integer;
   DoRtc              : in     Boolean;
   AssumeRvalues      : in     Boolean;
   LoopStack          : in     LoopContext.T;
   FlowHeap           : in out Heap.HeapRecord;
   VCGHeap            : in out Cells.Heap_Record;
   ContainsReals      : in out Boolean;
   VCGFailure         : in out Boolean;
   ShortCircuitStack  : in out CStacks.Stack;
   CheckStack         : in out CStacks.Stack;
   KindOfStackedCheck : in out Graph.Proof_Context_Type;
   DAGRoot            :    out Cells.Cell)
-- This procedure traverses a syntax tree of an expression, which may be
-- for example:
--    - an expression of an assignment statement,
--    - a condition of an if_statement (or elsif_part),
--    - an expression of a case_statement,
--    - a condition of an iteration scheme.
--    - a subprogram parameter
is
   DAGCell        : Cells.Cell;
   ExpnStack      : CStacks.Stack;
   NodeType       : SP_Symbols.SP_Symbol;
   LastNode, Node : STree.SyntaxNode;

   ReferencedVars : SeqAlgebra.Seq; -- Set of rvalues of expression

   -- Populate set of r-values.  This procedure is called from ProcessIdentifier and
   -- ProcessSelectedComponent whenever a variable is found.  A set of referenced
   -- entire variables (R-values) is constructed by this means.
   procedure AddRvalueSymbol (TheHeap : in out Heap.HeapRecord;
                              Sequ    : in     SeqAlgebra.Seq;
                              Sym     : in     Dictionary.Symbol)
   --# global in     AssumeRvalues;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     Scope;
   --#        in out Statistics.TableUsage;
   --# derives Statistics.TableUsage,
   --#         TheHeap               from *,
   --#                                    AssumeRvalues,
   --#                                    Dictionary.Dict,
   --#                                    LexTokenManager.State,
   --#                                    Scope,
   --#                                    Sequ,
   --#                                    Sym,
   --#                                    TheHeap;
   is
      function IsLocalVariable return Boolean
      --# global in Dictionary.Dict;
      --#        in Scope;
      --#        in Sym;
      is
      begin
         -- A variable is "local" if its scope if that of the current
         -- subprogram, and it's not a formal parameter.
         return Dictionary.Is_Variable (Sym)
           and then Dictionary.GetScope (Sym) = Scope
           and then not Dictionary.IsSubprogramParameter (Sym);
      end IsLocalVariable;

      function IsOutModeFormalParameter return Boolean
      --# global in Dictionary.Dict;
      --#        in Scope;
      --#        in Sym;
      is
      begin
         return Dictionary.GetScope (Sym) = Scope
           and then Dictionary.IsSubprogramParameter (Sym)
           and then Dictionary.GetSubprogramParameterMode (Sym) = Dictionary.OutMode;
      end IsOutModeFormalParameter;

      function IsDeferredNonPrivateConstant return Boolean
      --# global in Dictionary.Dict;
      --#        in LexTokenManager.State;
      --#        in Scope;
      --#        in Sym;
      is
      begin
         -- If a non-private, scalar constant is referenced and we don't know its value
         -- then no rules will be generated.  In that specific case it is worth asserting
         -- that the value is in type because that is the best we can do unless the type is universal.
         return Dictionary.Is_Constant (Sym)
           and then DiscreteTypeWithCheck (Dictionary.GetType (Sym), Scope)
           and then LexTokenManager.Lex_String_Case_Insensitive_Compare
           (Lex_Str1 => Dictionary.Get_Value (The_Constant => Sym),
            Lex_Str2 => LexTokenManager.Null_String) =
           LexTokenManager.Str_Eq
           and then -- i.e. no value known
           not (Dictionary.IsUniversalIntegerType (Dictionary.GetType (Sym)) or
                  Dictionary.IsUniversalRealType (Dictionary.GetType (Sym)));
      end IsDeferredNonPrivateConstant;

   begin -- AddRvalueSymbol
      if AssumeRvalues then
         -- Only add local variables or (in SPARK95) an "out" mode formal parameter or deferred constant
         if IsLocalVariable or IsOutModeFormalParameter or IsDeferredNonPrivateConstant then
            SeqAlgebra.AddMember (TheHeap, Sequ, Natural (Dictionary.SymbolRef (Sym)));
         end if;
      end if;
   end AddRvalueSymbol;

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

   procedure ConjoinParamConstraint
     (Type_Sym : in     Dictionary.Symbol;
      Var_Sym  : in     Dictionary.Symbol;
      DAGCell  : in out Cells.Cell)
   --# global in     Scope;
   --#        in out ContainsReals;
   --#        in out Dictionary.Dict;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out VCGFailure;
   --#        in out VCGHeap;
   --# derives ContainsReals,
   --#         DAGCell,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         SPARK_IO.File_Sys,
   --#         VCGFailure            from *,
   --#                                    Dictionary.Dict,
   --#                                    LexTokenManager.State,
   --#                                    Scope,
   --#                                    Type_Sym,
   --#                                    Var_Sym,
   --#                                    VCGHeap &
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    DAGCell,
   --#                                    Dictionary.Dict,
   --#                                    LexTokenManager.State,
   --#                                    Scope,
   --#                                    Type_Sym,
   --#                                    Var_Sym,
   --#                                    VCGHeap;
   is
      Constr, VarCell : Cells.Cell;
   begin
      CreateReferenceCell (VarCell, VCGHeap, Var_Sym);

      Type_Constraint.Make
        (The_Type              => Type_Sym,
         The_Expression        => VarCell,
         Scope                 => Scope,
         Consider_Always_Valid => False,
         The_Constraint        => Constr,
         VCG_Heap              => VCGHeap,
         VC_Contains_Reals     => ContainsReals,
         VC_Failure            => VCGFailure);

      if not Cells.Is_Null_Cell (Constr) then
         Cells.Utility.Conjoin (VCGHeap, Constr, DAGCell);
      end if;
   end ConjoinParamConstraint;

   -- Generate hypotheses that all variables in the
   -- ReferencedVars set are in their type
   procedure PlantRvalueAssumptions (ReferencedVars : in SeqAlgebra.Seq)
   --# global in     Scope;
   --#        in out ContainsReals;
   --#        in out Dictionary.Dict;
   --#        in out FlowHeap;
   --#        in out Graph.Table;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out StmtStack.S;
   --#        in out VCGFailure;
   --#        in out VCGHeap;
   --# derives ContainsReals,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         SPARK_IO.File_Sys,
   --#         Statistics.TableUsage,
   --#         VCGFailure            from *,
   --#                                    Dictionary.Dict,
   --#                                    FlowHeap,
   --#                                    LexTokenManager.State,
   --#                                    ReferencedVars,
   --#                                    Scope,
   --#                                    VCGHeap &
   --#         FlowHeap              from *,
   --#                                    ReferencedVars &
   --#         Graph.Table,
   --#         StmtStack.S,
   --#         VCGHeap               from Dictionary.Dict,
   --#                                    FlowHeap,
   --#                                    Graph.Table,
   --#                                    LexTokenManager.State,
   --#                                    ReferencedVars,
   --#                                    Scope,
   --#                                    StmtStack.S,
   --#                                    VCGHeap;
   is
      DAGCell   : Cells.Cell := Cells.Null_Cell;
      VarSym    : Dictionary.Symbol;
      TypeSym   : Dictionary.Symbol;
      X         : SeqAlgebra.MemberOfSeq;
      StmtLabel : Labels.Label;
      StmtCell  : Cells.Cell;
   begin
      -- ReferencedVars is a set of R-value leaves populated by BuildExpnDAG
      X := SeqAlgebra.FirstMember (FlowHeap, ReferencedVars);
      while not SeqAlgebra.IsNullMember (X) loop
         VarSym  :=
           Dictionary.ConvertSymbolRef (ExaminerConstants.RefType (SeqAlgebra.Value_Of_Member (The_Heap => FlowHeap,
                                                                                               M        => X)));
         TypeSym := Dictionary.GetType (VarSym);
         ConjoinParamConstraint (TypeSym, VarSym, DAGCell);

         -- remove each element after it is used to recover heap space and prevent
         -- unnecessary repetition of hypothese
         SeqAlgebra.RemoveMember (FlowHeap, ReferencedVars, SeqAlgebra.Value_Of_Member (The_Heap => FlowHeap,
                                                                                        M        => X));
         X := SeqAlgebra.FirstMember (FlowHeap, ReferencedVars);
         -- original method replaced two lines baove with one below, doen't recover heap space
         -- X := SeqAlgebra.NextMember (FlowHeap, X);
      end loop;

      -- DAGCell is now a complete list of constraints that we need to plant as a set of hypotheses
      PrepareLabel (VCGHeap, StmtLabel, StmtCell);
      SetRightArgument (StmtCell, DAGCell, VCGHeap);
      Chain (StmtLabel, VCGHeap);
   end PlantRvalueAssumptions;

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

   -- Conditionally generate hypotheses that all variables in the
   -- ReferencedVars set are in their type
   procedure CheckPlantRvalueAssumptions
   --# global in     AssumeRvalues;
   --#        in     ReferencedVars;
   --#        in     Scope;
   --#        in out ContainsReals;
   --#        in out Dictionary.Dict;
   --#        in out FlowHeap;
   --#        in out Graph.Table;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out StmtStack.S;
   --#        in out VCGFailure;
   --#        in out VCGHeap;
   --# derives ContainsReals,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         SPARK_IO.File_Sys,
   --#         Statistics.TableUsage,
   --#         VCGFailure            from *,
   --#                                    AssumeRvalues,
   --#                                    Dictionary.Dict,
   --#                                    FlowHeap,
   --#                                    LexTokenManager.State,
   --#                                    ReferencedVars,
   --#                                    Scope,
   --#                                    VCGHeap &
   --#         FlowHeap              from *,
   --#                                    AssumeRvalues,
   --#                                    ReferencedVars &
   --#         Graph.Table,
   --#         StmtStack.S,
   --#         VCGHeap               from AssumeRvalues,
   --#                                    Dictionary.Dict,
   --#                                    FlowHeap,
   --#                                    Graph.Table,
   --#                                    LexTokenManager.State,
   --#                                    ReferencedVars,
   --#                                    Scope,
   --#                                    StmtStack.S,
   --#                                    VCGHeap;
   is
   begin
      if AssumeRvalues then
         PlantRvalueAssumptions (ReferencedVars);
      end if;
   end CheckPlantRvalueAssumptions;

   ---------------------------------------------------------------------
   -- Concrete_Function is a reference to a concrete function declaration.
   -- Abstraction specifies whether the abstract or refined view of the
   -- precondition is required.
   -- The_Precondition is a DAG containing the prcondition expression - it will
   -- be null if the function does not have a precondition.
   procedure Get_Precondition
     (Concrete_Function : in     Dictionary.Symbol;
      Abstraction       : in     Dictionary.Abstractions;
      Scope             : in     Dictionary.Scopes;
      The_Precondition  :    out Cells.Cell;
      Function_Defs     : in out CStacks.Stack)
   --# global in     CommandLineData.Content;
   --#        in     LoopStack;
   --#        in     STree.Table;
   --#        in out ContainsReals;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out VCGFailure;
   --#        in out VCGHeap;
   --# derives ContainsReals,
   --#         Dictionary.Dict,
   --#         Function_Defs,
   --#         LexTokenManager.State,
   --#         Statistics.TableUsage,
   --#         VCGFailure,
   --#         VCGHeap                    from *,
   --#                                         Abstraction,
   --#                                         CommandLineData.Content,
   --#                                         Concrete_Function,
   --#                                         Dictionary.Dict,
   --#                                         Function_Defs,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         VCGHeap &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from Abstraction,
   --#                                         CommandLineData.Content,
   --#                                         Concrete_Function,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Function_Defs,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         VCGHeap &
   --#         The_Precondition           from Abstraction,
   --#                                         CommandLineData.Content,
   --#                                         Concrete_Function,
   --#                                         Dictionary.Dict,
   --#                                         Function_Defs,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         VCGHeap;
   is
      Instantiated_Subprogram : Dictionary.Symbol;
      Local_Abstraction       : Dictionary.Abstractions;
      Constraint              : STree.SyntaxNode;
   begin
      if Dictionary.IsInstantiation (Concrete_Function) then
         Instantiated_Subprogram := Concrete_Function;
         Local_Abstraction       := Dictionary.IsAbstract;
      else -- not generic
         Instantiated_Subprogram := Dictionary.NullSymbol;
         Local_Abstraction       := Abstraction;
      end if;

      Constraint := STree.RefToNode (Dictionary.GetPrecondition (Local_Abstraction, Concrete_Function));
      if Constraint /= STree.NullNode then
         Build_Annotation_Expression
           (Exp_Node                         => Constraint,
            Instantiated_Subprogram          => Instantiated_Subprogram,
            Scope                            => Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                                           The_Unit       => Concrete_Function),
            Calling_Scope                    => Scope,
            Force_Abstract                   => Abstraction = Dictionary.IsAbstract,
            Loop_Stack                       => LoopStack,
            Generate_Function_Instantiations => True,
            VC_Failure                       => VCGFailure,
            VC_Contains_Reals                => ContainsReals,
            VCG_Heap                         => VCGHeap,
            DAG_Root                         => The_Precondition,
            Function_Defs                    => Function_Defs);
      else
         The_Precondition := Cells.Null_Cell;
      end if;
   end Get_Precondition;

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

   -- Actual_Called_Function is data structure created by Setup_Function_Call
   -- for a called function and must refer to a concrete function.
   -- Abstraction specifies whether the abstract or refined view of the
   -- precondition is to be planted.
   procedure Plant_Precondition_Check
     (Actual_Function_Call : in Cells.Cell;
      Scope                : in Dictionary.Scopes;
      Abstraction          : in Dictionary.Abstractions)
   --# global in     CommandLineData.Content;
   --#        in     LoopStack;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out Graph.Table;
   --#        in out KindOfStackedCheck;
   --#        in out LexTokenManager.State;
   --#        in out ShortCircuitStack;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out StmtStack.S;
   --#        in out VCGFailure;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         Graph.Table,
   --#         Statistics.TableUsage,
   --#         StmtStack.S                from *,
   --#                                         Abstraction,
   --#                                         Actual_Function_Call,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         Graph.Table,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         VCGHeap &
   --#         ContainsReals,
   --#         Dictionary.Dict,
   --#         KindOfStackedCheck,
   --#         LexTokenManager.State,
   --#         ShortCircuitStack,
   --#         VCGFailure                 from *,
   --#                                         Abstraction,
   --#                                         Actual_Function_Call,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         VCGHeap &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from Abstraction,
   --#                                         Actual_Function_Call,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         VCGHeap &
   --#         VCGHeap                    from *,
   --#                                         Abstraction,
   --#                                         Actual_Function_Call,
   --#                                         CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         Graph.Table,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         StmtStack.S,
   --#                                         STree.Table;
   is
      DAG_Cell                : Cells.Cell;
      Conjoined_Function_Defs : Cells.Cell;
      Function_Symbol         : Dictionary.Symbol;
      Function_Defs           : CStacks.Stack;
   begin
      -- Stack of definitions of functions called within the precondition
      CStacks.CreateStack (Function_Defs);

      Function_Symbol := Cells.Get_Symbol_Value (VCGHeap, Actual_Function_Call);
      -- Function_Symbol must refer to a concrete function.
      Get_Precondition
        (Concrete_Function => Function_Symbol,
         Abstraction       => Abstraction,
         Scope             => Scope,
         The_Precondition  => DAG_Cell,
         Function_Defs     => Function_Defs);
      if not Cells.Is_Null_Cell (DAG_Cell) then
         AddAnyShortCircuitImplications (VCGHeap, DAG_Cell, ShortCircuitStack);
         Substitutions.Substitute_Parameters
           (Called_Function => Actual_Function_Call,
            Constraint      => DAG_Cell,
            VCG_Heap        => VCGHeap);

         if not CStacks.IsEmpty (Function_Defs) then
            -- There are called function definitions.
            -- Use null statement as place holder for them.
            ModelNullStmt (VCGHeap);
            -- Conjoin all the function definitions on the stack
            --# accept F, 10, Function_Defs, "The stack has been emptied";
            Join_And (Stack    => Function_Defs,
                      Conjunct => Conjoined_Function_Defs,
                      VCG_Heap => VCGHeap);
            --# end accept;

            -- Substitute actual parameters for formal parameters referenced in
            -- the function calls within the precondition
            Substitutions.Substitute_Parameters
              (Called_Function => Actual_Function_Call,
               Constraint      => Conjoined_Function_Defs,
               VCG_Heap        => VCGHeap);

            -- Assume the function definitions from the point of the null statement
            IncorporateAssumption (VCGHeap, Conjoined_Function_Defs);
         end if;

         StackCheckStatement (DAG_Cell, VCGHeap, CheckStack);
         KindOfStackedCheck := Graph.Precon_Check;
      end if;
      -- No need to check type of import globals because these must already
      -- be in type because of previous checks.
   end Plant_Precondition_Check;

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

   -- Assume_Function_Return_Type plants an assumption in the DAG that a
   -- function return value is in-type provided it is not an
   -- unchecked conversion function.
   -- The Implicit_Function must refer to an implicitly declared proof function
   -- corresponding to a concrete function declaration.
   procedure Assume_Function_Return_Type (Implicit_Function : in Cells.Cell)
   --# global in     Scope;
   --#        in out ContainsReals;
   --#        in out Dictionary.Dict;
   --#        in out Graph.Table;
   --#        in out LexTokenManager.State;
   --#        in out ShortCircuitStack;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out StmtStack.S;
   --#        in out VCGFailure;
   --#        in out VCGHeap;
   --# derives ContainsReals,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         ShortCircuitStack,
   --#         SPARK_IO.File_Sys,
   --#         VCGFailure            from *,
   --#                                    Dictionary.Dict,
   --#                                    Implicit_Function,
   --#                                    LexTokenManager.State,
   --#                                    Scope,
   --#                                    VCGHeap &
   --#         Graph.Table,
   --#         StmtStack.S,
   --#         VCGHeap               from Dictionary.Dict,
   --#                                    Graph.Table,
   --#                                    Implicit_Function,
   --#                                    LexTokenManager.State,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    StmtStack.S,
   --#                                    VCGHeap &
   --#         Statistics.TableUsage from *,
   --#                                    Dictionary.Dict,
   --#                                    Implicit_Function,
   --#                                    LexTokenManager.State,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    VCGHeap;
   is
      Concrete_Function_Symbol, Proof_Function_Symbol : Dictionary.Symbol;
      StmtCell, RetCell                               : Cells.Cell;
      StmtLabel                                       : Labels.Label;
   begin
      Proof_Function_Symbol    := Cells.Get_Symbol_Value (VCGHeap, Implicit_Function);
      Concrete_Function_Symbol := Dictionary.GetAdaFunction (Proof_Function_Symbol);

      -- Don't assume return type is valid if it is an unchecked conversion
      if not Dictionary.IsAnUncheckedConversion (Concrete_Function_Symbol) then

         Type_Constraint.Make
           (The_Type              => Dictionary.GetType (Proof_Function_Symbol),
            The_Expression        => Implicit_Function,
            Scope                 => Scope,
            Consider_Always_Valid => False,
            The_Constraint        => RetCell,
            VCG_Heap              => VCGHeap,
            VC_Contains_Reals     => ContainsReals,
            VC_Failure            => VCGFailure);

         if not Cells.Is_Null_Cell (RetCell) then
            AddAnyShortCircuitImplications (VCGHeap, RetCell, ShortCircuitStack);
            PrepareLabel (VCGHeap, StmtLabel, StmtCell);
            SetRightArgument (StmtCell, RetCell, VCGHeap);
            Chain (StmtLabel, VCGHeap);
         end if;
      end if;
   end Assume_Function_Return_Type;

   ----------------------------------------------------------------------------------------------
   -- Assume_Function_Return_Annotation plants an assumption of the translation
   -- of the function's return annotation.
   -- Concrete_Function is a reference to a concrete function declaration.
   -- Abstraction specifies whether the abstract or refined view of the
   -- precondition is required.
   procedure Assume_Function_Return_Annotation
     (Actual_Function_Call : in Cells.Cell;
      Proof_Function_Call  : in Cells.Cell;
      Scope                : in Dictionary.Scopes;
      Abstraction          : in Dictionary.Abstractions)
   --# global in     CommandLineData.Content;
   --#        in     LoopStack;
   --#        in     STree.Table;
   --#        in out ContainsReals;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out Graph.Table;
   --#        in out LexTokenManager.State;
   --#        in out ShortCircuitStack;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out StmtStack.S;
   --#        in out VCGFailure;
   --#        in out VCGHeap;
   --# derives ContainsReals,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         VCGFailure                 from *,
   --#                                         Abstraction,
   --#                                         Actual_Function_Call,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         VCGHeap &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from Abstraction,
   --#                                         Actual_Function_Call,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         VCGHeap &
   --#         Graph.Table,
   --#         StmtStack.S,
   --#         VCGHeap                    from Abstraction,
   --#                                         Actual_Function_Call,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         Graph.Table,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Proof_Function_Call,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         VCGHeap &
   --#         ShortCircuitStack,
   --#         Statistics.TableUsage      from *,
   --#                                         Abstraction,
   --#                                         Actual_Function_Call,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Proof_Function_Call,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         STree.Table,
   --#                                         VCGHeap;
   is
      Concrete_Function_Symbol : Dictionary.Symbol;
      Implicit_Var             : Dictionary.Symbol;
      Assumed_Predicate        : Cells.Cell;
      Assumed_Return_Anno      : Cells.Cell;
      StmtCell                 : Cells.Cell;
      Persistent_Function_Call : Cells.Cell;
      Conjoined_Function_Defs  : Cells.Cell;
      StmtLabel                : Labels.Label;
      Function_Defs            : CStacks.Stack;

      -------------------------------------------------------------------
      -- Concrete_Function is a reference to a concrete function declaration.
      -- Abstraction specifies whether the abstract or refined view of the
      -- the return annotation is required.
      -- The_Return_Anno is a DAG containing the expression of the return
      -- annotation - it will be null if the function does not have a return
      -- annotation.
      -- Implicit_Var is the implicit variable of an implicit return annoatation.
      -- If the return annotation is explicit the Implicit_Var will be null.
      procedure Get_Function_Return_Annotation
        (Concrete_Function : in     Dictionary.Symbol;
         Abstraction       : in     Dictionary.Abstractions;
         Scope             : in     Dictionary.Scopes;
         The_Return_Anno   :    out Cells.Cell;
         Implicit_Var      :    out Dictionary.Symbol;
         Function_Defs     : in out CStacks.Stack)
      --# global in     CommandLineData.Content;
      --#        in     LoopStack;
      --#        in     STree.Table;
      --#        in out ContainsReals;
      --#        in out Dictionary.Dict;
      --#        in out ErrorHandler.Error_Context;
      --#        in out LexTokenManager.State;
      --#        in out SPARK_IO.File_Sys;
      --#        in out Statistics.TableUsage;
      --#        in out VCGFailure;
      --#        in out VCGHeap;
      --# derives ContainsReals,
      --#         Dictionary.Dict,
      --#         Function_Defs,
      --#         LexTokenManager.State,
      --#         Statistics.TableUsage,
      --#         VCGFailure,
      --#         VCGHeap                    from *,
      --#                                         Abstraction,
      --#                                         CommandLineData.Content,
      --#                                         Concrete_Function,
      --#                                         Dictionary.Dict,
      --#                                         Function_Defs,
      --#                                         LexTokenManager.State,
      --#                                         LoopStack,
      --#                                         Scope,
      --#                                         STree.Table,
      --#                                         VCGHeap &
      --#         ErrorHandler.Error_Context,
      --#         SPARK_IO.File_Sys          from Abstraction,
      --#                                         CommandLineData.Content,
      --#                                         Concrete_Function,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         Function_Defs,
      --#                                         LexTokenManager.State,
      --#                                         LoopStack,
      --#                                         Scope,
      --#                                         SPARK_IO.File_Sys,
      --#                                         STree.Table,
      --#                                         VCGHeap &
      --#         Implicit_Var               from Abstraction,
      --#                                         Concrete_Function,
      --#                                         Dictionary.Dict,
      --#                                         STree.Table &
      --#         The_Return_Anno            from Abstraction,
      --#                                         CommandLineData.Content,
      --#                                         Concrete_Function,
      --#                                         Dictionary.Dict,
      --#                                         Function_Defs,
      --#                                         LexTokenManager.State,
      --#                                         LoopStack,
      --#                                         Scope,
      --#                                         STree.Table,
      --#                                         VCGHeap;
      is
         Force_Abstract          : Boolean;
         Instantiated_Subprogram : Dictionary.Symbol;
         Local_Abstraction       : Dictionary.Abstractions;
         Constraint              : STree.SyntaxNode;
      begin
         if Abstraction = Dictionary.IsAbstract
           and then Dictionary.Get_Visibility (Scope => Dictionary.GetScope (Concrete_Function)) = Dictionary.Local then
            --  declaration is in body only so contract should not be abstract (not refined either... see TN JC17-035)
            Force_Abstract := False;
         else
            Force_Abstract := Abstraction = Dictionary.IsAbstract;
         end if;

         if Dictionary.IsInstantiation (Concrete_Function) then
            Instantiated_Subprogram := Concrete_Function;
            Local_Abstraction       := Dictionary.IsAbstract;
         else -- not generic
            Instantiated_Subprogram := Dictionary.NullSymbol;
            Local_Abstraction       := Abstraction;
         end if;

         Constraint := STree.RefToNode (Dictionary.GetPostcondition (Local_Abstraction, Concrete_Function));
         if Constraint /= STree.NullNode then
            if STree.Syntax_Node_Type (Node => Constraint) = SP_Symbols.annotation_expression then
               -- It is an explicit return annotation and has no implicit
               -- variable.
               Implicit_Var := Dictionary.NullSymbol;
               Build_Annotation_Expression
                 (Exp_Node                         => Constraint,
                  Instantiated_Subprogram          => Instantiated_Subprogram,
                  Scope                            => Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                                                 The_Unit       => Concrete_Function),
                  Calling_Scope                    => Scope,
                  Force_Abstract                   => Force_Abstract,
                  Loop_Stack                       => LoopStack,
                  Generate_Function_Instantiations => True,
                  VC_Failure                       => VCGFailure,
                  VC_Contains_Reals                => ContainsReals,
                  VCG_Heap                         => VCGHeap,
                  DAG_Root                         => The_Return_Anno,
                  Function_Defs                    => Function_Defs);
            else
               -- It is an implicit return annotation - get the implicit
               -- variable.
               Implicit_Var := Dictionary.GetImplicitReturnVariable (Abstraction, Concrete_Function);
               -- Build s DAG of the expression containing the implicit
               -- variable.
               Build_Annotation_Expression
                 (Exp_Node                         => STree.Next_Sibling (Current_Node => Constraint),
                  Instantiated_Subprogram          => Instantiated_Subprogram,
                  Scope                            => Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                                                 The_Unit       => Implicit_Var),
                  Calling_Scope                    => Scope,
                  Force_Abstract                   => Force_Abstract,
                  Loop_Stack                       => LoopStack,
                  Generate_Function_Instantiations => True,
                  VC_Failure                       => VCGFailure,
                  VC_Contains_Reals                => ContainsReals,
                  VCG_Heap                         => VCGHeap,
                  DAG_Root                         => The_Return_Anno,
                  Function_Defs                    => Function_Defs);
            end if;
         else
            The_Return_Anno := Cells.Null_Cell;
            Implicit_Var    := Dictionary.NullSymbol;
         end if;
      end Get_Function_Return_Annotation;

   begin -- Assume_Function_Return_Annotation

      -- Stack for definition of functions called within the return annotation
      CStacks.CreateStack (Function_Defs);

      Concrete_Function_Symbol := Cells.Get_Symbol_Value (VCGHeap, Actual_Function_Call);

      Get_Function_Return_Annotation
        (Concrete_Function => Concrete_Function_Symbol,
         Abstraction       => Abstraction,
         Scope             => Scope,
         The_Return_Anno   => Assumed_Return_Anno,
         Implicit_Var      => Implicit_Var,
         Function_Defs     => Function_Defs);

      if not Cells.Is_Null_Cell (Assumed_Return_Anno) then
         -- The function has a return annotation. Determine whether
         -- it is explict or implicit and process accordingly.

         if Dictionary.Is_Null_Symbol (Implicit_Var) then
            -- It is an explict return annotation. It needs to be made a
            -- boolean expression (a predicate) by making the assumption
            -- <proof_function_call> equals the annotation expression.

            if Dictionary.TypeIsBoolean (Dictionary.GetType (Concrete_Function_Symbol)) then
               -- set two DAGs to be equal
               -- use <-> for boolean functions otherwise use =
               CreateOpCell (Assumed_Predicate, VCGHeap, SP_Symbols.is_equivalent_to);
            else
               CreateOpCell (Assumed_Predicate, VCGHeap, SP_Symbols.equals);
            end if;

            -- The proof function view of a called function always used in VCs.
            -- A pesistent copy of the function call needs to be made from the
            -- temporary version on the ExprStack.
            Structures.CopyStructure (Heap     => VCGHeap,
                                      Root     => Proof_Function_Call,
                                      RootCopy => Persistent_Function_Call);
            SetLeftArgument (Assumed_Predicate, Persistent_Function_Call, VCGHeap);
            SetRightArgument (Assumed_Predicate, Assumed_Return_Anno, VCGHeap);

            AddAnyShortCircuitImplications (VCGHeap, Assumed_Predicate, ShortCircuitStack);

            Substitutions.Substitute_Parameters
              (Called_Function => Actual_Function_Call,
               Constraint      => Assumed_Predicate,
               VCG_Heap        => VCGHeap);
         else
            -- It is an impliciit return annotation and the
            -- Assumed_Return_Anno with the implict variables replaced by
            -- the proof function "call" is the boolean predicate.
            Substitutions.Substitute_Implicit_Vars
              (Proof_Function       => Proof_Function_Call,
               Implicit_Var         => Implicit_Var,
               Implicit_Return_Expr => Assumed_Return_Anno,
               VCG_Heap             => VCGHeap);

            AddAnyShortCircuitImplications (VCGHeap, Assumed_Return_Anno, ShortCircuitStack);

            Substitutions.Substitute_Parameters
              (Called_Function => Actual_Function_Call,
               Constraint      => Assumed_Return_Anno,
               VCG_Heap        => VCGHeap);

            Assumed_Predicate := Assumed_Return_Anno;
         end if;

         if not CStacks.IsEmpty (Function_Defs) then
            -- There are function definititions
            --# accept F, 10, Function_Defs, "The stack has been emptied";
            Join_And (Stack    => Function_Defs,
                      Conjunct => Conjoined_Function_Defs,
                      VCG_Heap => VCGHeap);
            --# end accept;
            if not Dictionary.Is_Null_Symbol (Implicit_Var) then
               -- It is an implicit return expression; substitute
               -- implicit variable in the function definitions
               Substitutions.Substitute_Implicit_Vars
                 (Proof_Function       => Proof_Function_Call,
                  Implicit_Var         => Implicit_Var,
                  Implicit_Return_Expr => Conjoined_Function_Defs,
                  VCG_Heap             => VCGHeap);
            end if;

            Substitutions.Substitute_Parameters
              (Called_Function => Actual_Function_Call,
               Constraint      => Conjoined_Function_Defs,
               VCG_Heap        => VCGHeap);

            -- Conjoin the function definitions with the return anno predicate
            Cells.Utility.Conjoin (VCGHeap, Conjoined_Function_Defs, Assumed_Predicate);
         end if;

         PrepareLabel (VCGHeap, StmtLabel, StmtCell);
         SetRightArgument (StmtCell, Assumed_Predicate, VCGHeap);
         Chain (StmtLabel, VCGHeap);
      end if;
   end Assume_Function_Return_Annotation;

   ----------------------------------------------------------------------------------------------
   -- Setup_Function_Call is called during the BuildExpnDAG "down-loop" and
   -- establishes a data structure to represent the actual parameters and
   -- globals of a function call.
   -- It enters all the global variables of a function into the data structure
   -- the parameters are entered during the "up-loop" by the procedure
   -- Process_Positional_Argument_Association or Process_Named_Argument_Association.
   -- If it is a parameterless function (it may have globals) then this
   -- procedure completes the model of the function call by adding the
   -- pre-condition checks to the DAG and then adding a in-type assumption to
   -- the DAG for its return value. The function symbol is changed to its
   -- implicit proof function equivalent so that all globals become parameters
   -- of the function.
   -- If the function has parameters then the completion of the function call
   -- model is performed by the procedure ProcessNameArgumentList during the
   -- BuildExpnDAG "up-loop".
   procedure Setup_Function_Call (ThisScope : in Dictionary.Scopes;
                                  Prefix    : in Dictionary.Symbol)
   --# global in     CommandLineData.Content;
   --#        in     DoRtc;
   --#        in     LineNmbr;
   --#        in     LoopStack;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out ExpnStack;
   --#        in out Graph.Table;
   --#        in out KindOfStackedCheck;
   --#        in out LexTokenManager.State;
   --#        in out ShortCircuitStack;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out StmtStack.S;
   --#        in out VCGFailure;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         KindOfStackedCheck         from *,
   --#                                         CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ExpnStack,
   --#                                         Graph.Table,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Prefix,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap &
   --#         ContainsReals,
   --#         Dictionary.Dict,
   --#         Graph.Table,
   --#         LexTokenManager.State,
   --#         ShortCircuitStack,
   --#         Statistics.TableUsage,
   --#         StmtStack.S,
   --#         VCGFailure,
   --#         VCGHeap                    from *,
   --#                                         CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ExpnStack,
   --#                                         Graph.Table,
   --#                                         KindOfStackedCheck,
   --#                                         LexTokenManager.State,
   --#                                         LineNmbr,
   --#                                         LoopStack,
   --#                                         Prefix,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ErrorHandler.Error_Context,
   --#                                         ExpnStack,
   --#                                         Graph.Table,
   --#                                         KindOfStackedCheck,
   --#                                         LexTokenManager.State,
   --#                                         LineNmbr,
   --#                                         LoopStack,
   --#                                         Prefix,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         SPARK_IO.File_Sys,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap &
   --#         ExpnStack                  from *,
   --#                                         Dictionary.Dict,
   --#                                         ThisScope,
   --#                                         VCGHeap;
   is
      -- Creates a data structure into which DAGs of actual parameters can be
      -- slotted.
      -- We end up with (after the empty data structure is populated by
      -- Process_Positional_Argument_Association (or the named equivalent)):
      -- function --- , --- , --- DAG
      --              |     |
      --             DAG   DAG
      --
      -- (where DAG is a DAG of an actual parameter expression, a down bar is
      -- the A ptr and a right bar a B ptr).
      -- As well as the parameter DAGs, the structure will contain DAGs for any
      -- globals referenced by the function since, in the proof model, we don't
      -- have a concept of global variables.
      --
      -- In addition, each DAG cell may have hanging off its C ptr, a cell
      -- conating an index cosntraint.  This gets used in SubtituteParameters
      -- when dealing with attributes of unconstrained arrays where the actual
      -- parameter constrains the formal in some way.

      NumberOfParameters, NumberOfGlobals, TotalArguments : Natural;
      Function_Symbol, Proof_Function_Symbol              : Dictionary.Symbol;
      Abstraction                                         : Dictionary.Abstractions;
      ConstraintAbstraction                               : Dictionary.Abstractions;
      Actual_Function_Call, Proof_Function_Call           : Cells.Cell;

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

      procedure CopyInGlobals (ParamCount  : in Natural;
                               Sym         : in Dictionary.Symbol;
                               Abstraction : in Dictionary.Abstractions)
      --# global in     Dictionary.Dict;
      --#        in     ExpnStack;
      --#        in     Prefix;
      --#        in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives Statistics.TableUsage,
      --#         VCGHeap               from *,
      --#                                    Abstraction,
      --#                                    Dictionary.Dict,
      --#                                    ExpnStack,
      --#                                    ParamCount,
      --#                                    Prefix,
      --#                                    Sym,
      --#                                    VCGHeap;
      is
         GlobalCell, StartPoint : Cells.Cell;
         Unused                 : Boolean;
         It                     : Dictionary.Iterator;

         function SubstituteProtectedTypeSelfReference (Sym : Dictionary.Symbol) return Dictionary.Symbol
         --# global in Dictionary.Dict;
         --#        in Prefix;
         is
            Result : Dictionary.Symbol;
         begin
            -- if Sym is the implicitly-declared own variable of a protected
            -- type then we must replace it with the "current instance of the
            -- protected object"
            --
            -- Background: given protected type PT its operations will globally
            -- reference and derive PT meaning, in this case, "myself".
            -- If an object PO of type PT (or a subtype of PT) is declared then
            -- calls to its operations will take the form PO.Op and the calling
            -- environment will be annotated in terms of PO.  Therefore, when
            -- checking that the globals necessary for the call PO.Op are
            -- visible (for example), we need to replace all references to PT
            -- by references to PO before making the check.  The Prefix Symbol
            -- of the call is the symbol we need to substitute in.
            Result := Sym;
            if not Dictionary.Is_Null_Symbol (Prefix)
              and then Dictionary.IsOwnVariable (Sym)
              and then Dictionary.IsProtectedType (Dictionary.GetOwner (Sym)) then
               Result := Prefix;
            end if;
            return Result;
         end SubstituteProtectedTypeSelfReference;

      begin -- CopyInGlobals

         --# accept F, 10, Unused, "Unused here OK";
         CalculateInsertPoint (VCGHeap, ExpnStack, ParamCount,
                               -- to get
                               StartPoint, Unused);
         --# end accept;
         It := Dictionary.FirstGlobalVariable (Abstraction, Sym);
         while not Dictionary.IsNullIterator (It) loop
            CreateReferenceCell (GlobalCell, VCGHeap, SubstituteProtectedTypeSelfReference (Dictionary.CurrentSymbol (It)));

            if Cells.Is_Null_Cell (RightPtr (VCGHeap, StartPoint)) then
               SetRightArgument (StartPoint, GlobalCell, VCGHeap);
            else
               StartPoint := RightPtr (VCGHeap, StartPoint);
               SetLeftArgument (StartPoint, GlobalCell, VCGHeap);
            end if;
            It := Dictionary.NextSymbol (It);
         end loop;
         --# accept F, 33, Unused, "Unused here OK";
      end CopyInGlobals;

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

   begin -- Setup_Function_Call
      Function_Symbol := Cells.Get_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, ExpnStack));
      -- The function call may have either an abstract or refined signature
      -- depending on where it is called.  The refinement may be due to data
      -- refinement of an own variable or, a private data type refinement in
      -- which case only the pre and return annotations are refined.

      -- This abstraction relates to the global list and dependency relations.
      Abstraction := Dictionary.GetAbstraction (Function_Symbol, ThisScope);

      -- This abstraction relates to the pre and return annotations.
      ConstraintAbstraction := Dictionary.GetConstraintAbstraction (Function_Symbol, ThisScope);

      NumberOfParameters := Dictionary.GetNumberOfSubprogramParameters (Function_Symbol);

      NumberOfGlobals := Dictionary.GetNumberOfGlobalVariables (Abstraction, Function_Symbol);
      TotalArguments  := NumberOfParameters + NumberOfGlobals;

      -- Create an empty data structure as described above to hold the actual
      -- parameters of the function call and any globals of the function and
      -- make it the right-hand argument of the function call cell at on
      -- the top of the ExpnStack.
      CreateEmptyList (TotalArguments, VCGHeap, ExpnStack);

      if NumberOfGlobals > 0 then
         -- The function has globals so copy them into the data structure.
         -- They will appear in the data structure after the function parameters.
         CopyInGlobals (NumberOfParameters, Function_Symbol, Abstraction);
      end if;

      -- If the function is parameterless then the function model has to be
      -- completed here on the down-loop because ProcessNameArgumentList will
      -- not be called on the up-loop to complete the function model.
      -- The function model is completed setting the Cell.Kind to a
      -- proof function and the Cell.SymbolValue to the implictly declared
      -- proof function corresponding to the concrete function.
      if NumberOfParameters = 0 then
         Cells.Set_Kind (VCGHeap, CStacks.Top (VCGHeap, ExpnStack), Cell_Storage.Proof_Function);
         Proof_Function_Symbol := Dictionary.GetImplicitProofFunction (Abstraction, Function_Symbol);

         if DoRtc then
            -- If the function is parameterless the function model needs to be
            -- completed by inserting the precondition checks to the DAG
            -- and then adding an aasumption that the return value from the
            -- function is in-type.
            -- Only the proof functions appear in VCGs and so the function
            -- symbol is replaced by its proof function equivalent where all the
            -- globals copied in above appear as parameters of the function.

            -- Make a copy of the concrete function call from the
            -- ExpnStack because Assume_Function_Return_Annotation requires
            -- references to both the concrete and proof views of the of the
            -- function call
            Cells.Create_Cell (Heap     => VCGHeap,
                               CellName => Actual_Function_Call);
            Cells.Copy_Contents (Heap        => VCGHeap,
                                 Source      => CStacks.Top (VCGHeap, ExpnStack),
                                 Destination => Actual_Function_Call);

            -- Set the current top of ExpnStack to reference the implicitly
            -- declared proof function
            Cells.Set_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, ExpnStack), Proof_Function_Symbol);

            Proof_Function_Call := CStacks.Top (VCGHeap, ExpnStack);
            -- Here Proof_Function_Call refers to the proof function "call"
            -- and a list of parameters (globals have been made parameters).

            -- Plant_Precondition_And_Parameter_Checks must be called with the
            -- Cell referencing the concrete function, i.e., the actual
            -- function call.
            Plant_Precondition_Check
              (Actual_Function_Call => Actual_Function_Call,
               Scope                => Scope,
               Abstraction          => ConstraintAbstraction);
            UnStackRtcs (LineNmbr, VCGHeap, CheckStack, KindOfStackedCheck);

            -- Assume_Function_Return_Type must be called with the
            -- Cell referencing the implicitly declared proof function, i.e.,
            -- the implicit function.
            Assume_Function_Return_Type (Implicit_Function => Proof_Function_Call);

            -- Assume_Function_Return_Annotation requires both the concrete and
            -- proof views of the function call.
            Assume_Function_Return_Annotation
              (Actual_Function_Call => Actual_Function_Call,
               Proof_Function_Call  => Proof_Function_Call,
               Scope                => Scope,
               Abstraction          => ConstraintAbstraction);

            Cells.Dispose_Of_Cell (Heap     => VCGHeap,
                                   CellName => Actual_Function_Call);

         else
            -- Even if  run time checks are not being generated the ExpnStack
            -- referencing the function still has to be updated to refer to the
            -- corresponding implictly declared proof function.
            Cells.Set_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, ExpnStack), Proof_Function_Symbol);
         end if;
      end if;
   end Setup_Function_Call;

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

   procedure SetUpArrayAccess
   --# global in     Dictionary.Dict;
   --#        in out ExpnStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    Dictionary.Dict,
   --#                                    ExpnStack,
   --#                                    VCGHeap;
   is
      NumberOfDimensions : Positive;
      --ExpressionCell,
      DAGCell : Cells.Cell;
      TypeSym : Dictionary.Symbol;

   begin
      TypeSym := Cells.Get_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, ExpnStack));
      if Dictionary.IsTypeMark (TypeSym) then
         NumberOfDimensions := Dictionary.GetNumberOfDimensions (TypeSym);
      else
         NumberOfDimensions := Dictionary.GetNumberOfDimensions (Dictionary.GetType (TypeSym));
      end if;
      CreateCellKind (DAGCell, VCGHeap, Cell_Storage.List_Function);
      CStacks.Push (VCGHeap, DAGCell, ExpnStack);
      CreateEmptyList (NumberOfDimensions, VCGHeap, ExpnStack);
   end SetUpArrayAccess;

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

   -- This procedure is called during the "up-loop" of BuildDAGExpnDAG for each
   -- positional argument encountered (either in a function call,
   -- array access, or type conversion).
   -- A function is identified by a Cell Kind of Pending_Function on the
   -- Expression stack.
   -- It populates the data structure for the arguments established during
   -- the down loop traversal
   -- (e.g., by Setup_Function_Call for function parameters).
   procedure Process_Positional_Argument_Association (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out ExpnStack;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ContainsReals         from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ShortCircuitStack     from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.positional_argument_association;
   is
      ExpressionCell                             : Cells.Cell;
      TOSkind                                    : Cells.Cell_Kind;
      ConversionTargetType, ConversionSourceType : Dictionary.Symbol;
      ConstraintCell                             : Cells.Cell;
      ConstraintIndex                            : Dictionary.Symbol;
   begin
      CStacks.PopOff (VCGHeap, ExpnStack, ExpressionCell);
      TOSkind := Cells.Get_Kind (VCGHeap, CStacks.Top (VCGHeap, ExpnStack));

      if TOSkind = Cell_Storage.Pending_Function then
         if DoRtc then
            -- the wffs have provided the expected type.  We extract that and use it to
            -- constraint check the parameter.  If the function is an unchecked conversion
            -- and the wffs have determined that the subtype expected and given are identical,
            -- then no type symbol is planted and no check is generated.
            CheckConstraintRunTimeError
              (STree.NodeSymbol (Node),
               ExpressionCell,
               Scope,
               VCGHeap,
               ShortCircuitStack,
               CheckStack,
               ContainsReals);
         end if;

         -- We may need to convert the actual parameter by inserting some inherit
         -- derefences in front of it; conversion is required if we have called
         -- an inherited root function.  The parameter in this case must be an
         -- object.
         ConvertTaggedActualIfNecessary
           (Cells.Get_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, ExpnStack)),
            VCGHeap,
            ExpressionCell); -- function symbol

         -- If the formal parameter is unconstrained and the actual is a constrained subtype, then
         -- the wffs will have planted a constraining type at the expression node.  If we find such a
         -- type, we link it into the actual parameter expression DAG but using the expression's
         -- auxialliary (C) ptr.  Linking it in this way means that it is not part of the DAG itself and won't
         -- be printed; however, it will be available when we want to substitute actuals for formals in
         -- any check of the called function's precondition.
         ConstraintIndex := STree.NodeSymbol (STree.Expression_From_Positional_Argument_Association (Node => Node));
         if not Dictionary.Is_Null_Symbol (ConstraintIndex) then
            CreateCellKind (ConstraintCell, VCGHeap, Cell_Storage.Constraining_Index);
            Cells.Set_Symbol_Value (VCGHeap, ConstraintCell, ConstraintIndex);
            SetAuxPtr (ExpressionCell, ConstraintCell, VCGHeap);
         end if;
         InsertParameterInNextFreeSlot (CStacks.Top (VCGHeap, ExpnStack), ExpressionCell, VCGHeap);
      elsif TOSkind = Cell_Storage.List_Function then
         if DoRtc then
            CheckConstraintRunTimeError
              (STree.NodeSymbol (Node),
               ExpressionCell,
               Scope,
               VCGHeap,
               ShortCircuitStack,
               CheckStack,
               ContainsReals);
         end if;
         InsertParameterInNextFreeSlot (CStacks.Top (VCGHeap, ExpnStack), ExpressionCell, VCGHeap);
      elsif TOSkind = Cell_Storage.Fixed_Var then
         ConversionSourceType := STree.NodeSymbol (Node);
         ConversionTargetType := Cells.Get_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, ExpnStack));
         CStacks.Pop (VCGHeap, ExpnStack);                  -- get rid of type mark
         CStacks.Push (VCGHeap, ExpressionCell, ExpnStack); -- restore expression
         if IsRealType (ConversionSourceType)
           and then (IsIntegerType (ConversionTargetType) or else IsModularType (ConversionTargetType)) then
            PushFunction (Cell_Storage.Trunc_Function, VCGHeap, ExpnStack);
         end if;

         if DoRtc then
            if IsScalarType (ConversionTargetType) then

               CheckConstraintRunTimeError
                 (ConversionTargetType,
                  CStacks.Top (VCGHeap, ExpnStack),
                  Scope,
                  VCGHeap,
                  ShortCircuitStack,
                  CheckStack,
                  ContainsReals);
            end if;
         end if;
      else -- must be dealing with first indexed expression of array access
         if DoRtc then
            CheckConstraintRunTimeError
              (STree.NodeSymbol (Node),
               ExpressionCell,
               Scope,
               VCGHeap,
               ShortCircuitStack,
               CheckStack,
               ContainsReals);
         end if;
         SetUpArrayAccess;
         InsertParameterInNextFreeSlot (CStacks.Top (VCGHeap, ExpnStack), ExpressionCell, VCGHeap);
      end if;
   end Process_Positional_Argument_Association;

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

   -- This procedure is called during the "up-loop" of BuildDAGExpnDAG for each
   -- named argument encountered in a function call.
   -- It populates the data structure for the arguments (actual parameters)
   -- established during the down loop traversal by Setup_Function_Call.
   procedure Process_Named_Argument_Association (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     LexTokenManager.State;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out ExpnStack;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         Statistics.TableUsage from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ContainsReals         from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Node,
   --#                                    STree.Table &
   --#         ExpnStack             from *,
   --#                                    VCGHeap &
   --#         ShortCircuitStack     from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    LexTokenManager.State,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.named_argument_association;
   is
      InsertPoint, ExpressionCell : Cells.Cell;
      FunctionSym                 : Dictionary.Symbol;
      ParamPos                    : Positive;
      LastOne                     : Boolean;
      ConstraintCell              : Cells.Cell;
      ConstraintIndex             : Dictionary.Symbol;

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

      function FindIdentifier (Node : STree.SyntaxNode) return STree.SyntaxNode
      --# global in STree.Table;
      is
         IdentNode : STree.SyntaxNode;

      begin
         if STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => Node)) = SP_Symbols.simple_name then
            IdentNode := STree.Child_Node (Current_Node => STree.Child_Node (Current_Node => Node));
         else
            IdentNode :=
              STree.Child_Node (Current_Node => STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node)));
         end if;
         return IdentNode;
      end FindIdentifier;

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

      procedure GetParamNumber (Name    : in     LexTokenManager.Lex_String;
                                FunSym  : in     Dictionary.Symbol;
                                ParamNo :    out Positive)
      --# global in Dictionary.Dict;
      --#        in LexTokenManager.State;
      --# derives ParamNo from Dictionary.Dict,
      --#                      FunSym,
      --#                      LexTokenManager.State,
      --#                      Name;
      is
         It  : Dictionary.Iterator;
         Sym : Dictionary.Symbol;
      begin
         It := Dictionary.FirstSubprogramParameter (FunSym);
         SystemErrors.RT_Assert
           (C       => not Dictionary.IsNullIterator (It),
            Sys_Err => SystemErrors.Precondition_Failure,
            Msg     => "Can't find first subprogram parameter in BuildExpnDAG.GetParamNumber");
         loop
            Sym := Dictionary.CurrentSymbol (It);
            exit when LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Dictionary.GetSimpleName (Sym),
               Lex_Str2 => Name) =
              LexTokenManager.Str_Eq;
            It := Dictionary.NextSymbol (It);
            exit when Dictionary.IsNullIterator (It);
         end loop;
         ParamNo := Dictionary.GetSubprogramParameterNumber (Sym);
      end GetParamNumber;

   begin -- Process_Named_Argument_Association

      --we must be dealing with a function call
      CStacks.PopOff (VCGHeap, ExpnStack, ExpressionCell);

      if DoRtc then
         CheckConstraintRunTimeError
           (STree.NodeSymbol (Node),
            ExpressionCell,
            Scope,
            VCGHeap,
            ShortCircuitStack,
            CheckStack,
            ContainsReals);
      end if;
      FunctionSym := Cells.Get_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, ExpnStack));

      -- We may need to convert the actual parameter by inserting some inherit
      -- derefences in front of it; conversion is required if we have called
      -- an inherited root function.  The parameter in this case must be an
      -- object.
      ConvertTaggedActualIfNecessary (FunctionSym, VCGHeap, ExpressionCell);

      -- If the formal parameter is unconstrained and the actual is a constrained subtype, then
      -- the wffs will have planted a constraining type at the expression node.  If we find such a
      -- type, we link it into the actual parameter expression DAG but using the expression's
      -- auxialliary (C) ptr.  Linking it in this way means that it is not part of the DAG itself and won't
      -- be printed; however, it will be available when we want to substitute actuals for formals in
      -- any check of the called function's precondition.
      ConstraintIndex := STree.NodeSymbol (STree.Expression_From_Named_Argument_Association (Node => Node));
      if not Dictionary.Is_Null_Symbol (ConstraintIndex) then
         CreateCellKind (ConstraintCell, VCGHeap, Cell_Storage.Constraining_Index);
         Cells.Set_Symbol_Value (VCGHeap, ConstraintCell, ConstraintIndex);
         SetAuxPtr (ExpressionCell, ConstraintCell, VCGHeap);
      end if;
      GetParamNumber (STree.Node_Lex_String (Node => FindIdentifier (Node)), FunctionSym,
                      -- to get
                      ParamPos);
      CalculateInsertPoint (VCGHeap, ExpnStack, ParamPos,
                            -- to get
                            InsertPoint, LastOne);
      if LastOne then
         SetRightArgument (InsertPoint, ExpressionCell, VCGHeap);
      else
         SetLeftArgument (InsertPoint, ExpressionCell, VCGHeap);
      end if;
   end Process_Named_Argument_Association;

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

   -- This procedure is called during the "up-loop" of BuildDAGExpnDAG once
   -- all of the arguments (with positional or named association) have been
   -- processed by ProcessPositionalArgumentAssocaition or
   -- Process_Named_Argument_Association respectively.
   -- A function is identified by a Cell Kind of Pending_Function on the
   -- Expression stack and an array aggregate a Cell Kind of List_Function.
   -- It completes the model of a function call or an array access started
   -- on the down loop by Setup_Function_Call or SetUpArrayAccess.
   -- A function call model is completed by:
   --   planting a check corresponding to its precondition
   --   changing the function symbol to its implicit proof function equivalent
   --     (this is done to replace global variables by parameters as is
   --      required for FDL functions)
   --   planting assumptions that all its parameters are in type after the call
   --   planting an assumption that the result of the function is in-type.
   -- An array access model is completed by:
   --   translating the array access to an FDL element function
   --   associating the index type with the array access for potential use with
   --     translating unconstrained array attributes.
   procedure ProcessNameArgumentList
   --# global in     AssumeRvalues;
   --#        in     CommandLineData.Content;
   --#        in     DoRtc;
   --#        in     ExpnScope;
   --#        in     LineNmbr;
   --#        in     LoopStack;
   --#        in     ReferencedVars;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out ExpnStack;
   --#        in out FlowHeap;
   --#        in out Graph.Table;
   --#        in out KindOfStackedCheck;
   --#        in out LexTokenManager.State;
   --#        in out ShortCircuitStack;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out StmtStack.S;
   --#        in out VCGFailure;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         KindOfStackedCheck         from *,
   --#                                         AssumeRvalues,
   --#                                         CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ExpnScope,
   --#                                         ExpnStack,
   --#                                         FlowHeap,
   --#                                         Graph.Table,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         ReferencedVars,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         VCGHeap &
   --#         ContainsReals,
   --#         Dictionary.Dict,
   --#         Graph.Table,
   --#         LexTokenManager.State,
   --#         ShortCircuitStack,
   --#         Statistics.TableUsage,
   --#         StmtStack.S,
   --#         VCGFailure,
   --#         VCGHeap                    from *,
   --#                                         AssumeRvalues,
   --#                                         CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ExpnScope,
   --#                                         ExpnStack,
   --#                                         FlowHeap,
   --#                                         Graph.Table,
   --#                                         KindOfStackedCheck,
   --#                                         LexTokenManager.State,
   --#                                         LineNmbr,
   --#                                         LoopStack,
   --#                                         ReferencedVars,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         VCGHeap &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from AssumeRvalues,
   --#                                         CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ErrorHandler.Error_Context,
   --#                                         ExpnScope,
   --#                                         ExpnStack,
   --#                                         FlowHeap,
   --#                                         Graph.Table,
   --#                                         KindOfStackedCheck,
   --#                                         LexTokenManager.State,
   --#                                         LineNmbr,
   --#                                         LoopStack,
   --#                                         ReferencedVars,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         SPARK_IO.File_Sys,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         VCGHeap &
   --#         ExpnStack                  from *,
   --#                                         VCGHeap &
   --#         FlowHeap                   from *,
   --#                                         AssumeRvalues,
   --#                                         DoRtc,
   --#                                         ExpnStack,
   --#                                         ReferencedVars,
   --#                                         VCGHeap;
   is
      TOSkind               : Cells.Cell_Kind;
      Actual_Function_Call  : Cells.Cell;
      Proof_Function_Call   : Cells.Cell;
      Temp                  : Cells.Cell;
      TypeSym               : Dictionary.Symbol;
      FunctionSym           : Dictionary.Symbol;
      Abstraction           : Dictionary.Abstractions;
      ConstraintAbstraction : Dictionary.Abstractions;

   begin
      TOSkind := Cells.Get_Kind (VCGHeap, CStacks.Top (VCGHeap, ExpnStack));
      if TOSkind = Cell_Storage.Pending_Function then
         Cells.Set_Kind (VCGHeap, CStacks.Top (VCGHeap, ExpnStack), Cell_Storage.Proof_Function);

         -- Make a copy of the concrete function call from the
         -- ExpnStack because Assume_Function_Return_Annotation requires
         -- references to both the concrete and proof views of the of the
         -- function call
         Cells.Create_Cell (Heap     => VCGHeap,
                            CellName => Actual_Function_Call);
         Cells.Copy_Contents (Heap        => VCGHeap,
                              Source      => CStacks.Top (VCGHeap, ExpnStack),
                              Destination => Actual_Function_Call);

         FunctionSym := Cells.Get_Symbol_Value (VCGHeap, Actual_Function_Call);

         -- We need to know whether we are constructing the function call model using the
         -- abstract or refined signature for it.  Note that we need to consider this separately
         -- for flow annotations and proof annotations; this is because SEPR 1694 introduced the
         -- use of a second, refined constraint in the case of subprograms that manipulate a private
         -- type.  In such cases, weher there is no own variable refinement, we may use the asbtract flow
         -- annotation and the refined proof annotation - so two abstractions are invovled, thus:
         Abstraction           := Dictionary.GetAbstraction (FunctionSym, ExpnScope);
         ConstraintAbstraction := Dictionary.GetConstraintAbstraction (FunctionSym, ExpnScope);

         -- The function call model is completed by changing the function view
         -- from the concrete to the implicitly declared proof function
         -- equivalent
         Cells.Set_Symbol_Value
           (VCGHeap,
            CStacks.Top (VCGHeap, ExpnStack),
            Dictionary.GetImplicitProofFunction (Abstraction, FunctionSym));

         Proof_Function_Call := CStacks.Top (VCGHeap, ExpnStack);
         -- Here Proof_Function_Call refers to the proof function "call"
         -- and a list of parameters (globals have been made parameters).

         if DoRtc then
            Plant_Precondition_Check
              (Actual_Function_Call => Actual_Function_Call,
               Scope                => Scope,
               Abstraction          => ConstraintAbstraction);

            -- Before unstacking any RTCs associated with the now complete
            -- function call, we plant hypotheses to assume that all R-values
            -- (including the function's parameters are in type.
            CheckPlantRvalueAssumptions;
            -- then unstack checks
            UnStackRtcs (LineNmbr, VCGHeap, CheckStack, KindOfStackedCheck);

            -- Assume_Function_Return_Type must be called with the
            -- Cell referencing the implicitly declared proof function, i.e.,
            -- the implicit function.
            Assume_Function_Return_Type (Implicit_Function => Proof_Function_Call);

            -- Assume_Function_Return_Annotation requires both the concrete and
            -- proof views of the function call.
            Assume_Function_Return_Annotation
              (Actual_Function_Call => Actual_Function_Call,
               Proof_Function_Call  => Proof_Function_Call,
               Scope                => Scope,
               Abstraction          => ConstraintAbstraction);

         end if;

         Cells.Dispose_Of_Cell (Heap     => VCGHeap,
                                CellName => Actual_Function_Call);

      elsif TOSkind = Cell_Storage.List_Function then
         -- complete element model and store type so far in case of further
         -- indexing (to handle array of arrays case)
         CStacks.PopOff (VCGHeap, ExpnStack, Temp);
         TypeSym := Cells.Get_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, ExpnStack));
         if Dictionary.IsTypeMark (TypeSym) then
            TypeSym := Dictionary.GetArrayComponent (TypeSym);
         else
            TypeSym := Dictionary.GetArrayComponent (Dictionary.GetType (TypeSym));
         end if;
         CStacks.Push (VCGHeap, Temp, ExpnStack);
         PushOperator (Binary, SP_Symbols.comma, VCGHeap, ExpnStack);
         PushFunction (Cell_Storage.Element_Function, VCGHeap, ExpnStack);

         -- Note the TypeSym of the array component here.  This used later on
         -- in BuildGraph.ModelProcedureCall to get the type of an array element
         -- actual parameter
         Cells.Set_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, ExpnStack), TypeSym);

         -- elsif TOSkind = Cell_Storage.Fixed_Var
         -- then
         --  null; --type conversions not done yet
      end if;
   end ProcessNameArgumentList;

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

   procedure ModelQualifiedExpression (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out ExpnStack;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         ShortCircuitStack,
   --#         Statistics.TableUsage from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ContainsReals         from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ExpnStack             from *,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table;
   is
      ExpnCell, TypeMarkCell : Cells.Cell;
   begin
      if STree.Syntax_Node_Type (Node => STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node))) =
        SP_Symbols.expression then
         -- discard type indication and return its argument to top of stack;
         CStacks.PopOff (VCGHeap, ExpnStack, ExpnCell);
         -- the topmost stack cell contains the typemark;
         CStacks.PopOff (VCGHeap, ExpnStack, TypeMarkCell);
         CStacks.Push (VCGHeap, ExpnCell, ExpnStack);

         if DoRtc then
            CheckConstraintRunTimeError
              (Cells.Get_Symbol_Value (VCGHeap, TypeMarkCell),
               ExpnCell,
               Scope,
               VCGHeap,
               ShortCircuitStack,
               CheckStack,
               ContainsReals);
         end if;
      end if;
   end ModelQualifiedExpression;

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

   procedure UpProcessAggregateChoice (Node : in STree.SyntaxNode)
   --# global in     STree.Table;
   --#        in out ExpnStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   is
      RangeNodeType   : SP_Symbols.SP_Symbol;
      RangeExpression : Cells.Cell;

   begin
      RangeNodeType :=
        STree.Syntax_Node_Type (Node => STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node)));
      if RangeNodeType = SP_Symbols.simple_expression then
         PushOperator (Binary, SP_Symbols.double_dot, VCGHeap, ExpnStack);
      elsif RangeNodeType = SP_Symbols.range_constraint then
         TransformRangeConstraint (VCGHeap, ExpnStack);
         CStacks.PopOff (VCGHeap, ExpnStack, RangeExpression);
         CStacks.Pop (VCGHeap, ExpnStack); -- discard type mark part of range
         CStacks.Push (VCGHeap, RangeExpression, ExpnStack);
      elsif Cells.Get_Kind (VCGHeap, CStacks.Top (VCGHeap, ExpnStack)) = Cell_Storage.Fixed_Var then -- type mark found
         TransformTypeName (VCGHeap, ExpnStack);
      end if;
   end UpProcessAggregateChoice;

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

   procedure UpProcessNamedAssociationRep (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out ExpnStack;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ContainsReals         from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Node,
   --#                                    STree.Table &
   --#         ShortCircuitStack     from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   is
      AggExp : Cells.Cell;
   begin
      -- check components of array & record aggregates using named assoc
      if DoRtc then
         CheckConstraintRunTimeError
           (STree.NodeSymbol (Node),
            CStacks.Top (VCGHeap, ExpnStack),
            Scope,
            VCGHeap,
            ShortCircuitStack,
            CheckStack,
            ContainsReals);
      end if;
      PushOperator (Binary, SP_Symbols.becomes, VCGHeap, ExpnStack);

      if DoingArrayAggregate (VCGHeap, ExpnStack) then
         if STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => Node)) = SP_Symbols.named_association_rep then
            PushOperator (Binary, SP_Symbols.comma, VCGHeap, ExpnStack);
         end if;
      else -- record
         CStacks.PopOff (VCGHeap, ExpnStack, AggExp);
         InsertAssociation (CStacks.Top (VCGHeap, ExpnStack), AggExp, VCGHeap);
      end if;
   end UpProcessNamedAssociationRep;

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

   procedure UpProcessNamedRecordComponentAssociation (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out ExpnStack;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ContainsReals         from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Node,
   --#                                    STree.Table &
   --#         ShortCircuitStack     from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   is
      AggExp : Cells.Cell;
   begin
      -- Node is named_record_component_association
      -- Direction is UP
      -- TOS is expression to be associated
      -- 2nd TOS is field name
      -- 3rd TOS is incomplete aggregate being constructed.

      -- check components of array & record aggregates using named assoc
      if DoRtc then
         CheckConstraintRunTimeError
           (STree.NodeSymbol (Node),
            CStacks.Top (VCGHeap, ExpnStack),
            Scope,
            VCGHeap,
            ShortCircuitStack,
            CheckStack,
            ContainsReals);
      end if;
      -- associated field name with expression
      PushOperator (Binary, SP_Symbols.becomes, VCGHeap, ExpnStack);
      CStacks.PopOff (VCGHeap, ExpnStack, AggExp);
      InsertAssociation (CStacks.Top (VCGHeap, ExpnStack), AggExp, VCGHeap);
   end UpProcessNamedRecordComponentAssociation;

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

   procedure UpProcessPositionalRecordComponentAssociation (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out ExpnStack;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ContainsReals         from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Node,
   --#                                    STree.Table &
   --#         ShortCircuitStack     from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   is
      AggExp, TypeCell : Cells.Cell;
   begin
      -- Node is positional_record_component_association
      -- Direction is UP
      -- TOS is expression to be associated
      -- 2nd TOS is incomplete aggregate being constructed.
      -- 3rd TOS is agggregate counter giving current field number

      -- check components for RTCs
      if DoRtc then
         CheckConstraintRunTimeError
           (STree.NodeSymbol (Node),
            CStacks.Top (VCGHeap, ExpnStack),
            Scope,
            VCGHeap,
            ShortCircuitStack,
            CheckStack,
            ContainsReals);
      end if;
      CreateFixedVarCell
        (TypeCell,
         VCGHeap,
         Dictionary.GetRecordComponent (AggregateType (VCGHeap, ExpnStack), CurrentFieldOrIndex (VCGHeap, ExpnStack)));
      CStacks.Push (VCGHeap, TypeCell, ExpnStack);
      SwitchAndPush (SP_Symbols.becomes, VCGHeap, ExpnStack);
      IncCurrentFieldOrIndex (ExpnStack, VCGHeap);
      CStacks.PopOff (VCGHeap, ExpnStack, AggExp);
      InsertAssociation (CStacks.Top (VCGHeap, ExpnStack), AggExp, VCGHeap);
   end UpProcessPositionalRecordComponentAssociation;

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

   procedure UpProcessAggregateOrExpression (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out ExpnStack;
   --#        in out LexTokenManager.State;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         LexTokenManager.State from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ContainsReals         from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Node,
   --#                                    STree.Table &
   --#         ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    LexTokenManager.State,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ShortCircuitStack     from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   is
      IndexType                         : Dictionary.Symbol;
      CounterCell, AttribCell, TypeCell : Cells.Cell;
      CounterString                     : LexTokenManager.Lex_String;
      AggExp                            : Cells.Cell;

   begin --UpProcessAggregateOrExpression
      if STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Node)) = SP_Symbols.positional_association_rep
        or else STree.Next_Sibling (Current_Node => Node) /= STree.NullNode then
         -- check components of array & record aggregates using
         -- positional association, but not the others part
         if DoRtc then
            CheckConstraintRunTimeError
              (STree.NodeSymbol (Node),
               CStacks.Top (VCGHeap, ExpnStack),
               Scope,
               VCGHeap,
               ShortCircuitStack,
               CheckStack,
               ContainsReals);

         end if;
         if DoingArrayAggregate (VCGHeap, ExpnStack) then
            CreateCellKind (TypeCell, VCGHeap, Cell_Storage.Fixed_Var);
            IndexType := Dictionary.GetArrayIndex (AggregateType (VCGHeap, ExpnStack), 1);

            Cells.Set_Symbol_Value (VCGHeap, TypeCell, IndexType);
            CStacks.Push (VCGHeap, TypeCell, ExpnStack);

            CreateAttribValueCell (AttribCell, VCGHeap, LexTokenManager.First_Token);
            CStacks.Push (VCGHeap, AttribCell, ExpnStack);
            PushOperator (Binary, SP_Symbols.apostrophe, VCGHeap, ExpnStack);

            if Dictionary.TypeIsEnumeration (IndexType) then
               for I in Integer range 2 .. CurrentFieldOrIndex (VCGHeap, ExpnStack) loop
                  --# accept F, 41, "Stable expression expected here";
                  if Dictionary.TypeIsBoolean (IndexType) then
                     PushOperator (Unary, SP_Symbols.RWnot, VCGHeap, ExpnStack);
                  else
                     PushFunction (Cell_Storage.Succ_Function, VCGHeap, ExpnStack);
                  end if;
                  --# end accept;
               end loop;
            else --index type is numeric discrete
               if CurrentFieldOrIndex (VCGHeap, ExpnStack) > 1 then
                  LexTokenManager.Insert_Nat (N       => CurrentFieldOrIndex (VCGHeap, ExpnStack) - 1,
                                              Lex_Str => CounterString);
                  CreateManifestConstCell (CounterCell, VCGHeap, CounterString);
                  CStacks.Push (VCGHeap, CounterCell, ExpnStack);
                  PushOperator (Binary, SP_Symbols.plus, VCGHeap, ExpnStack);
               end if;
            end if;
            PushFunction (Cell_Storage.List_Function, VCGHeap, ExpnStack);

         else --record aggregate
            CreateFixedVarCell
              (TypeCell,
               VCGHeap,
               Dictionary.GetRecordComponent (AggregateType (VCGHeap, ExpnStack), CurrentFieldOrIndex (VCGHeap, ExpnStack)));
            CStacks.Push (VCGHeap, TypeCell, ExpnStack);
         end if;

         SwitchAndPush (SP_Symbols.becomes, VCGHeap, ExpnStack);

         IncCurrentFieldOrIndex (ExpnStack, VCGHeap);

         if DoingArrayAggregate (VCGHeap, ExpnStack) then
            if STree.Next_Sibling (Current_Node => Node) = STree.NullNode then
               PushOperator (Binary, SP_Symbols.comma, VCGHeap, ExpnStack);
            end if;
         else -- record
            CStacks.PopOff (VCGHeap, ExpnStack, AggExp);
            InsertAssociation (CStacks.Top (VCGHeap, ExpnStack), AggExp, VCGHeap);
         end if;
      end if;
   end UpProcessAggregateOrExpression;

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

   procedure UpProcessComponentAssociation (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out ExpnStack;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ContainsReals         from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Node,
   --#                                    STree.Table &
   --#         ShortCircuitStack     from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   is
   begin
      if STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => STree.Child_Node (Current_Node => Node))) /=
        STree.NullNode then
         -- check the others part of an array aggregate with either
         -- named or positional association; but does not cover a
         -- lone others part.
         if DoRtc then
            CheckConstraintRunTimeError
              (STree.NodeSymbol (Node),
               CStacks.Top (VCGHeap, ExpnStack),
               Scope,
               VCGHeap,
               ShortCircuitStack,
               CheckStack,
               ContainsReals);
         end if;
         SwitchAndPush (SP_Symbols.comma, VCGHeap, ExpnStack);
      end if;
   end UpProcessComponentAssociation;

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

   procedure UpProcessAggregate
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     Node;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out ExpnStack;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ContainsReals         from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Node,
   --#                                    STree.Table &
   --#         ShortCircuitStack     from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   is
      TempAgg : Cells.Cell;
   begin
      --RTC--a lone others clause gets picked up here and will need a RTC.
      --     In this case TOS is the expn dag of the others expression and
      --     all that happens is that a mk_array get put on top of it so
      --     that (others => X) becomes mk_array (X).  The expected type
      --     will be found at the component_association node (1 down) and
      --     the check is only needed if the node 2 down is an agg_or_exp.

      --RTC--added if statement to control whether RTC on lone others needed
      if STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => STree.Child_Node (Current_Node => Node))) =
        SP_Symbols.aggregate_or_expression then
         --there is a lone others clause that needs a RTC and the expn is TOS
         if DoRtc then
            CheckConstraintRunTimeError
              (STree.NodeSymbol (STree.Child_Node (Current_Node => Node)),
               CStacks.Top (VCGHeap, ExpnStack),
               Scope,
               VCGHeap,
               ShortCircuitStack,
               CheckStack,
               ContainsReals);

         end if;
      end if;
      --RTC--end of new if clause

      -- Tidy up expression stack

      -- At this point the stack is rather confused (even for an ex-FORTH programmer.
      -- If we are doing a record then TOS is the IncompleteAggregate function and its arguments,
      --                           2nd TOS is the aggregate counter used for positional association.
      --
      -- If we are doing an array then TOS is the comma-delimited list of arguments to the MkAggregate func,
      --                           2nd TOS is the IncompleteAggregate function itself,
      --                           3rd TOS is the aggregate counter
      --
      CStacks.PopOff (VCGHeap, ExpnStack, TempAgg);  -- hold the aggregate expression or list
      if Cells.Get_Kind (VCGHeap, CStacks.Top (VCGHeap, ExpnStack)) = Cell_Storage.Aggregate_Counter then
         -- we are doing a record and just need to get rid of the counter
         CStacks.Pop (VCGHeap, ExpnStack); -- get rid of counter
      else
         -- we are doing an array and TOS is the Incomplete function which needs to be connected to
         -- the comma-delimited list
         SetRightArgument (CStacks.Top (VCGHeap, ExpnStack), TempAgg, VCGHeap);
         -- hold the now complete aggregate expression and then get rid of the exposed counter
         CStacks.PopOff (VCGHeap, ExpnStack, TempAgg);
         CStacks.Pop (VCGHeap, ExpnStack);
      end if;
      -- Convert aggregate to a finished MkAggregate function
      Cells.Set_Kind (VCGHeap, TempAgg, Cell_Storage.Mk_Aggregate);
      -- Finally, restore aggregate DAG to TOS
      CStacks.Push (VCGHeap, TempAgg, ExpnStack);
   end UpProcessAggregate;

   ---------------------------------------------------------------------
   --                       Attribute Processing                      --
   ---------------------------------------------------------------------

   procedure DownProcessAttributeIdent (Node : in STree.SyntaxNode)
   --# global in     STree.Table;
   --#        in out ExpnStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   is
      DAGCell : Cells.Cell;
   begin
      CreateAttribValueCell (DAGCell, VCGHeap, STree.Node_Lex_String (Node => Node));
      CStacks.Push (VCGHeap, DAGCell, ExpnStack);
      PushOperator (Binary, SP_Symbols.apostrophe, VCGHeap, ExpnStack);
   end DownProcessAttributeIdent;

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

   -- Note name here is different from similar subunit within BuildAnnotationExpnDAG
   -- do avoid clash with Ada83 "no identical subunit names" rule.
   procedure UpAttributeDesignator (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ExpnStack;
   --#        in out LexTokenManager.State;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    LexTokenManager.State,
   --#                                    Node,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         LexTokenManager.State from *,
   --#                                    Dictionary.Dict,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ShortCircuitStack     from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    LexTokenManager.State,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCGHeap;
      is separate;

   ---------------------------------------------------------------------
   --                 Identifier and Selected Components              --
   ---------------------------------------------------------------------

   -- Called whenever an identifer is encountered in the expression
   -- An identifier appears in many places in the grammar. It is paricularly
   -- interesting if it is a variable, a type mark or a function call.
   -- If it is a function call the procedure Setup_Function_Call establishes
   -- the environment to represent the function arguments and ProcessIdentifier
   -- creates a Cell to represent the function on the Expression Stack with a
   -- Cell Kind of Pending_Function.
   procedure ProcessIdentifier (Node      : in STree.SyntaxNode;
                                ThisScope : in Dictionary.Scopes)
   --# global in     AssumeRvalues;
   --#        in     CommandLineData.Content;
   --#        in     DoRtc;
   --#        in     LineNmbr;
   --#        in     LoopStack;
   --#        in     ReferencedVars;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out ExpnStack;
   --#        in out FlowHeap;
   --#        in out Graph.Table;
   --#        in out KindOfStackedCheck;
   --#        in out LexTokenManager.State;
   --#        in out ShortCircuitStack;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out StmtStack.S;
   --#        in out VCGFailure;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         KindOfStackedCheck         from *,
   --#                                         CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ExpnStack,
   --#                                         Graph.Table,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Node,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap &
   --#         ContainsReals,
   --#         Dictionary.Dict,
   --#         Graph.Table,
   --#         LexTokenManager.State,
   --#         ShortCircuitStack,
   --#         StmtStack.S,
   --#         VCGFailure,
   --#         VCGHeap                    from *,
   --#                                         CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ExpnStack,
   --#                                         Graph.Table,
   --#                                         KindOfStackedCheck,
   --#                                         LexTokenManager.State,
   --#                                         LineNmbr,
   --#                                         LoopStack,
   --#                                         Node,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ErrorHandler.Error_Context,
   --#                                         ExpnStack,
   --#                                         Graph.Table,
   --#                                         KindOfStackedCheck,
   --#                                         LexTokenManager.State,
   --#                                         LineNmbr,
   --#                                         LoopStack,
   --#                                         Node,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         SPARK_IO.File_Sys,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap &
   --#         ExpnStack                  from *,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap &
   --#         FlowHeap                   from *,
   --#                                         AssumeRvalues,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         ReferencedVars,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         ThisScope &
   --#         Statistics.TableUsage      from *,
   --#                                         AssumeRvalues,
   --#                                         CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ExpnStack,
   --#                                         FlowHeap,
   --#                                         Graph.Table,
   --#                                         KindOfStackedCheck,
   --#                                         LexTokenManager.State,
   --#                                         LineNmbr,
   --#                                         LoopStack,
   --#                                         Node,
   --#                                         ReferencedVars,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap;
   is
      Sym     : Dictionary.Symbol;
      DAGCell : Cells.Cell;
   begin
      Sym :=
        Dictionary.LookupItem
        (Name              => STree.Node_Lex_String (Node => Node),
         Scope             => ThisScope,
         Context           => Dictionary.ProgramContext,
         Full_Package_Name => False);

      -- If we call an inherited root function then the above call will fail
      -- to find it and returns a null symbol.  In this case we can check the
      -- syntax tree for the symbol of the root operation that will have been
      -- planted by StackIdentifier.
      if Dictionary.Is_Null_Symbol (Sym) then
         Sym := STree.NodeSymbol (Node);
      end if;

      Cells.Create_Cell (VCGHeap, DAGCell);
      if Dictionary.Is_Variable (Sym) then
         -- each time we find a referenced variable we add it to the set of referenced vars
         AddRvalueSymbol (FlowHeap, ReferencedVars, Sym);

         Cells.Set_Kind (VCGHeap, DAGCell, Cell_Storage.Reference);
         Cells.Set_Symbol_Value (VCGHeap, DAGCell, Sym);
         CStacks.Push (VCGHeap, DAGCell, ExpnStack);
      elsif Dictionary.IsFunction (Sym) then
         Cells.Set_Kind (VCGHeap, DAGCell, Cell_Storage.Pending_Function);
         Cells.Set_Symbol_Value (VCGHeap, DAGCell, Sym);
         --LexTokenManager.InsertNat (1, LexStr);
         --Cells.Set_Lex_Str (VCGHeap, DAGCell, LexStr);
         CStacks.Push (VCGHeap, DAGCell, ExpnStack);
         Setup_Function_Call (ThisScope => ThisScope,
                              Prefix    => Dictionary.NullSymbol);
      elsif Dictionary.IsTypeMark (Sym) then

         -- If the identifier denotes a record subtype, then push its
         -- root type for subsequent VCG modelling...
         if Dictionary.TypeIsRecord (Sym) and then Dictionary.IsSubtype (Sym) then
            Sym := Dictionary.GetRootType (Sym);
         end if;

         Cells.Set_Kind (VCGHeap, DAGCell, Cell_Storage.Fixed_Var);
         Cells.Set_Symbol_Value (VCGHeap, DAGCell, Sym);
         CStacks.Push (VCGHeap, DAGCell, ExpnStack);
      else
         -- also check to see whether we need Rvalue for constants (see AddRValueSymbol for which sort)
         AddRvalueSymbol (FlowHeap, ReferencedVars, Sym);

         Cells.Set_Kind (VCGHeap, DAGCell, Cell_Storage.Named_Const);
         Cells.Set_Symbol_Value (VCGHeap, DAGCell, Sym);
         CStacks.Push (VCGHeap, DAGCell, ExpnStack);
      end if;
   end ProcessIdentifier;

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

   procedure ModelRecordComponent (RecordType, Sym : in Dictionary.Symbol)
   --# global in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in out ExpnStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    Dictionary.Dict,
   --#                                    ExpnStack,
   --#                                    LexTokenManager.State,
   --#                                    RecordType,
   --#                                    Sym,
   --#                                    VCGHeap;
   is
      DAGCell  : Cells.Cell;
      ExpnCell : Cells.Cell;
   begin
      CStacks.PopOff (VCGHeap, ExpnStack, ExpnCell);
      -- ExpnCell is a DAG representing an expression which is a record field
      -- Insert one or more "fld_inherit (" before the expression
      ModelInheritedFieldsOfTaggedRecord (Dictionary.GetSimpleName (Sym), RecordType, VCGHeap, ExpnCell);
      -- Then prefix it with fld_? (
      CreateCellKind (DAGCell, VCGHeap, Cell_Storage.Field_Access_Function);
      Cells.Set_Symbol_Value (VCGHeap, DAGCell, Sym);
      Cells.Set_Lex_Str (VCGHeap, DAGCell, Dictionary.GetSimpleName (Sym));
      --SetRightArgument (DAGCell, CStacks.Top (VCGHeap, ExpnStack));
      --CStacks.Pop (VCGHeap, ExpnStack);
      SetRightArgument (DAGCell, ExpnCell, VCGHeap);
      CStacks.Push (VCGHeap, DAGCell, ExpnStack);
   end ModelRecordComponent;

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

   -- Called whenever a selected_component is encountered in the expression
   -- A selected_component appears in many places in the grammar.
   -- This procedure deals with each of the places in which it may appear.
   -- If it is a function call the procedure Setup_Function_Call establishes
   -- the environment to represent the function arguments and
   -- ProcessSelectedComponent creates a Cell to represent the function on the
   -- Expression Stack with a Cell Kind of Pending_Function.
   procedure ProcessSelectedComponent (Node      : in STree.SyntaxNode;
                                       ThisScope : in Dictionary.Scopes)
   --# global in     AssumeRvalues;
   --#        in     CommandLineData.Content;
   --#        in     DoRtc;
   --#        in     LineNmbr;
   --#        in     LoopStack;
   --#        in     ReferencedVars;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out ExpnStack;
   --#        in out FlowHeap;
   --#        in out Graph.Table;
   --#        in out KindOfStackedCheck;
   --#        in out LexTokenManager.State;
   --#        in out ShortCircuitStack;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out StmtStack.S;
   --#        in out VCGFailure;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         KindOfStackedCheck         from *,
   --#                                         CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ExpnStack,
   --#                                         Graph.Table,
   --#                                         LexTokenManager.State,
   --#                                         LoopStack,
   --#                                         Node,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap &
   --#         ContainsReals,
   --#         Dictionary.Dict,
   --#         Graph.Table,
   --#         LexTokenManager.State,
   --#         ShortCircuitStack,
   --#         StmtStack.S,
   --#         VCGFailure,
   --#         VCGHeap                    from *,
   --#                                         CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ExpnStack,
   --#                                         Graph.Table,
   --#                                         KindOfStackedCheck,
   --#                                         LexTokenManager.State,
   --#                                         LineNmbr,
   --#                                         LoopStack,
   --#                                         Node,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ErrorHandler.Error_Context,
   --#                                         ExpnStack,
   --#                                         Graph.Table,
   --#                                         KindOfStackedCheck,
   --#                                         LexTokenManager.State,
   --#                                         LineNmbr,
   --#                                         LoopStack,
   --#                                         Node,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         SPARK_IO.File_Sys,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap &
   --#         ExpnStack                  from *,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap &
   --#         FlowHeap                   from *,
   --#                                         AssumeRvalues,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ExpnStack,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         ReferencedVars,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap &
   --#         Statistics.TableUsage      from *,
   --#                                         AssumeRvalues,
   --#                                         CheckStack,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         DoRtc,
   --#                                         ExpnStack,
   --#                                         FlowHeap,
   --#                                         Graph.Table,
   --#                                         KindOfStackedCheck,
   --#                                         LexTokenManager.State,
   --#                                         LineNmbr,
   --#                                         LoopStack,
   --#                                         Node,
   --#                                         ReferencedVars,
   --#                                         Scope,
   --#                                         ShortCircuitStack,
   --#                                         StmtStack.S,
   --#                                         STree.Table,
   --#                                         ThisScope,
   --#                                         VCGHeap;
   is
      DAGCell   : Cells.Cell;
      Sym       : Dictionary.Symbol;
      IdentNode : STree.SyntaxNode;
      Prefix    : Dictionary.Symbol;

   begin
      DAGCell   := CStacks.Top (VCGHeap, ExpnStack);
      IdentNode :=
        STree.Child_Node
        (Current_Node => STree.Child_Node (Current_Node => STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node))));

      Prefix := GetTOStype (VCGHeap, ExpnStack);

      Sym :=
        Dictionary.LookupSelectedItem (Prefix, --GetTOStype,
                                       STree.Node_Lex_String (Node => IdentNode), ThisScope, Dictionary.ProgramContext);

      -- If we call an inherited root function then the above call will fail
      -- to find it and returns a null symbol.  In this case we can check the
      -- syntax tree for the symbol of the root operation that will have been
      -- planted by StackIdentifier.
      if Dictionary.Is_Null_Symbol (Sym) then
         Sym := STree.NodeSymbol (Node);
      end if;

      if Dictionary.IsRecordComponent (Sym) then
         ModelRecordComponent (Prefix, Sym);
      elsif Dictionary.Is_Variable (Sym) then
         -- each time we find a referenced variable we add it to the set of referenced vars
         AddRvalueSymbol (FlowHeap, ReferencedVars, Sym);

         Cells.Set_Kind (VCGHeap, DAGCell, Cell_Storage.Reference);
         Cells.Set_Symbol_Value (VCGHeap, DAGCell, Sym);
      elsif Dictionary.IsFunction (Sym) then
         -- Before processing function, find the actual prefix symbol used
         Prefix := Cells.Get_Symbol_Value (VCGHeap, DAGCell);
         -- if Prefix is a protected object then we are handling a fucntion call
         -- of the form PO.F.  In this case we need to pass PO to Setup_Function_Call
         -- so that it can replace globals of F expressed in terms of the type PT
         -- with the object PO
         if not (Dictionary.IsOwnVariable (Prefix) and then Dictionary.GetOwnVariableProtected (Prefix)) then
            -- Prefix is NOT a protected object so we set it to null so that
            -- Setup_Function_Call won't do any subtitutions.  If it is a PO
            -- we leave it alone and it gets passed to Setup_Function_Call
            Prefix := Dictionary.NullSymbol;
         end if;
         -- now replace top of stack with the function
         Cells.Set_Kind (VCGHeap, DAGCell, Cell_Storage.Pending_Function);
         Cells.Set_Symbol_Value (VCGHeap, DAGCell, Sym);
         -- set up the paramater list (and copy in the globals)
         Setup_Function_Call (ThisScope => ThisScope,
                              Prefix    => Prefix);
      elsif Dictionary.IsTypeMark (Sym) then
         Cells.Set_Kind (VCGHeap, DAGCell, Cell_Storage.Fixed_Var);
         Cells.Set_Symbol_Value (VCGHeap, DAGCell, Sym);
      elsif Dictionary.IsPackage (Sym) then
         -- replace package symbolwith the child ready for next lookup
         Cells.Set_Symbol_Value (VCGHeap, DAGCell, Sym);
      else
         -- check to see whether we need Rvalue for constants (see AddRValueSymbol for which sort)
         AddRvalueSymbol (FlowHeap, ReferencedVars, Sym);

         Cells.Set_Kind (VCGHeap, DAGCell, Cell_Storage.Named_Const);
         Cells.Set_Symbol_Value (VCGHeap, DAGCell, Sym);
      end if;
   end ProcessSelectedComponent;

   ---------------------------------------------------------------------
   --                            Expressions                          --
   ---------------------------------------------------------------------

   -- procedure to model XOR iaw B manual para 3.1.5
   procedure ModelXorOperator
   --# global in out ExpnStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    ExpnStack,
   --#                                    VCGHeap;
   is
      DAGCell, Left, Right : Cells.Cell;
   begin
      CStacks.PopOff (VCGHeap, ExpnStack, Right);
      CStacks.PopOff (VCGHeap, ExpnStack, Left);

      CreateOpCell (DAGCell, VCGHeap, SP_Symbols.RWor);
      SetRightArgument (DAGCell, Right, VCGHeap);
      SetLeftArgument (DAGCell, Left, VCGHeap);
      CStacks.Push (VCGHeap, DAGCell, ExpnStack);

      CreateOpCell (DAGCell, VCGHeap, SP_Symbols.RWand);
      SetRightArgument (DAGCell, Right, VCGHeap);
      SetLeftArgument (DAGCell, Left, VCGHeap);
      CStacks.Push (VCGHeap, DAGCell, ExpnStack);

      PushOperator (Unary, SP_Symbols.RWnot, VCGHeap, ExpnStack);
      PushOperator (Binary, SP_Symbols.RWand, VCGHeap, ExpnStack);
   end ModelXorOperator;

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

   procedure ProcessExpression (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     STree.Table;
   --#        in out ExpnStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    Dictionary.Dict,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   is
      Op_Node    : STree.SyntaxNode;
      Operator   : SP_Symbols.SP_Symbol;
      ResultType : Dictionary.Symbol;

      procedure ModelBitwiseOperation (Operator : in SP_Symbols.SP_Symbol;
                                       TypeSym  : in Dictionary.Symbol)

      --# global in out ExpnStack;
      --#        in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives ExpnStack,
      --#         Statistics.TableUsage,
      --#         VCGHeap               from *,
      --#                                    ExpnStack,
      --#                                    Operator,
      --#                                    TypeSym,
      --#                                    VCGHeap;
      is
         BoolOpCell : Cells.Cell;
      begin -- ModelBitwiseOperation
         CreateBoolOpCell (BoolOpCell, VCGHeap, TypeSym, Operator);
         -- on the stack are the arguments we want for this new function.
         PushOperator (Binary, SP_Symbols.comma, VCGHeap, ExpnStack);

         -- tos now has comma cell joining the two arguments
         SetRightArgument (BoolOpCell, CStacks.Top (VCGHeap, ExpnStack), VCGHeap);
         CStacks.Pop (VCGHeap, ExpnStack);
         CStacks.Push (VCGHeap, BoolOpCell, ExpnStack);
         -- modelling function is now on TOS
      end ModelBitwiseOperation;

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

   begin -- ProcessExpression
      Op_Node := STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node));
      if Op_Node /= STree.NullNode then
         Operator := STree.Syntax_Node_Type (Node => Op_Node);

         -- check to see if result type is an array and
         --     build special model if it is
         ResultType := STree.NodeSymbol (Op_Node);
         if Dictionary.IsTypeMark (ResultType) and then Dictionary.TypeIsArray (ResultType) then
            -- must be a Boolean array operation
            ModelBitwiseOperation (Operator, ResultType);

         elsif IsModularBitwiseOp (Operator, ResultType) then
            ModelBitwiseOperation (Operator, ResultType);

         else -- procede as before for scalar bool ops
            if Operator = SP_Symbols.RWxor then
               ModelXorOperator;
            elsif Operator = SP_Symbols.RWandthen or Operator = SP_Symbols.RWorelse then
               -- do nothing for AndThen's and OrElse's here as they have
               -- already been left-associated in ProcessRelation
               null;
            else
               PushOperator (Binary, Operator, VCGHeap, ExpnStack);
            end if;
         end if;
      end if;
   end ProcessExpression;

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

   procedure ModelInClause (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     STree.Table;
   --#        in out ExpnStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    Dictionary.Dict,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   is
      LeftSideOfRange, RightSideOfRange, TypeMarkCell, AttribCell : Cells.Cell;

      RelOperationLHS, RelOperationRHS, MiddleOperator : SP_Symbols.SP_Symbol;

      InOperatorNode, RangeNode : STree.SyntaxNode;

      type StaticResults is (IsTrue, IsFalse, IsUnknown);
      StaticResult : StaticResults;

      type MembershipKinds is (Inside, Outside);
      MembershipKind : MembershipKinds;

      procedure CheckIfResultStaticallyKnown
      --# global in     Dictionary.Dict;
      --#        in     InOperatorNode;
      --#        in     STree.Table;
      --#           out StaticResult;
      --# derives StaticResult from Dictionary.Dict,
      --#                           InOperatorNode,
      --#                           STree.Table;
      is
         Sym : Dictionary.Symbol;
      begin
         Sym := STree.NodeSymbol (InOperatorNode);
         if Dictionary.IsEnumerationLiteral (Sym) then
            if Dictionary.Enumeration_Literals_Are_Equal (Left_Symbol  => Sym,
                                                          Right_Symbol => Dictionary.GetTrue) then
               StaticResult := IsTrue;
            elsif Dictionary.Enumeration_Literals_Are_Equal (Left_Symbol  => Sym,
                                                             Right_Symbol => Dictionary.GetFalse) then
               StaticResult := IsFalse;
            else
               StaticResult := IsUnknown;
            end if;
         else
            StaticResult := IsUnknown;
         end if;
      end CheckIfResultStaticallyKnown;

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

      procedure ModelStaticallyKnownResult
      --# global in     Dictionary.Dict;
      --#        in     StaticResult;
      --#        in out ExpnStack;
      --#        in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives ExpnStack             from Dictionary.Dict,
      --#                                    StaticResult,
      --#                                    VCGHeap &
      --#         Statistics.TableUsage from *,
      --#                                    Dictionary.Dict,
      --#                                    StaticResult,
      --#                                    VCGHeap &
      --#         VCGHeap               from *,
      --#                                    Dictionary.Dict,
      --#                                    ExpnStack,
      --#                                    StaticResult;
      is
         StaticResultCell : Cells.Cell;

      begin -- ModelStaticallyKnownResult
         CreateCellKind (StaticResultCell, VCGHeap, Cell_Storage.Named_Const);
         if StaticResult = IsTrue then
            Cells.Set_Symbol_Value (VCGHeap, StaticResultCell, Dictionary.GetTrue);
         else
            Cells.Set_Symbol_Value (VCGHeap, StaticResultCell, Dictionary.GetFalse);
         end if;
         CStacks.Push (VCGHeap, StaticResultCell, ExpnStack);
      end ModelStaticallyKnownResult;

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

      procedure CompleteInequalityModel
      --# global in     LeftSideOfRange;
      --#        in     MiddleOperator;
      --#        in     RelOperationLHS;
      --#        in     RelOperationRHS;
      --#        in     RightSideOfRange;
      --#        in out ExpnStack;
      --#        in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives ExpnStack,
      --#         Statistics.TableUsage,
      --#         VCGHeap               from *,
      --#                                    ExpnStack,
      --#                                    LeftSideOfRange,
      --#                                    MiddleOperator,
      --#                                    RelOperationLHS,
      --#                                    RelOperationRHS,
      --#                                    RightSideOfRange,
      --#                                    VCGHeap;
      is
         LeftOperand : Cells.Cell;
      begin -- CompleteInequalityModel
         CStacks.PopOff (VCGHeap, ExpnStack, LeftOperand);
         -- restore stack keeping copy of LeftOperand
         CStacks.Push (VCGHeap, LeftOperand, ExpnStack);
         CStacks.Push (VCGHeap, LeftSideOfRange, ExpnStack);
         PushOperator (Binary, RelOperationLHS, VCGHeap, ExpnStack);
         CStacks.Push (VCGHeap, LeftOperand, ExpnStack);
         CStacks.Push (VCGHeap, RightSideOfRange, ExpnStack);
         PushOperator (Binary, RelOperationRHS, VCGHeap, ExpnStack);
         -- form conjunction of the two range constraints;
         PushOperator (Binary, MiddleOperator, VCGHeap, ExpnStack);
      end CompleteInequalityModel;

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

      function IsBooleanMembership return Boolean
      --# global in Dictionary.Dict;
      --#        in InOperatorNode;
      --#        in STree.Table;
      is
         Sym : Dictionary.Symbol;
      begin
         Sym := STree.NodeSymbol (InOperatorNode);
         return Dictionary.IsType (Sym) and then Dictionary.TypeIsBoolean (Sym);
      end IsBooleanMembership;

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

      procedure CompleteBooleanModel
      --# global in     LeftSideOfRange;
      --#        in     MembershipKind;
      --#        in     RightSideOfRange;
      --#        in out ExpnStack;
      --#        in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives ExpnStack,
      --#         Statistics.TableUsage,
      --#         VCGHeap               from *,
      --#                                    ExpnStack,
      --#                                    LeftSideOfRange,
      --#                                    MembershipKind,
      --#                                    RightSideOfRange,
      --#                                    VCGHeap;
      is
         LeftOperand : Cells.Cell;
      begin -- CompleteBooleanModel

         -- model: for X in L .. R create (X and R) or (not X and not L)
         --        negate entire model if operator is 'not in' rather than 'in'

         CStacks.PopOff (VCGHeap, ExpnStack, LeftOperand);

         -- create not L
         CStacks.Push (VCGHeap, LeftSideOfRange, ExpnStack);
         PushOperator (Unary, SP_Symbols.RWnot, VCGHeap, ExpnStack);
         -- create not X (using copy of X)
         CStacks.Push (VCGHeap, LeftOperand, ExpnStack);
         PushOperator (Unary, SP_Symbols.RWnot, VCGHeap, ExpnStack);
         -- conjoin
         PushOperator (Binary, SP_Symbols.RWand, VCGHeap, ExpnStack);

         -- create X and R
         CStacks.Push (VCGHeap, RightSideOfRange, ExpnStack);
         CStacks.Push (VCGHeap, LeftOperand, ExpnStack);
         PushOperator (Binary, SP_Symbols.RWand, VCGHeap, ExpnStack);

         -- disjoin above two subexpressions
         PushOperator (Binary, SP_Symbols.RWor, VCGHeap, ExpnStack);

         -- finally, if outside rather than inside then invert answer
         if MembershipKind = Outside then
            PushOperator (Unary, SP_Symbols.RWnot, VCGHeap, ExpnStack);
         end if;
      end CompleteBooleanModel;

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

   begin -- ModelInClause
      InOperatorNode := STree.Next_Sibling (Current_Node => Node);
      if STree.Syntax_Node_Type (Node => InOperatorNode) = SP_Symbols.inside then
         MembershipKind  := Inside;
         RelOperationLHS := SP_Symbols.greater_or_equal;
         RelOperationRHS := SP_Symbols.less_or_equal;
         MiddleOperator  := SP_Symbols.RWand;
      else
         MembershipKind  := Outside;
         RelOperationLHS := SP_Symbols.less_than;
         RelOperationRHS := SP_Symbols.greater_than;
         MiddleOperator  := SP_Symbols.RWor;
      end if;

      RangeNode := STree.Next_Sibling (Current_Node => InOperatorNode);
      if STree.Syntax_Node_Type (Node => RangeNode) = SP_Symbols.arange then
         -- set is defined by a range, held in stack;
         if STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => RangeNode)) = SP_Symbols.attribute then
            -- range is defined by a range attribute on top of stack
            -- this has already been transformed by UpAttribute
            -- which has left Index'First .. Index'Last on stack
            LeftSideOfRange  := LeftPtr (VCGHeap, CStacks.Top (VCGHeap, ExpnStack));
            RightSideOfRange := RightPtr (VCGHeap, CStacks.Top (VCGHeap, ExpnStack));
            CStacks.Pop (VCGHeap, ExpnStack);  -- discard ..
         else
            -- range is defined by a pair of simple expressions;
            CStacks.PopOff (VCGHeap, ExpnStack, RightSideOfRange);
            CStacks.PopOff (VCGHeap, ExpnStack, LeftSideOfRange);
         end if;
         if IsBooleanMembership then
            CompleteBooleanModel;
         else
            CompleteInequalityModel;
         end if;
      else
         -- range is defined by a typemark on top of stack;
         -- form the right operands from this typemark, using FIRST and LAST;
         CheckIfResultStaticallyKnown; -- it will be static if type is non-scalar
         CStacks.PopOff (VCGHeap, ExpnStack, TypeMarkCell);
         if StaticResult = IsUnknown then
            -- not known so build attribute range from typemark
            CreateCellKind (AttribCell, VCGHeap, Cell_Storage.Attrib_Value);
            CreateOpCell (LeftSideOfRange, VCGHeap, SP_Symbols.apostrophe);
            SetLeftArgument (LeftSideOfRange, TypeMarkCell, VCGHeap);
            SetRightArgument (LeftSideOfRange, AttribCell, VCGHeap);
            Structures.CopyStructure (VCGHeap, LeftSideOfRange, RightSideOfRange);
            Cells.Set_Lex_Str (VCGHeap, RightPtr (VCGHeap, LeftSideOfRange), LexTokenManager.First_Token);
            Cells.Set_Lex_Str (VCGHeap, RightPtr (VCGHeap, RightSideOfRange), LexTokenManager.Last_Token);
            CompleteInequalityModel;
         else
            -- it is known get rid of expression from TOS
            CStacks.Pop (VCGHeap, ExpnStack);
            -- put True or False literal cell on stack
            ModelStaticallyKnownResult;
         end if;
      end if;
   end ModelInClause;

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

   procedure DownProcessRelation (Node : in STree.SyntaxNode)
   --# global in     DoRtc;
   --#        in     ExpnStack;
   --#        in     STree.Table;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives ShortCircuitStack,
   --#         Statistics.TableUsage from *,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         VCGHeap               from *,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table;
   is
      NotLeftHand, LeftHand : Cells.Cell;

   begin
      if DoRtc
        and then STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Node)) = SP_Symbols.expression_rep2 then
         -- take a copy of the top of ExpnStack which is the LHS of
         -- the andthen; and push it on ShortCircuitStack
         Structures.CopyStructure (VCGHeap, CStacks.Top (VCGHeap, ExpnStack), LeftHand);
         CStacks.Push (VCGHeap, LeftHand, ShortCircuitStack);
      elsif DoRtc
        and then STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Node)) = SP_Symbols.expression_rep4 then
         -- take a copy of the top of ExpnStack which is the LHS of
         -- the orelse and negate it; and push it on ShortCircuitStack
         Structures.CopyStructure (VCGHeap, CStacks.Top (VCGHeap, ExpnStack), LeftHand);
         CreateOpCell (NotLeftHand, VCGHeap, SP_Symbols.RWnot);
         SetRightArgument (NotLeftHand, LeftHand, VCGHeap);

         CStacks.Push (VCGHeap, NotLeftHand, ShortCircuitStack);
      end if;

   end DownProcessRelation;

   procedure ModelAndThen
   --# global in out ExpnStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    ExpnStack,
   --#                                    VCGHeap;
   is
      DAGCell, Left, Right : Cells.Cell;
   begin
      -- continue to model AndThen as And for the moment

      CStacks.PopOff (VCGHeap, ExpnStack, Right);
      CStacks.PopOff (VCGHeap, ExpnStack, Left);

      CreateOpCell (DAGCell, VCGHeap, SP_Symbols.RWand);
      SetRightArgument (DAGCell, Right, VCGHeap);
      SetLeftArgument (DAGCell, Left, VCGHeap);
      CStacks.Push (VCGHeap, DAGCell, ExpnStack);

   end ModelAndThen;

   procedure ModelOrElse
   --# global in out ExpnStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    ExpnStack,
   --#                                    VCGHeap;
   is
      DAGCell, Left, Right : Cells.Cell;
   begin
      -- continue to model OrElse as Or for the moment

      CStacks.PopOff (VCGHeap, ExpnStack, Right);
      CStacks.PopOff (VCGHeap, ExpnStack, Left);

      CreateOpCell (DAGCell, VCGHeap, SP_Symbols.RWor);
      SetRightArgument (DAGCell, Right, VCGHeap);
      SetLeftArgument (DAGCell, Left, VCGHeap);
      CStacks.Push (VCGHeap, DAGCell, ExpnStack);

   end ModelOrElse;

   procedure ProcessRelation (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     STree.Table;
   --#        in out ExpnStack;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives ExpnStack,
   --#         ShortCircuitStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   is
      Op_Node : STree.SyntaxNode;

   begin

      Op_Node := STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node));
      if Op_Node /= STree.NullNode then
         if STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.relational_operator then
            PushOperator
              (Binary,
               STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => Op_Node)),
               VCGHeap,
               ExpnStack);
         else
            ModelInClause (STree.Child_Node (Current_Node => Node));
         end if;
      end if;

      -- detect any short-circuit forms
      if STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Node)) = SP_Symbols.expression_rep2 then
         if DoRtc then
            CStacks.Pop (VCGHeap, ShortCircuitStack);
         end if;
         -- left associate and then's
         ModelAndThen;
      elsif STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Node)) = SP_Symbols.expression_rep4 then
         if DoRtc then
            CStacks.Pop (VCGHeap, ShortCircuitStack);
         end if;
         -- left associate orelse's
         ModelOrElse;
      end if;

   end ProcessRelation;

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

   procedure Process_Simple_Expression (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out ExpnStack;
   --#        in out LexTokenManager.State;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         ShortCircuitStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    LexTokenManager.State,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ContainsReals         from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Node,
   --#                                    STree.Table &
   --#         ExpnStack             from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    LexTokenManager.State,
   --#                                    Node,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         LexTokenManager.State from *,
   --#                                    Dictionary.Dict,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   is
      Origin_Type : SP_Symbols.SP_Symbol;
      Rel_Op_Node : STree.SyntaxNode;
      Op_Node     : STree.SyntaxNode;
      Op          : SP_Symbols.SP_Symbol;

      procedure CreateNonZeroConstraint (Expr       : in     Cells.Cell;
                                         Check_Cell :    out Cells.Cell)
      --# global in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives Check_Cell            from VCGHeap &
      --#         Statistics.TableUsage from *,
      --#                                    VCGHeap &
      --#         VCGHeap               from *,
      --#                                    Expr;
      is
         ZeroCell, NotEqualsCell : Cells.Cell;
      begin -- CreateNonZeroConstraint
         CreateManifestConstCell (ZeroCell, VCGHeap, LexTokenManager.Zero_Value);

         CreateOpCell (NotEqualsCell, VCGHeap, SP_Symbols.not_equal);
         SetRightArgument (NotEqualsCell, ZeroCell, VCGHeap);
         SetLeftArgument (NotEqualsCell, Expr, VCGHeap);

         Check_Cell := NotEqualsCell;
      end CreateNonZeroConstraint;

      procedure CheckDivideByZero (RightArg : in Cells.Cell)
      --# global in     DoRtc;
      --#        in out CheckStack;
      --#        in out ShortCircuitStack;
      --#        in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives CheckStack,
      --#         ShortCircuitStack,
      --#         Statistics.TableUsage from *,
      --#                                    DoRtc,
      --#                                    RightArg,
      --#                                    ShortCircuitStack,
      --#                                    VCGHeap &
      --#         VCGHeap               from *,
      --#                                    CheckStack,
      --#                                    DoRtc,
      --#                                    RightArg,
      --#                                    ShortCircuitStack;
      is
         Check_Cell, CpRightArg : Cells.Cell;
      begin
         if DoRtc then
            Structures.CopyStructure (VCGHeap, RightArg, CpRightArg);
            CreateNonZeroConstraint (CpRightArg, Check_Cell);
            PlantCheckStatement (Check_Cell, VCGHeap, ShortCircuitStack, CheckStack);

         end if;
      end CheckDivideByZero;

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

      procedure ModelDivide
      --# global in     Dictionary.Dict;
      --#        in     DoRtc;
      --#        in     Op_Node;
      --#        in     STree.Table;
      --#        in out CheckStack;
      --#        in out ExpnStack;
      --#        in out ShortCircuitStack;
      --#        in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives CheckStack,
      --#         ShortCircuitStack,
      --#         Statistics.TableUsage from *,
      --#                                    Dictionary.Dict,
      --#                                    DoRtc,
      --#                                    ExpnStack,
      --#                                    Op_Node,
      --#                                    ShortCircuitStack,
      --#                                    STree.Table,
      --#                                    VCGHeap &
      --#         ExpnStack             from *,
      --#                                    Dictionary.Dict,
      --#                                    Op_Node,
      --#                                    STree.Table,
      --#                                    VCGHeap &
      --#         VCGHeap               from *,
      --#                                    CheckStack,
      --#                                    Dictionary.Dict,
      --#                                    DoRtc,
      --#                                    ExpnStack,
      --#                                    Op_Node,
      --#                                    ShortCircuitStack,
      --#                                    STree.Table;
      is
         OpCell : Cells.Cell;
      begin
         Cells.Create_Cell (VCGHeap, OpCell);
         if Dictionary.TypeIsReal (STree.NodeSymbol (Op_Node)) then
            Cells.Set_Kind (VCGHeap, OpCell, Cell_Storage.Op);
            Cells.Set_Op_Symbol (VCGHeap, OpCell, SP_Symbols.divide);
         else
            Cells.Set_Kind (VCGHeap, OpCell, Cell_Storage.FDL_Div_Op);
         end if;

         SetRightArgument (OpCell, CStacks.Top (VCGHeap, ExpnStack), VCGHeap);
         CStacks.Pop (VCGHeap, ExpnStack);
         SetLeftArgument (OpCell, CStacks.Top (VCGHeap, ExpnStack), VCGHeap);
         CStacks.Pop (VCGHeap, ExpnStack);
         CStacks.Push (VCGHeap, OpCell, ExpnStack);

         -- Should check for real types here?
         CheckDivideByZero (RightPtr (VCGHeap, CStacks.Top (VCGHeap, ExpnStack)));
      end ModelDivide;

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

      procedure ModelRem
      --# global in     DoRtc;
      --#        in out CheckStack;
      --#        in out ExpnStack;
      --#        in out ShortCircuitStack;
      --#        in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives CheckStack,
      --#         ShortCircuitStack,
      --#         Statistics.TableUsage from *,
      --#                                    DoRtc,
      --#                                    ExpnStack,
      --#                                    ShortCircuitStack,
      --#                                    VCGHeap &
      --#         ExpnStack             from *,
      --#                                    VCGHeap &
      --#         VCGHeap               from *,
      --#                                    CheckStack,
      --#                                    DoRtc,
      --#                                    ExpnStack,
      --#                                    ShortCircuitStack;
      is
         DAGCell, Left, Right : Cells.Cell;
      begin
         -- modelling of I rem J as I - (I div J)  * J
         -- J is top of stack and I is 2nd TOS
         CStacks.PopOff (VCGHeap, ExpnStack, Right);
         CStacks.PopOff (VCGHeap, ExpnStack, Left);

         CreateCellKind (DAGCell, VCGHeap, Cell_Storage.FDL_Div_Op);
         SetRightArgument (DAGCell, Right, VCGHeap);
         SetLeftArgument (DAGCell, Left, VCGHeap);
         CStacks.Push (VCGHeap, DAGCell, ExpnStack);

         CreateOpCell (DAGCell, VCGHeap, SP_Symbols.multiply);
         SetRightArgument (DAGCell, Right, VCGHeap);
         SetLeftArgument (DAGCell, CStacks.Top (VCGHeap, ExpnStack), VCGHeap);
         CStacks.Pop (VCGHeap, ExpnStack);
         CStacks.Push (VCGHeap, DAGCell, ExpnStack);

         CreateOpCell (DAGCell, VCGHeap, SP_Symbols.minus);
         SetRightArgument (DAGCell, CStacks.Top (VCGHeap, ExpnStack), VCGHeap);
         CStacks.Pop (VCGHeap, ExpnStack);
         SetLeftArgument (DAGCell, Left, VCGHeap);
         CStacks.Push (VCGHeap, DAGCell, ExpnStack);

         CheckDivideByZero (Right);
      end ModelRem;

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

   begin -- Process_Simple_Expression
      Op_Node := STree.Child_Node (Current_Node => STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node)));
      if Op_Node /= STree.NullNode then
         -- detection of / and REM for special handling
         Op := STree.Syntax_Node_Type (Node => Op_Node);
         if Op = SP_Symbols.divide then
            ModelDivide;
         elsif Op = SP_Symbols.RWrem then
            ModelRem;

         elsif Op = SP_Symbols.ampersand then
            Model_Catenation (ExpnStack, VCGHeap);
         else
            PushOperator (Binary, Op, VCGHeap, ExpnStack);
            if Op = SP_Symbols.RWmod then
               CheckDivideByZero (RightPtr (VCGHeap, CStacks.Top (VCGHeap, ExpnStack)));
            end if;
         end if;
         ModularizeIfNeeded (STree.NodeSymbol (Op_Node), VCGHeap, ExpnStack);

         if DoRtc then
            if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.simple_expression then
               Origin_Type :=
                 STree.Syntax_Node_Type
                 (Node => STree.Parent_Node
                    (Current_Node => -- relation
                       STree.Parent_Node
                       (Current_Node => -- expression
                          STree.Parent_Node (Current_Node => Node))));
               -- check for relational operator
               Rel_Op_Node :=
                 STree.Next_Sibling
                 (Current_Node => STree.Child_Node (Current_Node => STree.Parent_Node (Current_Node => Node)));
            else -- SP_Symbols.term
               Origin_Type :=
                 STree.Syntax_Node_Type
                 (Node => STree.Parent_Node
                    (Current_Node => -- simple_expression_opt
                       STree.Parent_Node
                       (Current_Node => -- simple_expression
                          STree.Parent_Node
                          (Current_Node => -- relation
                             STree.Parent_Node
                             (Current_Node => -- expression
                                STree.Parent_Node (Current_Node => Node))))));
               -- check for relational operator
               Rel_Op_Node :=
                 STree.Next_Sibling
                 (Current_Node => STree.Child_Node
                    (Current_Node => STree.Parent_Node
                       (Current_Node => STree.Parent_Node (Current_Node => STree.Parent_Node (Current_Node => Node)))));
            end if;
            if Origin_Type /= SP_Symbols.assignment_statement or else Rel_Op_Node /= STree.NullNode then
               -- suppress overflow check for outermost expression on rhs
               -- of assignment
               CheckOverflowRunTimeError
                 (STree.NodeSymbol (Op_Node),
                  CStacks.Top (VCGHeap, ExpnStack),
                  Scope,
                  VCGHeap,
                  ShortCircuitStack,
                  ContainsReals,
                  CheckStack);

            end if;
         end if;
      end if;
   end Process_Simple_Expression;

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

   procedure Process_Simple_Expression_Opt (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out ExpnStack;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         ShortCircuitStack,
   --#         Statistics.TableUsage from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ContainsReals         from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Node,
   --#                                    STree.Table &
   --#         ExpnStack             from *,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table;
   is
      Origin_Type : SP_Symbols.SP_Symbol;
      Rel_Op_Node : STree.SyntaxNode;
      Op_Node     : STree.SyntaxNode;
   begin
      Op_Node := STree.Child_Node (Current_Node => Node);
      if STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.unary_adding_operator then
         PushOperator (Unary, STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => Op_Node)), VCGHeap, ExpnStack);
         if DoRtc then
            Origin_Type :=
              STree.Syntax_Node_Type
              (Node => STree.Parent_Node
                 (Current_Node => -- simple_expression
                    STree.Parent_Node
                    (Current_Node => -- relation
                       STree.Parent_Node
                       (Current_Node => -- expression
                          STree.Parent_Node (Current_Node => Node)))));

            -- check for relational operator
            Rel_Op_Node :=
              STree.Next_Sibling
              (Current_Node => STree.Child_Node
                 (Current_Node => STree.Parent_Node (Current_Node => STree.Parent_Node (Current_Node => Node))));
            if Origin_Type /= SP_Symbols.assignment_statement or else Rel_Op_Node /= STree.NullNode then
               -- suppress overflow check for outermost expression on rhs
               -- of assignment
               CheckOverflowRunTimeError
                 (STree.NodeSymbol (Op_Node),
                  CStacks.Top (VCGHeap, ExpnStack),
                  Scope,
                  VCGHeap,
                  ShortCircuitStack,
                  ContainsReals,
                  CheckStack);
            end if;
         end if;
      end if;
   end Process_Simple_Expression_Opt;

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

   procedure ProcessFactor (Node : in STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     Scope;
   --#        in     STree.Table;
   --#        in out CheckStack;
   --#        in out ContainsReals;
   --#        in out ExpnStack;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         ShortCircuitStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    ExpnStack,
   --#                                    Node,
   --#                                    Scope,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap &
   --#         ContainsReals         from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Node,
   --#                                    STree.Table &
   --#         ExpnStack             from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Node,
   --#                                    ShortCircuitStack,
   --#                                    STree.Table,
   --#                                    VCGHeap;
   is
      Origin_Type                      : SP_Symbols.SP_Symbol;
      Rel_Op_Node, OpNextNode, Op_Node : STree.SyntaxNode;
      BoolOpCell                       : Cells.Cell;
      ResultType                       : Dictionary.Symbol;

      procedure CreateGeZeroConstraint (Expr       : in     Cells.Cell;
                                        Check_Cell :    out Cells.Cell)
      --# global in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives Check_Cell            from VCGHeap &
      --#         Statistics.TableUsage from *,
      --#                                    VCGHeap &
      --#         VCGHeap               from *,
      --#                                    Expr;
      is
         ZeroCell, GeCell : Cells.Cell;
      begin
         CreateManifestConstCell (ZeroCell, VCGHeap, LexTokenManager.Zero_Value);

         CreateOpCell (GeCell, VCGHeap, SP_Symbols.greater_or_equal);
         SetRightArgument (GeCell, ZeroCell, VCGHeap);
         SetLeftArgument (GeCell, Expr, VCGHeap);

         Check_Cell := GeCell;
      end CreateGeZeroConstraint;

      procedure CreateEqZeroConstraint (Expr       : in     Cells.Cell;
                                        Check_Cell :    out Cells.Cell)
      --# global in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives Check_Cell            from VCGHeap &
      --#         Statistics.TableUsage from *,
      --#                                    VCGHeap &
      --#         VCGHeap               from *,
      --#                                    Expr;
      is
         ZeroCell, GeCell : Cells.Cell;
      begin -- CreateEqZeroConstraint
         CreateManifestConstCell (ZeroCell, VCGHeap, LexTokenManager.Zero_Value);

         CreateOpCell (GeCell, VCGHeap, SP_Symbols.equals);
         SetRightArgument (GeCell, ZeroCell, VCGHeap);
         SetLeftArgument (GeCell, Expr, VCGHeap);

         Check_Cell := GeCell;
      end CreateEqZeroConstraint;

      procedure CheckExponentConstraint (LhsTypeSym : in Dictionary.Symbol;
                                         LeftArg    : in Cells.Cell;
                                         RightArg   : in Cells.Cell)
      --# global in     Dictionary.Dict;
      --#        in     DoRtc;
      --#        in out CheckStack;
      --#        in out ShortCircuitStack;
      --#        in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives CheckStack,
      --#         ShortCircuitStack,
      --#         Statistics.TableUsage from *,
      --#                                    Dictionary.Dict,
      --#                                    DoRtc,
      --#                                    LeftArg,
      --#                                    LhsTypeSym,
      --#                                    RightArg,
      --#                                    ShortCircuitStack,
      --#                                    VCGHeap &
      --#         VCGHeap               from *,
      --#                                    CheckStack,
      --#                                    Dictionary.Dict,
      --#                                    DoRtc,
      --#                                    LeftArg,
      --#                                    LhsTypeSym,
      --#                                    RightArg,
      --#                                    ShortCircuitStack;
      is
         Check_Cell, EQcell, GEcell, CpLeftArg, CpRightArg : Cells.Cell;
      begin
         if DoRtc then
            if IsIntegerType (LhsTypeSym) or IsModularType (LhsTypeSym) then
               -- LRM95 4.5.6(8) says that RHS for signed integer or modular
               -- types must be subtype Natural - i.e. >= 0, so...
               Structures.CopyStructure (VCGHeap, RightArg, CpRightArg);
               CreateGeZeroConstraint (CpRightArg, Check_Cell);
               PlantCheckStatement (Check_Cell, VCGHeap, ShortCircuitStack, CheckStack);

            elsif IsRealType (LhsTypeSym) then
               -- detect 0.0 to negative power case
               -- N.B. This is not guarded by the RealRTC switch because it
               -- effectively a division by zero and we already regard that as
               -- a special case in the RTC, even for reals
               Structures.CopyStructure (VCGHeap, RightArg, CpRightArg);
               CreateGeZeroConstraint (CpRightArg, GEcell);

               Structures.CopyStructure (VCGHeap, LeftArg, CpLeftArg);
               CreateEqZeroConstraint (CpLeftArg, EQcell);

               CreateOpCell (Check_Cell, VCGHeap, SP_Symbols.implies);
               SetLeftArgument (Check_Cell, EQcell, VCGHeap);
               SetRightArgument (Check_Cell, GEcell, VCGHeap);
               PlantCheckStatement (Check_Cell, VCGHeap, ShortCircuitStack, CheckStack);
            end if;
         end if;
      end CheckExponentConstraint;

      -- Note, there is a similar version of this
      -- subprogram in BuildAnnotationExprDAG
      procedure ModelModularNotOperation
      --# global in     ResultType;
      --#        in out ExpnStack;
      --#        in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives ExpnStack,
      --#         Statistics.TableUsage,
      --#         VCGHeap               from *,
      --#                                    ExpnStack,
      --#                                    ResultType,
      --#                                    VCGHeap;
      is
         MinusOpCell, TickCell, PrefixCell, ModulusCell : Cells.Cell;
      begin
         ----------------------------------------------------
         -- LRM 4.5.6 (5) defines "not X" for a modular    --
         -- type T to be equivalent to T'Last - X.         --
         ----------------------------------------------------

         -- create ' operator
         CreateOpCell (TickCell, VCGHeap, SP_Symbols.apostrophe);

         -- create Last attribute name
         CreateAttribValueCell (ModulusCell, VCGHeap, LexTokenManager.Last_Token);

         -- Create prefix given by ResultType
         CreateFixedVarCell (PrefixCell, VCGHeap, ResultType);

         -- Assemble T'Last
         SetLeftArgument (TickCell, PrefixCell, VCGHeap);
         SetRightArgument (TickCell, ModulusCell, VCGHeap);

         -- create binary "-" operator
         CreateOpCell (MinusOpCell, VCGHeap, SP_Symbols.minus);

         -- Construct T'Last - X, where X is on the top-of-stack
         SetRightArgument (MinusOpCell, CStacks.Top (VCGHeap, ExpnStack), VCGHeap);
         SetLeftArgument (MinusOpCell, TickCell, VCGHeap);
         CStacks.Pop (VCGHeap, ExpnStack);
         CStacks.Push (VCGHeap, MinusOpCell, ExpnStack);
      end ModelModularNotOperation;

   begin  -- ProcessFactor
      Op_Node := STree.Child_Node (Current_Node => Node);
      if STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.RWnot then
         -- check to see if result type is an array and
         -- build special model if it is
         ResultType := STree.NodeSymbol (Op_Node);

         if Dictionary.IsTypeMark (ResultType) then

            if Dictionary.TypeIsArray (ResultType) then
               -- must be a Boolean array "not" operation
               CreateBoolOpCell (BoolOpCell, VCGHeap, ResultType, SP_Symbols.RWnot);
               SetRightArgument (BoolOpCell, CStacks.Top (VCGHeap, ExpnStack), VCGHeap);
               CStacks.Pop (VCGHeap, ExpnStack);
               CStacks.Push (VCGHeap, BoolOpCell, ExpnStack);
            elsif Dictionary.TypeIsModular (ResultType) then
               -- must be a Modular "not" operation.
               ModelModularNotOperation;
            else -- proceed as before for scalar bool ops
               PushOperator (Unary, SP_Symbols.RWnot, VCGHeap, ExpnStack);
            end if;

         else -- proceed as before for scalar bool ops
            PushOperator (Unary, SP_Symbols.RWnot, VCGHeap, ExpnStack);
         end if;

         -- handle abs
      elsif STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.RWabs then
         PushFunction (Cell_Storage.Abs_Function, VCGHeap, ExpnStack);
         if DoRtc then
            Origin_Type :=
              STree.Syntax_Node_Type
              (Node => STree.Parent_Node
                 (Current_Node => -- term
                    STree.Parent_Node
                    (Current_Node => -- simple_expression_opt
                       STree.Parent_Node
                       (Current_Node => -- simple_expression
                          STree.Parent_Node
                          (Current_Node => -- relation
                             STree.Parent_Node
                             (Current_Node => -- expression
                                STree.Parent_Node (Current_Node => Node)))))));
            -- check for relational operator
            Rel_Op_Node :=
              STree.Next_Sibling
              (STree.Child_Node
                 (Current_Node => STree.Parent_Node
                    (Current_Node => STree.Parent_Node
                       (Current_Node => STree.Parent_Node (Current_Node => STree.Parent_Node (Current_Node => Node))))));
            if Origin_Type /= SP_Symbols.assignment_statement or else Rel_Op_Node /= STree.NullNode then
               -- suppress overflow check for outermost expression on rhs
               -- of assignment
               CheckOverflowRunTimeError
                 (STree.NodeSymbol (Op_Node),
                  CStacks.Top (VCGHeap, ExpnStack),
                  Scope,
                  VCGHeap,
                  ShortCircuitStack,
                  ContainsReals,
                  CheckStack);
            end if;
         end if;
      else
         OpNextNode := STree.Next_Sibling (Current_Node => Op_Node);
         if OpNextNode /= STree.NullNode then
            PushOperator (Binary, SP_Symbols.double_star, VCGHeap, ExpnStack);
            CheckExponentConstraint
              (STree.NodeSymbol (Op_Node),
               LeftPtr (VCGHeap, CStacks.Top (VCGHeap, ExpnStack)),
               RightPtr (VCGHeap, CStacks.Top (VCGHeap, ExpnStack)));

            ModularizeIfNeeded (STree.NodeSymbol (Op_Node), VCGHeap, ExpnStack);
            if DoRtc then
               Origin_Type :=
                 STree.Syntax_Node_Type
                 (Node => STree.Parent_Node
                    (Current_Node => -- term
                       STree.Parent_Node
                       (Current_Node => -- simple_expression_opt
                          STree.Parent_Node
                          (Current_Node => -- simple_expression
                             STree.Parent_Node
                             (Current_Node => -- relation
                                STree.Parent_Node
                                (Current_Node => -- expression
                                   STree.Parent_Node (Current_Node => Node)))))));
               if Origin_Type /= SP_Symbols.assignment_statement then
                  -- suppress overflow check for outermost expression on rhs
                  -- of assignment
                  CheckOverflowRunTimeError
                    (STree.NodeSymbol (Op_Node),
                     CStacks.Top (VCGHeap, ExpnStack),
                     Scope,
                     VCGHeap,
                     ShortCircuitStack,
                     ContainsReals,
                     CheckStack);
               end if;
            end if;
         end if;
      end if;
   end ProcessFactor;

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

   function ValidStartNode return Boolean
   --# global in StartNode;
   --#        in STree.Table;
   is
      NodeType : SP_Symbols.SP_Symbol;
   begin
      NodeType := STree.Syntax_Node_Type (Node => StartNode);
      return NodeType = SP_Symbols.expression
        or else NodeType = SP_Symbols.name
        or else NodeType = SP_Symbols.selected_component
        or else NodeType = SP_Symbols.simple_expression
        or else NodeType = SP_Symbols.condition
        or else NodeType = SP_Symbols.simple_name
        or else NodeType = SP_Symbols.attribute;
   end ValidStartNode;

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

begin -- BuildExpnDAG

   SeqAlgebra.CreateSeq (FlowHeap, ReferencedVars);

   SystemErrors.RT_Assert
     (C       => ValidStartNode,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Invalid start node passed to BuildExpnDAG");
   CStacks.CreateStack (ExpnStack);

   Node := StartNode;

   -- The down-loop traverses the syntax tree from the given root to its leaves.
   loop --------------------------------down loop
      LastNode := Node;
      NodeType := STree.Syntax_Node_Type (Node => Node);
      case NodeType is
         -- prune at selector nodes so that only left most idents found
         when SP_Symbols.selector =>
            Node := STree.NullNode;

         when SP_Symbols.numeric_literal =>
            CreateManifestConstCell
              (DAGCell,
               VCGHeap,
               STree.Node_Lex_String (Node => STree.Child_Node (Current_Node => STree.Child_Node (Current_Node => Node))));
            CStacks.Push (VCGHeap, DAGCell, ExpnStack);
            Node := STree.NullNode;

         when SP_Symbols.character_literal | SP_Symbols.string_literal =>
            CreateManifestConstCell (DAGCell, VCGHeap, STree.Node_Lex_String (Node => Node));
            CStacks.Push (VCGHeap, DAGCell, ExpnStack);
            Node := STree.NullNode;

         when SP_Symbols.attribute_ident =>
            DownProcessAttributeIdent (Node);
            Node := STree.NullNode;

         when SP_Symbols.identifier =>
            ProcessIdentifier (Node, ExpnScope);
            Node := STree.NullNode;

         when SP_Symbols.simple_name =>
            if STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => LastNode)) =
              SP_Symbols.named_argument_association then
               -- do not want look at parameter or field identifier
               Node := STree.NullNode;
            else
               Node := STree.Child_Node (Current_Node => Node);
            end if;

         when SP_Symbols.aggregate =>
            DownProcessAggregate (SP_Symbols.qualified_expression, VCGHeap, Node, ExpnStack);

         when SP_Symbols.aggregate_choice_rep =>
            DownProcessAggregateChoiceRep (LastNode, ExpnScope, VCGHeap, ExpnStack,
                                           -- to get
                                           Node);

         when SP_Symbols.record_component_selector_name =>
            DownProcessRecordComponentSelectorName (LastNode, ExpnScope, VCGHeap, ExpnStack,
                                                    -- to get
                                                    Node);

            -- detect any short-circuit forms
         when SP_Symbols.relation =>
            DownProcessRelation (Node);
            Node := STree.Child_Node (Current_Node => Node);

         when others =>
            Node := STree.Child_Node (Current_Node => Node);

      end case;
      if Node = STree.NullNode and LastNode /= StartNode then

         -- The up-loop traverses the syntax tree from the leaves toward a
         -- given root.
         loop ------------------------up loop---------------------
            Node := STree.Next_Sibling (Current_Node => LastNode);
            exit when Node /= STree.NullNode;
            Node := STree.Parent_Node (Current_Node => LastNode);
            exit when Node = STree.NullNode;
            NodeType := STree.Syntax_Node_Type (Node => Node);
            case NodeType is
               when SP_Symbols.selected_component =>
                  ProcessSelectedComponent (Node, ExpnScope);

               when SP_Symbols.qualified_expression =>
                  ModelQualifiedExpression (Node);

               when SP_Symbols.aggregate =>
                  UpProcessAggregate;

               when SP_Symbols.extension_aggregate =>
                  UpProcessExtensionAggregate (VCGHeap, ExpnStack);

               when SP_Symbols.ancestor_part =>
                  ProcessAncestorPart (Node, VCGHeap, ExpnStack);

               when SP_Symbols.component_association =>
                  UpProcessComponentAssociation (Node);

               when SP_Symbols.named_association_rep =>
                  UpProcessNamedAssociationRep (Node);

               when SP_Symbols.named_record_component_association =>
                  UpProcessNamedRecordComponentAssociation (Node);

               when SP_Symbols.aggregate_choice_rep =>
                  UpProcessAggregateChoiceRep (Node, VCGHeap, ExpnStack);

               when SP_Symbols.aggregate_or_expression =>
                  UpProcessAggregateOrExpression (Node);

               when SP_Symbols.positional_record_component_association =>
                  UpProcessPositionalRecordComponentAssociation (Node);

               when SP_Symbols.aggregate_choice =>
                  UpProcessAggregateChoice (Node);

               when SP_Symbols.expression      |
                 SP_Symbols.expression_rep1 |
                 SP_Symbols.expression_rep2 |
                 SP_Symbols.expression_rep3 |
                 SP_Symbols.expression_rep4 |
                 SP_Symbols.expression_rep5 =>
                  ProcessExpression (Node);

               when SP_Symbols.relation =>
                  ProcessRelation (Node);

               when SP_Symbols.simple_expression | SP_Symbols.term =>
                  Process_Simple_Expression (Node => Node);

               when SP_Symbols.simple_expression_opt =>
                  Process_Simple_Expression_Opt (Node => Node);

               when SP_Symbols.factor =>
                  ProcessFactor (Node);

               when SP_Symbols.positional_argument_association =>
                  Process_Positional_Argument_Association (Node => Node);

               when SP_Symbols.named_argument_association =>
                  Process_Named_Argument_Association (Node => Node);

               when SP_Symbols.name_argument_list =>
                  ProcessNameArgumentList;

               when SP_Symbols.attribute_designator =>
                  UpAttributeDesignator (Node);

               when others =>
                  null;
            end case;
            exit when Node = StartNode;
            LastNode := Node;
         end loop; -----------------------------up loop--------------
      end if;
      exit when Node = STree.NullNode or Node = StartNode;
   end loop;  --------------------------down loop------------------

   --# accept F, 10, ExpnStack, "Ineffective assignment here OK";
   CStacks.PopOff (VCGHeap, ExpnStack, DAGRoot);
   --# end accept;

   -- at this point assume variables in set ReferencedVars are in their type
   CheckPlantRvalueAssumptions;

   if CommandLineData.Content.Debug.DAG then
      Debug_Print_DAG (Start_Node => StartNode,
                       Scope      => Scope,
                       DAG_Root   => DAGRoot,
                       VCG_Heap   => VCGHeap);
   end if;
end BuildExpnDAG;
