-------------------------------------------------------------------------------
-- (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 E_Strings;
with LexTokenManager;
with SeqAlgebra;
with SP_Symbols;
with Structures;
with ExaminerConstants;
with Cells.Utility;
with Symbol_Set;

-- This procedure traverses a syntax tree of an annotation expression
separate (DAG)
procedure Build_Annotation_Expression
  (Exp_Node                         : in     STree.SyntaxNode;
   Instantiated_Subprogram          : in     Dictionary.Symbol;
   Scope                            : in     Dictionary.Scopes;
   Calling_Scope                    : in     Dictionary.Scopes;
   Force_Abstract                   : in     Boolean;
   Loop_Stack                       : in     LoopContext.T;
   Generate_Function_Instantiations : in     Boolean;
   VC_Failure                       : in out Boolean;
   VC_Contains_Reals                : in out Boolean;
   VCG_Heap                         : in out Cells.Heap_Record;
   DAG_Root                         :    out Cells.Cell;
   Function_Defs                    : in out CStacks.Stack)
is

   type Loop_Direction is (Down_Loop, Up_Loop);

   Direction             : Loop_Direction; -- Records direction of tree traversal
   Next_Node, Last_Node  : STree.SyntaxNode;
   Node_Type             : SP_Symbols.SP_Symbol;
   DAG_Cell              : Cells.Cell;
   E_Stack               : CStacks.Stack;
   L_Scope               : Dictionary.Scopes;
   Implicit_Var          : Dictionary.Symbol; -- Context for parsing return annos
   Calling_Function      : Cells.Cell;        -- Used in processing nested calls
   Function_Definition   : Cells.Cell;
   Precondition          : Cells.Cell;
   Start_Node            : STree.SyntaxNode;
   True_Cell             : Cells.Cell;
   Current_Instantiation : Dictionary.Symbol;
   Current_Unit          : Dictionary.Symbol; -- Context used to obtain current scope
   Tmp_Cell_1            : Cells.Cell;
   Tmp_Cell_2            : Cells.Cell;
   Tmp_Parent            : Cells.Cell;
   -- To avoid the posibility of infinite looping due to recursion a record
   -- has to be kept of the called functions within an annotation expression.
   Called_Functions      : Symbol_Set.T;
   Done                  : Boolean;  -- Indicates parsing of the expression is complete

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

   function Function_Has_Unconstrained_Parameter (The_FDL_Function : Dictionary.Symbol) return Boolean
   --# global Dictionary.Dict;
   is
      Number_Of_Parameters : Natural;
      The_Argument         : Dictionary.Symbol;
      The_Type             : Dictionary.Symbol;
      Result               : Boolean;
   begin
      Number_Of_Parameters := Dictionary.GetNumberOfSubprogramParameters (The_FDL_Function);
      Result               := False;
      for I in Natural range 1 .. Number_Of_Parameters loop
         The_Argument := Dictionary.GetSubprogramParameter (The_FDL_Function, I);
         The_Type     := Dictionary.GetType (The_Argument);
         if Dictionary.IsUnconstrainedArrayType (The_Type) then
            Result := True;
            exit;
         end if;
      end loop;
      return Result;
   end Function_Has_Unconstrained_Parameter;

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

   -- Returns True if Instantiated_Subprogram refers to an instantiation of a
   -- generic subprogram and Exp_Node refers to the formal pre-condition,
   -- post-condition, or return predicate attached to that generic declaration.
   function Is_Generic_Constraint (Exp_Node                : STree.SyntaxNode;
                                   Instantiated_Subprogram : Dictionary.Symbol) return Boolean
   --# global in Dictionary.Dict;
   --#        in STree.Table;
   is
      The_Precondition  : STree.SyntaxNode;
      The_Postcondition : STree.SyntaxNode;
      Result            : Boolean;
   begin
      if not Dictionary.Is_Null_Symbol (Instantiated_Subprogram) then
         The_Precondition  :=
           STree.RefToNode
           (Dictionary.GetPrecondition (Dictionary.IsAbstract, Dictionary.GetGenericOfInstantiation (Instantiated_Subprogram)));
         The_Postcondition :=
           STree.RefToNode
           (Dictionary.GetPostcondition
              (Dictionary.IsAbstract,
               Dictionary.GetGenericOfInstantiation (Instantiated_Subprogram)));
         Result            := Exp_Node = The_Precondition
           or else Exp_Node = The_Postcondition
           or else (The_Postcondition /= STree.NullNode
                      and then Exp_Node = STree.Next_Sibling (Current_Node => The_Postcondition));
      else
         Result := False;
      end if;
      return Result;
   end Is_Generic_Constraint;

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

   ---------------------------------------------------------------------
   -- Returns the correct Scope needed to generate the DAG for
   -- a subprogram.  For generic units, the Scope needs to be
   -- adjusted to that of the generic declaration.
   --
   -- Exp_Node refers to either the pre-condition, post-condition or return
   -- constraint for which a DAG is currently being built.
   --
   -- Instantiated_Subprogram refers to the instantiation of a generic
   -- subprogram, or NullSymbol in the case of a non-generic subprogram.
   --
   -- Scope is that passed into Build_Annotation_Expression from the calling
   -- environment.
   ---------------------------------------------------------------------
   function Get_Generic_Scope
     (Exp_Node                : STree.SyntaxNode;
      Instantiated_Subprogram : Dictionary.Symbol;
      Scope                   : Dictionary.Scopes)
     return                    Dictionary.Scopes
   --# global in Dictionary.Dict;
   is
      The_Postcondition : STree.SyntaxNode;
      The_Precondition  : STree.SyntaxNode;
      Return_Scope      : Dictionary.Scopes;
   begin
      -- Check that we hav e generic constraint
      if Instantiated_Subprogram /= Dictionary.NullSymbol then
         The_Precondition  :=
           STree.RefToNode
           (Dictionary.GetPrecondition (Dictionary.IsAbstract, Dictionary.GetGenericOfInstantiation (Instantiated_Subprogram)));
         The_Postcondition :=
           STree.RefToNode
           (Dictionary.GetPostcondition
              (Dictionary.IsAbstract,
               Dictionary.GetGenericOfInstantiation (Instantiated_Subprogram)));
         if Exp_Node = The_Precondition or else Exp_Node = The_Postcondition then
            -- Exp_Node refere to either the pre or the explicit return
            -- annotation of the generic declaration
            -- Set the scope to that of the generic declaration
            Return_Scope :=
              Dictionary.Set_Visibility
              (The_Visibility => Dictionary.Get_Visibility (Scope => Scope),
               The_Unit       => Dictionary.GetGenericOfInstantiation (Instantiated_Subprogram));
         else

            -- The constraint syntax node, Exp_Node does not refer to the
            -- pre of the generic nor an explicit return annotation of the generic
            -- An implicit return annotation uses the scope of the implicit var
            -- and the correct scope is used without modification and so is treated
            -- as not generic.
            Return_Scope := Scope;
         end if;
      else
         Return_Scope := Scope;
      end if;
      return Return_Scope;
   end Get_Generic_Scope;

   ---------------------------------------------------------------------
   -- Constraint appears to be just an input but is actually exported.
   -- (It is effectively a pointer to a data structure which is updated).
   procedure Instantiate_Parameters
     (Constraint              : in     Cells.Cell;
      Instantiated_Subprogram : in     Dictionary.Symbol;
      VCG_Heap                : in out Cells.Heap_Record)

   -- replace symbols in DAG which belong to a generic unit with the equivalent
   -- associated with the instantiated unit.  Substitutes generic formals/actuals
   -- and also parameters
   --# global in     Dictionary.Dict;
   --#        in out Statistics.TableUsage;
   --# derives Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Constraint,
   --#                                    Dictionary.Dict,
   --#                                    Instantiated_Subprogram,
   --#                                    VCG_Heap;
   is
      P                                : Cells.Cell;
      S                                : CStacks.Stack;
      Sym_To_Check, Generic_Subprogram : Dictionary.Symbol;
   begin
      Generic_Subprogram := Dictionary.GetGenericOfInstantiation (Instantiated_Subprogram);

      -- DAG traversal algorithm of D.E. Knuth, Fundamental
      -- Algorithms, p.317;
      CStacks.CreateStack (S);
      P := Constraint;
      loop
         loop
            exit when Cells.Is_Null_Cell (P);
            CStacks.Push (VCG_Heap, P, S);
            if Is_Leaf (Node     => P,
                        VCG_Heap => VCG_Heap) then
               P := Cells.Null_Cell;
            else
               P := LeftPtr (VCG_Heap, P);
            end if;
         end loop;
         exit when CStacks.IsEmpty (S);
         P := CStacks.Top (VCG_Heap, S);
         CStacks.Pop (VCG_Heap, S);
         if Is_Leaf (Node     => P,
                     VCG_Heap => VCG_Heap) then
            Sym_To_Check := Cells.Get_Symbol_Value (VCG_Heap, P);
            if Dictionary.IsFormalParameter (Generic_Subprogram, Sym_To_Check) then
               Cells.Set_Symbol_Value (VCG_Heap, P, Dictionary.ActualOfGenericParameter (Sym_To_Check, Instantiated_Subprogram));
            elsif Dictionary.IsGenericFormalParameter (Generic_Subprogram, Sym_To_Check) then
               Cells.Set_Symbol_Value
                 (VCG_Heap,
                  P,
                  Dictionary.ActualOfGenericFormalObject (Sym_To_Check, Instantiated_Subprogram));
            elsif Dictionary.IsType (Sym_To_Check) and then Dictionary.TypeIsGeneric (Sym_To_Check) then
               Cells.Set_Symbol_Value (VCG_Heap, P, Dictionary.ActualOfGenericFormalType (Sym_To_Check, Instantiated_Subprogram));
            elsif Dictionary.IsParameterConstraint (Sym_To_Check)
              and then Dictionary.TypeIsGeneric (Dictionary.GetType (Sym_To_Check)) then
               Cells.Set_Symbol_Value
                 (VCG_Heap,
                  P,
                  Dictionary.ActualOfParameterConstraint (Sym_To_Check, Instantiated_Subprogram));
            end if;
            P := Cells.Null_Cell;
         else
            P := RightPtr (VCG_Heap, P);
         end if;
      end loop;
   end Instantiate_Parameters;

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

   --  Given a function call in Function_Call; this procedure will
   --  return a typecheck expression for all arguments in
   --  Argument_Check and an assumption that the return of the
   --  function is in type.
   procedure Get_Function_Type_Constraints
     (Function_Call     : in     Cells.Cell;
      Calling_Scope     : in     Dictionary.Scopes;
      Argument_Check    :    out Cells.Cell;
      Return_Assumption :    out Cells.Cell;
      VCG_Heap          : in out Cells.Heap_Record)
   --# global in out Dictionary.Dict;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out VC_Contains_Reals;
   --#        in out VC_Failure;
   --# derives Argument_Check,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         Return_Assumption,
   --#         VCG_Heap              from Calling_Scope,
   --#                                    Dictionary.Dict,
   --#                                    Function_Call,
   --#                                    LexTokenManager.State,
   --#                                    VCG_Heap &
   --#         SPARK_IO.File_Sys,
   --#         Statistics.TableUsage,
   --#         VC_Contains_Reals,
   --#         VC_Failure            from *,
   --#                                    Calling_Scope,
   --#                                    Dictionary.Dict,
   --#                                    Function_Call,
   --#                                    LexTokenManager.State,
   --#                                    VCG_Heap;

   is
      The_FDL_Function : Dictionary.Symbol;

      The_Constraint : Cells.Cell;
      The_Type       : Dictionary.Symbol;
      The_Argument   : Dictionary.Symbol;

      Check_Parameter : Boolean;

      Number_Of_Parameters : Natural;
      Arg_List             : Cells.Cell;
      The_Arg              : Cells.Cell;

      Arg_Stack : CStacks.Stack;
   begin
      --  Work out some basic facts.
      The_FDL_Function     := Cells.Get_Symbol_Value (VCG_Heap, Function_Call);
      Number_Of_Parameters := Dictionary.GetNumberOfSubprogramParameters (The_FDL_Function);

      --  Work out the return assumption.
      The_Type := Dictionary.GetType (The_FDL_Function);
      Type_Constraint.Make
        (The_Expression        => Function_Call,
         The_Type              => The_Type,
         Scope                 => Calling_Scope,
         Consider_Always_Valid => False,
         VCG_Heap              => VCG_Heap,
         The_Constraint        => Return_Assumption,
         VC_Contains_Reals     => VC_Contains_Reals,
         VC_Failure            => VC_Failure);

      --  Work out the check required for each function parameter and
      --  push them onto Arg_Stack.
      CStacks.CreateStack (Arg_Stack);

      --  The arguments of the function are stashed in a somewhat
      --  annoying way. For a single argument we have:
      --
      --       fn_call
      --        /  \
      --       /    \
      --      /      \
      --   (...)   Argument
      --
      --  For 2+ arguments we have something like:
      --
      --       fn_call
      --        /  \
      --       /    \
      --      /      \
      --   (...)   op ','
      --            / \
      --           /   \
      --          /     \
      --        Arg1  op ','
      --               /  \
      --              /    \
      --             /      \
      --           Arg2    Arg3

      if Number_Of_Parameters = 1 then
         Arg_List := Function_Call;
      else
         Arg_List := Cells.Get_B_Ptr (VCG_Heap, Function_Call);
      end if;
      --  Arg_List now points to the top of the argument list where
      --  A_Ptr is the current argument and B_Ptr is the rest; except
      --  where:
      --     - We have a single argument; then B is the current argument
      --     - We are in the last argument; then B is the current argument

      for Param_N in Natural range 1 .. Number_Of_Parameters loop
         --  Work out the type of the current argument.
         The_Argument    := Dictionary.GetSubprogramParameter (The_FDL_Function, Param_N);
         The_Type        := Dictionary.GetType (The_Argument);
         Check_Parameter := True;

         --  If we have a parameter which is really an own in variable
         --  there is no need to typecheck it as externally it is
         --  always not in type and the implementation of a "reading"
         --  subprogram must deal with this.
         if Dictionary.IsOwnVariable (The_Argument)
           and then Dictionary.GetOwnVariableMode (The_Argument) = Dictionary.InMode then
            Check_Parameter := False;
         end if;

         if Check_Parameter then

            --  Pick out the current argument.
            if Param_N < Number_Of_Parameters then
               The_Arg := Cells.Get_A_Ptr (VCG_Heap, Arg_List);
            else
               The_Arg := Cells.Get_B_Ptr (VCG_Heap, Arg_List);
            end if;

            Type_Constraint.Make
              (The_Expression        => The_Arg,
               The_Type              => The_Type,
               Scope                 => Calling_Scope,
               Consider_Always_Valid => False,
               VCG_Heap              => VCG_Heap,
               The_Constraint        => The_Constraint,
               VC_Contains_Reals     => VC_Contains_Reals,
               VC_Failure            => VC_Failure);

            --  Unless the contraint is trivially true, push it onto
            --  Arg_Stack.
            if not Cells.Utility.Is_True (VCG_Heap, The_Constraint) then
               CStacks.Push (VCG_Heap, The_Constraint, Arg_Stack);
            else
               Cells.Dispose_Of_Cell (VCG_Heap, The_Constraint);
            end if;

         end if;

         --  Point Arg_List to the tail of the list. If we are in the
         --  second-to-last or last argument we go no further.
         if Param_N < Number_Of_Parameters - 1 then
            Arg_List := Cells.Get_B_Ptr (VCG_Heap, Arg_List);
         end if;
      end loop;

      --  Finally we join together the stack of argument constraints
      --  with /\ and return that.

      --# accept F, 10, Arg_Stack, "The stack will be empty and no longer used after this.";
      Join_And (Stack    => Arg_Stack,
                Conjunct => Argument_Check,
                VCG_Heap => VCG_Heap);
      --# end accept;

   end Get_Function_Type_Constraints;

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

   -- Create_Saved_Context_DAG creates a DAG that may be placed on the
   -- expression stack which contains the values of the given in mode
   -- parameters.  The DAG is returned in the Argument_List parameter
   -- The Argument_List has the form:
   --         Op ","
   --         / \
   --        /   \
   --       /     \
   --    Scope    Op ","
   --             /\
   --            /  \
   --     Direction  \
   --              Op ","
   --              /\
   --             /  \
   --  Instantiated_  \
   --  Subprogram      \
   --               Op ","
   --                /\
   --               /  \
   --       In_Called_  \
   --       Function     \
   --                Op ","
   --                 /\
   --                /  \
   --     Implicit_Var   \
   --                 Op ","
   --                 /\
   --                /  \
   --       Start_Node   \
   --                 Op ","
   --                 /\
   --                /  \
   --        Last_Node  Next_Node
   procedure Create_Saved_Context_DAG
     (Scope                   : in     Dictionary.Scopes;
      Direction               : in     Loop_Direction;
      Instantiated_Subprogram : in     Dictionary.Symbol;
      Current_Unit            : in     Dictionary.Symbol;
      Implicit_Var            : in     Dictionary.Symbol;
      Start_Node              : in     STree.SyntaxNode;
      Last_Node               : in     STree.SyntaxNode;
      Next_Node               : in     STree.SyntaxNode;
      VCG_Heap                : in out Cells.Heap_Record;
      Argument_List           :    out Cells.Cell)
   --# global in out Statistics.TableUsage;
   --# derives Argument_List         from Current_Unit,
   --#                                    Direction,
   --#                                    Implicit_Var,
   --#                                    Instantiated_Subprogram,
   --#                                    Last_Node,
   --#                                    Next_Node,
   --#                                    Start_Node,
   --#                                    VCG_Heap &
   --#         Statistics.TableUsage from *,
   --#                                    Current_Unit,
   --#                                    Direction,
   --#                                    Implicit_Var,
   --#                                    Instantiated_Subprogram,
   --#                                    Last_Node,
   --#                                    Next_Node,
   --#                                    Start_Node,
   --#                                    VCG_Heap &
   --#         VCG_Heap              from *,
   --#                                    Current_Unit,
   --#                                    Direction,
   --#                                    Implicit_Var,
   --#                                    Instantiated_Subprogram,
   --#                                    Last_Node,
   --#                                    Next_Node,
   --#                                    Scope,
   --#                                    Start_Node;
   --#
   is
      Left_Ptr, Right_Ptr, Parent_Ptr : Cells.Cell;
   begin
      --  The Argument_List is constructed in reverse.

      --  Save the Last_Node and Next_Node which are a syntax nodes.

      --                 Op ","
      --                 /\
      --                /  \
      --        Last_Node  Next_Node
      CreateOpCell (Parent_Ptr, VCG_Heap, SP_Symbols.comma);

      CreateCellKind (CellName   => Left_Ptr,
                      VCGHeap    => VCG_Heap,
                      KindOfCell => Cell_Storage.Proof_Function_Syntax_Node);
      Cells.Set_Natural_Value (Heap     => VCG_Heap,
                               CellName => Left_Ptr,
                               Value    => Natural (STree.NodeToRef (Last_Node)));

      CreateCellKind (CellName   => Right_Ptr,
                      VCGHeap    => VCG_Heap,
                      KindOfCell => Cell_Storage.Proof_Function_Syntax_Node);
      Cells.Set_Natural_Value (Heap     => VCG_Heap,
                               CellName => Right_Ptr,
                               Value    => Natural (STree.NodeToRef (Next_Node)));

      SetLeftArgument (OpCell   => Parent_Ptr,
                       Argument => Left_Ptr,
                       VCGHeap  => VCG_Heap);
      SetRightArgument (OpCell   => Parent_Ptr,
                        Argument => Right_Ptr,
                        VCGHeap  => VCG_Heap);

      --               Op ","
      --                /\
      --               /  \
      --       Start_Node  \

      --  Create new comma cell and swap things around.
      Right_Ptr := Parent_Ptr;
      CreateOpCell (Parent_Ptr, VCG_Heap, SP_Symbols.comma);
      SetRightArgument (OpCell   => Parent_Ptr,
                        Argument => Right_Ptr,
                        VCGHeap  => VCG_Heap);

      --  Save the Start_Node which is a syntax node.
      CreateCellKind (CellName   => Left_Ptr,
                      VCGHeap    => VCG_Heap,
                      KindOfCell => Cell_Storage.Proof_Function_Syntax_Node);
      Cells.Set_Natural_Value (Heap     => VCG_Heap,
                               CellName => Left_Ptr,
                               Value    => Natural (STree.NodeToRef (Start_Node)));

      SetLeftArgument (OpCell   => Parent_Ptr,
                       Argument => Left_Ptr,
                       VCGHeap  => VCG_Heap);

      --              Op ","
      --              /\
      --             /  \
      --  Implicit_Var   \
      --  Create new comma cell and swap things around.
      Right_Ptr := Parent_Ptr;
      CreateOpCell (Parent_Ptr, VCG_Heap, SP_Symbols.comma);
      SetRightArgument (OpCell   => Parent_Ptr,
                        Argument => Right_Ptr,
                        VCGHeap  => VCG_Heap);

      --  Save the Current_Unit which is a dictionary
      --  symbol.
      CreateReferenceCell (CellName => Left_Ptr,
                           VCGHeap  => VCG_Heap,
                           Sym      => Implicit_Var);

      SetLeftArgument (OpCell   => Parent_Ptr,
                       Argument => Left_Ptr,
                       VCGHeap  => VCG_Heap);

      --              Op ","
      --              /\
      --             /  \
      --    In_Called_   \
      --    Function      \
      --  Create new comma cell and swap things around.
      Right_Ptr := Parent_Ptr;
      CreateOpCell (Parent_Ptr, VCG_Heap, SP_Symbols.comma);
      SetRightArgument (OpCell   => Parent_Ptr,
                        Argument => Right_Ptr,
                        VCGHeap  => VCG_Heap);

      --  Save the Current_Unit which is a dictionary
      --  symbol.
      CreateReferenceCell (CellName => Left_Ptr,
                           VCGHeap  => VCG_Heap,
                           Sym      => Current_Unit);

      SetLeftArgument (OpCell   => Parent_Ptr,
                       Argument => Left_Ptr,
                       VCGHeap  => VCG_Heap);

      --              Op ","
      --              /\
      --             /  \
      --  Instantiated_  \
      --  Subprogram      \

      --  Create new comma cell and swap things around.
      Right_Ptr := Parent_Ptr;
      CreateOpCell (Parent_Ptr, VCG_Heap, SP_Symbols.comma);
      SetRightArgument (OpCell   => Parent_Ptr,
                        Argument => Right_Ptr,
                        VCGHeap  => VCG_Heap);

      --  Save the Instantiated_Subprogram which is a dictionary
      --  symbol.
      CreateReferenceCell (CellName => Left_Ptr,
                           VCGHeap  => VCG_Heap,
                           Sym      => Instantiated_Subprogram);

      SetLeftArgument (OpCell   => Parent_Ptr,
                       Argument => Left_Ptr,
                       VCGHeap  => VCG_Heap);

      --             Op ","
      --             /\
      --            /  \
      --     Direction  \

      --  Create new comma cell and swap things around.
      Right_Ptr := Parent_Ptr;
      CreateOpCell (Parent_Ptr, VCG_Heap, SP_Symbols.comma);
      SetRightArgument (OpCell   => Parent_Ptr,
                        Argument => Right_Ptr,
                        VCGHeap  => VCG_Heap);

      --  Save Direction which is a Loop_Direction.
      Create_Internal_Natural_Cell (Cell_Name => Left_Ptr,
                                    VCG_Heap  => VCG_Heap,
                                    N         => Loop_Direction'Pos (Direction));
      SetLeftArgument (OpCell   => Parent_Ptr,
                       Argument => Left_Ptr,
                       VCGHeap  => VCG_Heap);

      --         Op ","
      --         / \
      --        /   \
      --       /     \
      --    Scope

      --  Create new comma cell and swap things around.
      Right_Ptr := Parent_Ptr;
      CreateOpCell (Parent_Ptr, VCG_Heap, SP_Symbols.comma);
      SetRightArgument (OpCell   => Parent_Ptr,
                        Argument => Right_Ptr,
                        VCGHeap  => VCG_Heap);

      --  Save the given scope.
      Cells.Utility.Create_Scope_Cell (VCG_Heap  => VCG_Heap,
                                       The_Scope => Scope,
                                       The_Cell  => Left_Ptr);
      SetLeftArgument (OpCell   => Parent_Ptr,
                       Argument => Left_Ptr,
                       VCGHeap  => VCG_Heap);

      --  The current parent is the argument list.
      Argument_List := Parent_Ptr;
   end Create_Saved_Context_DAG;

   ---------------------------------------------------------------------
   --  This procedure restores a previously saved context by the above
   --  procedure, Create_Saved_Context_DAG;
   --
   --  This also disposes of all cells in Argument_List.
   procedure Load_Saved_Context_DAG
     (Scope                   :    out Dictionary.Scopes;
      Direction               :    out Loop_Direction;
      Instantiated_Subprogram :    out Dictionary.Symbol;
      Current_Unit            :    out Dictionary.Symbol;
      Implicit_Var            :    out Dictionary.Symbol;
      Start_Node              :    out STree.SyntaxNode;
      Last_Node               :    out STree.SyntaxNode;
      Next_Node               :    out STree.SyntaxNode;
      VCG_Heap                : in out Cells.Heap_Record;
      Argument_List           : in     Cells.Cell)
   --# derives Current_Unit,
   --#         Direction,
   --#         Implicit_Var,
   --#         Instantiated_Subprogram,
   --#         Last_Node,
   --#         Next_Node,
   --#         Scope,
   --#         Start_Node,
   --#         VCG_Heap                from Argument_List,
   --#                                      VCG_Heap;
   is
      Left_Ptr, Right_Ptr, Parent_Ptr : Cells.Cell;
      Tmp                             : Natural;
   begin
      Parent_Ptr := Argument_List;

      --         Op ","
      --         / \
      --        /   \
      --       /     \
      --    Scope
      Left_Ptr  := LeftPtr (VCG_Heap, Parent_Ptr);
      Right_Ptr := RightPtr (VCG_Heap, Parent_Ptr);
      Cells.Dispose_Of_Cell (VCG_Heap, Parent_Ptr);

      Scope := Cells.Utility.Scope_Cell_Get_Scope (VCG_Heap, Left_Ptr);

      Parent_Ptr := Right_Ptr;

      --          Op ","
      --          /\
      --         /   \
      --  Direction   \
      Left_Ptr  := LeftPtr (VCG_Heap, Parent_Ptr);
      Right_Ptr := RightPtr (VCG_Heap, Parent_Ptr);
      Cells.Dispose_Of_Cell (VCG_Heap, Parent_Ptr);

      Tmp       := Cells.Get_Natural_Value (VCG_Heap, Left_Ptr);
      Direction := Loop_Direction'Val (Tmp);
      Cells.Dispose_Of_Cell (VCG_Heap, Left_Ptr);

      Parent_Ptr := Right_Ptr;

      --             Op ","
      --             /\
      --            /  \
      -- Instantiated_  \
      -- Subprogram      \
      Left_Ptr  := LeftPtr (VCG_Heap, Parent_Ptr);
      Right_Ptr := RightPtr (VCG_Heap, Parent_Ptr);
      Cells.Dispose_Of_Cell (VCG_Heap, Parent_Ptr);

      Instantiated_Subprogram := Cells.Get_Symbol_Value (VCG_Heap, Left_Ptr);
      Cells.Dispose_Of_Cell (VCG_Heap, Left_Ptr);

      Parent_Ptr := Right_Ptr;

      --             Op ","
      --             /\
      --            /  \
      --    In_Called_  \
      --    Function     \
      Left_Ptr  := LeftPtr (VCG_Heap, Parent_Ptr);
      Right_Ptr := RightPtr (VCG_Heap, Parent_Ptr);
      Cells.Dispose_Of_Cell (VCG_Heap, Parent_Ptr);

      Current_Unit := Cells.Get_Symbol_Value (VCG_Heap, Left_Ptr);
      Cells.Dispose_Of_Cell (VCG_Heap, Left_Ptr);

      Parent_Ptr := Right_Ptr;

      --             Op ","
      --             /\
      --            /  \
      --  Implicit_Var  \
      Left_Ptr  := LeftPtr (VCG_Heap, Parent_Ptr);
      Right_Ptr := RightPtr (VCG_Heap, Parent_Ptr);
      Cells.Dispose_Of_Cell (VCG_Heap, Parent_Ptr);

      Implicit_Var := Cells.Get_Symbol_Value (VCG_Heap, Left_Ptr);
      Cells.Dispose_Of_Cell (VCG_Heap, Left_Ptr);

      Parent_Ptr := Right_Ptr;

      --              Op ","
      --               /\
      --              /  \
      --      Start_Node  \
      Left_Ptr  := LeftPtr (VCG_Heap, Parent_Ptr);
      Right_Ptr := RightPtr (VCG_Heap, Parent_Ptr);
      Cells.Dispose_Of_Cell (VCG_Heap, Parent_Ptr);

      Tmp        := Cells.Get_Natural_Value (VCG_Heap, Left_Ptr);
      Start_Node := STree.RefToNode (ExaminerConstants.RefType (Tmp));
      Cells.Dispose_Of_Cell (VCG_Heap, Left_Ptr);

      Parent_Ptr := Right_Ptr;

      --                 Op ","
      --                 /\
      --                /  \
      --        Last_Node  Next_Node
      Left_Ptr  := LeftPtr (VCG_Heap, Parent_Ptr);
      Right_Ptr := RightPtr (VCG_Heap, Parent_Ptr);
      Cells.Dispose_Of_Cell (VCG_Heap, Parent_Ptr);

      Tmp       := Cells.Get_Natural_Value (VCG_Heap, Left_Ptr);
      Last_Node := STree.RefToNode (ExaminerConstants.RefType (Tmp));
      Cells.Dispose_Of_Cell (VCG_Heap, Left_Ptr);

      Tmp       := Cells.Get_Natural_Value (VCG_Heap, Right_Ptr);
      Next_Node := STree.RefToNode (ExaminerConstants.RefType (Tmp));
      Cells.Dispose_Of_Cell (VCG_Heap, Right_Ptr);
   end Load_Saved_Context_DAG;

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

   -- Insert_Guarded_Function_Definition saves the call of the Calling_Function
   -- of this function (this will be null if no function calls have been encountered)
   -- I then saves the current context of the parse loop:
   --   Subrogram_Instantiaton, Direction, Current_Unit, Implicit_Var,
   --   Start_Node, Last_Node and Next_Node.
   -- It then sets up the expression_stack, E_Stack
   -- in preparation for traversing the syntax trees of the pre and return
   -- annoatations of a function called in a proof context.
   -- It also establishes the basic function definition on the stack as
   -- <precondition> -> <function_call> = <return_annotation>,
   -- where the "=" operator may be an "<->" operator if the result type of the
   -- called function is Boolean.
   -- If the called function has no precondition then the precondition "True"
   -- is assumed.
   -- If the called function has no return annotation and is not of a Boolean
   -- type then the function definition is considered to be
   -- <precondition> -> <function_Call> = <Function_Call>
   -- This is needed so that the call of the function is recorded
   -- and so that an in-type assumption for its return value can be
   -- conjoined.
   -- If the called function has no return annotation and the result type
   -- is Boolean, its definition is omitted and Insert_Guarded_Function_Definition
   -- leaves E_Stack unchanged.
   -- If the call of the function is recursive then
   -- Insert_Guarded_Function_Definition the function definition is not further
   -- expanded and Insert_Guarded_Function_Definition leaves E_Stack unchanged.
   -- Insert_Guarded_Function_Definition also records whether the function call
   -- an istantiated generic subprogram by setting the value of
   -- Instantiated_Subprogram to refer to the generic subprogram.
   -- If the called is not an instantiation then Instantiated_Subprogram is
   -- a null symbol.
   -- Lastly, if the function call is one to be processed, Insert_Guarded_Function_Definition
   -- sets the value of the Start_Node, Last_Node and Next_Node to a null
   -- syntax node guaranteeing that the parse loops are immediately exited ready
   -- to parse the precondition and return annotation of the called function.
   -- Assuming that the called function has a pre and return annotation
   -- Insert_Guarded_Function_Definition places on the top of the E_Stack the
   -- following entities:
   --
   --  |-----------|<- Default return anno <function_call>
   --  |-----------|<- Proof_Function_Syntax_Node
   --  |-----------|<- Proof_Function_Obtain_Return
   --  |-----------|<- <function_call> "=" place holder for return anno
   --  |-----------|<- Proof_Function_Obtain_Precondition (left -> Function_Call)
   --  |-----------|<- precond placeholder "->" function definition placeholder
   --  |-----------|<- argument typecheck (this will be anded to the precondition)
   --  |-----------|<- Function_Call_In_Proof_Context
   --  |-----------|<- return assumption (this will be anded to the entire instantiation)
   --  |-----------|<- Calling_Function the function call that applied this function
   --  |     /     |
   --  |     \     |   previous values on stack
   --  |     /     |
   --
   -- The True Call and Proof_Function_Syntax_Node entities are needed to sychronize the
   -- stack for the next iteration of the parser.
   -- Function_Call_In_Proof_Context does not perform the action of popping off
   -- the entities which it stacks but is done within the outer loop enclosing
   -- the parser loops.  The unstacking is described here for completeness.
   --
   -- After exiting the parser loop the top element of the stack is always
   -- popped off.  This will reveal the Proof_Function_Syntax_Node which indicates the start
   -- of processing the definition of a called function and the need to enter
   -- the parse loop afresh with new root syntax node by setting the Direction
   -- to Down_Loop.
   -- When the parse loop is exited again, a DAG of the return anno is on the
   -- top of the stack.  This is popped off to reveal Proof_Function_Obtain_Return
   -- This indicates that the DAG just popped of the stack is the root of the
   -- return anno DAG and has to become the RHS of the "=" or "<->" operator.
   -- This operator is popped off and becomes the RHS of the "->" operator
   -- The Proof_Function_Obtain_Precondition may have be temporarilly popped off
   -- but it is the TOS when the parse loop is re-entered.
   -- The Proof_Function_Obtain_Precondition contains a reference to the
   -- precondition node of the called function and this is extracted to
   -- set up the values of Start_Node, Last_Node and Next_Node and the
   -- Direction is set to Down_Loop to enter the parse loop afresh with the
   -- new root syntax node of the precondition.
   -- If the called function has no precondition a True Cell is pushed
   -- on the E_Stack as the assumed precondition.
   -- When the parse loop exits again the popped of cell is the root of the
   -- precondition DAG which becomes the LHS of the "->" operator.
   -- The guarded function definition is now complete and may be popped of the
   -- E_Stack and pushed on to the function definition stack.
   -- The top of E_Stack is now Function_Call_In_Proof_Context
   -- and contains the saved context.  It is popped off and the saved context
   -- restored but further checks have to be performed on the restored context
   -- to ascertain whether the parsing sould continue within the down or up loop.
   procedure Insert_Guarded_Function_Definition
     (Function_Call           : in     Cells.Cell;
      Scope                   : in     Dictionary.Scopes;
      Calling_Scope           : in     Dictionary.Scopes;
      Concrete_Function       : in     Dictionary.Symbol;
      Abstraction             : in     Dictionary.Abstractions;
      Direction               : in     Loop_Direction;
      Called_Functions        : in out Symbol_Set.T;
      Instantiated_Subprogram : in out Dictionary.Symbol;
      Current_Unit            : in out Dictionary.Symbol;
      Implicit_Var            : in out Dictionary.Symbol;
      Start_Node              : in out STree.SyntaxNode;
      Last_Node               : in out STree.SyntaxNode;
      Next_Node               : in out STree.SyntaxNode;
      Calling_Function        : in out Cells.Cell;
      E_Stack                 : in out CStacks.Stack;
      VCG_Heap                : in out Cells.Heap_Record)
   --# global in     STree.Table;
   --#        in out Dictionary.Dict;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out VC_Contains_Reals;
   --#        in out VC_Failure;
   --# derives Called_Functions,
   --#         Current_Unit,
   --#         Instantiated_Subprogram,
   --#         Last_Node,
   --#         Next_Node,
   --#         Start_Node              from *,
   --#                                      Abstraction,
   --#                                      Called_Functions,
   --#                                      Concrete_Function,
   --#                                      Dictionary.Dict &
   --#         Calling_Function        from *,
   --#                                      Abstraction,
   --#                                      Called_Functions,
   --#                                      Concrete_Function,
   --#                                      Dictionary.Dict,
   --#                                      E_Stack,
   --#                                      Function_Call,
   --#                                      VCG_Heap &
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         SPARK_IO.File_Sys,
   --#         VC_Contains_Reals,
   --#         VC_Failure              from *,
   --#                                      Abstraction,
   --#                                      Called_Functions,
   --#                                      Calling_Function,
   --#                                      Calling_Scope,
   --#                                      Concrete_Function,
   --#                                      Dictionary.Dict,
   --#                                      E_Stack,
   --#                                      Function_Call,
   --#                                      LexTokenManager.State,
   --#                                      VCG_Heap &
   --#         E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap                from *,
   --#                                      Abstraction,
   --#                                      Called_Functions,
   --#                                      Calling_Function,
   --#                                      Calling_Scope,
   --#                                      Concrete_Function,
   --#                                      Current_Unit,
   --#                                      Dictionary.Dict,
   --#                                      Direction,
   --#                                      E_Stack,
   --#                                      Function_Call,
   --#                                      Implicit_Var,
   --#                                      Instantiated_Subprogram,
   --#                                      Last_Node,
   --#                                      LexTokenManager.State,
   --#                                      Next_Node,
   --#                                      Scope,
   --#                                      Start_Node,
   --#                                      STree.Table,
   --#                                      VCG_Heap &
   --#         Implicit_Var            from *,
   --#                                      Abstraction,
   --#                                      Called_Functions,
   --#                                      Calling_Function,
   --#                                      Calling_Scope,
   --#                                      Concrete_Function,
   --#                                      Dictionary.Dict,
   --#                                      E_Stack,
   --#                                      Function_Call,
   --#                                      LexTokenManager.State,
   --#                                      STree.Table,
   --#                                      VCG_Heap;

   is
      Precondition_Node             : STree.SyntaxNode;
      Return_Anno_Node              : STree.SyntaxNode;
      Copy_Of_Function_Call         : Cells.Cell;
      Function_Call_Marker          : Cells.Cell;
      Function_Symbol               : Cells.Cell;
      Implicit_Return_Var           : Cells.Cell;
      OP_Cell                       : Cells.Cell;
      New_Start_Node                : Cells.Cell;
      Precondition                  : Cells.Cell;
      Precondition_Marker           : Cells.Cell;
      Return_Anno                   : Cells.Cell;
      Return_Anno_Marker            : Cells.Cell;
      Argument_Check                : Cells.Cell;
      Return_Assumption             : Cells.Cell;
      Return_Type_Is_Boolean        : Boolean;
      Local_Abstraction             : Dictionary.Abstractions;
      Local_Instantiated_Subprogram : Dictionary.Symbol;
      Saved_Context                 : Cells.Cell;
   begin
      -- Get the details of the called function
      Return_Type_Is_Boolean := Dictionary.TypeIsBoolean (Dictionary.GetType (Concrete_Function));

      -- Determine whether we have a call of an instantiation of a generic
      if Dictionary.IsInstantiation (Concrete_Function) then
         Local_Instantiated_Subprogram := Concrete_Function;
         -- The view must be abstract if is an instantiation
         -- as the body cannot be visible.
         Local_Abstraction := Dictionary.IsAbstract;
      else -- not generic
         Local_Instantiated_Subprogram := Dictionary.NullSymbol;
         Local_Abstraction             := Abstraction;
      end if;

      -- Get the precondition and return anno syntax nodes
      -- (they may be from the instantiation or the generic declaration
      -- if the call is of an instantiation of a generic).
      Precondition_Node := STree.RefToNode (Dictionary.GetPrecondition (Local_Abstraction, Concrete_Function));
      Return_Anno_Node  := STree.RefToNode (Dictionary.GetPostcondition (Local_Abstraction, Concrete_Function));

      --  The function call is only processed if the function is not
      --  already being processed and it has a return anno.
      if not Symbol_Set.Contains (The_Set => Called_Functions,
                                  Sym     => Concrete_Function)
        and then Return_Anno_Node /= STree.NullNode then
         Symbol_Set.Add (The_Set => Called_Functions,
                         Sym     => Concrete_Function);

         ---------------------------------------------------------------------
         -- Save the calling function call on the stack
         CStacks.Push (Heap     => VCG_Heap,
                       CellName => Calling_Function,
                       S        => E_Stack);

         -- Make a copy of the called function and substitute the parameters
         -- if it is a nested call
         Structures.CopyStructure (Heap     => VCG_Heap,
                                   Root     => Function_Call,
                                   RootCopy => Copy_Of_Function_Call);
         if not Cells.Is_Null_Cell (Calling_Function) then
            Substitutions.Substitute_Parameters
              (Called_Function => Calling_Function,
               Constraint      => Copy_Of_Function_Call,
               VCG_Heap        => VCG_Heap);
         end if;

         -- The called function (with any parameter substituitons) becomes
         -- the calling function for any further nested calls
         Calling_Function := Copy_Of_Function_Call;

         ---------------------------------------------------------------------
         --  Push the function's argument check and return assumption
         --  onto the stack first.
         Get_Function_Type_Constraints
           (Function_Call     => Copy_Of_Function_Call,
            Calling_Scope     => Calling_Scope,
            Argument_Check    => Argument_Check,
            Return_Assumption => Return_Assumption,
            VCG_Heap          => VCG_Heap);
         CStacks.Push (VCG_Heap, Return_Assumption, E_Stack);

         ---------------------------------------------------------------------
         -- Create a function call marker and push it on the expression stack
         CreateCellKind
           (CellName   => Function_Call_Marker,
            VCGHeap    => VCG_Heap,
            KindOfCell => Cell_Storage.Function_Call_In_Proof_Context);
         CStacks.Push (Heap     => VCG_Heap,
                       CellName => Function_Call_Marker,
                       S        => E_Stack);
         -- TOS is a function call marker

         -- The right argument of a function call marker is the saved context
         Create_Saved_Context_DAG
           (Scope                   => Scope,
            Direction               => Direction,
            Instantiated_Subprogram => Instantiated_Subprogram,
            Current_Unit            => Current_Unit,
            Implicit_Var            => Implicit_Var,
            Start_Node              => Start_Node,
            Last_Node               => Last_Node,
            Next_Node               => Next_Node,
            VCG_Heap                => VCG_Heap,
            Argument_List           => Saved_Context);

         SetRightArgument (OpCell   => CStacks.Top (VCG_Heap, E_Stack),
                           Argument => Saved_Context,
                           VCGHeap  => VCG_Heap);

         -- The left argument of a function call marker is the concrete function symbol
         CreateCellKind (CellName   => Function_Symbol,
                         VCGHeap    => VCG_Heap,
                         KindOfCell => Cell_Storage.Declared_Function);
         Cells.Set_Symbol_Value (Heap     => VCG_Heap,
                                 CellName => Function_Symbol,
                                 Sym      => Concrete_Function);
         SetLeftArgument (OpCell   => CStacks.Top (VCG_Heap, E_Stack),
                          Argument => Function_Symbol,
                          VCGHeap  => VCG_Heap);

         --  Now we push the argument check.
         CStacks.Push (VCG_Heap, Argument_Check, E_Stack);

         ----------------------------------------------------------------------
         -- Create a -> operator and push it on the stack
         CreateOpCell (OP_Cell, VCG_Heap, SP_Symbols.implies);
         CStacks.Push (Heap     => VCG_Heap,
                       CellName => OP_Cell,
                       S        => E_Stack);
         -- TOS is "->" operator

         ----------------------------------------------------------------------
         -- Create a precondition marker and push it on the stack
         CreateCellKind
           (CellName   => Precondition_Marker,
            VCGHeap    => VCG_Heap,
            KindOfCell => Cell_Storage.Proof_Function_Obtain_Precondition);
         --  We remember the function call as otherwise its a bit
         --  painful to get to it in the main loop below.
         SetLeftArgument (Precondition_Marker, Copy_Of_Function_Call, VCG_Heap);
         CStacks.Push (Heap     => VCG_Heap,
                       CellName => Precondition_Marker,
                       S        => E_Stack);

         -- TOS is precondition marker

         -- Set the RHS of the precondition marker to a cell containing
         -- a reference to the syntax node for the precondition (which will be
         -- null if the called function does not have one).
         CreateCellKind (CellName   => Precondition,
                         VCGHeap    => VCG_Heap,
                         KindOfCell => Cell_Storage.Proof_Function_Syntax_Node);
         Cells.Set_Natural_Value
           (Heap     => VCG_Heap,
            CellName => Precondition,
            Value    => Natural (STree.NodeToRef (Precondition_Node)));
         SetRightArgument (OpCell   => CStacks.Top (VCG_Heap, E_Stack),
                           Argument => Precondition,
                           VCGHeap  => VCG_Heap);

         ----------------------------------------------------------------------
         -- Create a "=" or "<->"  operator depending on the function type
         -- and push it on the stack
         if Return_Type_Is_Boolean then
            CreateOpCell (OP_Cell, VCG_Heap, SP_Symbols.is_equivalent_to);
         else
            CreateOpCell (OP_Cell, VCG_Heap, SP_Symbols.equals);
         end if;
         CStacks.Push (Heap     => VCG_Heap,
                       CellName => OP_Cell,
                       S        => E_Stack);
         -- TOS is Op "=" or "<->"

         -- LHS of the operator to the actual function call
         SetLeftArgument (OpCell   => CStacks.Top (VCG_Heap, E_Stack),
                          Argument => Copy_Of_Function_Call,
                          VCGHeap  => VCG_Heap);

         ----------------------------------------------------------------------
         -- Create a return anno marker and push it on the stack
         CreateCellKind
           (CellName   => Return_Anno_Marker,
            VCGHeap    => VCG_Heap,
            KindOfCell => Cell_Storage.Proof_Function_Obtain_Return);
         CStacks.Push (Heap     => VCG_Heap,
                       CellName => Return_Anno_Marker,
                       S        => E_Stack);
         -- TOS is return anno marker

         -- Determine the called function has a return anno and if it has,
         -- the sort, explicit or implicit.
         if Return_Anno_Node = STree.NullNode
           or else STree.Syntax_Node_Type (Return_Anno_Node) = SP_Symbols.annotation_expression then
            -- The called function has no return anno or it is an explicit
            -- return anno.  In either case it has no implicit variable.
            Implicit_Var := Dictionary.NullSymbol;
         else
            -- It is an implicit return annotation - get the implicit
            -- variable.
            Implicit_Var := Dictionary.GetImplicitReturnVariable (Local_Abstraction, Concrete_Function);
            -- Set the Return_Anno_Node to the start of the start of the
            -- return expression (involving the implicit variable).
            Return_Anno_Node := STree.Next_Sibling (Current_Node => Return_Anno_Node);
         end if;

         -- Set the RHS of the return anno marker to a cell containing
         -- a reference to the root syntax tree node for the return anno
         CreateCellKind (CellName   => Return_Anno,
                         VCGHeap    => VCG_Heap,
                         KindOfCell => Cell_Storage.Proof_Function_Syntax_Node);
         Cells.Set_Natural_Value
           (Heap     => VCG_Heap,
            CellName => Return_Anno,
            Value    => Natural (STree.NodeToRef (Return_Anno_Node)));
         SetRightArgument (OpCell   => CStacks.Top (VCG_Heap, E_Stack),
                           Argument => Return_Anno,
                           VCGHeap  => VCG_Heap);

         -- Set the LHS of the return anno marker to a cell containing
         -- a reference to the implicit variable
         CreateReferenceCell (CellName => Implicit_Return_Var,
                              VCGHeap  => VCG_Heap,
                              Sym      => Implicit_Var);
         SetLeftArgument (OpCell   => CStacks.Top (VCG_Heap, E_Stack),
                          Argument => Implicit_Return_Var,
                          VCGHeap  => VCG_Heap);

         -- Set up the stack to start processing return anno
         CreateCellKind (CellName   => New_Start_Node,
                         VCGHeap    => VCG_Heap,
                         KindOfCell => Cell_Storage.Proof_Function_Syntax_Node);
         CStacks.Push (Heap     => VCG_Heap,
                       CellName => New_Start_Node,
                       S        => E_Stack);
         -- Put a default return anno <function_call> on the stack
         -- for when no return anno is given
         CStacks.Push (Heap     => VCG_Heap,
                       CellName => Function_Call,
                       S        => E_Stack);
         -- TOS is <function_Call> => Proof_Function_Syntax_Node => return anno marker

         -- Record whether the call is of an instantiation of a generic function
         -- This does not change whether the pre or return anno is being processed.
         Instantiated_Subprogram := Local_Instantiated_Subprogram;

         -- Determine the symbol from which the scope for parsing the pre and
         -- explicit return annotation is obtained.
         Current_Unit := Concrete_Function;

         -- Ensure that the parse loops are immediately exited by setting
         -- context variables to a null node
         Start_Node := STree.NullNode;
         Last_Node  := STree.NullNode;
         Next_Node  := STree.NullNode;
      end if;

   end Insert_Guarded_Function_Definition;

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

   -- Given a concrete or implicit function symbol and a scope
   -- Get_Concrete_And_FDL_Functions_And_Abstraction
   -- obtains the concrete function symbol, the symbol of the FDL version of
   -- the function used in the VCs and the level of abstraction for
   -- the call of the function from the given scope.
   procedure Get_Concrete_Function_And_Abstraction
     (Function_Symbol      : in     Dictionary.Symbol;
      Force_Abstract       : in     Boolean;
      Scope                : in     Dictionary.Scopes;
      Concrete_Function    :    out Dictionary.Symbol;
      FDL_Function         :    out Dictionary.Symbol;
      Level_Of_Abstraction :    out Dictionary.Abstractions)
   --# global in Dictionary.Dict;
   --# derives Concrete_Function    from Dictionary.Dict,
   --#                                   Function_Symbol &
   --#         FDL_Function,
   --#         Level_Of_Abstraction from Dictionary.Dict,
   --#                                   Force_Abstract,
   --#                                   Function_Symbol,
   --#                                   Scope;
   is
   begin

      --  Debug.PrintMsg ("Get_Concrete_Function_And_Abstraction", True);
      --  Debug.Print_Function_Sym ("   Function_Symbol: ",  Function_Symbol);
      --  Debug.PrintBool          ("   Force_Abstract:   ", Force_Abstract);
      --  Debug.PrintScope         ("   Scope:            ", Scope);

      --  The function symbol may refer to a concrete function (Ada or
      --  proof) or an implicit view of an Ada function; we need to be
      --  sure which one we have.
      if Dictionary.IsImplicitProofFunction (Function_Symbol) then
         -- GetAdaFuntion gets the concrete view of the Ada function
         Concrete_Function := Dictionary.GetAdaFunction (Function_Symbol);
      else
         Concrete_Function := Function_Symbol;
      end if;

      --  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.  Only the level of
      --  abstraction relating to the pre and return annotations is
      --  required in a proof context (an annotation expression).
      if Force_Abstract then
         Level_Of_Abstraction := Dictionary.IsAbstract;
      else
         Level_Of_Abstraction := Dictionary.GetConstraintAbstraction (Concrete_Function, Scope);
      end if;

      --  Finally we get the function symbol to use in FDL.
      if Dictionary.IsProofFunction (Function_Symbol) and not Dictionary.IsImplicitProofFunction (Function_Symbol) then
         FDL_Function := Function_Symbol;
      else
         FDL_Function := Dictionary.GetImplicitProofFunction (Level_Of_Abstraction, Concrete_Function);

         --  We may not have a refined function, in which case we
         --  should fall back to the abstract one.
         if Level_Of_Abstraction = Dictionary.IsRefined and Dictionary.Is_Null_Symbol (FDL_Function) then
            FDL_Function := Dictionary.GetImplicitProofFunction (Dictionary.IsAbstract, Concrete_Function);
         end if;
      end if;

      --  Debug.Print_Function_Sym ("   Concrete FN:     ",  Concrete_Function);
      --  Debug.Print_Function_Sym ("   FDL FN:          ",  FDL_Function);
      --  case Level_Of_Abstraction is
      --     when Dictionary.IsAbstract =>
      --        Debug.PrintMsg ("   Abstraction:      isAbstract", True);
      --     when Dictionary.IsRefined =>
      --        Debug.PrintMsg ("   Abstraction:      isRefined", True);
      --  end case;
   end Get_Concrete_Function_And_Abstraction;

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

   -- Setup_Function_Call is called during the DAG.Build_Annotation_Expression
   -- "down-loop" when a function call is encountered in an annotation
   -- expression and establishes a data structure to represent the actual
   -- parameters of the function call.
   -- The actual parameters are entered during the "up-loop" by the procedure
   -- by Process_Positional_Argument_Association
   -- or Process_Named_Argument_Association and the processing of the
   -- function call during the "up-loop" by Process_Name_Argument_List.
   -- Set_UpFunction_Call also determines the level of abstraction from the
   -- given scope and sets the DAG symbol value for the function to the correct
   -- implicit function.
   -- If it is a parameterless function (a function in an annotation expression
   --    does not have globals) there are no actual parameters to be processed
   --    during the up-loop and so the function call has to be completed by
   --    this subprogram: the DAG symbol kind is changed to a proof function,
   --    whether it is an Ada or a proof function, indicating the processing of
   --    the function call is complete and calling
   --    Insert_Guarded_Function_Definition to initiate processing of the
   --    pre and return annotations of the function.
   -- If the function has parameters: the completion of the function call
   --    is performed by the procedure Process_Name_Argument_List during the
   --    DAG.Build_Annotation_Expression "up-loop".
   procedure Setup_Function_Call
     (Direction             : in     Loop_Direction;
      Scope                 : in     Dictionary.Scopes;
      Calling_Scope         : in     Dictionary.Scopes;
      Force_Abstract        : in     Boolean;
      Current_Unit          : in out Dictionary.Symbol;
      Implicit_Var          : in out Dictionary.Symbol;
      Current_Instantiation : in out Dictionary.Symbol;
      Start_Node            : in out STree.SyntaxNode;
      Next_Node             : in out STree.SyntaxNode;
      Last_Node             : in out STree.SyntaxNode;
      Calling_Function      : in out Cells.Cell;
      Called_Functions      : in out Symbol_Set.T;
      E_Stack               : in out CStacks.Stack;
      VCG_Heap              : in out Cells.Heap_Record)
   --# global in     Generate_Function_Instantiations;
   --#        in     STree.Table;
   --#        in out Dictionary.Dict;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out VC_Contains_Reals;
   --#        in out VC_Failure;
   --# derives Called_Functions,
   --#         Calling_Function,
   --#         Current_Instantiation,
   --#         Current_Unit,
   --#         Last_Node,
   --#         Next_Node,
   --#         Start_Node            from *,
   --#                                    Called_Functions,
   --#                                    Calling_Scope,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    VCG_Heap &
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         SPARK_IO.File_Sys,
   --#         VC_Contains_Reals,
   --#         VC_Failure            from *,
   --#                                    Called_Functions,
   --#                                    Calling_Function,
   --#                                    Calling_Scope,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    LexTokenManager.State,
   --#                                    VCG_Heap &
   --#         E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Called_Functions,
   --#                                    Calling_Function,
   --#                                    Calling_Scope,
   --#                                    Current_Instantiation,
   --#                                    Current_Unit,
   --#                                    Dictionary.Dict,
   --#                                    Direction,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    Implicit_Var,
   --#                                    Last_Node,
   --#                                    LexTokenManager.State,
   --#                                    Next_Node,
   --#                                    Scope,
   --#                                    Start_Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap &
   --#         Implicit_Var          from *,
   --#                                    Called_Functions,
   --#                                    Calling_Function,
   --#                                    Calling_Scope,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    LexTokenManager.State,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      Number_Of_Parameters : Natural;
      Function_Sym         : Dictionary.Symbol;
      Level_Of_Abstraction : Dictionary.Abstractions;
      Concrete_Function    : Dictionary.Symbol;
      FDL_Function         : Dictionary.Symbol;
      Actual_Function_Call : Cells.Cell;
   begin
      -- Get the function symbol from the DAG
      Function_Sym := Cells.Get_Symbol_Value (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack));

      -- Ada functions have a concrete and and one or two
      -- implicit views.  An implicit view may be either abstract or refined
      -- but it is always an implicit view which appears in VCs.
      -- Both the concrete and implicit views of the function are
      -- required for processing the function call because the implicit
      -- view is used for the FDL and the concrete view contains the
      -- pre and return annoatations.
      -- A proof function only has a single concrete view.

      -- Ensure we have the concrete and FDL function symbols and the correct
      -- level of abstraction.
      -- An embedded function call is not forced to be abstract.
      Get_Concrete_Function_And_Abstraction
        (Function_Symbol      => Function_Sym,
         Force_Abstract       => Force_Abstract,
         Scope                => Calling_Scope,
         Concrete_Function    => Concrete_Function,
         FDL_Function         => FDL_Function,
         Level_Of_Abstraction => Level_Of_Abstraction);

      -- Ensure that the function symbol in the DAG has the correct implicit
      -- view.
      Cells.Set_Symbol_Value (Heap     => VCG_Heap,
                              CellName => CStacks.Top (VCG_Heap, E_Stack),
                              Sym      => FDL_Function);

      Number_Of_Parameters := Dictionary.GetNumberOfSubprogramParameters (FDL_Function);

      --  Establish the data structure to take the actual parameters
      CreateEmptyList (Number_Of_Parameters, VCG_Heap, E_Stack);

      -- If the function is parameterless then the function model has
      -- to be completed here on the down-loop because
      -- Process_Name_Argument_List will not be called on the up-loop to
      -- complete the function model.  The function call model is
      -- completed setting the Cell.Kind as a proof function
      -- and calling Insert_Gaurded_Function_Definition for subsequent
      -- building of the graphs for the pre and return annotations of the function.
      if Number_Of_Parameters = 0 then

         Cells.Set_Kind (Heap      => VCG_Heap,
                         CellName  => CStacks.Top (VCG_Heap, E_Stack),
                         KindConst => Cell_Storage.Proof_Function);

         if Generate_Function_Instantiations then
            Actual_Function_Call := CStacks.Top (VCG_Heap, E_Stack);

            Insert_Guarded_Function_Definition
              (Function_Call           => Actual_Function_Call,
               Scope                   => Scope,
               Calling_Scope           => Calling_Scope,
               Concrete_Function       => Concrete_Function,
               Abstraction             => Level_Of_Abstraction,
               Direction               => Direction,
               Called_Functions        => Called_Functions,
               Instantiated_Subprogram => Current_Instantiation,
               Current_Unit            => Current_Unit,
               Implicit_Var            => Implicit_Var,
               Start_Node              => Start_Node,
               Last_Node               => Last_Node,
               Next_Node               => Next_Node,
               E_Stack                 => E_Stack,
               Calling_Function        => Calling_Function,
               VCG_Heap                => VCG_Heap);
         end if;
      end if;

   end Setup_Function_Call;

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

   procedure Setup_Array_Access (E_Stack  : in out CStacks.Stack;
                                 VCG_Heap : in out Cells.Heap_Record)
   --# global in     Dictionary.Dict;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    VCG_Heap;
   is
      Number_Of_Dimensions : Positive;
      DAG_Cell             : Cells.Cell;
   begin
      Number_Of_Dimensions := Dictionary.GetNumberOfDimensions (GetTOStype (VCG_Heap, E_Stack));
      CreateCellKind (DAG_Cell, VCG_Heap, Cell_Storage.List_Function);
      CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);
      CreateEmptyList (Number_Of_Dimensions, VCG_Heap, E_Stack);
   end Setup_Array_Access;

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

   procedure Process_Positional_Argument_Association
     (Node     : in     STree.SyntaxNode;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     Dictionary.Dict;
   --#        in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      Expression_Cell                                : Cells.Cell;
      Conversion_Target_Type, Conversion_Source_Type : Dictionary.Symbol;
   begin
      CStacks.PopOff (VCG_Heap, E_Stack, Expression_Cell);
      case Cells.Get_Kind (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack)) is
         when Cell_Storage.Pending_Function =>
            -- 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 (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack)),
               VCG_Heap,
               Expression_Cell); -- function sym

            InsertParameterInNextFreeSlot (CStacks.Top (VCG_Heap, E_Stack), Expression_Cell, VCG_Heap);
         when Cell_Storage.List_Function =>
            InsertParameterInNextFreeSlot (CStacks.Top (VCG_Heap, E_Stack), Expression_Cell, VCG_Heap);
         when Cell_Storage.Fixed_Var =>
            Conversion_Source_Type := STree.NodeSymbol (Node);
            Conversion_Target_Type := Cells.Get_Symbol_Value (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack));
            -- assume integer numeric conversion for now
            CStacks.Pop (VCG_Heap, E_Stack); -- get rid of type mark
            CStacks.Push (VCG_Heap, Expression_Cell, E_Stack); -- restore expression

            -- insert trunc function if needed
            if Dictionary.TypeIsReal (Conversion_Source_Type)
              and then (Dictionary.TypeIsInteger (Conversion_Target_Type) or else IsModularType (Conversion_Target_Type)) then
               PushFunction (Cell_Storage.Trunc_Function, VCG_Heap, E_Stack);
            end if;
         when others => -- must be dealing with first indexed expression of array access
            Setup_Array_Access (E_Stack  => E_Stack,
                                VCG_Heap => VCG_Heap);
            InsertParameterInNextFreeSlot (CStacks.Top (VCG_Heap, E_Stack), Expression_Cell, VCG_Heap);
      end case;
   end Process_Positional_Argument_Association;

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

   procedure Process_Named_Argument_Association
     (Node     : in     STree.SyntaxNode;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack               from *,
   --#                                    VCG_Heap &
   --#         Statistics.TableUsage from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    VCG_Heap &
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    LexTokenManager.State,
   --#                                    Node,
   --#                                    STree.Table;
   is
      Insert_Point, Expression_Cell : Cells.Cell;
      Function_Sym                  : Dictionary.Symbol;
      Last_One                      : Boolean;

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

      function Find_Identifier (Node : STree.SyntaxNode) return STree.SyntaxNode
      --# global in STree.Table;
      is
         Ident_Node : STree.SyntaxNode;
      begin
         if STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => Node)) = SP_Symbols.annotation_simple_name then
            Ident_Node := STree.Child_Node (Current_Node => STree.Child_Node (Current_Node => Node));
         else
            Ident_Node :=
              STree.Child_Node (Current_Node => STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node)));
         end if;
         return Ident_Node;
      end Find_Identifier;

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

      -- This function has an implicit precondition, that the subprogram
      -- does have parameters and that the name passed identifies one of them
      -- this will be True because when VCs are generated, we know that the code
      -- is well-formed. Therefore the flow error can be ignored.
      function Get_Param_Number (Name         : in LexTokenManager.Lex_String;
                                 Function_Sym : in Dictionary.Symbol) return Positive
      --# global in Dictionary.Dict;
      --#        in LexTokenManager.State;
      is
         It     : Dictionary.Iterator;
         Sym    : Dictionary.Symbol;
         Number : Positive;
      begin
         It     := Dictionary.FirstSubprogramParameter (Function_Sym);
         Number := 1;
         SystemErrors.RT_Assert
           (C       => not Dictionary.IsNullIterator (It),
            Sys_Err => SystemErrors.Precondition_Failure,
            Msg     => "Can't find first subprogram parameter in Build_Annotation_Expression.Get_Param_Number");
         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);
            Number := Number + 1;
         end loop;
         return Number;
      end Get_Param_Number;

   begin -- Process_Named_Argument_Association

      -- we must be dealing with a function call
      CStacks.PopOff (VCG_Heap, E_Stack, Expression_Cell);
      Function_Sym := Cells.Get_Symbol_Value (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack));
      -- 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 (Function_Sym, VCG_Heap, Expression_Cell);

      CalculateInsertPoint
        (VCG_Heap,
         E_Stack,
         Get_Param_Number (Name         => STree.Node_Lex_String (Node => Find_Identifier (Node => Node)),
                           Function_Sym => Function_Sym),
         -- to get
         Insert_Point,
         Last_One);
      if Last_One then
         SetRightArgument (Insert_Point, Expression_Cell, VCG_Heap);
      else
         SetLeftArgument (Insert_Point, Expression_Cell, VCG_Heap);
      end if;
   end Process_Named_Argument_Association;

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

   -- This procedure is called during the "up-loop" of
   -- DAG.Build_Annotation_Expression once  all of the arguments
   -- (with positional or named association) of a function call in an annotation
   -- have been processed by Process_Positional_ArgumentAssocaition 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 by 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 Setup_Array_Access.
   -- A function call model is completed by:
   --    changing the DAG symbol kind to a proof function whether it is an Ada
   --    or a proof function and calling Insert_Guarded_Function_Definition
   --    to initiate the processing of the pre and return annotations of the
   --    function.
   -- 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 Process_Name_Argument_List
     (Direction             : in     Loop_Direction;
      Scope                 : in     Dictionary.Scopes;
      Calling_Scope         : in     Dictionary.Scopes;
      Force_Abstract        : in     Boolean;
      Calling_Function      : in out Cells.Cell;
      Current_Unit          : in out Dictionary.Symbol;
      Implicit_Var          : in out Dictionary.Symbol;
      Current_Instantiation : in out Dictionary.Symbol;
      Start_Node            : in out STree.SyntaxNode;
      Next_Node             : in out STree.SyntaxNode;
      Last_Node             : in out STree.SyntaxNode;
      Called_Functions      : in out Symbol_Set.T;
      E_Stack               : in out CStacks.Stack;
      VCG_Heap              : in out Cells.Heap_Record)
   --# global in     Generate_Function_Instantiations;
   --#        in     STree.Table;
   --#        in out Dictionary.Dict;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out VC_Contains_Reals;
   --#        in out VC_Failure;
   --# derives Called_Functions,
   --#         Calling_Function,
   --#         Current_Instantiation,
   --#         Current_Unit,
   --#         Last_Node,
   --#         Next_Node,
   --#         Start_Node            from *,
   --#                                    Called_Functions,
   --#                                    Calling_Scope,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    VCG_Heap &
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         SPARK_IO.File_Sys,
   --#         VC_Contains_Reals,
   --#         VC_Failure            from *,
   --#                                    Called_Functions,
   --#                                    Calling_Function,
   --#                                    Calling_Scope,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    LexTokenManager.State,
   --#                                    VCG_Heap &
   --#         E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Called_Functions,
   --#                                    Calling_Function,
   --#                                    Calling_Scope,
   --#                                    Current_Instantiation,
   --#                                    Current_Unit,
   --#                                    Dictionary.Dict,
   --#                                    Direction,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    Implicit_Var,
   --#                                    Last_Node,
   --#                                    LexTokenManager.State,
   --#                                    Next_Node,
   --#                                    Scope,
   --#                                    Start_Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap &
   --#         Implicit_Var          from *,
   --#                                    Called_Functions,
   --#                                    Calling_Function,
   --#                                    Calling_Scope,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    LexTokenManager.State,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   --#
   is
      Temp                 : Cells.Cell;
      Type_Sym             : Dictionary.Symbol;
      Concrete_Function    : Dictionary.Symbol;
      FDL_Function         : Dictionary.Symbol;
      Level_Of_Abstraction : Dictionary.Abstractions;
   begin
      case Cells.Get_Kind (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack)) is
         when Cell_Storage.Pending_Function =>

            --  Set_Up_Function_Call has ensured that the DAG function
            --  Symbol has the correct implicit view of the function
            Cells.Set_Kind
              (Heap      => VCG_Heap,
               CellName  => CStacks.Top (VCG_Heap, E_Stack),
               KindConst => Cell_Storage.Proof_Function);

            --  We need the concrete function symbol and the
            --  correct level of abstraction.
            -- An embedded function call is not forced to be abstract.
            Get_Concrete_Function_And_Abstraction
              (Function_Symbol      => Cells.Get_Symbol_Value (Heap     => VCG_Heap,
                                                               CellName => CStacks.Top (VCG_Heap, E_Stack)),
               Force_Abstract       => Force_Abstract,
               Scope                => Calling_Scope,
               Concrete_Function    => Concrete_Function,
               FDL_Function         => FDL_Function,
               Level_Of_Abstraction => Level_Of_Abstraction);

            --  Note: If a called function has an unconstrained array
            --  as a parameter then it is not (easily) possible to
            --  work out what kind of type an argument should be in;
            --  thus we do not instantiate it (for now).
            if Generate_Function_Instantiations and not Function_Has_Unconstrained_Parameter (FDL_Function) then

               --  Ensure that the function symbol in the DAG has the
               --  correct implicit view.
               Cells.Set_Symbol_Value (Heap     => VCG_Heap,
                                       CellName => CStacks.Top (VCG_Heap, E_Stack),
                                       Sym      => FDL_Function);

               --  Call Insert_Gaurded_Function_Definition for
               --  subsequent building of the graphs for the pre and
               --  return annotations of the function.
               Insert_Guarded_Function_Definition
                 (Function_Call           => CStacks.Top (VCG_Heap, E_Stack),
                  Scope                   => Scope,
                  Calling_Scope           => Calling_Scope,
                  Concrete_Function       => Concrete_Function,
                  Abstraction             => Level_Of_Abstraction,
                  Direction               => Direction,
                  Called_Functions        => Called_Functions,
                  Instantiated_Subprogram => Current_Instantiation,
                  Current_Unit            => Current_Unit,
                  Implicit_Var            => Implicit_Var,
                  Start_Node              => Start_Node,
                  Last_Node               => Last_Node,
                  Next_Node               => Next_Node,
                  Calling_Function        => Calling_Function,
                  E_Stack                 => E_Stack,
                  VCG_Heap                => VCG_Heap);
            end if;

         when Cell_Storage.List_Function =>
            -- complete element model and store type so far in case of further
            -- indexing (to handle array of arrays or array of records case)
            CStacks.PopOff (VCG_Heap, E_Stack, Temp);
            Type_Sym := Dictionary.GetArrayComponent (GetTOStype (VCG_Heap, E_Stack));
            CStacks.Push (VCG_Heap, Temp, E_Stack);
            PushOperator (Binary, SP_Symbols.comma, VCG_Heap, E_Stack);
            PushFunction (Cell_Storage.Element_Function, VCG_Heap, E_Stack);
            Cells.Set_Symbol_Value (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack), Type_Sym);
         when others =>
            null;
      end case;
   end Process_Name_Argument_List;

   -----------------------------------------------------------------------
   --            Handling Update Syntax in Annotations
   -----------------------------------------------------------------------

   procedure Down_Process_Store
     (L_Scope  : in     Dictionary.Scopes;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     Dictionary.Dict;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    L_Scope,
   --#                                    VCG_Heap;
   is
      Type_Sym : Dictionary.Symbol;
   begin
      Type_Sym := GetTOStype (VCG_Heap, E_Stack);
      -- Handle array and record updates differently, arrays need stuff for store-lists
      if Dictionary.IsArrayTypeMark (Type_Sym, L_Scope) then
         Setup_Array_Access (E_Stack  => E_Stack,
                             VCG_Heap => VCG_Heap);
         -- this leaves us with update subject on 2nd TOS and empty list on TOS
      end if;
      -- no action required for record
   end Down_Process_Store;

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

   procedure Down_Process_Store_List
     (Node      : in     STree.SyntaxNode;
      E_Stack   : in     CStacks.Stack;
      VCG_Heap  : in     Cells.Heap_Record;
      Next_Node :    out STree.SyntaxNode)
   --# global in STree.Table;
   --# derives Next_Node from E_Stack,
   --#                        Node,
   --#                        STree.Table,
   --#                        VCG_Heap;
   is
   begin
      if Cells.Get_Kind (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack)) = Cell_Storage.List_Function then
         -- we are doing an array
         Next_Node := STree.Child_Node (Current_Node => Node);
      else -- must be record so prune walk here
         Next_Node := STree.NullNode;
      end if;
   end Down_Process_Store_List;

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

   procedure Up_Process_Store
     (Node     : in     STree.SyntaxNode;
      L_Scope  : in     Dictionary.Scopes;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    CommandLineData.Content,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    LexTokenManager.State,
   --#                                    L_Scope,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      Temp, Up_Cell, Comma_Cell                             : Cells.Cell;
      Original_Object_Being_Updated                         : Cells.Cell;
      Local_Copy_Of_Object_Being_Updated                    : Cells.Cell;
      Object_Being_Updated                                  : Cells.Cell;
      Type_Sym, Field_Sym, Field_Sym_For_Inherit_Deref_Loop : Dictionary.Symbol;
      Field_Name                                            : LexTokenManager.Lex_String;
   begin
      -- for an array update we have exp, list, updated_obj on stack
      -- for a record we have exp, updated_obj on stack

      CStacks.PopOff (VCG_Heap, E_Stack, Temp); --this is assigned expression

      if Cells.Get_Kind (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack)) = Cell_Storage.List_Function then
         -- we are doing an array
         CStacks.Push (VCG_Heap, Temp, E_Stack);
         PushOperator (Binary, SP_Symbols.comma, VCG_Heap, E_Stack);
         -- now obtain type of whole composite object and store in update
         -- function cell so that updates of updates will work
         CStacks.PopOff (VCG_Heap, E_Stack, Temp); -- remove to get access to object
         Type_Sym := GetTOStype (VCG_Heap, E_Stack);
         CStacks.Push (VCG_Heap, Temp, E_Stack);
         PushOperator (Binary, SP_Symbols.comma, VCG_Heap, E_Stack);
         PushFunction (Cell_Storage.Update_Function, VCG_Heap, E_Stack);
         Cells.Set_Symbol_Value (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack), Type_Sym);

      else -- we are doing a record -----------------------------------------------------

         -- Get the root type here in case the updated object is of a record
         -- subtype.
         Type_Sym := Dictionary.GetRootType (GetTOStype (VCG_Heap, E_Stack));

         CStacks.PopOff (VCG_Heap, E_Stack, Object_Being_Updated);
         Original_Object_Being_Updated := Object_Being_Updated; -- because Object_Being_Updated changes later and we need a copy
         Field_Name                    := STree.Node_Lex_String (Node => STree.Last_Child_Of (Start_Node => Node));
         Field_Sym                     := Dictionary.LookupSelectedItem (Type_Sym, Field_Name, L_Scope, Dictionary.ProofContext);

         SystemErrors.RT_Assert
           (C       => not Dictionary.Is_Null_Symbol (Field_Sym),
            Sys_Err => SystemErrors.Invalid_Symbol_Table,
            Msg     => "DAG.Build_Annotation_Expression.Up_Process_Store : Program Error");

         -- The field we are updating may be inherited from an earlier tagged types.
         -- So insert as many fld_inherit()s in front as needed
         ModelInheritedFieldsOfTaggedRecord (Field_Name, Type_Sym, VCG_Heap, Object_Being_Updated);
         -- assemble upf_field (Object_Being_Updated, OriginalExpression)
         CStacks.Push (VCG_Heap, Object_Being_Updated, E_Stack);
         CStacks.Push (VCG_Heap, Temp, E_Stack);
         PushOperator (Binary, SP_Symbols.comma, VCG_Heap, E_Stack);
         CreateUpfCell (Up_Cell, VCG_Heap, Field_Sym, Dictionary.GetSimpleName (Field_Sym));
         SetRightArgument (Up_Cell, CStacks.Top (VCG_Heap, E_Stack), VCG_Heap);
         CStacks.Pop (VCG_Heap, E_Stack);
         CStacks.Push (VCG_Heap, Up_Cell, E_Stack);

         -- TOS now has an upf_field function that represents the most direct update of the field
         -- for example O[F=>exp] with no inheritance gives: upf_f (o, exp);
         -- if F is inherited one level we get:              upf_f (fld_inherit (o), exp)
         -- and two levels gives:                            upf_f (fld_inherit (fld_inherit (o), exp))
         --
         -- We now need to prefix this expression with some upf_ functions:
         -- First case required no prefix.
         -- Second case wants: "upf_inherit (o, "
         -- Third wants:       "upf_inherit (o, upf_inherit (fld_inherit (o), " etc.

         -- The number of prefixes required depends on ther inheritance depth at this point.
         -- Inner loop puts on the fld_inherits needed.  Loop not entered in no inheritance.
         -- After the inner loop we put on the upf_inherit function needed.

         -- We loop backwards so we can use I to tell us how many inherit derefs we need in an
         -- embedded loop.
         for I in reverse Integer range 1 .. Dictionary.GetInheritDepth (Field_Name, Type_Sym) loop
            -- Make copy of Object_Being_Updated because cell it is in gets changed each time we add inherit de-refs
            Local_Copy_Of_Object_Being_Updated := Original_Object_Being_Updated;
            CreateOpCell (Comma_Cell, VCG_Heap, SP_Symbols.comma);
            SetRightArgument (Comma_Cell, CStacks.Top (VCG_Heap, E_Stack), VCG_Heap);
            -- Insert n-1 inherit dereferences in front of Local_Copy_Of_Object_Being_Updated
            Field_Sym_For_Inherit_Deref_Loop := Type_Sym;
            for J in Integer range 1 .. (I - 1) loop
               Field_Sym_For_Inherit_Deref_Loop :=
                 Dictionary.GetType
                 (Dictionary.CurrentSymbol (Dictionary.FirstRecordComponent (Field_Sym_For_Inherit_Deref_Loop)));
               -- Local_Copy_Of_Object_Being_Updated gets changed by following call
               InsertInheritDeReference (Field_Sym_For_Inherit_Deref_Loop, VCG_Heap, Local_Copy_Of_Object_Being_Updated);

            end loop;
            SetLeftArgument (Comma_Cell, Local_Copy_Of_Object_Being_Updated, VCG_Heap);

            -- Now put upf_inherit on front
            CreateUpfCell
              (Up_Cell,
               VCG_Heap,
               Dictionary.LookupSelectedItem
                 (Field_Sym_For_Inherit_Deref_Loop,
                  LexTokenManager.Inherit_Token,
                  L_Scope,
                  Dictionary.ProofContext),
               LexTokenManager.Inherit_Token);
            SetRightArgument (Up_Cell, Comma_Cell, VCG_Heap);
            CStacks.Pop (VCG_Heap, E_Stack);            -- old expression
            CStacks.Push (VCG_Heap, Up_Cell, E_Stack);  -- expression with one level of prefix
         end loop;
      end if;
   end Up_Process_Store;

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

   procedure Up_Process_Store_List (E_Stack  : in out CStacks.Stack;
                                    VCG_Heap : in out Cells.Heap_Record)
   --# derives E_Stack,
   --#         VCG_Heap from E_Stack,
   --#                       VCG_Heap;
   is
      Expression_Cell : Cells.Cell;
   begin
      --will only be called if array being processed, earlier pruning
      --will stop us getting here for records

      CStacks.PopOff (VCG_Heap, E_Stack, Expression_Cell);
      InsertParameterInNextFreeSlot (CStacks.Top (VCG_Heap, E_Stack), Expression_Cell, VCG_Heap);
   end Up_Process_Store_List;

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

   -- only do this if down, right node is expression.
   procedure Model_Qualified_Expression
     (Node     : in     STree.SyntaxNode;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    E_Stack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      Expression_Cell : Cells.Cell;
   begin
      if STree.Syntax_Node_Type (Node => STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node))) =
        SP_Symbols.annotation_expression then
         -- discard type indication and return its argument to top of stack;
         CStacks.PopOff (VCG_Heap, E_Stack, Expression_Cell);
         -- the topmost stack cell contains the typemark;
         CStacks.Pop (VCG_Heap, E_Stack);
         CStacks.Push (VCG_Heap, Expression_Cell, E_Stack);
      end if;
   end Model_Qualified_Expression;

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

   procedure Up_Process_Aggregate_Choice
     (Node     : in     STree.SyntaxNode;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    E_Stack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      Range_Node_Type  : SP_Symbols.SP_Symbol;
      Range_Expression : Cells.Cell;
   begin
      Range_Node_Type :=
        STree.Syntax_Node_Type (Node => STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node)));
      if Range_Node_Type = SP_Symbols.annotation_simple_expression then
         PushOperator (Binary, SP_Symbols.double_dot, VCG_Heap, E_Stack);
      elsif Range_Node_Type = SP_Symbols.annotation_range_constraint then
         TransformRangeConstraint (VCG_Heap, E_Stack);
         CStacks.PopOff (VCG_Heap, E_Stack, Range_Expression);
         CStacks.Pop (VCG_Heap, E_Stack); -- discard type mark part of range
         CStacks.Push (VCG_Heap, Range_Expression, E_Stack);
      elsif Cells.Get_Kind (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack)) = Cell_Storage.Fixed_Var then
         -- type mark found
         TransformTypeName (VCG_Heap, E_Stack);
      end if;
   end Up_Process_Aggregate_Choice;

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

   procedure Up_Process_Named_Association_Rep
     (Node     : in     STree.SyntaxNode;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     Dictionary.Dict;
   --#        in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      Agg_Exp : Cells.Cell;
   begin
      PushOperator (Binary, SP_Symbols.becomes, VCG_Heap, E_Stack);
      if DoingArrayAggregate (VCG_Heap, E_Stack) then
         if STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => Node)) =
           SP_Symbols.annotation_named_association_rep then
            PushOperator (Binary, SP_Symbols.comma, VCG_Heap, E_Stack);
         end if;
      else -- record
         CStacks.PopOff (VCG_Heap, E_Stack, Agg_Exp);
         InsertAssociation (CStacks.Top (VCG_Heap, E_Stack), Agg_Exp, VCG_Heap);
      end if;
   end Up_Process_Named_Association_Rep;

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

   procedure Up_Process_Named_Record_Component_Association (E_Stack  : in out CStacks.Stack;
                                                            VCG_Heap : in out Cells.Heap_Record)
   --# global in     Dictionary.Dict;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage from *,
   --#                                    E_Stack,
   --#                                    VCG_Heap &
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack;
   is
      Agg_Exp : 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.

      -- associated field name with expression
      PushOperator (Binary, SP_Symbols.becomes, VCG_Heap, E_Stack);
      CStacks.PopOff (VCG_Heap, E_Stack, Agg_Exp);
      InsertAssociation (CStacks.Top (VCG_Heap, E_Stack), Agg_Exp, VCG_Heap);
   end Up_Process_Named_Record_Component_Association;

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

   procedure Up_Process_Positional_Record_Component_Association
     (E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     Dictionary.Dict;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    VCG_Heap;
   is
      Agg_Exp, Type_Cell : 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
      CreateFixedVarCell
        (Type_Cell,
         VCG_Heap,
         Dictionary.GetRecordComponent (AggregateType (VCG_Heap, E_Stack), CurrentFieldOrIndex (VCG_Heap, E_Stack)));
      CStacks.Push (VCG_Heap, Type_Cell, E_Stack);
      SwitchAndPush (SP_Symbols.becomes, VCG_Heap, E_Stack);
      IncCurrentFieldOrIndex (E_Stack, VCG_Heap);
      CStacks.PopOff (VCG_Heap, E_Stack, Agg_Exp);
      InsertAssociation (CStacks.Top (VCG_Heap, E_Stack), Agg_Exp, VCG_Heap);
   end Up_Process_Positional_Record_Component_Association;

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

   procedure Up_Process_Aggregate_Or_Expression
     (Node     : in     STree.SyntaxNode;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     Dictionary.Dict;
   --#        in     STree.Table;
   --#        in out LexTokenManager.State;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         LexTokenManager.State,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    LexTokenManager.State,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      Index_Type                           : Dictionary.Symbol;
      Counter_Cell, Attrib_Cell, Type_Cell : Cells.Cell;
      Counter_String                       : LexTokenManager.Lex_String;
      Agg_Exp                              : Cells.Cell;
   begin
      if STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Node)) =
        SP_Symbols.annotation_positional_association_rep
        or else STree.Next_Sibling (Current_Node => Node) /= STree.NullNode then
         if DoingArrayAggregate (VCG_Heap, E_Stack) then
            CreateCellKind (Type_Cell, VCG_Heap, Cell_Storage.Fixed_Var);
            Index_Type := Dictionary.GetArrayIndex (AggregateType (VCG_Heap, E_Stack), 1);
            Cells.Set_Symbol_Value (VCG_Heap, Type_Cell, Index_Type);
            CStacks.Push (VCG_Heap, Type_Cell, E_Stack);

            CreateAttribValueCell (Attrib_Cell, VCG_Heap, LexTokenManager.First_Token);
            CStacks.Push (VCG_Heap, Attrib_Cell, E_Stack);
            PushOperator (Binary, SP_Symbols.apostrophe, VCG_Heap, E_Stack);

            if Dictionary.TypeIsEnumeration (Index_Type) then
               for I in Integer range 2 .. CurrentFieldOrIndex (VCG_Heap, E_Stack) loop
                  --# accept F, 41, "Stable expression here OK";
                  if Dictionary.TypeIsBoolean (Index_Type) then
                     PushOperator (Unary, SP_Symbols.RWnot, VCG_Heap, E_Stack);
                  else
                     PushFunction (Cell_Storage.Succ_Function, VCG_Heap, E_Stack);
                  end if;
                  --# end accept;
               end loop;
            else -- index type is numeric discrete
               if CurrentFieldOrIndex (VCG_Heap, E_Stack) > 1 then
                  LexTokenManager.Insert_Nat (N       => CurrentFieldOrIndex (VCG_Heap, E_Stack) - 1,
                                              Lex_Str => Counter_String);
                  CreateManifestConstCell (Counter_Cell, VCG_Heap, Counter_String);
                  CStacks.Push (VCG_Heap, Counter_Cell, E_Stack);
                  PushOperator (Binary, SP_Symbols.plus, VCG_Heap, E_Stack);
               end if;
            end if;
            PushFunction (Cell_Storage.List_Function, VCG_Heap, E_Stack);
         else -- record aggregate
            CreateFixedVarCell
              (Type_Cell,
               VCG_Heap,
               Dictionary.GetRecordComponent (AggregateType (VCG_Heap, E_Stack), CurrentFieldOrIndex (VCG_Heap, E_Stack)));
            CStacks.Push (VCG_Heap, Type_Cell, E_Stack);
         end if;

         SwitchAndPush (SP_Symbols.becomes, VCG_Heap, E_Stack);
         IncCurrentFieldOrIndex (E_Stack, VCG_Heap);
         if DoingArrayAggregate (VCG_Heap, E_Stack) then
            if STree.Next_Sibling (Current_Node => Node) = STree.NullNode then
               PushOperator (Binary, SP_Symbols.comma, VCG_Heap, E_Stack);
            end if;
         else -- record
            CStacks.PopOff (VCG_Heap, E_Stack, Agg_Exp);
            InsertAssociation (CStacks.Top (VCG_Heap, E_Stack), Agg_Exp, VCG_Heap);
         end if;
      end if;
   end Up_Process_Aggregate_Or_Expression;

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

   procedure Up_Process_Component_Association
     (Node     : in     STree.SyntaxNode;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    E_Stack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
   begin
      if STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => STree.Child_Node (Current_Node => Node))) /=
        STree.NullNode then
         SwitchAndPush (SP_Symbols.comma, VCG_Heap, E_Stack);
      end if;
   end Up_Process_Component_Association;

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

   procedure Up_Process_Aggregate (E_Stack  : in out CStacks.Stack;
                                   VCG_Heap : in out Cells.Heap_Record)
   --# global in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    E_Stack,
   --#                                    VCG_Heap;
   is
      Agg_Cell : Cells.Cell;
   begin
      -- 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 (VCG_Heap, E_Stack, Agg_Cell);  -- hold the aggregate expression or list
      if Cells.Get_Kind (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack)) = Cell_Storage.Aggregate_Counter then
         -- we are doing a record and just need to get rid of the counter
         CStacks.Pop (VCG_Heap, E_Stack); -- get rid of counter
      else
         -- we are doing an array and TOS is the IncompleteArray function which needs to be connected to
         -- the comma-delimited list
         SetRightArgument (CStacks.Top (VCG_Heap, E_Stack), Agg_Cell, VCG_Heap);
         -- hold the now complete aggregate expression and then get rid of the exposed counter
         CStacks.PopOff (VCG_Heap, E_Stack, Agg_Cell);
         CStacks.Pop (VCG_Heap, E_Stack);
      end if;
      -- Convert aggregate to a finished MkAggregate function
      Cells.Set_Kind (VCG_Heap, Agg_Cell, Cell_Storage.Mk_Aggregate);
      -- Finally, restore aggregate DAG to TOS
      CStacks.Push (VCG_Heap, Agg_Cell, E_Stack);
   end Up_Process_Aggregate;

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

   procedure Down_Process_Attribute_Ident
     (Node     : in     STree.SyntaxNode;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    E_Stack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      DAG_Cell : Cells.Cell;
   begin
      CreateAttribValueCell (DAG_Cell, VCG_Heap, STree.Node_Lex_String (Node => Node));
      CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);
      PushOperator (Binary, SP_Symbols.apostrophe, VCG_Heap, E_Stack);
   end Down_Process_Attribute_Ident;

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

   procedure Up_Process_Attribute_Designator
     (Node     : in     STree.SyntaxNode;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     Dictionary.Dict;
   --#        in     STree.Table;
   --#        in out LexTokenManager.State;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         LexTokenManager.State,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    LexTokenManager.State,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is

      Expression_Found, Base_Found                                                 : Boolean;
      Temp_Cell, Prefix_Cell, Attrib_Cell, Expression_Cell, Second_Expression_Cell : Cells.Cell;
      Lex_Str, Attrib_Name                                                         : LexTokenManager.Lex_String;
      Prefix_Type                                                                  : Dictionary.Symbol;
      Expression_Node                                                              : STree.SyntaxNode;

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

      procedure Eliminate_Base (Prefix_Cell, TOS : in     Cells.Cell;
                                VCG_Heap         : in out Cells.Heap_Record)
      --# derives VCG_Heap from *,
      --#                       Prefix_Cell,
      --#                       TOS;
      is
         Base_Cell : Cells.Cell;
      begin
         Base_Cell := LeftPtr (VCG_Heap, TOS);
         if Cells.Get_Kind (VCG_Heap, Base_Cell) = Cell_Storage.Op then
            -- 'Base exists
            Cells.Dispose_Of_Cell (VCG_Heap, RightPtr (VCG_Heap, Base_Cell));
            Cells.Dispose_Of_Cell (VCG_Heap, Base_Cell);
            SetLeftArgument (TOS, Prefix_Cell, VCG_Heap);
         end if;
      end Eliminate_Base;

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

      procedure Model_Simple_Function_Attribute
        (Expression_Cell, Attrib_Cell, Prefix_Cell : in     Cells.Cell;
         Strip_To_Root_Type                        : in     Boolean;
         E_Stack                                   : in     CStacks.Stack;
         VCG_Heap                                  : in out Cells.Heap_Record)
      --# global in Dictionary.Dict;
      --# derives VCG_Heap from *,
      --#                       Attrib_Cell,
      --#                       Dictionary.Dict,
      --#                       Expression_Cell,
      --#                       E_Stack,
      --#                       Prefix_Cell,
      --#                       Strip_To_Root_Type;
      is
      begin
         Eliminate_Base (Prefix_Cell => Prefix_Cell,
                         TOS         => CStacks.Top (VCG_Heap, E_Stack),
                         VCG_Heap    => VCG_Heap);

         -- Most attributes are modelled in FDL by reference to the
         -- underlying root type.  Most notably, 'Valid is always
         -- in terms of the indicated sub-type (see LRM 13.9.1(2)) so we need
         -- the option here to use the Root Type or not.
         if Strip_To_Root_Type then
            Cells.Set_Symbol_Value
              (VCG_Heap,
               Prefix_Cell,
               Dictionary.GetRootType (Cells.Get_Symbol_Value (VCG_Heap, Prefix_Cell)));
         end if;

         Cells.Set_Kind (VCG_Heap, Attrib_Cell, Cell_Storage.Attrib_Function);
         SetRightArgument (Attrib_Cell, Expression_Cell, VCG_Heap);
      end Model_Simple_Function_Attribute;

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

      procedure Model_Min_Max
        (Expression_Cell, Second_Expression_Cell, Attrib_Cell, Prefix_Cell : in     Cells.Cell;
         E_Stack                                                           : in     CStacks.Stack;
         VCG_Heap                                                          : in out Cells.Heap_Record)
      --# global in     Dictionary.Dict;
      --#        in out Statistics.TableUsage;
      --# derives Statistics.TableUsage from *,
      --#                                    VCG_Heap &
      --#         VCG_Heap              from *,
      --#                                    Attrib_Cell,
      --#                                    Dictionary.Dict,
      --#                                    Expression_Cell,
      --#                                    E_Stack,
      --#                                    Prefix_Cell,
      --#                                    Second_Expression_Cell;
      is
         Comma_Cell : Cells.Cell;
      begin
         CreateOpCell (Comma_Cell, VCG_Heap, SP_Symbols.comma);
         Eliminate_Base (Prefix_Cell => Prefix_Cell,
                         TOS         => CStacks.Top (VCG_Heap, E_Stack),
                         VCG_Heap    => VCG_Heap);
         Cells.Set_Symbol_Value (VCG_Heap, Prefix_Cell, Dictionary.GetRootType (Cells.Get_Symbol_Value (VCG_Heap, Prefix_Cell)));
         Cells.Set_Kind (VCG_Heap, Attrib_Cell, Cell_Storage.Attrib_Function);
         SetLeftArgument (Comma_Cell, Expression_Cell, VCG_Heap);
         SetRightArgument (Comma_Cell, Second_Expression_Cell, VCG_Heap);
         SetRightArgument (Attrib_Cell, Comma_Cell, VCG_Heap);
      end Model_Min_Max;

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

      procedure Model_Length_Attribute (E_Stack  : in out CStacks.Stack;
                                        VCG_Heap : in out Cells.Heap_Record)
      --# global in     Dictionary.Dict;
      --#        in out LexTokenManager.State;
      --#        in out Statistics.TableUsage;
      --# derives E_Stack,
      --#         Statistics.TableUsage,
      --#         VCG_Heap              from *,
      --#                                    Dictionary.Dict,
      --#                                    E_Stack,
      --#                                    LexTokenManager.State,
      --#                                    VCG_Heap &
      --#         LexTokenManager.State from *;
      is
         One_Cell, High_End_Cell, Low_End_Cell, Pos_Cell : Cells.Cell;
         Type_Sym                                        : Dictionary.Symbol;
         Lex_Str                                         : LexTokenManager.Lex_String;
      begin
         CStacks.PopOff (VCG_Heap, E_Stack, High_End_Cell);
         Structures.CopyStructure (VCG_Heap, High_End_Cell, Low_End_Cell);
         Cells.Set_Lex_Str (VCG_Heap, RightPtr (VCG_Heap, High_End_Cell), LexTokenManager.Last_Token);
         Cells.Set_Lex_Str (VCG_Heap, RightPtr (VCG_Heap, Low_End_Cell), LexTokenManager.First_Token);
         Type_Sym := Cells.Get_Symbol_Value (VCG_Heap, LeftPtr (VCG_Heap, High_End_Cell));
         if Dictionary.IsTypeMark (Type_Sym) and then Dictionary.TypeIsEnumeration (Type_Sym) then
            CreateAttribFunctionCell (LexTokenManager.Pos_Token, Type_Sym, VCG_Heap, Pos_Cell);
            SetRightArgument (RightPtr (VCG_Heap, Pos_Cell), High_End_Cell, VCG_Heap);
            High_End_Cell := Pos_Cell;
            CreateAttribFunctionCell (LexTokenManager.Pos_Token, Type_Sym, VCG_Heap, Pos_Cell);
            SetRightArgument (RightPtr (VCG_Heap, Pos_Cell), Low_End_Cell, VCG_Heap);
            Low_End_Cell := Pos_Cell;
         end if;
         CStacks.Push (VCG_Heap, High_End_Cell, E_Stack);
         CStacks.Push (VCG_Heap, Low_End_Cell, E_Stack);
         PushOperator (Binary, SP_Symbols.minus, VCG_Heap, E_Stack);
         LexTokenManager.Insert_Nat (N       => 1,
                                     Lex_Str => Lex_Str);
         CreateManifestConstCell (One_Cell, VCG_Heap, Lex_Str);
         CStacks.Push (VCG_Heap, One_Cell, E_Stack);
         PushOperator (Binary, SP_Symbols.plus, VCG_Heap, E_Stack);
      end Model_Length_Attribute;

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

      procedure Model_Tail_Function_Attribute
        (Expression_Cell, Attrib_Cell : in     Cells.Cell;
         VCG_Heap                     : in out Cells.Heap_Record)
      --# derives VCG_Heap from *,
      --#                       Attrib_Cell,
      --#                       Expression_Cell;
      is
      begin
         Cells.Set_Kind (VCG_Heap, Attrib_Cell, Cell_Storage.Attrib_Function);
         SetRightArgument (Attrib_Cell, Expression_Cell, VCG_Heap);
      end Model_Tail_Function_Attribute;

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

      procedure Model_Append_Function_Attribute
        (Expression_Cell, Second_Expression_Cell, Attrib_Cell : in     Cells.Cell;
         VCG_Heap                                             : in out Cells.Heap_Record)
      --# global in out Statistics.TableUsage;
      --# derives Statistics.TableUsage from *,
      --#                                    VCG_Heap &
      --#         VCG_Heap              from *,
      --#                                    Attrib_Cell,
      --#                                    Expression_Cell,
      --#                                    Second_Expression_Cell;
      is
         Comma_Cell : Cells.Cell;
      begin
         CreateOpCell (Comma_Cell, VCG_Heap, SP_Symbols.comma);
         Cells.Set_Kind (VCG_Heap, Attrib_Cell, Cell_Storage.Attrib_Function);
         SetLeftArgument (Comma_Cell, Expression_Cell, VCG_Heap);
         SetRightArgument (Comma_Cell, Second_Expression_Cell, VCG_Heap);
         SetRightArgument (Attrib_Cell, Comma_Cell, VCG_Heap);
      end Model_Append_Function_Attribute;

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

      procedure Model_Mod_Function_Attribute
        (Expression_Cell, Prefix_Cell : in     Cells.Cell;
         Type_Sym                     : in     Dictionary.Symbol;
         E_Stack                      : in out CStacks.Stack;
         VCG_Heap                     : in out Cells.Heap_Record)
      --# global in     Dictionary.Dict;
      --#        in out Statistics.TableUsage;
      --# derives E_Stack,
      --#         Statistics.TableUsage,
      --#         VCG_Heap              from *,
      --#                                    Dictionary.Dict,
      --#                                    Expression_Cell,
      --#                                    E_Stack,
      --#                                    Prefix_Cell,
      --#                                    Type_Sym,
      --#                                    VCG_Heap;
      is
         Type_Cell, Attrib_Value_Cell, Mod_Op_Cell, Tick_Cell, Temp_Cell : Cells.Cell;
      begin
         Eliminate_Base (Prefix_Cell => Prefix_Cell,
                         TOS         => CStacks.Top (VCG_Heap, E_Stack),
                         VCG_Heap    => VCG_Heap);

         -- Create the DAG for the the functional attribute.
         -- The root of the DAG is "Mod", the left child
         -- is the attribute's argument and the right child is the
         -- DAG representing T'modulus.

         -- Root "Mod" cell.
         CreateOpCell (Mod_Op_Cell, VCG_Heap, SP_Symbols.RWmod);

         -- Left child
         SetLeftArgument (Mod_Op_Cell, Expression_Cell, VCG_Heap);

         -- Right child which represents T'Modulus.
         CreateOpCell (Tick_Cell, VCG_Heap, SP_Symbols.apostrophe);
         SetRightArgument (Mod_Op_Cell, Tick_Cell, VCG_Heap);

         CreateFixedVarCell (Type_Cell, VCG_Heap, Dictionary.GetRootType (Type_Sym));
         SetLeftArgument (Tick_Cell, Type_Cell, VCG_Heap);

         CreateAttribValueCell (Attrib_Value_Cell, VCG_Heap, LexTokenManager.Modulus_Token);
         SetRightArgument (Tick_Cell, Attrib_Value_Cell, VCG_Heap);

         -- Update the E_Stack after processing the attribute.
         CStacks.PopOff (VCG_Heap, E_Stack, Temp_Cell);
         Cells.Dispose_Of_Cell (VCG_Heap, LeftPtr (VCG_Heap, Temp_Cell));
         Cells.Dispose_Of_Cell (VCG_Heap, RightPtr (VCG_Heap, Temp_Cell));
         Cells.Dispose_Of_Cell (VCG_Heap, Temp_Cell);
         CStacks.Push (VCG_Heap, Mod_Op_Cell, E_Stack);
      end Model_Mod_Function_Attribute;

   begin -- Up_Process_Attribute_Designator

      -- If there are any expression associated with the attribute they will be TOS
      -- Below it (or TOS if there is no expression) is a DAG representing the attribute

      -- move to where first expression would be if there is one
      Expression_Node :=
        STree.Child_Node (Current_Node => STree.Last_Sibling_Of (Start_Node => STree.Child_Node (Current_Node => Node)));

      --# assert True;
      -- check for second expression
      if Expression_Node /= STree.NullNode and then STree.Next_Sibling (Current_Node => Expression_Node) /= STree.NullNode then
         -- There is a 2nd expression associated with attribute
         CStacks.PopOff (VCG_Heap, E_Stack, Second_Expression_Cell);
      else
         Second_Expression_Cell := Cells.Null_Cell;
      end if;

      --# assert True;
      -- then check for first expression
      if Expression_Node /= STree.NullNode then
         -- There is a 1st expression associated with attribute
         CStacks.PopOff (VCG_Heap, E_Stack, Expression_Cell);
         Expression_Found := True;
      else
         Expression_Cell  := Cells.Null_Cell;
         Expression_Found := False;
      end if;

      --# assert True;
      Prefix_Cell := LeftPtr (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack));
      if Cells.Get_Kind (VCG_Heap, Prefix_Cell) = Cell_Storage.Op then  --must be a 'BASE
         Prefix_Cell := LeftPtr (VCG_Heap, Prefix_Cell);
         Base_Found  := True;
      else
         Base_Found := False;
      end if;

      -- If no expression forms part of the attribute we
      -- now need to make a copy of the prefix for possible use in modelling 'valid.
      -- This is because fdl model of valid takes an argument which is created from the
      -- prefix to the attribute.  By the time we know we are modelling 'valid this prefix
      -- subtree may have been patched with type information extracted from the syntax tree
      --# assert True;
      if not Expression_Found then
         Structures.CopyStructure (VCG_Heap, Prefix_Cell,
                                   -- to get
                                   Expression_Cell);
      end if;

      Attrib_Cell := RightPtr (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack));
      Attrib_Name := Cells.Get_Lex_Str (VCG_Heap, Attrib_Cell);

      -- Recover type planted in syntax tree by wellformation checker.
      -- For all cases except attributes of unconstrained objects, this will be type mark.
      -- For attributes of constrained array objects the wffs will haev resolved all such
      -- things as dimesnion number arguments and will have planted the appropriate type.
      -- For unconstraiend objects only, the wffs will plant a symbol of a special kind
      -- (ParameterConstraintSymbol) associated with the object.  This special symbol kind
      -- behaves for all practical purposes like a type except that we typically don't
      -- know its bounds.

      Prefix_Type := STree.NodeSymbol (Node);
      Cells.Set_Kind (VCG_Heap, Prefix_Cell, Cell_Storage.Fixed_Var);

      -- Note that we only do this if the attribute is not a proof attribute (e.g. 'Tail or 'Append)
      -- because if it is then we want the prefix to be the object not its type.  In this case
      -- we just want to convert the prefix to a fixed var cell

      --# assert True;
      if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                              Lex_Str2 => LexTokenManager.Tail_Token) /=
        LexTokenManager.Str_Eq
        and then LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Attrib_Name,
         Lex_Str2 => LexTokenManager.Append_Token) /=
        LexTokenManager.Str_Eq then
         -- transform prefix cell to be cell just containing the prefix type
         Cells.Set_Symbol_Value (VCG_Heap, Prefix_Cell, Prefix_Type);
      end if;

      -- If prefix is unconstrained object then make cell an UnconstrainedAttributePrefix to allow special
      -- formal-to-actual substitution in procedure and function call pre con and proc call post con checks
      if Dictionary.IsParameterConstraint (Prefix_Type) then
         Cells.Set_Kind (VCG_Heap, Prefix_Cell, Cell_Storage.Unconstrained_Attribute_Prefix);
      end if;

      -- make leaf
      SetLeftArgument (Prefix_Cell, Cells.Null_Cell, VCG_Heap);
      SetRightArgument (Prefix_Cell, Cells.Null_Cell, VCG_Heap);
      SetAuxPtr (Prefix_Cell, Cells.Null_Cell, VCG_Heap);

      --# assert True;
      if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                              Lex_Str2 => LexTokenManager.Pos_Token) =
        LexTokenManager.Str_Eq
        or else LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Attrib_Name,
         Lex_Str2 => LexTokenManager.Val_Token) =
        LexTokenManager.Str_Eq then
         if Dictionary.TypeIsEnumeration (Prefix_Type) and then not Dictionary.TypeIsCharacter (Prefix_Type) then

            -- Enumeration type but NOT character - model as an FDL
            -- function.
            Model_Simple_Function_Attribute
              (Expression_Cell    => Expression_Cell,
               Attrib_Cell        => Attrib_Cell,
               Prefix_Cell        => Prefix_Cell,
               Strip_To_Root_Type => True,
               E_Stack            => E_Stack,
               VCG_Heap           => VCG_Heap);
         else
            -- must be discrete numeric type or character so simply discard attribute,
            -- since for all integer (signed or modular) and Character types X (or subtypes
            -- thereof...), X'Pos (Y) = X'Val (Y) = Y
            Eliminate_Base (Prefix_Cell => Prefix_Cell,
                            TOS         => CStacks.Top (VCG_Heap, E_Stack),
                            VCG_Heap    => VCG_Heap);
            CStacks.PopOff (VCG_Heap, E_Stack, Temp_Cell);
            Cells.Dispose_Of_Cell (VCG_Heap, LeftPtr (VCG_Heap, Temp_Cell));
            Cells.Dispose_Of_Cell (VCG_Heap, RightPtr (VCG_Heap, Temp_Cell));
            Cells.Dispose_Of_Cell (VCG_Heap, Temp_Cell);
            CStacks.Push (VCG_Heap, Expression_Cell, E_Stack);
         end if;
      elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                                 Lex_Str2 => LexTokenManager.Pred_Token) =
        LexTokenManager.Str_Eq
        or else LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Attrib_Name,
         Lex_Str2 => LexTokenManager.Succ_Token) =
        LexTokenManager.Str_Eq then
         Eliminate_Base (Prefix_Cell => Prefix_Cell,
                         TOS         => CStacks.Top (VCG_Heap, E_Stack),
                         VCG_Heap    => VCG_Heap);
         CStacks.PopOff (VCG_Heap, E_Stack, Temp_Cell);
         Cells.Dispose_Of_Cell (VCG_Heap, LeftPtr (VCG_Heap, Temp_Cell));
         Cells.Dispose_Of_Cell (VCG_Heap, RightPtr (VCG_Heap, Temp_Cell));
         Cells.Dispose_Of_Cell (VCG_Heap, Temp_Cell);
         CStacks.Push (VCG_Heap, Expression_Cell, E_Stack);

         if Dictionary.TypeIsEnumeration (Prefix_Type) then
            if LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Attrib_Name,
               Lex_Str2 => LexTokenManager.Succ_Token) =
              LexTokenManager.Str_Eq then
               PushFunction (Cell_Storage.Succ_Function, VCG_Heap, E_Stack);
            else
               PushFunction (Cell_Storage.Pred_Function, VCG_Heap, E_Stack);
            end if;
         else -- must be discrete numeric type so use + or - instead
            LexTokenManager.Insert_Nat (N       => 1,
                                        Lex_Str => Lex_Str);
            CreateManifestConstCell (Temp_Cell, VCG_Heap, Lex_Str);
            CStacks.Push (VCG_Heap, Temp_Cell, E_Stack);
            if LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Attrib_Name,
               Lex_Str2 => LexTokenManager.Succ_Token) =
              LexTokenManager.Str_Eq then
               PushOperator (Binary, SP_Symbols.plus, VCG_Heap, E_Stack);
            else
               PushOperator (Binary, SP_Symbols.minus, VCG_Heap, E_Stack);
            end if;
            ModularizeIfNeeded (Prefix_Type, VCG_Heap, E_Stack);
         end if;

      elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                                 Lex_Str2 => LexTokenManager.First_Token) =
        LexTokenManager.Str_Eq
        or else LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Attrib_Name,
         Lex_Str2 => LexTokenManager.Last_Token) =
        LexTokenManager.Str_Eq then
         if Base_Found and then Dictionary.TypeIsEnumeration (Prefix_Type) then
            Cells.Set_Symbol_Value (VCG_Heap, Prefix_Cell, Dictionary.GetRootType (Prefix_Type));
            Eliminate_Base (Prefix_Cell => Prefix_Cell,
                            TOS         => CStacks.Top (VCG_Heap, E_Stack),
                            VCG_Heap    => VCG_Heap);
         end if;

      elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                                 Lex_Str2 => LexTokenManager.Range_Token) =
        LexTokenManager.Str_Eq then
         TransformRangeConstraint (VCG_Heap, E_Stack);

      elsif LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Attrib_Name,
         Lex_Str2 => LexTokenManager.Length_Token) =
        LexTokenManager.Str_Eq then
         Model_Length_Attribute (E_Stack  => E_Stack,
                                 VCG_Heap => VCG_Heap);

      elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                                 Lex_Str2 => LexTokenManager.Max_Token) =
        LexTokenManager.Str_Eq
        or else -- 830
        LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                             Lex_Str2 => LexTokenManager.Min_Token) =
        LexTokenManager.Str_Eq then
         Model_Min_Max
           (Expression_Cell        => Expression_Cell,
            Second_Expression_Cell => Second_Expression_Cell,
            Attrib_Cell            => Attrib_Cell,
            Prefix_Cell            => Prefix_Cell,
            E_Stack                => E_Stack,
            VCG_Heap               => VCG_Heap);

      elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                                 Lex_Str2 => LexTokenManager.Valid_Token) =
        LexTokenManager.Str_Eq then
         -- using the Expression_Cell which is a copy of the prefix
         -- to the attribute made earlier.
         --
         -- Data validity is defined in terms of the indicated sub-type
         -- (LRM 13.9.1(2)), so we don't strip to the root type in this case
         Model_Simple_Function_Attribute
           (Expression_Cell    => Expression_Cell,
            Attrib_Cell        => Attrib_Cell,
            Prefix_Cell        => Prefix_Cell,
            Strip_To_Root_Type => False,
            E_Stack            => E_Stack,
            VCG_Heap           => VCG_Heap);

      elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                                 Lex_Str2 => LexTokenManager.Floor_Token) =
        LexTokenManager.Str_Eq
        or else LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Attrib_Name,
         Lex_Str2 => LexTokenManager.Ceiling_Token) =
        LexTokenManager.Str_Eq then
         Model_Simple_Function_Attribute
           (Expression_Cell    => Expression_Cell,
            Attrib_Cell        => Attrib_Cell,
            Prefix_Cell        => Prefix_Cell,
            Strip_To_Root_Type => True,
            E_Stack            => E_Stack,
            VCG_Heap           => VCG_Heap);

      elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                                 Lex_Str2 => LexTokenManager.Tail_Token) =
        LexTokenManager.Str_Eq then
         Model_Tail_Function_Attribute (Expression_Cell => Expression_Cell,
                                        Attrib_Cell     => Attrib_Cell,
                                        VCG_Heap        => VCG_Heap);

      elsif LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Attrib_Name,
         Lex_Str2 => LexTokenManager.Append_Token) =
        LexTokenManager.Str_Eq then
         Model_Append_Function_Attribute
           (Expression_Cell        => Expression_Cell,
            Second_Expression_Cell => Second_Expression_Cell,
            Attrib_Cell            => Attrib_Cell,
            VCG_Heap               => VCG_Heap);

      elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                                 Lex_Str2 => LexTokenManager.Mod_Token) =
        LexTokenManager.Str_Eq then
         Model_Mod_Function_Attribute
           (Expression_Cell => Expression_Cell,
            Prefix_Cell     => Prefix_Cell,
            Type_Sym        => Prefix_Type,
            E_Stack         => E_Stack,
            VCG_Heap        => VCG_Heap);

      else -- it's a non-function, non-substitutable attribute
         if Cells.Get_Kind (VCG_Heap, Prefix_Cell) = Cell_Storage.Reference then
            Cells.Set_Kind (VCG_Heap, Prefix_Cell, Cell_Storage.Fixed_Var);
         end if;
      end if;
   end Up_Process_Attribute_Designator;

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

   procedure Replace_With_On_Entry_Variable
     (DAG_Cell   : in     Cells.Cell;
      Var_Sym    : in     Dictionary.Symbol;
      Loop_Stack : in     LoopContext.T;
      VCG_Heap   : in out Cells.Heap_Record)
   --# global in Dictionary.Dict;
   --# derives VCG_Heap from *,
   --#                       DAG_Cell,
   --#                       Dictionary.Dict,
   --#                       Loop_Stack,
   --#                       Var_Sym;
   is
      On_Entry_Variable : Dictionary.Symbol;
      Current_Loop      : Dictionary.Symbol;
   begin
      -- For a variable which appears in a for loop invariant in the form X%, replace X with the
      -- variable set up in BuildGraph as X_on_entry_to_the_loop.

      -- The variable we are seeking may appear in the exit condition of an enclosing for loop so we
      -- need to loop through any enclosing loops
      Current_Loop := LoopContext.CurrentLoopSym (Loop_Stack, VCG_Heap);
      loop
         On_Entry_Variable := Dictionary.GetLoopOnEntryVariable (Var_Sym, Current_Loop);
         -- success exit condition, sought variable is used in loop exit conditon
         exit when not Dictionary.Is_Null_Symbol (On_Entry_Variable);

         -- If we have a null symbol then the variable isn't used in the exit condition of the current loop
         -- so we need to get the enclosing loop and try again
         Current_Loop := LoopContext.EnclosingLoopSym (Loop_Stack, VCG_Heap, Current_Loop);
         -- failure case, we have run out of loops without finding soughtvariable
         if Dictionary.Is_Null_Symbol (Current_Loop) then
            On_Entry_Variable := Dictionary.NullSymbol;
            exit;
         end if;
      end loop;

      -- If % is used on a variable that doesn't appear in any enclosing for loop exit condition then
      -- On_Entry_Variable will be still be a null symbol here.  Ideally we should prevent use of percent in this
      -- situation but the wffs for that would be very hard to write.  As a second best we simply
      -- don't make the substitution in this case.  In effect we say that X% = X is X doesn't appear
      -- in the for loop exit condition.
      if not Dictionary.Is_Null_Symbol (On_Entry_Variable) then
         Cells.Set_Symbol_Value (VCG_Heap, DAG_Cell, On_Entry_Variable);
      end if;
   end Replace_With_On_Entry_Variable;

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

   procedure Process_Identifier
     (L_Scope               : in     Dictionary.Scopes;
      Calling_Scope         : in     Dictionary.Scopes;
      Force_Abstract        : in     Boolean;
      Loop_Stack            : in     LoopContext.T;
      Calling_Function      : in out Cells.Cell;
      Current_Unit          : in out Dictionary.Symbol;
      Implicit_Var          : in out Dictionary.Symbol;
      Current_Instantiation : in out Dictionary.Symbol;
      Called_Functions      : in out Symbol_Set.T;
      Start_Node            : in out STree.SyntaxNode;
      Next_Node             : in out STree.SyntaxNode;
      Last_Node             : in out STree.SyntaxNode;
      E_Stack               : in out CStacks.Stack;
      VCG_Heap              : in out Cells.Heap_Record)
   --# global in     CommandLineData.Content;
   --#        in     Generate_Function_Instantiations;
   --#        in     STree.Table;
   --#        in out Dictionary.Dict;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out VC_Contains_Reals;
   --#        in out VC_Failure;
   --# derives Called_Functions,
   --#         Calling_Function,
   --#         Current_Instantiation,
   --#         Current_Unit,
   --#         Last_Node,
   --#         Next_Node,
   --#         Start_Node            from *,
   --#                                    Called_Functions,
   --#                                    Calling_Scope,
   --#                                    CommandLineData.Content,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    LexTokenManager.State,
   --#                                    L_Scope,
   --#                                    Next_Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap &
   --#         Dictionary.Dict,
   --#         Implicit_Var,
   --#         LexTokenManager.State,
   --#         SPARK_IO.File_Sys,
   --#         VC_Contains_Reals,
   --#         VC_Failure            from *,
   --#                                    Called_Functions,
   --#                                    Calling_Function,
   --#                                    Calling_Scope,
   --#                                    CommandLineData.Content,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    LexTokenManager.State,
   --#                                    L_Scope,
   --#                                    Next_Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap &
   --#         E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Called_Functions,
   --#                                    Calling_Function,
   --#                                    Calling_Scope,
   --#                                    CommandLineData.Content,
   --#                                    Current_Instantiation,
   --#                                    Current_Unit,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    Implicit_Var,
   --#                                    Last_Node,
   --#                                    LexTokenManager.State,
   --#                                    Loop_Stack,
   --#                                    L_Scope,
   --#                                    Next_Node,
   --#                                    Start_Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      Sym               : Dictionary.Symbol;
      Enclosing_Package : Dictionary.Symbol;
      DAG_Cell          : Cells.Cell;

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

      function Get_Enclosing_Package (Scope : Dictionary.Scopes) return Dictionary.Symbol
      --# global in Dictionary.Dict;
      is
         Result          : Dictionary.Symbol;
         Enclosing_Scope : Dictionary.Scopes;
      begin
         Enclosing_Scope := Scope;
         loop
            Enclosing_Scope := Dictionary.GetEnclosingScope (Enclosing_Scope);

            Result := Dictionary.GetRegion (Enclosing_Scope);
            exit when Dictionary.IsPackage (Result);

            -- fail-safe exit if we hit "standard"
            if Dictionary.IsPredefinedScope (Enclosing_Scope) then
               Result := Dictionary.GetRegion (Enclosing_Scope);
               exit;
            end if;

         end loop;
         return Result;
      end Get_Enclosing_Package;

   begin -- Process_Identifier
      Sym :=
        Dictionary.LookupItem
        (Name              => STree.Node_Lex_String (Node => Next_Node),
         Scope             => L_Scope,
         Context           => Dictionary.ProofContext,
         Full_Package_Name => False);

      -- if we are doing an abstract pre/post and we fail to find what we are
      -- expecting at the first attempt we need to re-search in the visible
      -- scope of the package where our subprogram is declared; this is to
      -- pick up abstract own variables that have been refined away
      if Dictionary.Is_Null_Symbol (Sym) and then Force_Abstract then

         Enclosing_Package := Get_Enclosing_Package (Scope => L_Scope);
         if Dictionary.IsPackage (Enclosing_Package) then
            Sym :=
              Dictionary.LookupItem
              (Name              => STree.Node_Lex_String (Node => Next_Node),
               Scope             => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                               The_Unit       => Enclosing_Package),
               Context           => Dictionary.ProofContext,
               Full_Package_Name => False);
         end if;
      end if;

      -- 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 (Next_Node);
      end if;

      SystemErrors.RT_Assert
        (C       => not Dictionary.Is_Null_Symbol (Sym),
         Sys_Err => SystemErrors.Invalid_Symbol_Table,
         Msg     => "DAG.Build_Annotation_Expression.Process_Identifier : Program Error");

      Cells.Create_Cell (VCG_Heap, DAG_Cell);
      if Dictionary.Is_Variable (Sym) then
         Cells.Set_Kind (VCG_Heap, DAG_Cell, Cell_Storage.Reference);
         Cells.Set_Symbol_Value (VCG_Heap, DAG_Cell, Sym);
         if STree.IdentifierHasTildeSuffix (Next_Node) then
            SetTilde (DAG_Cell, VCG_Heap);
         elsif STree.IdentifierHasPercentSuffix (Next_Node) then
            Replace_With_On_Entry_Variable (DAG_Cell   => DAG_Cell,
                                            Var_Sym    => Sym,
                                            Loop_Stack => Loop_Stack,
                                            VCG_Heap   => VCG_Heap);
         end if;
         CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);
      elsif Dictionary.IsFunction (Sym) then
         -- The down loop is exited following processing of an identifier
         -- which is aa function call so set the Next_Node to null and
         -- the direction as Up_Loop.
         Next_Node := STree.NullNode;
         Cells.Set_Kind (VCG_Heap, DAG_Cell, Cell_Storage.Pending_Function);
         Cells.Set_Symbol_Value (VCG_Heap, DAG_Cell, Sym);
         CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);
         Setup_Function_Call
           (Direction             => Up_Loop,
            Called_Functions      => Called_Functions,
            Current_Unit          => Current_Unit,
            Implicit_Var          => Implicit_Var,
            Current_Instantiation => Current_Instantiation,
            Start_Node            => Start_Node,
            Next_Node             => Next_Node,
            Last_Node             => Last_Node,
            Scope                 => L_Scope,
            Calling_Scope         => Calling_Scope,
            Calling_Function      => Calling_Function,
            Force_Abstract        => Force_Abstract,
            E_Stack               => E_Stack,
            VCG_Heap              => VCG_Heap);
      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 (VCG_Heap, DAG_Cell, Cell_Storage.Fixed_Var);
         Cells.Set_Symbol_Value (VCG_Heap, DAG_Cell, Sym);
         CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);
      else
         Cells.Set_Kind (VCG_Heap, DAG_Cell, Cell_Storage.Named_Const);
         Cells.Set_Symbol_Value (VCG_Heap, DAG_Cell, Sym);
         CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);
      end if;
   end Process_Identifier;

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

   procedure Process_Selected_Component
     (Direction             : in     Loop_Direction;
      L_Scope               : in     Dictionary.Scopes;
      Calling_Scope         : in     Dictionary.Scopes;
      Force_Abstract        : in     Boolean;
      Loop_Stack            : in     LoopContext.T;
      Calling_Function      : in out Cells.Cell;
      Current_Unit          : in out Dictionary.Symbol;
      Implicit_Var          : in out Dictionary.Symbol;
      Current_Instantiation : in out Dictionary.Symbol;
      Called_Functions      : in out Symbol_Set.T;
      Start_Node            : in out STree.SyntaxNode;
      Next_Node             : in out STree.SyntaxNode;
      Last_Node             : in out STree.SyntaxNode;
      E_Stack               : in out CStacks.Stack;
      VCG_Heap              : in out Cells.Heap_Record)
   --# global in     CommandLineData.Content;
   --#        in     Generate_Function_Instantiations;
   --#        in     STree.Table;
   --#        in out Dictionary.Dict;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out VC_Contains_Reals;
   --#        in out VC_Failure;
   --# derives Called_Functions,
   --#         Calling_Function,
   --#         Current_Instantiation,
   --#         Current_Unit,
   --#         Last_Node,
   --#         Next_Node,
   --#         Start_Node            from *,
   --#                                    Called_Functions,
   --#                                    Calling_Scope,
   --#                                    CommandLineData.Content,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    LexTokenManager.State,
   --#                                    L_Scope,
   --#                                    Next_Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap &
   --#         Dictionary.Dict,
   --#         Implicit_Var,
   --#         LexTokenManager.State,
   --#         SPARK_IO.File_Sys,
   --#         VC_Contains_Reals,
   --#         VC_Failure            from *,
   --#                                    Called_Functions,
   --#                                    Calling_Function,
   --#                                    Calling_Scope,
   --#                                    CommandLineData.Content,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    LexTokenManager.State,
   --#                                    L_Scope,
   --#                                    Next_Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap &
   --#         E_Stack,
   --#         Statistics.TableUsage from *,
   --#                                    Called_Functions,
   --#                                    Calling_Function,
   --#                                    Calling_Scope,
   --#                                    CommandLineData.Content,
   --#                                    Current_Instantiation,
   --#                                    Current_Unit,
   --#                                    Dictionary.Dict,
   --#                                    Direction,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    Implicit_Var,
   --#                                    Last_Node,
   --#                                    LexTokenManager.State,
   --#                                    L_Scope,
   --#                                    Next_Node,
   --#                                    Start_Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap &
   --#         VCG_Heap              from *,
   --#                                    Called_Functions,
   --#                                    Calling_Function,
   --#                                    Calling_Scope,
   --#                                    CommandLineData.Content,
   --#                                    Current_Instantiation,
   --#                                    Current_Unit,
   --#                                    Dictionary.Dict,
   --#                                    Direction,
   --#                                    E_Stack,
   --#                                    Force_Abstract,
   --#                                    Generate_Function_Instantiations,
   --#                                    Implicit_Var,
   --#                                    Last_Node,
   --#                                    LexTokenManager.State,
   --#                                    Loop_Stack,
   --#                                    L_Scope,
   --#                                    Next_Node,
   --#                                    Start_Node,
   --#                                    STree.Table;

   is
      DAG_Cell   : Cells.Cell;
      Sym        : Dictionary.Symbol;
      Ident_Node : STree.SyntaxNode;
      Prefix     : Dictionary.Symbol;

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

      procedure Model_Record_Component
        (Record_Type, Sym : in     Dictionary.Symbol;
         E_Stack          : in out CStacks.Stack;
         VCG_Heap         : in out Cells.Heap_Record)
      --# global in     Dictionary.Dict;
      --#        in     LexTokenManager.State;
      --#        in out Statistics.TableUsage;
      --# derives E_Stack,
      --#         Statistics.TableUsage,
      --#         VCG_Heap              from *,
      --#                                    Dictionary.Dict,
      --#                                    E_Stack,
      --#                                    LexTokenManager.State,
      --#                                    Record_Type,
      --#                                    Sym,
      --#                                    VCG_Heap;
      is
         DAG_Cell        : Cells.Cell;
         Expression_Cell : Cells.Cell;
      begin
         CStacks.PopOff (VCG_Heap, E_Stack, Expression_Cell);
         -- Expression_Cell is a DAG representing an expression which is a record field
         -- Insert one or more "fld_inherit (" before the expression
         ModelInheritedFieldsOfTaggedRecord (Dictionary.GetSimpleName (Sym), Record_Type, VCG_Heap, Expression_Cell);
         -- Then prefix it with fld_? (
         CreateCellKind (DAG_Cell, VCG_Heap, Cell_Storage.Field_Access_Function);
         Cells.Set_Symbol_Value (VCG_Heap, DAG_Cell, Sym);
         Cells.Set_Lex_Str (VCG_Heap, DAG_Cell, Dictionary.GetSimpleName (Sym));
         SetRightArgument (DAG_Cell, Expression_Cell, VCG_Heap);
         CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);
      end Model_Record_Component;

   begin -- Process_Selected_Component
      DAG_Cell   := CStacks.Top (VCG_Heap, E_Stack);
      Ident_Node :=
        STree.Child_Node
        (Current_Node => STree.Child_Node
           (Current_Node => STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Next_Node))));
      Prefix     := GetTOStype (VCG_Heap, E_Stack);
      Sym        :=
        Dictionary.LookupSelectedItem (Prefix, STree.Node_Lex_String (Node => Ident_Node), L_Scope, Dictionary.ProofContext);

      -- 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 (Next_Node);
      end if;

      SystemErrors.RT_Assert
        (C       => not Dictionary.Is_Null_Symbol (Sym),
         Sys_Err => SystemErrors.Invalid_Symbol_Table,
         Msg     => "DAG.Build_Annotation_Expression.Process_Selected_Component : Program Error");

      if Dictionary.IsRecordComponent (Sym) then
         Model_Record_Component (Record_Type => Prefix,
                                 Sym         => Sym,
                                 E_Stack     => E_Stack,
                                 VCG_Heap    => VCG_Heap);
      elsif Dictionary.Is_Variable (Sym) then
         Cells.Set_Kind (VCG_Heap, DAG_Cell, Cell_Storage.Reference);
         Cells.Set_Symbol_Value (VCG_Heap, DAG_Cell, Sym);
         if STree.IdentifierHasTildeSuffix (Ident_Node) then
            SetTilde (DAG_Cell, VCG_Heap);
         elsif STree.IdentifierHasPercentSuffix (Ident_Node) then
            Replace_With_On_Entry_Variable (DAG_Cell   => DAG_Cell,
                                            Var_Sym    => Sym,
                                            Loop_Stack => Loop_Stack,
                                            VCG_Heap   => VCG_Heap);
         end if;
      elsif Dictionary.IsFunction (Sym) then
         Cells.Set_Kind (VCG_Heap, DAG_Cell, Cell_Storage.Pending_Function);
         Cells.Set_Symbol_Value (VCG_Heap, DAG_Cell, Sym);
         Setup_Function_Call
           (Direction             => Direction,
            Called_Functions      => Called_Functions,
            Current_Instantiation => Current_Instantiation,
            Current_Unit          => Current_Unit,
            Implicit_Var          => Implicit_Var,
            Start_Node            => Start_Node,
            Next_Node             => Next_Node,
            Last_Node             => Last_Node,
            Scope                 => L_Scope,
            Calling_Scope         => Calling_Scope,
            Calling_Function      => Calling_Function,
            Force_Abstract        => Force_Abstract,
            E_Stack               => E_Stack,
            VCG_Heap              => VCG_Heap);
      elsif Dictionary.IsTypeMark (Sym) then
         Cells.Set_Kind (VCG_Heap, DAG_Cell, Cell_Storage.Fixed_Var);
         Cells.Set_Symbol_Value (VCG_Heap, DAG_Cell, Sym);
      else
         Cells.Set_Kind (VCG_Heap, DAG_Cell, Cell_Storage.Named_Const);
         Cells.Set_Symbol_Value (VCG_Heap, DAG_Cell, Sym);
      end if;
   end Process_Selected_Component;

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

   procedure Process_Expression
     (Node     : in     STree.SyntaxNode;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     Dictionary.Dict;
   --#        in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      Op_Node     : STree.SyntaxNode;
      Operator    : SP_Symbols.SP_Symbol;
      Result_Type : Dictionary.Symbol;

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

      procedure Model_Bitwise_Operation
        (Operator : in     SP_Symbols.SP_Symbol;
         Type_Sym : in     Dictionary.Symbol;
         E_Stack  : in out CStacks.Stack;
         VCG_Heap : in out Cells.Heap_Record)

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

         -- tos now has comma cell joining the two arguments
         SetRightArgument (Bool_Op_Cell, CStacks.Top (VCG_Heap, E_Stack), VCG_Heap);
         CStacks.Pop (VCG_Heap, E_Stack);
         CStacks.Push (VCG_Heap, Bool_Op_Cell, E_Stack);
         -- modelling function is now on TOS
      end Model_Bitwise_Operation;

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

      -- model XOR iaw B manual para 3.1.5
      procedure Model_Xor_Operator (E_Stack  : in out CStacks.Stack;
                                    VCG_Heap : in out Cells.Heap_Record)
      --# global in out Statistics.TableUsage;
      --# derives E_Stack,
      --#         Statistics.TableUsage,
      --#         VCG_Heap              from *,
      --#                                    E_Stack,
      --#                                    VCG_Heap;
      is
         DAG_Cell, Left, Right, Copy_Of_Left, Copy_Of_Right : Cells.Cell;
      begin
         -- Obtain operands and make copies of them so that we can construct a model
         -- that does not make multiple links to the Left and Right cells.  This
         -- change arises from CFR 1154 and affects only annotation expressions since
         -- it is to avoid problems when substituting for tilded globals in postconditions.
         CStacks.PopOff (VCG_Heap, E_Stack, Right);
         Structures.CopyStructure (VCG_Heap, Right, Copy_Of_Right);
         CStacks.PopOff (VCG_Heap, E_Stack, Left);
         Structures.CopyStructure (VCG_Heap, Left, Copy_Of_Left);

         -- model OR part using original arguments
         CreateOpCell (DAG_Cell, VCG_Heap, SP_Symbols.RWor);
         SetRightArgument (DAG_Cell, Right, VCG_Heap);
         SetLeftArgument (DAG_Cell, Left, VCG_Heap);
         CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);

         -- model AND part using copies
         CreateOpCell (DAG_Cell, VCG_Heap, SP_Symbols.RWand);
         SetRightArgument (DAG_Cell, Copy_Of_Right, VCG_Heap);
         SetLeftArgument (DAG_Cell, Copy_Of_Left, VCG_Heap);
         CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);
         -- negate AND part
         PushOperator (Unary, SP_Symbols.RWnot, VCG_Heap, E_Stack);

         -- complete model by conjoining the OR and NOT AND parts
         PushOperator (Binary, SP_Symbols.RWand, VCG_Heap, E_Stack);
      end Model_Xor_Operator;

   begin -- Process_Expression
      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
         Result_Type := STree.NodeSymbol (Op_Node);
         if Dictionary.IsTypeMark (Result_Type) and then Dictionary.TypeIsArray (Result_Type) then
            -- must be a Boolean array operation
            Model_Bitwise_Operation (Operator => Operator,
                                     Type_Sym => Result_Type,
                                     E_Stack  => E_Stack,
                                     VCG_Heap => VCG_Heap);

         elsif IsModularBitwiseOp (Operator, Result_Type) then
            Model_Bitwise_Operation (Operator => Operator,
                                     Type_Sym => Result_Type,
                                     E_Stack  => E_Stack,
                                     VCG_Heap => VCG_Heap);

         else -- proceed as before for scalar bool ops
            if Operator = SP_Symbols.RWxor then
               Model_Xor_Operator (E_Stack  => E_Stack,
                                   VCG_Heap => VCG_Heap);
            else
               PushOperator (Binary, Operator, VCG_Heap, E_Stack);
            end if;
         end if;
      end if;
   end Process_Expression;

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

   procedure Process_Simple_Expression
     (Node     : in     STree.SyntaxNode;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     Dictionary.Dict;
   --#        in     STree.Table;
   --#        in out LexTokenManager.State;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         LexTokenManager.State,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    LexTokenManager.State,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      Op_Node : STree.SyntaxNode;
      Op      : SP_Symbols.SP_Symbol;

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

      procedure Model_Divide (E_Stack  : in out CStacks.Stack;
                              VCG_Heap : in out Cells.Heap_Record)
      --# global in     Dictionary.Dict;
      --#        in     Op_Node;
      --#        in     STree.Table;
      --#        in out Statistics.TableUsage;
      --# derives E_Stack,
      --#         Statistics.TableUsage,
      --#         VCG_Heap              from *,
      --#                                    Dictionary.Dict,
      --#                                    E_Stack,
      --#                                    Op_Node,
      --#                                    STree.Table,
      --#                                    VCG_Heap;
      is
         Op_Cell : Cells.Cell;
      begin
         Cells.Create_Cell (VCG_Heap, Op_Cell);
         if Dictionary.TypeIsReal (STree.NodeSymbol (Op_Node)) then
            Cells.Set_Kind (VCG_Heap, Op_Cell, Cell_Storage.Op);
            Cells.Set_Op_Symbol (VCG_Heap, Op_Cell, SP_Symbols.divide);
         else
            Cells.Set_Kind (VCG_Heap, Op_Cell, Cell_Storage.FDL_Div_Op);
         end if;
         SetRightArgument (Op_Cell, CStacks.Top (VCG_Heap, E_Stack), VCG_Heap);
         CStacks.Pop (VCG_Heap, E_Stack);
         SetLeftArgument (Op_Cell, CStacks.Top (VCG_Heap, E_Stack), VCG_Heap);
         CStacks.Pop (VCG_Heap, E_Stack);
         CStacks.Push (VCG_Heap, Op_Cell, E_Stack);
      end Model_Divide;

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

      procedure Model_Rem (E_Stack  : in out CStacks.Stack;
                           VCG_Heap : in out Cells.Heap_Record)
      --# global in out Statistics.TableUsage;
      --# derives E_Stack,
      --#         Statistics.TableUsage,
      --#         VCG_Heap              from *,
      --#                                    E_Stack,
      --#                                    VCG_Heap;
      is
         DAG_Cell, Left, Right, Copy_Of_Left, Copy_Of_Right : Cells.Cell;
      begin
         -- correct modelling of I rem J as I - (I div J)  * J
         -- J is top of stack and I is 2nd TOS
         CStacks.PopOff (VCG_Heap, E_Stack, Right);
         CStacks.PopOff (VCG_Heap, E_Stack, Left);
         -- Make deep copies of arguments so that we can construct a model with
         -- no sharing of the argument cells.  This change arises from CFR 1154
         -- and affects only annotation expression because of potential problems
         -- substituting tilded globals in post conditions if a cell is revisited.
         Structures.CopyStructure (VCG_Heap, Left, Copy_Of_Left);
         Structures.CopyStructure (VCG_Heap, Right, Copy_Of_Right);

         -- make core DIV sub-model using original arguments
         CreateCellKind (DAG_Cell, VCG_Heap, Cell_Storage.FDL_Div_Op);
         SetRightArgument (DAG_Cell, Right, VCG_Heap);
         SetLeftArgument (DAG_Cell, Left, VCG_Heap);
         CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);

         -- multiply by copy of right rather than re-using rigth
         CreateOpCell (DAG_Cell, VCG_Heap, SP_Symbols.multiply);
         SetRightArgument (DAG_Cell, Copy_Of_Right, VCG_Heap);
         SetLeftArgument (DAG_Cell, CStacks.Top (VCG_Heap, E_Stack), VCG_Heap);
         CStacks.Pop (VCG_Heap, E_Stack);
         CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);

         CreateOpCell (DAG_Cell, VCG_Heap, SP_Symbols.minus);
         SetRightArgument (DAG_Cell, CStacks.Top (VCG_Heap, E_Stack), VCG_Heap);
         CStacks.Pop (VCG_Heap, E_Stack);
         SetLeftArgument (DAG_Cell, Copy_Of_Left, VCG_Heap); -- note use of copy
         CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);
      end Model_Rem;

   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
            Model_Divide (E_Stack  => E_Stack,
                          VCG_Heap => VCG_Heap);
         elsif Op = SP_Symbols.RWrem then
            Model_Rem (E_Stack  => E_Stack,
                       VCG_Heap => VCG_Heap);
         elsif Op = SP_Symbols.ampersand then
            Model_Catenation (E_Stack, VCG_Heap);
         else
            PushOperator (Binary, Op, VCG_Heap, E_Stack);
         end if;
         ModularizeIfNeeded (STree.NodeSymbol (Op_Node), VCG_Heap, E_Stack);
      end if;
   end Process_Simple_Expression;

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

   procedure Process_Simple_Expression_Opt
     (Node     : in     STree.SyntaxNode;
      E_Stack  : in out CStacks.Stack;
      VCG_Heap : in out Cells.Heap_Record)
   --# global in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    E_Stack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      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)), VCG_Heap, E_Stack);
      end if;
   end Process_Simple_Expression_Opt;

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

   procedure Process_Relation (Node     : in     STree.SyntaxNode;
                               E_Stack  : in out CStacks.Stack;
                               VCG_Heap : in out Cells.Heap_Record)
   --# global in     Dictionary.Dict;
   --#        in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      Op_Node : STree.SyntaxNode;

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

      procedure Model_In_Clause
        (Node     : in     STree.SyntaxNode;
         E_Stack  : in out CStacks.Stack;
         VCG_Heap : in out Cells.Heap_Record)
      --# global in     Dictionary.Dict;
      --#        in     STree.Table;
      --#        in out Statistics.TableUsage;
      --# derives E_Stack,
      --#         Statistics.TableUsage,
      --#         VCG_Heap              from *,
      --#                                    Dictionary.Dict,
      --#                                    E_Stack,
      --#                                    Node,
      --#                                    STree.Table,
      --#                                    VCG_Heap;
      is
         Left_Side_Of_Range, Right_Side_Of_Range, Type_Mark_Cell, Attrib_Cell : Cells.Cell;
         Rel_Operation_LHS, Rel_Operation_RHS, Middle_Operator                : SP_Symbols.SP_Symbol;
         In_Operator_Node, Range_Node                                         : STree.SyntaxNode;

         type Static_Results is (Is_True, Is_False, Is_Unknown);
         Static_Result : Static_Results;

         type Membership_Kinds is (Inside, Outside);
         Membership_Kind : Membership_Kinds;

         function Check_If_Result_Statically_Known (In_Operator_Node : STree.SyntaxNode) return Static_Results
         --# global in Dictionary.Dict;
         --#        in STree.Table;
         is
            Static_Result : Static_Results := Is_Unknown;
         begin
            if Dictionary.IsEnumerationLiteral (STree.NodeSymbol (In_Operator_Node)) then
               if Dictionary.Enumeration_Literals_Are_Equal
                 (Left_Symbol  => STree.NodeSymbol (In_Operator_Node),
                  Right_Symbol => Dictionary.GetTrue) then
                  Static_Result := Is_True;
               elsif Dictionary.Enumeration_Literals_Are_Equal
                 (Left_Symbol  => STree.NodeSymbol (In_Operator_Node),
                  Right_Symbol => Dictionary.GetFalse) then
                  Static_Result := Is_False;
               end if;
            end if;
            return Static_Result;
         end Check_If_Result_Statically_Known;

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

         procedure Model_Statically_Known_Result
           (Static_Result : in     Static_Results;
            E_Stack       : in out CStacks.Stack;
            VCG_Heap      : in out Cells.Heap_Record)
         --# global in     Dictionary.Dict;
         --#        in out Statistics.TableUsage;
         --# derives E_Stack               from Dictionary.Dict,
         --#                                    Static_Result,
         --#                                    VCG_Heap &
         --#         Statistics.TableUsage from *,
         --#                                    Dictionary.Dict,
         --#                                    Static_Result,
         --#                                    VCG_Heap &
         --#         VCG_Heap              from *,
         --#                                    Dictionary.Dict,
         --#                                    E_Stack,
         --#                                    Static_Result;
         is
            Static_Result_Cell : Cells.Cell;
         begin
            CreateCellKind (Static_Result_Cell, VCG_Heap, Cell_Storage.Named_Const);
            if Static_Result = Is_True then
               Cells.Set_Symbol_Value (VCG_Heap, Static_Result_Cell, Dictionary.GetTrue);
            else
               Cells.Set_Symbol_Value (VCG_Heap, Static_Result_Cell, Dictionary.GetFalse);
            end if;
            CStacks.Push (VCG_Heap, Static_Result_Cell, E_Stack);
         end Model_Statically_Known_Result;

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

         procedure Complete_Inequality_Model
           (Left_Side_Of_Range, Right_Side_Of_Range : in     Cells.Cell;
            Rel_Operation_LHS, Rel_Operation_RHS    : in     SP_Symbols.SP_Symbol;
            Middle_Operator                         : in     SP_Symbols.SP_Symbol;
            E_Stack                                 : in out CStacks.Stack;
            VCG_Heap                                : in out Cells.Heap_Record)
         --# global in out Statistics.TableUsage;
         --# derives E_Stack,
         --#         Statistics.TableUsage,
         --#         VCG_Heap              from *,
         --#                                    E_Stack,
         --#                                    Left_Side_Of_Range,
         --#                                    Middle_Operator,
         --#                                    Rel_Operation_LHS,
         --#                                    Rel_Operation_RHS,
         --#                                    Right_Side_Of_Range,
         --#                                    VCG_Heap;
         is
            Left_Operand, Copy_Of_Left_Operand : Cells.Cell;
         begin
            CStacks.PopOff (VCG_Heap, E_Stack, Left_Operand);
            -- Make deep copy of left operand so that we can construct the model
            -- without making multiple links to Left_Operand cell.  This change
            -- arises from CFR 1154 and is only needed in annotation expressions
            -- because of potential problems using tilded globals in postconditions
            -- that use IN operators
            Structures.CopyStructure (VCG_Heap, Left_Operand, Copy_Of_Left_Operand);

            -- restore stack, model first inequality
            CStacks.Push (VCG_Heap, Left_Operand, E_Stack);
            CStacks.Push (VCG_Heap, Left_Side_Of_Range, E_Stack);
            PushOperator (Binary, Rel_Operation_LHS, VCG_Heap, E_Stack);

            -- model second inequality using copy of LHS
            CStacks.Push (VCG_Heap, Copy_Of_Left_Operand, E_Stack);
            CStacks.Push (VCG_Heap, Right_Side_Of_Range, E_Stack);
            PushOperator (Binary, Rel_Operation_RHS, VCG_Heap, E_Stack);

            -- form conjunction of the two range constraints;
            PushOperator (Binary, Middle_Operator, VCG_Heap, E_Stack);
         end Complete_Inequality_Model;

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

         function Is_Boolean_Membership (In_Operator_Node : STree.SyntaxNode) return Boolean
         --# global in Dictionary.Dict;
         --#        in STree.Table;
         is
         begin
            return Dictionary.IsType (STree.NodeSymbol (In_Operator_Node))
              and then Dictionary.TypeIsBoolean (STree.NodeSymbol (In_Operator_Node));
         end Is_Boolean_Membership;

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

         procedure Complete_Boolean_Model
           (Left_Side_Of_Range, Right_Side_Of_Range : in     Cells.Cell;
            Membership_Kind                         : in     Membership_Kinds;
            E_Stack                                 : in out CStacks.Stack;
            VCG_Heap                                : in out Cells.Heap_Record)
         --# global in out Statistics.TableUsage;
         --# derives E_Stack,
         --#         Statistics.TableUsage,
         --#         VCG_Heap              from *,
         --#                                    E_Stack,
         --#                                    Left_Side_Of_Range,
         --#                                    Membership_Kind,
         --#                                    Right_Side_Of_Range,
         --#                                    VCG_Heap;
         is
            Left_Operand, Copy_Of_Left_Operand : Cells.Cell;
         begin
            -- 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 (VCG_Heap, E_Stack, Left_Operand);
            -- Make deep copy of left operand so that we can construct the model
            -- without making multiple links to Left_Operand cell.  This change
            -- arises from CFR 1154 and is only needed in annotation expressions
            -- because of potential problems using tilded globals in postconditions
            -- that use IN operators
            Structures.CopyStructure (VCG_Heap, Left_Operand, Copy_Of_Left_Operand);

            -- create not L
            CStacks.Push (VCG_Heap, Left_Side_Of_Range, E_Stack);
            PushOperator (Unary, SP_Symbols.RWnot, VCG_Heap, E_Stack);
            -- create not X (using copy of X)
            CStacks.Push (VCG_Heap, Copy_Of_Left_Operand, E_Stack);
            PushOperator (Unary, SP_Symbols.RWnot, VCG_Heap, E_Stack);
            -- conjoin
            PushOperator (Binary, SP_Symbols.RWand, VCG_Heap, E_Stack);

            -- create X and R
            CStacks.Push (VCG_Heap, Right_Side_Of_Range, E_Stack);
            CStacks.Push (VCG_Heap, Left_Operand, E_Stack);
            PushOperator (Binary, SP_Symbols.RWand, VCG_Heap, E_Stack);

            -- disjoin above two subexpressions
            PushOperator (Binary, SP_Symbols.RWor, VCG_Heap, E_Stack);

            -- finally, if outside rather than inside then invert answer
            if Membership_Kind = Outside then
               PushOperator (Unary, SP_Symbols.RWnot, VCG_Heap, E_Stack);
            end if;
         end Complete_Boolean_Model;

      begin -- Model_In_Clause
         In_Operator_Node := STree.Next_Sibling (Current_Node => Node);
         if STree.Syntax_Node_Type (Node => In_Operator_Node) = SP_Symbols.inside then
            Membership_Kind   := Inside;
            Rel_Operation_LHS := SP_Symbols.greater_or_equal;
            Rel_Operation_RHS := SP_Symbols.less_or_equal;
            Middle_Operator   := SP_Symbols.RWand;
         else
            Membership_Kind   := Outside;
            Rel_Operation_LHS := SP_Symbols.less_than;
            Rel_Operation_RHS := SP_Symbols.greater_than;
            Middle_Operator   := SP_Symbols.RWor;
         end if;

         Range_Node := STree.Next_Sibling (Current_Node => In_Operator_Node);
         if STree.Syntax_Node_Type (Node => Range_Node) = SP_Symbols.annotation_arange then
            -- set is defined by a range, held in stack;
            if STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => Range_Node)) =
              SP_Symbols.annotation_attribute then
               -- range is defined by a range attribute on top of stack
               -- this has already been transformed by UpProcessAttribute
               -- which has left Index'First .. Index'Last on stack
               Left_Side_Of_Range  := LeftPtr (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack));
               Right_Side_Of_Range := RightPtr (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack));
               CStacks.Pop (VCG_Heap, E_Stack);  --discard ..
            else
               -- range is defined by a pair of simple expressions;
               CStacks.PopOff (VCG_Heap, E_Stack, Right_Side_Of_Range);
               CStacks.PopOff (VCG_Heap, E_Stack, Left_Side_Of_Range);
            end if;
            if Is_Boolean_Membership (In_Operator_Node => In_Operator_Node) then
               Complete_Boolean_Model
                 (Left_Side_Of_Range  => Left_Side_Of_Range,
                  Right_Side_Of_Range => Right_Side_Of_Range,
                  Membership_Kind     => Membership_Kind,
                  E_Stack             => E_Stack,
                  VCG_Heap            => VCG_Heap);
            else
               Complete_Inequality_Model
                 (Left_Side_Of_Range  => Left_Side_Of_Range,
                  Right_Side_Of_Range => Right_Side_Of_Range,
                  Rel_Operation_LHS   => Rel_Operation_LHS,
                  Rel_Operation_RHS   => Rel_Operation_RHS,
                  Middle_Operator     => Middle_Operator,
                  E_Stack             => E_Stack,
                  VCG_Heap            => VCG_Heap);
            end if;
         else
            -- range is defined by a typemark on top of stack;
            -- form the right operands from this typemark, using FIRST and LAST;
            Static_Result := Check_If_Result_Statically_Known (In_Operator_Node => In_Operator_Node);
            -- it will be static if type is non-scalar
            CStacks.PopOff (VCG_Heap, E_Stack, Type_Mark_Cell);
            if Static_Result = Is_Unknown then
               CreateCellKind (Attrib_Cell, VCG_Heap, Cell_Storage.Attrib_Value);
               CreateOpCell (Left_Side_Of_Range, VCG_Heap, SP_Symbols.apostrophe);
               SetLeftArgument (Left_Side_Of_Range, Type_Mark_Cell, VCG_Heap);
               SetRightArgument (Left_Side_Of_Range, Attrib_Cell, VCG_Heap);
               Structures.CopyStructure (VCG_Heap, Left_Side_Of_Range, Right_Side_Of_Range);
               Cells.Set_Lex_Str (VCG_Heap, RightPtr (VCG_Heap, Left_Side_Of_Range), LexTokenManager.First_Token);
               Cells.Set_Lex_Str (VCG_Heap, RightPtr (VCG_Heap, Right_Side_Of_Range), LexTokenManager.Last_Token);
               Complete_Inequality_Model
                 (Left_Side_Of_Range  => Left_Side_Of_Range,
                  Right_Side_Of_Range => Right_Side_Of_Range,
                  Rel_Operation_LHS   => Rel_Operation_LHS,
                  Rel_Operation_RHS   => Rel_Operation_RHS,
                  Middle_Operator     => Middle_Operator,
                  E_Stack             => E_Stack,
                  VCG_Heap            => VCG_Heap);
            else
               CStacks.Pop (VCG_Heap, E_Stack);
               Model_Statically_Known_Result (Static_Result => Static_Result,
                                              E_Stack       => E_Stack,
                                              VCG_Heap      => VCG_Heap);
            end if;
         end if;
      end Model_In_Clause;

   begin -- Process_Relation
      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)), VCG_Heap, E_Stack);
         else
            Model_In_Clause (Node     => STree.Child_Node (Current_Node => Node),
                             E_Stack  => E_Stack,
                             VCG_Heap => VCG_Heap);
         end if;
      end if;
   end Process_Relation;

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

   procedure Process_Factor (Node     : in     STree.SyntaxNode;
                             E_Stack  : in out CStacks.Stack;
                             VCG_Heap : in out Cells.Heap_Record)
   --# global in     Dictionary.Dict;
   --#        in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives E_Stack,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      Op_Node      : STree.SyntaxNode;
      Bool_Op_Cell : Cells.Cell;
      Result_Type  : Dictionary.Symbol;

      -- Note, there is a similar version of this
      -- subprogram in BuildExprDAG
      procedure Model_Modular_Not_Operation
        (Result_Type : in     Dictionary.Symbol;
         E_Stack     : in out CStacks.Stack;
         VCG_Heap    : in out Cells.Heap_Record)
      --# global in out Statistics.TableUsage;
      --# derives E_Stack,
      --#         Statistics.TableUsage,
      --#         VCG_Heap              from *,
      --#                                    E_Stack,
      --#                                    Result_Type,
      --#                                    VCG_Heap;
      is
         Minus_Op_Cell, Tick_Cell, Prefix_Cell, Modulus_Cell : 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 (Tick_Cell, VCG_Heap, SP_Symbols.apostrophe);

         -- create Last attribute name
         CreateAttribValueCell (Modulus_Cell, VCG_Heap, LexTokenManager.Last_Token);

         -- Create prefix given by Result_Type
         CreateFixedVarCell (Prefix_Cell, VCG_Heap, Result_Type);

         -- Assemble T'Last
         SetLeftArgument (Tick_Cell, Prefix_Cell, VCG_Heap);
         SetRightArgument (Tick_Cell, Modulus_Cell, VCG_Heap);

         -- create binary "-" operator
         CreateOpCell (Minus_Op_Cell, VCG_Heap, SP_Symbols.minus);

         -- Construct T'Last - X, where X is on the top-of-stack
         SetRightArgument (Minus_Op_Cell, CStacks.Top (VCG_Heap, E_Stack), VCG_Heap);
         SetLeftArgument (Minus_Op_Cell, Tick_Cell, VCG_Heap);
         CStacks.Pop (VCG_Heap, E_Stack);
         CStacks.Push (VCG_Heap, Minus_Op_Cell, E_Stack);
      end Model_Modular_Not_Operation;

   begin -- Process_Factor
      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
         Result_Type := STree.NodeSymbol (Op_Node);

         if Dictionary.IsTypeMark (Result_Type) then

            if Dictionary.TypeIsArray (Result_Type) then
               -- must be a Boolean array "not" operation
               CreateBoolOpCell (Bool_Op_Cell, VCG_Heap, Result_Type, SP_Symbols.RWnot);
               SetRightArgument (Bool_Op_Cell, CStacks.Top (VCG_Heap, E_Stack), VCG_Heap);
               CStacks.Pop (VCG_Heap, E_Stack);
               CStacks.Push (VCG_Heap, Bool_Op_Cell, E_Stack);
            elsif Dictionary.TypeIsModular (Result_Type) then
               -- must be a Modular "not" operation.
               Model_Modular_Not_Operation (Result_Type => Result_Type,
                                            E_Stack     => E_Stack,
                                            VCG_Heap    => VCG_Heap);
            else -- proceed as before for scalar bool ops
               PushOperator (Unary, SP_Symbols.RWnot, VCG_Heap, E_Stack);
            end if;

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

         -- handle abs
      elsif STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.RWabs then
         PushFunction (Cell_Storage.Abs_Function, VCG_Heap, E_Stack);

      else
         Op_Node := STree.Next_Sibling (Current_Node => Op_Node);
         if Op_Node /= STree.NullNode then
            PushOperator (Binary, SP_Symbols.double_star, VCG_Heap, E_Stack);
            ModularizeIfNeeded (STree.NodeSymbol (Op_Node), VCG_Heap, E_Stack);
         end if;
      end if;
   end Process_Factor;

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

   procedure Down_Process_Quantifier
     (Node          : in     STree.SyntaxNode;
      Current_Unit  :    out Dictionary.Symbol;
      E_Stack       : in out CStacks.Stack;
      Function_Defs : in out CStacks.Stack;
      VCG_Heap      : in out Cells.Heap_Record;
      L_Scope       :    out Dictionary.Scopes;
      Next_Node     :    out STree.SyntaxNode)
   --# global in     Dictionary.Dict;
   --#        in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives Current_Unit,
   --#         L_Scope,
   --#         Next_Node             from Node,
   --#                                    STree.Table &
   --#         E_Stack               from Dictionary.Dict,
   --#                                    Function_Defs,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap &
   --#         Function_Defs         from Dictionary.Dict,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap &
   --#         Statistics.TableUsage from *,
   --#                                    Dictionary.Dict,
   --#                                    Function_Defs,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap &
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Function_Defs,
   --#                                    Node,
   --#                                    STree.Table;
   is
      Ident_Node        : STree.SyntaxNode;
      Quantifier_Sym    : Dictionary.Symbol;
      Type_Sym          : Dictionary.Symbol;
      Var_Decl          : Cells.Cell;
      Quantifier_Ident  : Cells.Cell;
      Type_Ident        : Cells.Cell;
      Quantifier_Marker : Cells.Cell;
   begin
      Ident_Node := STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node));

      -- continue tree walk from the range node if present or else the predicate node
      Next_Node := STree.Next_Sibling (Current_Node => STree.Next_Sibling (Current_Node => Ident_Node));

      -- Get the Quantifier symbol planted by wffs and  enter local scope of
      -- quantifier.  Set the Current_Unit to the quantifier symbol.
      Quantifier_Sym := STree.NodeSymbol (Ident_Node);
      L_Scope        := Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                   The_Unit       => Quantifier_Sym);
      Current_Unit   := Quantifier_Sym;

      -- build quantifier and type declaration and stack it.  In FDL we want the base type
      Type_Sym := Dictionary.GetRootType (Dictionary.GetType (Quantifier_Sym));
      CreateFixedVarCell (Type_Ident, VCG_Heap, Type_Sym);
      CreateFixedVarCell (Quantifier_Ident, VCG_Heap, Quantifier_Sym);
      -- create Var_Decl as Quantifier_Ident : Type_Ident
      CreateOpCell (Var_Decl, VCG_Heap, SP_Symbols.colon);
      SetLeftArgument (Var_Decl, Quantifier_Ident, VCG_Heap);
      SetRightArgument (Var_Decl, Type_Ident, VCG_Heap);

      -- Put the marker on the function Def stack to indicate
      -- the end of functions defined within the quantified expression.
      CreateCellKind (CellName   => Quantifier_Marker,
                      VCGHeap    => VCG_Heap,
                      KindOfCell => Cell_Storage.Quantifier);
      CStacks.Push (Heap     => VCG_Heap,
                    CellName => Quantifier_Marker,
                    S        => Function_Defs);

      -- stack for use on the way up
      CStacks.Push (VCG_Heap, Var_Decl, E_Stack);
   end Down_Process_Quantifier;

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

   procedure Up_Process_Quantifier
     (Node          : in     STree.SyntaxNode;
      Current_Unit  :    out Dictionary.Symbol;
      E_Stack       : in out CStacks.Stack;
      Function_Defs : in out CStacks.Stack;
      VCG_Heap      : in out Cells.Heap_Record;
      L_Scope       : in out Dictionary.Scopes)
   --# global in     Dictionary.Dict;
   --#        in     STree.Table;
   --#        in out Statistics.TableUsage;
   --# derives Current_Unit,
   --#         L_Scope               from Dictionary.Dict,
   --#                                    L_Scope &
   --#         E_Stack,
   --#         Function_Defs,
   --#         Statistics.TableUsage,
   --#         VCG_Heap              from *,
   --#                                    Dictionary.Dict,
   --#                                    E_Stack,
   --#                                    Function_Defs,
   --#                                    Node,
   --#                                    STree.Table,
   --#                                    VCG_Heap;
   is
      Range_Found                  : Boolean;
      Range_Node                   : STree.SyntaxNode;
      Quantifier_Kind              : SP_Symbols.SP_Symbol;
      Quantifier_Sym               : Dictionary.Symbol;
      Quantifier_Type              : Dictionary.Symbol;
      Predicate                    : Cells.Cell;
      Declaration                  : Cells.Cell;
      Range_Data                   : Cells.Cell;
      Left_Side_Of_Range           : Cells.Cell;
      Right_Side_Of_Range          : Cells.Cell;
      Left_Op                      : Cells.Cell;
      Right_Op                     : Cells.Cell;
      Quantifier_Ident_Cell        : Cells.Cell;
      Quantified_Expression        : Cells.Cell;
      Quantifier_Function_Defs     : Cells.Cell;
      Function_Defs_Join           : Cells.Cell;
      Comma_Cell                   : Cells.Cell;
      Implies_Cell                 : Cells.Cell;
      Function_Def_Uses_Quantifier : Boolean;
      Function_Defs_Present        : Boolean;
      Temp_Function_Stack          : CStacks.Stack;
   begin
      --  TODO: Init here to shut up the flow analyser. Is this OK?
      Quantifier_Ident_Cell    := Cells.Null_Cell;
      Quantifier_Function_Defs := Cells.Null_Cell;

      Range_Node      :=
        STree.Next_Sibling
        (Current_Node => STree.Next_Sibling (Current_Node => STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node))));
      Range_Found     := STree.Syntax_Node_Type (Node => Range_Node) = SP_Symbols.annotation_arange;
      Quantifier_Kind := STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => Node));

      -- TOS is the DAG representing the predicate
      CStacks.PopOff (VCG_Heap, E_Stack, Predicate);

      -- 2nd TOS is range expression if its there
      if Range_Found then
         -- range is either an attribute or explicit range
         if STree.Syntax_Node_Type (Node => STree.Child_Node (Current_Node => Range_Node)) =
           SP_Symbols.annotation_attribute then
            -- range is defined by a range attribute on top of stack
            -- this has already been transformed by UpProcessAttribute
            -- which has left Index'First .. Index'Last on stack
            Left_Side_Of_Range  := LeftPtr (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack));
            Right_Side_Of_Range := RightPtr (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack));
            CStacks.Pop (VCG_Heap, E_Stack);  -- discard ..
         else
            -- range is defined by a pair of simple expressions;
            CStacks.PopOff (VCG_Heap, E_Stack, Right_Side_Of_Range);
            CStacks.PopOff (VCG_Heap, E_Stack, Left_Side_Of_Range);
         end if;
         -- we now have the bounds of the range which we just need to assemble into a pair
         -- of bounds checks

         -- first get the Declaration data
         CStacks.PopOff (VCG_Heap, E_Stack, Declaration);
         Quantifier_Ident_Cell := LeftPtr (VCG_Heap, Declaration);

         -- create left sub-tree
         CreateOpCell (Left_Op, VCG_Heap, SP_Symbols.greater_or_equal);
         SetLeftArgument (Left_Op, Quantifier_Ident_Cell, VCG_Heap);
         SetRightArgument (Left_Op, Left_Side_Of_Range, VCG_Heap);

         -- create right subtree
         CreateOpCell (Right_Op, VCG_Heap, SP_Symbols.less_or_equal);
         SetLeftArgument (Right_Op, Quantifier_Ident_Cell, VCG_Heap);
         SetRightArgument (Right_Op, Right_Side_Of_Range, VCG_Heap);

         -- and them together to for Range_Data DAG
         CreateOpCell (Range_Data, VCG_Heap, SP_Symbols.RWand);
         SetLeftArgument (Range_Data, Left_Op, VCG_Heap);
         SetRightArgument (Range_Data, Right_Op, VCG_Heap);

      else -- no explicit range
         CStacks.PopOff (VCG_Heap, E_Stack, Declaration);
         -- create a range DAG here
         -- Declaration is the colon in "ident : type"
         Quantifier_Sym  := Cells.Get_Symbol_Value (VCG_Heap, LeftPtr (VCG_Heap, Declaration));
         Quantifier_Type := Dictionary.GetType (Quantifier_Sym);

         -- For Boolean, we _mustn't_ try to create a range constraint, since Boolean
         -- isn't ordered in FDL.  Sem-compunit-wf_arange forbids the use
         -- of explicit ranges with Boolean, so the only possibility here is full-range
         -- Boolean.
         --
         -- We can't emit (Sym >= False and Sym <= True), for the reason stated above.
         -- We really know that (Sym or not Sym), but that's just "True"!
         if Dictionary.TypeIsBoolean (Quantifier_Type) then
            CreateTrueCell (VCG_Heap, Range_Data);
         else
            Type_Constraint.Process_Discrete
              (The_Type       => Quantifier_Type,
               The_Expression => LeftPtr (VCG_Heap, Declaration),
               The_Constraint => Range_Data,
               VCG_Heap       => VCG_Heap);
         end if;
      end if;

      -- Check whether any functions have been defined from called
      -- functions within the quantified expression.  If there are none the
      -- TOS will be a quantifer marker placed on the stack by
      -- Down_Process_Quantifier
      if Cells.Get_Kind (Heap     => VCG_Heap,
                         CellName => CStacks.Top (VCG_Heap, Function_Defs)) /= Cell_Storage.Quantifier then
         CStacks.CreateStack (Temp_Function_Stack);
         -- Transfer all function defs down to the quantifier marker to the
         -- temoprary stack
         loop
            CStacks.Push (Heap     => VCG_Heap,
                          CellName => CStacks.Top (VCG_Heap, Function_Defs),
                          S        => Temp_Function_Stack);
            CStacks.Pop (VCG_Heap, Function_Defs);
            exit when Cells.Get_Kind (Heap     => VCG_Heap,
                                      CellName => CStacks.Top (VCG_Heap, Function_Defs)) =
              Cell_Storage.Quantifier;
         end loop;
         -- remove the quantifer marker from the function stack
         CStacks.Pop (VCG_Heap, Function_Defs);

         -- The function defs which do not use the current quantified variable
         -- should be pushed back on to the Function_Defs stack.
         -- The functions which do use the quantified variable must be placed
         -- within the quantified expression and conjoined within
         -- Quantifier_Function_Defs
         Function_Defs_Present := False;
         while not (CStacks.IsEmpty (Temp_Function_Stack) or Function_Defs_Present) loop
            ContainsQuantIdent
              (DataElem   => CStacks.Top (VCG_Heap, Temp_Function_Stack),
               QuantIdent => Quantifier_Ident_Cell,
               VCGHeap    => VCG_Heap,
               Result     => Function_Def_Uses_Quantifier);
            if Function_Def_Uses_Quantifier then
               -- The function def on the top of the stack uses the quantifier
               Function_Defs_Present := True;
            else
               -- The function def does not use the quantifier
               -- Transfer from temp function stack to function def stack
               CStacks.Push (Heap     => VCG_Heap,
                             CellName => CStacks.Top (VCG_Heap, Temp_Function_Stack),
                             S        => Function_Defs);
               CStacks.Pop (VCG_Heap, Temp_Function_Stack);
            end if;
         end loop;

         if Function_Defs_Present then
            --  Get the first function def using the quantifier from
            --  the top of the stack.
            CStacks.PopOff (Heap => VCG_Heap,
                            S    => Temp_Function_Stack,
                            C    => Quantifier_Function_Defs);

            while not CStacks.IsEmpty (Temp_Function_Stack) loop
               ContainsQuantIdent
                 (DataElem   => CStacks.Top (VCG_Heap, Temp_Function_Stack),
                  QuantIdent => Quantifier_Ident_Cell,
                  VCGHeap    => VCG_Heap,
                  Result     => Function_Def_Uses_Quantifier);

               if Function_Def_Uses_Quantifier then
                  --  If the current tos is relevant to to us, we join
                  --  it onto the cell containing the other relevant
                  --  instantiations.
                  Cells.Utility.Conjoin
                    (VCG_Heap => VCG_Heap,
                     New_Term => CStacks.Top (VCG_Heap, Temp_Function_Stack),
                     Conjunct => Quantifier_Function_Defs);
                  CStacks.Pop (VCG_Heap, Temp_Function_Stack);
               else
                  --  The function def does not use the quantifier;
                  --  transfer from temp function stack to function
                  --  def stack.
                  CStacks.Push (Heap     => VCG_Heap,
                                CellName => CStacks.Top (VCG_Heap, Temp_Function_Stack),
                                S        => Function_Defs);
                  CStacks.Pop (VCG_Heap, Temp_Function_Stack);
               end if;
            end loop;
            --  Quantifier_Function_Defs contains all function defs
            --  that use the quantifier conjcoined.
         end if;
      else
         Function_Defs_Present := False;
         -- Pop off the quantifier marker from the function_defs stack.
         -- as the parsing of the quantified expression is complete.
         CStacks.Pop (VCG_Heap, Function_Defs);
      end if;

      -- now assemble the quantifier expression
      CreateOpCell (Quantified_Expression, VCG_Heap, Quantifier_Kind);
      CreateOpCell (Comma_Cell, VCG_Heap, SP_Symbols.comma);
      if Quantifier_Kind = SP_Symbols.RWforall then
         CreateOpCell (Implies_Cell, VCG_Heap, SP_Symbols.implies);
      else -- must for_some
         CreateOpCell (Implies_Cell, VCG_Heap, SP_Symbols.RWand);
      end if;

      SetLeftArgument (Implies_Cell, Range_Data, VCG_Heap);

      -- If there are function defs present that use the quanitfier
      -- then these need to be placed within the quantifier as follows,
      -- where -> is replaced and by for existential qauntification:
      -- <dec> <range> -> <function_defs> -> <predicate>
      if Function_Defs_Present then
         CreateOpCell (Function_Defs_Join, VCG_Heap, SP_Symbols.implies);

         SetLeftArgument (Function_Defs_Join, Quantifier_Function_Defs, VCG_Heap);
         SetRightArgument (Function_Defs_Join, Predicate, VCG_Heap);

         SetRightArgument (Implies_Cell, Function_Defs_Join, VCG_Heap);
      else
         -- Otherwise the format is:
         -- <dec> <range> -> Predicate
         SetRightArgument (Implies_Cell, Predicate, VCG_Heap);
      end if;

      SetLeftArgument (Comma_Cell, Declaration, VCG_Heap);
      SetRightArgument (Comma_Cell, Implies_Cell, VCG_Heap);

      SetRightArgument (Quantified_Expression, Comma_Cell, VCG_Heap);

      CStacks.Push (VCG_Heap, Quantified_Expression, E_Stack);

      -- leave local scope of quantifier
      L_Scope      := Dictionary.GetEnclosingScope (L_Scope);
      Current_Unit := Dictionary.GetRegion (L_Scope);

   end Up_Process_Quantifier;

begin -- Build_Annotation_Expression

   -- The set of called functions is initiallized and set to a null set.
   Symbol_Set.Initialise (Called_Functions);

   -- Initially it is not possible to be within a nested function call
   -- There is no calling function.
   Calling_Function := Cells.Null_Cell;

   Done := False;

   CStacks.CreateStack (E_Stack);
   --  scope may change locally in loops but will always be back to
   --  original scope on exit from procedure.  In all calls below
   --  L_Scope replaces Scope.
   L_Scope := Get_Generic_Scope (Exp_Node                => Exp_Node,
                                 Instantiated_Subprogram => Instantiated_Subprogram,
                                 Scope                   => Scope);

   Start_Node            := Exp_Node;
   Next_Node             := Start_Node;
   Last_Node             := Next_Node;
   Current_Instantiation := Instantiated_Subprogram;

   -- At the outermost level the current unit is not known within
   -- Build_Annotation_Expression. Only the scope is known.
   Current_Unit := Dictionary.NullSymbol;

   Implicit_Var := Dictionary.NullSymbol;

   Direction := Down_Loop;

   --  Debug.PrintScope ("L_Scope is       ", L_Scope);
   --  Debug.PrintScope ("Calling_Scope is ", Calling_Scope);
   --  Debug.PrintBool  ("Force_Abstract:  ", Force_Abstract);

   loop

      -- As SPARK 95 does not support recursion the syntax tree is traversed using
      -- a down and an up loop.  The up-loop is wholly contained within the
      -- down-loop.  The syntax tree nodes maintain a reference to their parent
      -- and so a stack is not required to traverse the tree using the down and
      -- up loops.  However, the purpose of traversing the tree is to build a DAG
      -- representation of the syntax tree.  The building of the DAG does involve
      -- a stack, the expression stack (E_Stack).  During the down part of the
      -- traversal structures are pushed on to the stack and if necessary these
      -- are completed during the up-loop.  The up-loop also uses the E_Stack
      -- directly to build expressions DAGs without using recursion.
      loop
         if Direction = Down_Loop then
            --------------------------------down loop
            -- Start_Node is the syntax node of the whole expression
            -- Next_Node is the child node of the current node which is being
            -- visited in the syntax tree
            -- Last_Node is the node which is currently being visited.
            --
            -- Initially Next_Node = Start_Node
            --
            -- The down-loop includes the up-loop.
            -- Starting at the Start_Node the down loop traverses the syntax tree
            -- by taking successive child nodes.
            -- At the start of each iteration of the loop Last_Node set set equal
            -- to the Next_Node and its Node_Type determined and used as a case
            -- selector.  The Node_Type gives the grammar production that the syntax
            -- node represents.  The down loop processes certain grammar productions
            -- but others it may ignore and just moving to the child node of the
            -- currently visted node in the syntax tree.  The processing of a
            -- production ibvolves building a DAG on the expression stack, E_Stack.
            -- The down-loop processing is suspended when a null syntax node is
            -- encountered.  The null syntax node may be encountered purely by
            -- traversing the syntax tree and reaching a leaf or by being forced
            -- by processing a production of the grammar of annotation expressions.
            -- In either case when a null syntax node is encountered the up-loop
            -- is entered provided that the Last_Node is not equal to the Start_Node
            -- (i.e., we are back at the beginning of the expression and cannot
            -- go backup any further).
            --
            -- The up-loop
            -- At the start of each loop there is a loop exit checks:
            --   a.  if there is a sibling of the node which has not been vsited
            --       then the up-loop is exited.
            --   b.  Next_Node is set to the parent of the currently visited node
            --       and the Last_Node set to the new value of Next_Node.
            --       If the new value of Last_Node is a null node then the up-loop
            --       is exited.
            -- Once the up-loop proper is entered a selection is made on the type
            -- of the currently visited syntax tree node referenced by Last_Node.
            -- A number of grammar productions are processed on the up-loop and use
            -- the E_Stack to build a DAG.  Other productions are not processed.
            -- At the end of the up-loop a check is made to see if the currently
            -- visited node (here repreented by Next_Node) references the the
            -- initial syntax node of the expresion, Start_Node.
            -- If it does we cannot progress up any further and the up-loop is
            -- otherwise the up-loop just iteratees choosing the next sibling or
            -- the parent of the currently viisted node.
            -- Ultimately the down-loop and therefore the up-loop will be exited
            -- at the end of the down-loop when the next node yo be processed is
            -- null or references the initial syntax node of the expression, Start_Node.
            Last_Node := Next_Node;
            Node_Type := STree.Syntax_Node_Type (Node => Next_Node);
            case Node_Type is
               when SP_Symbols.attribute_ident =>
                  Down_Process_Attribute_Ident (Node     => Next_Node,
                                                E_Stack  => E_Stack,
                                                VCG_Heap => VCG_Heap);
                  Next_Node := STree.NullNode;
               when SP_Symbols.character_literal | SP_Symbols.string_literal =>
                  -- ASSUME Last_Node = character_literal OR string_literal
                  CreateManifestConstCell (DAG_Cell, VCG_Heap, STree.Node_Lex_String (Node => Next_Node));
                  CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);
                  Next_Node := STree.NullNode;
               when SP_Symbols.numeric_literal =>
                  -- ASSUME Last_Node = numeric_literal
                  CreateManifestConstCell
                    (DAG_Cell,
                     VCG_Heap,
                     STree.Node_Lex_String (Node => STree.Child_Node (Current_Node => STree.Child_Node (Current_Node => Next_Node))));
                  CStacks.Push (VCG_Heap, DAG_Cell, E_Stack);
                  Next_Node := STree.NullNode;
               when SP_Symbols.annotation_selector =>
                  -- ASSUME Last_Node = annotation_selector
                  -- prune at selector nodes so that only left most idents found
                  Next_Node := STree.NullNode;
               when SP_Symbols.annotation_simple_name =>
                  -- ASSUME Last_Node = annotation_simple_name
                  if STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Last_Node)) =
                    SP_Symbols.annotation_named_argument_association then
                     -- do not want look at parameter or field identifier
                     Next_Node := STree.NullNode;
                  else
                     Next_Node := STree.Child_Node (Current_Node => Next_Node);
                  end if;
               when SP_Symbols.identifier =>
                  -- ASSUME Last_Node = identifier
                  --# accept F, 10, Next_Node, "Ineffective assignment OK - Process_Identifier does use",
                  --#        "the intial value of Next_Node";
                  Process_Identifier
                    (L_Scope               => L_Scope,
                     Calling_Scope         => Calling_Scope,
                     Force_Abstract        => Force_Abstract,
                     Loop_Stack            => Loop_Stack,
                     Calling_Function      => Calling_Function,
                     Current_Unit          => Current_Unit,
                     Implicit_Var          => Implicit_Var,
                     Current_Instantiation => Current_Instantiation,
                     Called_Functions      => Called_Functions,
                     Start_Node            => Start_Node,
                     Next_Node             => Next_Node,
                     Last_Node             => Last_Node,
                     E_Stack               => E_Stack,
                     VCG_Heap              => VCG_Heap);
                  Next_Node := STree.NullNode;
                  --# end accept;
               when SP_Symbols.annotation_aggregate =>
                  -- ASSUME Last_Node = annotation_aggregate
                  DownProcessAggregate (SP_Symbols.annotation_qualified_expression, VCG_Heap, Next_Node, E_Stack);
               when SP_Symbols.annotation_aggregate_choice_rep =>
                  -- ASSUME Last_Node = annotation_aggregate_choice_rep
                  DownProcessAggregateChoiceRep (Last_Node, L_Scope, VCG_Heap, E_Stack, Next_Node);
               when SP_Symbols.record_component_selector_name =>
                  -- ASSUME Last_Node = record_component_selector_name
                  DownProcessRecordComponentSelectorName (Last_Node, L_Scope, VCG_Heap, E_Stack, Next_Node);
               when SP_Symbols.store =>
                  -- ASSUME Last_Node = store
                  Down_Process_Store (L_Scope  => L_Scope,
                                      E_Stack  => E_Stack,
                                      VCG_Heap => VCG_Heap);
                  Next_Node := STree.Child_Node (Current_Node => Next_Node);
               when SP_Symbols.store_list =>
                  -- ASSUME Last_Node = store_list
                  Down_Process_Store_List (Node      => Last_Node,
                                           E_Stack   => E_Stack,
                                           VCG_Heap  => VCG_Heap,
                                           Next_Node => Next_Node);
               when SP_Symbols.quantified_expression =>
                  -- ASSUME Last_Node = quantified_expression
                  Down_Process_Quantifier
                    (Node          => Last_Node,
                     Current_Unit  => Current_Unit,
                     E_Stack       => E_Stack,
                     Function_Defs => Function_Defs,
                     VCG_Heap      => VCG_Heap,
                     L_Scope       => L_Scope,
                     Next_Node     => Next_Node);
               when others =>
                  Next_Node := STree.Child_Node (Current_Node => Next_Node);
            end case;
         end if; -- Down_Loop

         -------------------------------------------------up loop----------
         if Direction = Up_Loop or else (Next_Node = STree.NullNode and then Last_Node /= Start_Node) then
            Direction := Up_Loop;
            loop
               Next_Node := STree.Next_Sibling (Current_Node => Last_Node);
               if Next_Node /= STree.NullNode then
                  Direction := Down_Loop;
                  exit;
               end if;

               Next_Node := STree.Parent_Node (Current_Node => Last_Node);
               Last_Node := Next_Node;

               if Last_Node = STree.NullNode then
                  Direction := Down_Loop;
                  exit;
               end if;

               case STree.Syntax_Node_Type (Node => Last_Node) is
                  when SP_Symbols.annotation_expression      |
                    SP_Symbols.annotation_expression_rep1 |
                    SP_Symbols.annotation_expression_rep2 |
                    SP_Symbols.annotation_expression_rep3 |
                    SP_Symbols.annotation_expression_rep4 |
                    SP_Symbols.annotation_expression_rep5 |
                    SP_Symbols.annotation_expression_rep6 |
                    SP_Symbols.annotation_expression_rep7 =>
                     -- ASSUME Last_Node = annotation_expression_rep1 OR annotation_expression_rep2 OR annotation_expression_rep3 OR
                     --                    annotation_expression_rep4 OR annotation_expression_rep5 OR annotation_expression_rep6 OR
                     --                    annotation_expression_rep7 OR annotation_expression
                     Process_Expression (Node     => Last_Node,
                                         E_Stack  => E_Stack,
                                         VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_simple_expression =>
                     -- ASSUME Last_Node = annotation_simple_expression
                     Process_Simple_Expression (Node     => Last_Node,
                                                E_Stack  => E_Stack,
                                                VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_simple_expression_opt =>
                     -- ASSUME Last_Node = annotation_simple_expression_opt
                     Process_Simple_Expression_Opt (Node     => Last_Node,
                                                    E_Stack  => E_Stack,
                                                    VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_term =>
                     -- ASSUME Last_Node = annotation_term
                     Process_Simple_Expression (Node     => Last_Node,
                                                E_Stack  => E_Stack,
                                                VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_factor =>
                     -- ASSUME Last_Node = annotation_factor
                     Process_Factor (Node     => Last_Node,
                                     E_Stack  => E_Stack,
                                     VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_relation =>
                     -- ASSUME Last_Node = annotation_relation
                     Process_Relation (Node     => Last_Node,
                                       E_Stack  => E_Stack,
                                       VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_selected_component =>
                     -- ASSUME Last_Node = annotation_selected_component
                     Process_Selected_Component
                       (Direction             => Direction,
                        L_Scope               => L_Scope,
                        Calling_Scope         => Calling_Scope,
                        Force_Abstract        => Force_Abstract,
                        Called_Functions      => Called_Functions,
                        Calling_Function      => Calling_Function,
                        Current_Instantiation => Current_Instantiation,
                        Current_Unit          => Current_Unit,
                        Implicit_Var          => Implicit_Var,
                        Start_Node            => Start_Node,
                        Next_Node             => Next_Node,
                        Last_Node             => Last_Node,
                        Loop_Stack            => Loop_Stack,
                        E_Stack               => E_Stack,
                        VCG_Heap              => VCG_Heap);
                  when SP_Symbols.annotation_attribute_designator =>
                     -- ASSUME Last_Node = annotation_attribute_designator
                     Up_Process_Attribute_Designator (Node     => Last_Node,
                                                      E_Stack  => E_Stack,
                                                      VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_positional_argument_association =>
                     -- ASSUME Last_Node = annotation_positional_argument_association
                     Process_Positional_Argument_Association (Node     => Last_Node,
                                                              E_Stack  => E_Stack,
                                                              VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_named_argument_association =>
                     -- ASSUME Last_Node = annotation_named_argument_association
                     Process_Named_Argument_Association (Node     => Last_Node,
                                                         E_Stack  => E_Stack,
                                                         VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_name_argument_list =>
                     -- ASSUME Last_Node = annotation_name_argument_list
                     Process_Name_Argument_List
                       (Direction             => Direction,
                        Current_Instantiation => Current_Instantiation,
                        Current_Unit          => Current_Unit,
                        Implicit_Var          => Implicit_Var,
                        Called_Functions      => Called_Functions,
                        Calling_Function      => Calling_Function,
                        Start_Node            => Start_Node,
                        Next_Node             => Next_Node,
                        Last_Node             => Last_Node,
                        E_Stack               => E_Stack,
                        Scope                 => L_Scope,
                        Calling_Scope         => Calling_Scope,
                        Force_Abstract        => Force_Abstract,
                        VCG_Heap              => VCG_Heap);
                  when SP_Symbols.annotation_ancestor_part =>
                     -- ASSUME Last_Node = annotation_ancestor_part
                     ProcessAncestorPart (Last_Node, VCG_Heap, E_Stack);
                  when SP_Symbols.annotation_aggregate_choice =>
                     -- ASSUME Last_Node = annotation_aggregate_choice
                     Up_Process_Aggregate_Choice (Node     => Last_Node,
                                                  E_Stack  => E_Stack,
                                                  VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_aggregate_choice_rep =>
                     -- ASSUME Last_Node = annotation_aggregate_choice_rep
                     UpProcessAggregateChoiceRep (Last_Node, VCG_Heap, E_Stack);
                  when SP_Symbols.annotation_named_association_rep =>
                     -- ASSUME Last_Node = annotation_named_association_rep
                     Up_Process_Named_Association_Rep (Node     => Last_Node,
                                                       E_Stack  => E_Stack,
                                                       VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_named_record_component_association =>
                     -- ASSUME Last_Node = annotation_named_record_component_association
                     Up_Process_Named_Record_Component_Association (E_Stack  => E_Stack,
                                                                    VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_aggregate_or_expression =>
                     -- ASSUME Last_Node = annotation_aggregate_or_expression
                     Up_Process_Aggregate_Or_Expression (Node     => Last_Node,
                                                         E_Stack  => E_Stack,
                                                         VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_positional_record_component_association =>
                     -- ASSUME Last_Node = annotation_positional_record_component_association
                     Up_Process_Positional_Record_Component_Association (E_Stack  => E_Stack,
                                                                         VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_component_association =>
                     -- ASSUME Last_Node = annotation_component_association
                     Up_Process_Component_Association (Node     => Last_Node,
                                                       E_Stack  => E_Stack,
                                                       VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_aggregate =>
                     -- ASSUME Last_Node = annotation_aggregate
                     Up_Process_Aggregate (E_Stack  => E_Stack,
                                           VCG_Heap => VCG_Heap);
                  when SP_Symbols.annotation_extension_aggregate =>
                     -- ASSUME Last_Node = annotation_extension_aggregate
                     UpProcessExtensionAggregate (VCG_Heap, E_Stack);
                  when SP_Symbols.annotation_qualified_expression =>
                     -- ASSUME Last_Node = annotation_qualified_expression
                     Model_Qualified_Expression (Node     => Last_Node,
                                                 E_Stack  => E_Stack,
                                                 VCG_Heap => VCG_Heap);
                  when SP_Symbols.store =>
                     -- ASSUME Last_Node = store
                     Up_Process_Store (Node     => Last_Node,
                                       L_Scope  => L_Scope,
                                       E_Stack  => E_Stack,
                                       VCG_Heap => VCG_Heap);
                  when SP_Symbols.store_list =>
                     -- ASSUME Last_Node = store_list
                     Up_Process_Store_List (E_Stack  => E_Stack,
                                            VCG_Heap => VCG_Heap);
                  when SP_Symbols.quantified_expression =>
                     -- ASSUME Last_Node = quantified_expression
                     Up_Process_Quantifier
                       (Node          => Last_Node,
                        Current_Unit  => Current_Unit,
                        E_Stack       => E_Stack,
                        Function_Defs => Function_Defs,
                        VCG_Heap      => VCG_Heap,
                        L_Scope       => L_Scope);
                  when others =>
                     null;
               end case;

               if Next_Node = Start_Node then
                  Direction := Down_Loop;
                  exit;
               end if;

            end loop; -- up
         end if;
         exit when Next_Node = STree.NullNode or else Next_Node = Start_Node;
      end loop; -- down

      -- DAG Root contains the DAG of the annotation expression
      CStacks.PopOff (VCG_Heap, E_Stack, DAG_Root);

      if Is_Generic_Constraint (Exp_Node                => Start_Node,
                                Instantiated_Subprogram => Instantiated_Subprogram) then
         Instantiate_Parameters (Constraint              => DAG_Root,
                                 Instantiated_Subprogram => Instantiated_Subprogram,
                                 VCG_Heap                => VCG_Heap);
      end if;

      if not CStacks.IsEmpty (E_Stack) then
         case Cells.Get_Kind (Heap     => VCG_Heap,
                              CellName => CStacks.Top (Heap => VCG_Heap,
                                                       S    => E_Stack)) is
            when Cell_Storage.Proof_Function_Syntax_Node =>
               -- This sort of Cell indicates the start of processing a
               -- called function with a return anno and is used to synchronize
               -- the stack with the new context variables and initiate the
               -- parser with a new context.
               -- DAG_Root contains a default return anno expression

               -- The Proof_Function_Syntax_Node Pop is no longer required,
               -- Pop it off.
               CStacks.Pop (VCG_Heap, E_Stack);
               -- TOS is Proof_Function_Obtain_Return

               -- Obtain the root syntax tree node for return anno;
               -- it has been saved in the RHS of the return anno marker
               -- which is on the top of the stack.
               Start_Node :=
                 STree.RefToNode
                 (ExaminerConstants.RefType (Cells.Get_Natural_Value
                                               (Heap     => VCG_Heap,
                                                CellName => Cells.Get_B_Ptr (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack)))));

               if Start_Node /= STree.NullNode then
                  -- The called function has a return anno and Start_Node
                  -- references the root node of its syntax tree.

                  -- Set up the scope to use in parsing based on the
                  -- Current_Unit and Implicit_Var symbols
                  if Implicit_Var = Dictionary.NullSymbol then
                     -- An explicit return anno
                     L_Scope := Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                           The_Unit       => Current_Unit);

                     -- Adjust for instantiation
                     L_Scope :=
                       Get_Generic_Scope
                       (Exp_Node                => Exp_Node,
                        Instantiated_Subprogram => Instantiated_Subprogram,
                        Scope                   => L_Scope);
                  else
                     -- An implicit return anno.  The Implicit_Var gives
                     -- the corrct scope whether it is from the generic
                     -- declaration or the instantiation.
                     L_Scope := Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                           The_Unit       => Implicit_Var);
                  end if;

                  -- Set up the context variables to parse the return anno
                  Last_Node := Start_Node;
                  Next_Node := Start_Node;

               else
                  -- If the return anno node is null then the return expression
                  -- is taken to be the called function and the definition becomes:
                  -- <precondition> -> <function_call> = <function_call>.

                  -- The DAG_Root just popped of the stack contains the
                  -- <function_call>.
                  -- Push it back on to the stack to become the DAG
                  -- of the return anno for the next cycle
                  CStacks.Push (Heap     => VCG_Heap,
                                CellName => DAG_Root,
                                S        => E_Stack);
                  -- TOS is <function_call> => Proof_Function_Obtain_Return

                  -- Ensure that parse loops are exited immediatly
                  -- so as to leave <function_call> as the parsed DAG
                  -- for the next cycle.
                  Last_Node := STree.NullNode;
                  Next_Node := STree.NullNode;

               end if;

               -- set Direction to Down_Loop to enter parse loop afresh
               Direction := Down_Loop;

            when Cell_Storage.Proof_Function_Obtain_Return =>
               -- DAG_Root contains the return anno expression DAG
               -- Pop off Proof_Function_Obtain_Return as it is no longer required
               CStacks.Pop (VCG_Heap, E_Stack);
               -- TOS is now <function_call> "=" place holder

               -- Determine whether the return anno uses an implicit variable.
               -- If it is a null symbol if the function does not have an
               -- implcit return variable.
               if Implicit_Var /= Dictionary.NullSymbol then
                  -- Substitute the implicit variable by the function call
                  Substitutions.Substitute_Implicit_Vars
                    (Proof_Function       => Cells.Get_A_Ptr (Heap     => VCG_Heap,
                                                              CellName => CStacks.Top (VCG_Heap, E_Stack)),
                     Implicit_Var         => Implicit_Var,
                     Implicit_Return_Expr => DAG_Root,
                     VCG_Heap             => VCG_Heap);
               end if;

               -- Substitute actual parameters from call in return annotation DAG
               -- requires the function call from the TOS
               Substitutions.Substitute_Parameters
                 (Called_Function => Cells.Get_A_Ptr (Heap     => VCG_Heap,
                                                      CellName => CStacks.Top (VCG_Heap, E_Stack)),
                  Constraint      => DAG_Root,
                  VCG_Heap        => VCG_Heap);

               if Implicit_Var /= Dictionary.NullSymbol then
                  --  For functions with implicit returns we just
                  --  replace the f(...) = foo node with foo itself.
                  CStacks.Pop (VCG_Heap, E_Stack);
                  CStacks.Push (VCG_Heap, DAG_Root, E_Stack);
               else
                  --  Set RHS of =/<-> op now on top of stack to
                  --  return annotation DAG.
                  SetRightArgument (OpCell   => CStacks.Top (VCG_Heap, E_Stack),
                                    Argument => DAG_Root,
                                    VCGHeap  => VCG_Heap);
               end if;

               -- pop off the completed =/<-> op
               CStacks.PopOff (Heap => VCG_Heap,
                               S    => E_Stack,
                               C    => Function_Definition);
               -- TOS is precondition marker
               -- temporarily pop off precondition marker to expose -> at TOS
               CStacks.PopOff (Heap => VCG_Heap,
                               S    => E_Stack,
                               C    => Precondition);
               -- TOS is place holder "->" place holder
               -- set RHS of -> op to completed =/<-> op.
               SetRightArgument (OpCell   => CStacks.Top (VCG_Heap, E_Stack),
                                 Argument => Function_Definition,
                                 VCGHeap  => VCG_Heap);

               -- push precondition marker back on to stack.
               CStacks.Push (Heap     => VCG_Heap,
                             CellName => Precondition,
                             S        => E_Stack);
               -- TOS is precondition marker

               -- Obtain the root syntax tree node for the precondition
               -- it has been saved in the RHS of the precondition marker
               Start_Node :=
                 STree.RefToNode
                 (ExaminerConstants.RefType (Cells.Get_Natural_Value
                                               (Heap     => VCG_Heap,
                                                CellName => Cells.Get_B_Ptr (VCG_Heap, Precondition))));

               -- If the precondition syntax trree root node is null
               -- then the called function does not have a precondition.
               -- An assumed precondition of True is pushed on to the stack
               if Start_Node = STree.NullNode then
                  CreateTrueCell (VCG_Heap, True_Cell);
                  CStacks.Push (Heap     => VCG_Heap,
                                CellName => True_Cell,
                                S        => E_Stack);
                  -- TOS is True => precondition marker
               end if;

               -- Set up the correct scope to parse the precondition based
               -- on the called function symbol
               L_Scope := Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                     The_Unit       => Current_Unit);

               -- Adjust for instantiation
               L_Scope :=
                 Get_Generic_Scope (Exp_Node                => Exp_Node,
                                    Instantiated_Subprogram => Instantiated_Subprogram,
                                    Scope                   => L_Scope);

               -- The start node contains the root node of the syntax tree of
               -- the precondition
               -- If it is null then the top of the stack is a True cell
               -- and both the down and the up loop will exit immediately
               -- when they are entered afresh leaving the True cell on top.
               -- If the precondition root syntax tree node is not null
               -- then as the parser loops are entered afresh, because
               -- the Direction is Down_Loop, the precondition is parsed
               -- and when complete the precondition DAG is on the top of
               -- the stack.
               Last_Node := Start_Node;
               Next_Node := Start_Node;
               Direction := Down_Loop;

            when Cell_Storage.Proof_Function_Obtain_Precondition =>
               -- DAG_Root is precondition DAG

               -- Pop off the precondition marker as it is no longer required
               CStacks.PopOff (Heap => VCG_Heap,
                               S    => E_Stack,
                               C    => Precondition);
               -- TOS is place holder -> <function_call> = <return anno expr>

               --  We need to get to the argument check, which is
               --  stashed underneath the current TOS.
               CStacks.PopOff (VCG_Heap, E_Stack, Tmp_Cell_2);
               CStacks.PopOff (VCG_Heap, E_Stack, Tmp_Cell_1); -- This is the argument typecheck.
               CStacks.Push (VCG_Heap, Tmp_Cell_2, E_Stack);

               -- Substitute actual parameters from call in precondition DAG
               -- requires the function call from the RHS of the -> op on TOS
               Substitutions.Substitute_Parameters
                 (Called_Function => LeftPtr (VCG_Heap, Precondition),
                  Constraint      => DAG_Root,
                  VCG_Heap        => VCG_Heap);

               --  Tmp_Cell_1 is the argument check.
               --  DAG_Root is the precondition.
               Cells.Utility.Create_And (VCG_Heap => VCG_Heap,
                                         Left     => Tmp_Cell_1,
                                         Right    => DAG_Root,
                                         Conjunct => Tmp_Parent);
               Cells.Utility.Simplify (VCG_Heap, Tmp_Parent);
               --  Tmp_Parent is now (argument_check /\ precondition)

               CStacks.PopOff (VCG_Heap, E_Stack, Tmp_Cell_1);
               SetLeftArgument (OpCell   => Tmp_Cell_1,
                                Argument => Tmp_Parent,
                                VCGHeap  => VCG_Heap);
               Cells.Utility.Simplify (VCG_Heap, Tmp_Cell_1);
               CStacks.Push (VCG_Heap, Tmp_Cell_1, E_Stack);
               -- "->" op on TOS set the LHS argument to the precondition DAG

               -- Ensure that parse loops are exited immediatly
               -- by setting the context variables to a null node
               -- and the direction to Down_Loop
               -- so as to leave the completed guarded function definition
               -- on the top of the stack for the next cycle.
               Start_Node := STree.NullNode;
               Last_Node  := STree.NullNode;
               Next_Node  := STree.NullNode;
               Direction  := Down_Loop;

            when Cell_Storage.Function_Call_In_Proof_Context =>
               -- DAG_Root is guarded function definition DAG
               -- TOS is Function_Call_In_Proof_Context

               --  We need to get to the return assumption, which is
               --  stashed underneath the current TOS.
               CStacks.PopOff (VCG_Heap, E_Stack, Tmp_Cell_2);
               CStacks.PopOff (VCG_Heap, E_Stack, Tmp_Cell_1); -- This is the return assumption.
               CStacks.Push (VCG_Heap, Tmp_Cell_2, E_Stack);

               --  DAG_Root is  (typecheck /\ pre) -> return
               --  Tmp_Cell_1 is the return assumption
               if Cells.Utility.Is_True (VCG_Heap, Tmp_Cell_1) then
                  --  We have a trivial true return assumption; we can
                  --  skip this as it adds nothing.
                  Tmp_Parent := DAG_Root;
                  Cells.Dispose_Of_Cell (VCG_Heap, Tmp_Cell_1);
               else
                  --  Otherwise we and the return assumption onto
                  --  DAG_Root.
                  CreateOpCell (Tmp_Parent, VCG_Heap, SP_Symbols.RWand);
                  SetLeftArgument (Tmp_Parent, DAG_Root, VCG_Heap);
                  SetRightArgument (Tmp_Parent, Tmp_Cell_1, VCG_Heap);
               end if;
               --  Tmp_Parent is now ((typecheck /\ pre) -> return) /\ return_assumption

               --  Push the full instantiation on to the Function_Defs
               --  stack.
               CStacks.Push (Heap     => VCG_Heap,
                             CellName => Tmp_Parent,
                             S        => Function_Defs);

               -- Remove function from set of called functions.  The called
               -- function symbol is in LHS of the Function_Call_In_Proof_Context
               -- marker.
               Symbol_Set.Remove
                 (The_Set => Called_Functions,
                  Sym     => Cells.Get_Symbol_Value
                    (Heap     => VCG_Heap,
                     CellName => Cells.Get_A_Ptr (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack))));

               -- Restore context variables to those before encountering
               -- called function.  These are saved in the RHS
               -- of the Function_Call_In_Proof_Context marker
               Load_Saved_Context_DAG
                 (Scope                   => L_Scope,
                  Direction               => Direction,
                  Instantiated_Subprogram => Current_Instantiation,
                  Current_Unit            => Current_Unit,
                  Implicit_Var            => Implicit_Var,
                  Start_Node              => Start_Node,
                  Last_Node               => Last_Node,
                  Next_Node               => Next_Node,
                  VCG_Heap                => VCG_Heap,
                  Argument_List           => RightPtr (VCG_Heap, CStacks.Top (VCG_Heap, E_Stack)));

               -- Pop off Function_Call_In_Proof_Context
               CStacks.Pop (VCG_Heap, E_Stack);

               -- Retsore the previous Calling_Function
               CStacks.PopOff (Heap => VCG_Heap,
                               S    => E_Stack,
                               C    => Calling_Function);

               -- Determine whether the parsing is complete based on the exit
               -- for the parse loops.
               Done := Next_Node = Start_Node or else (Direction = Down_Loop and Next_Node = STree.NullNode);

            when others =>
               Done := True;
         end case;
      else
         Done := True;
      end if;

      exit when Done;

   end loop;

end Build_Annotation_Expression;
