-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
-- Public License for more details. You should have received a copy of the GNU
-- General Public License distributed with the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

separate (DAG.BuildExpnDAG)
procedure UpAttributeDesignator (Node : in STree.SyntaxNode) is
   ExpnFound, BaseFound                                       : Boolean;
   TempCell, PrefixCell, AttribCell, ExpnCell, SecondExpnCell : Cells.Cell;
   LexStr, AttribName                                         : LexTokenManager.Lex_String;
   PrefixType                                                 : Dictionary.Symbol;
   ExpnNode                                                   : STree.SyntaxNode;

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

   procedure EliminateBase (TOS : in Cells.Cell)
   --# global in     PrefixCell;
   --#        in out VCGHeap;
   --# derives VCGHeap from *,
   --#                      PrefixCell,
   --#                      TOS;
   is
      BaseCell : Cells.Cell;

   begin
      BaseCell := LeftPtr (VCGHeap, TOS);
      if Cells.Get_Kind (VCGHeap, BaseCell) = Cell_Storage.Op then
         -- 'Base exists
         Cells.Dispose_Of_Cell (VCGHeap, RightPtr (VCGHeap, BaseCell));
         Cells.Dispose_Of_Cell (VCGHeap, BaseCell);
         SetLeftArgument (TOS, PrefixCell, VCGHeap);
      end if;
   end EliminateBase;

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

   procedure ModelSimpleFunctionAttribute (StripToRootType : in Boolean)
   --# global in     AttribCell;
   --#        in     Dictionary.Dict;
   --#        in     ExpnCell;
   --#        in     ExpnStack;
   --#        in     PrefixCell;
   --#        in out VCGHeap;
   --# derives VCGHeap from *,
   --#                      AttribCell,
   --#                      Dictionary.Dict,
   --#                      ExpnCell,
   --#                      ExpnStack,
   --#                      PrefixCell,
   --#                      StripToRootType;
   is
   begin
      EliminateBase (CStacks.Top (VCGHeap, ExpnStack));

      -- 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 StripToRootType then
         Cells.Set_Symbol_Value (VCGHeap, PrefixCell, Dictionary.GetRootType (Cells.Get_Symbol_Value (VCGHeap, PrefixCell)));
      end if;

      Cells.Set_Kind (VCGHeap, AttribCell, Cell_Storage.Attrib_Function);
      SetRightArgument (AttribCell, ExpnCell, VCGHeap);
   end ModelSimpleFunctionAttribute;

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

   procedure ModelMinMax
   --# global in     AttribCell;
   --#        in     Dictionary.Dict;
   --#        in     ExpnCell;
   --#        in     ExpnStack;
   --#        in     PrefixCell;
   --#        in     SecondExpnCell;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives Statistics.TableUsage from *,
   --#                                    VCGHeap &
   --#         VCGHeap               from *,
   --#                                    AttribCell,
   --#                                    Dictionary.Dict,
   --#                                    ExpnCell,
   --#                                    ExpnStack,
   --#                                    PrefixCell,
   --#                                    SecondExpnCell;
   is
      CommaCell : Cells.Cell;
   begin
      CreateOpCell (CommaCell, VCGHeap, SP_Symbols.comma);
      EliminateBase (CStacks.Top (VCGHeap, ExpnStack));
      Cells.Set_Symbol_Value (VCGHeap, PrefixCell, Dictionary.GetRootType (Cells.Get_Symbol_Value (VCGHeap, PrefixCell)));
      Cells.Set_Kind (VCGHeap, AttribCell, Cell_Storage.Attrib_Function);
      SetLeftArgument (CommaCell, ExpnCell, VCGHeap);
      SetRightArgument (CommaCell, SecondExpnCell, VCGHeap);
      SetRightArgument (AttribCell, CommaCell, VCGHeap);
   end ModelMinMax;

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

   procedure ModelLengthAttribute
   --# global in     Dictionary.Dict;
   --#        in out ExpnStack;
   --#        in out LexTokenManager.State;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    Dictionary.Dict,
   --#                                    ExpnStack,
   --#                                    LexTokenManager.State,
   --#                                    VCGHeap &
   --#         LexTokenManager.State from *;
   is
      OneCell, HighEndCell, LowEndCell : Cells.Cell;
      TypeSym                          : Dictionary.Symbol;
      LexStr                           : LexTokenManager.Lex_String;

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

      procedure InsertPos
      --# global in     TypeSym;
      --#        in out HighEndCell;
      --#        in out LowEndCell;
      --#        in out Statistics.TableUsage;
      --#        in out VCGHeap;
      --# derives HighEndCell           from TypeSym,
      --#                                    VCGHeap &
      --#         LowEndCell            from HighEndCell,
      --#                                    TypeSym,
      --#                                    VCGHeap &
      --#         Statistics.TableUsage from *,
      --#                                    HighEndCell,
      --#                                    TypeSym,
      --#                                    VCGHeap &
      --#         VCGHeap               from *,
      --#                                    HighEndCell,
      --#                                    LowEndCell,
      --#                                    TypeSym;
      is
         PosCell : Cells.Cell;

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

      begin
         CreateAttribFunctionCell (LexTokenManager.Pos_Token, TypeSym, VCGHeap,
                                   -- to get
                                   PosCell);
         SetRightArgument (RightPtr (VCGHeap, PosCell), HighEndCell, VCGHeap);
         HighEndCell := PosCell;
         CreateAttribFunctionCell (LexTokenManager.Pos_Token, TypeSym, VCGHeap,
                                   --to get
                                   PosCell);
         SetRightArgument (RightPtr (VCGHeap, PosCell), LowEndCell, VCGHeap);
         LowEndCell := PosCell;
      end InsertPos;

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

   begin --ModelLengthAttribute
      CStacks.PopOff (VCGHeap, ExpnStack, HighEndCell);
      Structures.CopyStructure (VCGHeap, HighEndCell, LowEndCell);
      Cells.Set_Lex_Str (VCGHeap, RightPtr (VCGHeap, HighEndCell), LexTokenManager.Last_Token);
      Cells.Set_Lex_Str (VCGHeap, RightPtr (VCGHeap, LowEndCell), LexTokenManager.First_Token);
      TypeSym := Cells.Get_Symbol_Value (VCGHeap, LeftPtr (VCGHeap, HighEndCell));
      if Dictionary.IsTypeMark (TypeSym) and then Dictionary.TypeIsEnumeration (TypeSym) then
         InsertPos;
      end if;
      CStacks.Push (VCGHeap, HighEndCell, ExpnStack);
      CStacks.Push (VCGHeap, LowEndCell, ExpnStack);
      PushOperator (Binary, SP_Symbols.minus, VCGHeap, ExpnStack);
      LexTokenManager.Insert_Nat (N       => 1,
                                  Lex_Str => LexStr);
      CreateManifestConstCell (OneCell, VCGHeap, LexStr);
      CStacks.Push (VCGHeap, OneCell, ExpnStack);
      PushOperator (Binary, SP_Symbols.plus, VCGHeap, ExpnStack);
   end ModelLengthAttribute;

   ----------------------------------------------
   -- Ada2005 introduces the functional attribute T'mod(<universal integer>).
   -- The Examiner transforms expressions with this attribute to
   -- <universal integer> mod T'modulus.

   procedure ModelModFunctionAttribute (Type_Sym : in Dictionary.Symbol)
   --# global in     Dictionary.Dict;
   --#        in     ExpnCell;
   --#        in     PrefixCell;
   --#        in out ExpnStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives ExpnStack,
   --#         Statistics.TableUsage,
   --#         VCGHeap               from *,
   --#                                    Dictionary.Dict,
   --#                                    ExpnCell,
   --#                                    ExpnStack,
   --#                                    PrefixCell,
   --#                                    Type_Sym,
   --#                                    VCGHeap;

   is
      TypeCell, AttribValueCell, ModOpCell, TickCell, TempCell : Cells.Cell;
   begin
      EliminateBase (CStacks.Top (VCGHeap, ExpnStack));

      -- 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 (ModOpCell, VCGHeap, SP_Symbols.RWmod);

      -- Left child
      SetLeftArgument (ModOpCell, ExpnCell, VCGHeap);

      -- Right child which represents T'Modulus.
      CreateOpCell (TickCell, VCGHeap, SP_Symbols.apostrophe);
      SetRightArgument (ModOpCell, TickCell, VCGHeap);

      CreateFixedVarCell (TypeCell, VCGHeap, Dictionary.GetRootType (Type_Sym));
      SetLeftArgument (TickCell, TypeCell, VCGHeap);

      CreateAttribValueCell (AttribValueCell, VCGHeap, LexTokenManager.Modulus_Token);
      SetRightArgument (TickCell, AttribValueCell, VCGHeap);

      -- Update the ExpnStack after processing the attribute.
      CStacks.PopOff (VCGHeap, ExpnStack, TempCell);
      Cells.Dispose_Of_Cell (VCGHeap, LeftPtr (VCGHeap, TempCell));
      Cells.Dispose_Of_Cell (VCGHeap, RightPtr (VCGHeap, TempCell));
      Cells.Dispose_Of_Cell (VCGHeap, TempCell);
      CStacks.Push (VCGHeap, ModOpCell, ExpnStack);

   end ModelModFunctionAttribute;

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

   procedure CreatePredSuccConstraint
     (Expr       : in     Cells.Cell;
      Type_Sym   : in     Dictionary.Symbol;
      AttribName : in     LexTokenManager.Lex_String;
      Check_Cell :    out Cells.Cell)
   --# global in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives Check_Cell            from AttribName,
   --#                                    Dictionary.Dict,
   --#                                    LexTokenManager.State,
   --#                                    Type_Sym,
   --#                                    VCGHeap &
   --#         Statistics.TableUsage from *,
   --#                                    AttribName,
   --#                                    Dictionary.Dict,
   --#                                    LexTokenManager.State,
   --#                                    Type_Sym,
   --#                                    VCGHeap &
   --#         VCGHeap               from *,
   --#                                    AttribName,
   --#                                    Dictionary.Dict,
   --#                                    Expr,
   --#                                    LexTokenManager.State,
   --#                                    Type_Sym;
   is
      TypeLimit, NotEqualsCell, BaseCell, AttribCell : Cells.Cell;
   begin
      -- create BaseCell for Type_Sym
      CreateFixedVarCell (BaseCell, VCGHeap, Dictionary.GetRootType (Type_Sym));

      -- Create TypeLimit as apostrophe (BaseCell, first) or
      -- apostrophe (BaseCell, last) depending on AttribName
      CreateCellKind (AttribCell, VCGHeap, Cell_Storage.Attrib_Value);
      CreateOpCell (TypeLimit, VCGHeap, SP_Symbols.apostrophe);
      SetLeftArgument (TypeLimit, BaseCell, VCGHeap);
      SetRightArgument (TypeLimit, AttribCell, VCGHeap);
      if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                              Lex_Str2 => LexTokenManager.Pred_Token) =
        LexTokenManager.Str_Eq then
         Cells.Set_Lex_Str (VCGHeap, RightPtr (VCGHeap, TypeLimit), LexTokenManager.First_Token);
      else
         Cells.Set_Lex_Str (VCGHeap, RightPtr (VCGHeap, TypeLimit), LexTokenManager.Last_Token);
      end if;

      -- create inequality
      CreateOpCell (NotEqualsCell, VCGHeap, SP_Symbols.not_equal);
      SetRightArgument (NotEqualsCell, TypeLimit, VCGHeap);
      SetLeftArgument (NotEqualsCell, Expr, VCGHeap);

      Check_Cell := NotEqualsCell;
   end CreatePredSuccConstraint;

   procedure CheckPredSuccConstraint
     (Type_Sym   : in Dictionary.Symbol;
      Expr       : in Cells.Cell;
      AttribName : in LexTokenManager.Lex_String)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in     LexTokenManager.State;
   --#        in out CheckStack;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         ShortCircuitStack,
   --#         Statistics.TableUsage from *,
   --#                                    AttribName,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Expr,
   --#                                    LexTokenManager.State,
   --#                                    ShortCircuitStack,
   --#                                    Type_Sym,
   --#                                    VCGHeap &
   --#         VCGHeap               from *,
   --#                                    AttribName,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Expr,
   --#                                    LexTokenManager.State,
   --#                                    ShortCircuitStack,
   --#                                    Type_Sym;
   is
      Check_Cell, Exp_Copy : Cells.Cell;
   begin
      if DoRtc and then not IsModularType (Type_Sym) then
         --  no need to check Type_Sym as SPARK's static-semantics
         --  allows only discrete non-Boolean types here and then
         --  DiscreteTypeWithCheck (Type_Sym)

         -- make a copy of Expr
         Structures.CopyStructure (VCGHeap, Expr, Exp_Copy);

         CreatePredSuccConstraint (Exp_Copy, Type_Sym, AttribName, Check_Cell);
         PlantCheckStatement (Check_Cell, VCGHeap, ShortCircuitStack, CheckStack);
      end if;
   end CheckPredSuccConstraint;

   procedure CreateValConstraint (Expr       : in     Cells.Cell;
                                  Type_Sym   : in     Dictionary.Symbol;
                                  Check_Cell :    out Cells.Cell)
   --# global in     Dictionary.Dict;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives Check_Cell,
   --#         VCGHeap               from Dictionary.Dict,
   --#                                    Expr,
   --#                                    Type_Sym,
   --#                                    VCGHeap &
   --#         Statistics.TableUsage from *,
   --#                                    Dictionary.Dict,
   --#                                    Expr,
   --#                                    Type_Sym,
   --#                                    VCGHeap;
   is
      RelOperationLHS, RelOperationRHS, MiddleOperator : SP_Symbols.SP_Symbol;

      TypeFiLimit, TypeLaLimit, PosFiCell, PosLaCell, BaseCell, AttribCell, LeftAnd, RightAnd, rangeDAG : Cells.Cell;

      Root_Type_Sym : Dictionary.Symbol;
   begin
      -- create BaseCell for Type_Sym
      Root_Type_Sym := Dictionary.GetRootType (Type_Sym);

      CreateFixedVarCell (BaseCell, VCGHeap, Root_Type_Sym);

      RelOperationLHS := SP_Symbols.greater_or_equal;
      RelOperationRHS := SP_Symbols.less_or_equal;
      MiddleOperator  := SP_Symbols.RWand;

      -- Create TypeFiLimit as apostrophe (BaseCell, first)
      CreateCellKind (AttribCell, VCGHeap, Cell_Storage.Attrib_Value);
      CreateOpCell (TypeFiLimit, VCGHeap, SP_Symbols.apostrophe);
      SetLeftArgument (TypeFiLimit, BaseCell, VCGHeap);
      SetRightArgument (TypeFiLimit, AttribCell, VCGHeap);
      Cells.Set_Lex_Str (VCGHeap, RightPtr (VCGHeap, TypeFiLimit), LexTokenManager.First_Token);

      -- Create TypeLaLimit as apostrophe (BaseCell, last)
      Structures.CopyStructure (VCGHeap, TypeFiLimit, TypeLaLimit);
      Cells.Set_Lex_Str (VCGHeap, RightPtr (VCGHeap, TypeLaLimit), LexTokenManager.Last_Token);

      if Dictionary.TypeIsEnumeration (Root_Type_Sym) and then not Dictionary.TypeIsCharacter (Root_Type_Sym) then

         ---------------------------------------------------------
         -- For enumeration types that AREN'T Character, we
         -- build
         --    X >= T'Pos (T'First) and X <= T'Pos (T'Last)
         ---------------------------------------------------------

         -- Create PosFiCell from TypeFiLimit
         CreateAttribFunctionCell (LexTokenManager.Pos_Token, Root_Type_Sym, VCGHeap, PosFiCell);
         SetRightArgument (RightPtr (VCGHeap, PosFiCell), TypeFiLimit, VCGHeap);

         -- Create PosLaCell from TypeLaLimit
         CreateAttribFunctionCell (LexTokenManager.Pos_Token, Root_Type_Sym, VCGHeap, PosLaCell);
         SetRightArgument (RightPtr (VCGHeap, PosLaCell), TypeLaLimit, VCGHeap);

         -- create left-hand of AND
         CreateOpCell (LeftAnd, VCGHeap, RelOperationLHS);
         SetRightArgument (LeftAnd, PosFiCell, VCGHeap);
         SetLeftArgument (LeftAnd, Expr, VCGHeap);

         -- create right-hand of AND
         CreateOpCell (RightAnd, VCGHeap, RelOperationRHS);
         SetRightArgument (RightAnd, PosLaCell, VCGHeap);
         SetLeftArgument (RightAnd, Expr, VCGHeap);
      else
         ---------------------------------------------------------
         -- For integer (signed or modular) and Character types,
         -- we know that
         --       T'Pos (X) = T'Val (X) = X
         -- so we simply build
         --       X >= T'First and X <= T'Last
         ---------------------------------------------------------

         -- create left-hand of AND
         CreateOpCell (LeftAnd, VCGHeap, RelOperationLHS);
         SetRightArgument (LeftAnd, TypeFiLimit, VCGHeap);
         SetLeftArgument (LeftAnd, Expr, VCGHeap);

         -- create right-hand of AND
         CreateOpCell (RightAnd, VCGHeap, RelOperationRHS);
         SetRightArgument (RightAnd, TypeLaLimit, VCGHeap);
         SetLeftArgument (RightAnd, Expr, VCGHeap);

      end if;

      -- form conjunction of the two constraints;
      CreateOpCell (rangeDAG, VCGHeap, MiddleOperator);
      SetRightArgument (rangeDAG, RightAnd, VCGHeap);
      SetLeftArgument (rangeDAG, LeftAnd, VCGHeap);

      Check_Cell := rangeDAG;
   end CreateValConstraint;

   procedure CheckValConstraint (Type_Sym : in Dictionary.Symbol;
                                 Expr     : in Cells.Cell)
   --# global in     Dictionary.Dict;
   --#        in     DoRtc;
   --#        in out CheckStack;
   --#        in out ShortCircuitStack;
   --#        in out Statistics.TableUsage;
   --#        in out VCGHeap;
   --# derives CheckStack,
   --#         ShortCircuitStack,
   --#         Statistics.TableUsage from *,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Expr,
   --#                                    ShortCircuitStack,
   --#                                    Type_Sym,
   --#                                    VCGHeap &
   --#         VCGHeap               from *,
   --#                                    CheckStack,
   --#                                    Dictionary.Dict,
   --#                                    DoRtc,
   --#                                    Expr,
   --#                                    ShortCircuitStack,
   --#                                    Type_Sym;
   is
      Check_Cell, Exp_Copy : Cells.Cell;
   begin
      if DoRtc then
         -- No need to check Type_Sym as SPARK's static-semantics
         -- allows only discrete non-Boolean types here
         -- and then DiscreteTypeWithCheck (Type_Sym)

         -- make a copy of Expr
         Structures.CopyStructure (VCGHeap, Expr, Exp_Copy);

         CreateValConstraint (Exp_Copy, Type_Sym, Check_Cell);
         PlantCheckStatement (Check_Cell, VCGHeap, ShortCircuitStack, CheckStack);
      end if;
   end CheckValConstraint;

begin -- UpProcessAttributeDesignator

   --  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
   ExpnNode := STree.Child_Node (Current_Node => STree.Last_Sibling_Of (Start_Node => STree.Child_Node (Current_Node => Node)));

   --# assert True;
   -- Check for second expression
   if ExpnNode /= STree.NullNode and then STree.Next_Sibling (Current_Node => ExpnNode) /= STree.NullNode then
      -- There is a 2nd expression associated with attribute
      CStacks.PopOff (VCGHeap, ExpnStack, SecondExpnCell);
   else
      SecondExpnCell := Cells.Null_Cell;
   end if;

   --# assert True;
   -- then check for first expression
   if ExpnNode /= STree.NullNode then
      -- There is a 1st expression associated with attribute
      CStacks.PopOff (VCGHeap, ExpnStack, ExpnCell);
      ExpnFound := True;
   else
      ExpnFound := False;
      ExpnCell  := Cells.Null_Cell;
   end if;

   --# assert True;
   PrefixCell := LeftPtr (VCGHeap, CStacks.Top (VCGHeap, ExpnStack));
   if Cells.Get_Kind (VCGHeap, PrefixCell) = Cell_Storage.Op then  --must be a 'BASE
      PrefixCell := LeftPtr (VCGHeap, PrefixCell);
      BaseFound  := True;
   else
      BaseFound := 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 ExpnFound then
      Structures.CopyStructure (VCGHeap, PrefixCell,
                                -- to get
                                ExpnCell);
   end if;

   -- 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.

   PrefixType := STree.NodeSymbol (Node);
   Cells.Set_Kind (VCGHeap, PrefixCell, Cell_Storage.Fixed_Var);
   Cells.Set_Symbol_Value (VCGHeap, PrefixCell, PrefixType);
   if Dictionary.IsParameterConstraint (PrefixType) then
      -- 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
      Cells.Set_Kind (VCGHeap, PrefixCell, Cell_Storage.Unconstrained_Attribute_Prefix);
   end if;
   -- make leaf
   SetLeftArgument (PrefixCell, Cells.Null_Cell, VCGHeap);
   SetRightArgument (PrefixCell, Cells.Null_Cell, VCGHeap);
   SetAuxPtr (PrefixCell, Cells.Null_Cell, VCGHeap);

   AttribCell := RightPtr (VCGHeap, CStacks.Top (VCGHeap, ExpnStack));
   AttribName := Cells.Get_Lex_Str (VCGHeap, AttribCell);

   --# assert True;
   if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                           Lex_Str2 => LexTokenManager.Pos_Token) =
     LexTokenManager.Str_Eq
     or else LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                                  Lex_Str2 => LexTokenManager.Val_Token) =
     LexTokenManager.Str_Eq then
      if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                              Lex_Str2 => LexTokenManager.Val_Token) =
        LexTokenManager.Str_Eq then
         CheckValConstraint (PrefixType, ExpnCell);
      end if;

      if Dictionary.TypeIsEnumeration (PrefixType) and then not Dictionary.TypeIsCharacter (PrefixType) then

         -- Enumeration type but NOT character - model as an FDL
         -- function.
         ModelSimpleFunctionAttribute (StripToRootType => True);
      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
         EliminateBase (CStacks.Top (VCGHeap, ExpnStack));
         CStacks.PopOff (VCGHeap, ExpnStack, TempCell);
         Cells.Dispose_Of_Cell (VCGHeap, LeftPtr (VCGHeap, TempCell));
         Cells.Dispose_Of_Cell (VCGHeap, RightPtr (VCGHeap, TempCell));
         Cells.Dispose_Of_Cell (VCGHeap, TempCell);
         CStacks.Push (VCGHeap, ExpnCell, ExpnStack);
      end if;

   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                              Lex_Str2 => LexTokenManager.Floor_Token) =
     LexTokenManager.Str_Eq
     or else LexTokenManager.Lex_String_Case_Insensitive_Compare
     (Lex_Str1 => AttribName,
      Lex_Str2 => LexTokenManager.Ceiling_Token) =
     LexTokenManager.Str_Eq then
      ModelSimpleFunctionAttribute (StripToRootType => True);

   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                              Lex_Str2 => LexTokenManager.Pred_Token) =
     LexTokenManager.Str_Eq
     or else LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                                  Lex_Str2 => LexTokenManager.Succ_Token) =
     LexTokenManager.Str_Eq then
      EliminateBase (CStacks.Top (VCGHeap, ExpnStack));
      CStacks.PopOff (VCGHeap, ExpnStack, TempCell);
      Cells.Dispose_Of_Cell (VCGHeap, LeftPtr (VCGHeap, TempCell));
      Cells.Dispose_Of_Cell (VCGHeap, RightPtr (VCGHeap, TempCell));
      Cells.Dispose_Of_Cell (VCGHeap, TempCell);
      CStacks.Push (VCGHeap, ExpnCell, ExpnStack);

      CheckPredSuccConstraint (PrefixType, ExpnCell, AttribName);

      --# assert True;
      if Dictionary.TypeIsEnumeration (PrefixType) then
         if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                                 Lex_Str2 => LexTokenManager.Succ_Token) =
           LexTokenManager.Str_Eq then
            PushFunction (Cell_Storage.Succ_Function, VCGHeap, ExpnStack);
         else
            PushFunction (Cell_Storage.Pred_Function, VCGHeap, ExpnStack);
         end if;
      else -- must be discrete numeric type so use + or - instead
         LexTokenManager.Insert_Nat (N       => 1,
                                     Lex_Str => LexStr);
         CreateManifestConstCell (TempCell, VCGHeap, LexStr);
         CStacks.Push (VCGHeap, TempCell, ExpnStack);
         if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                                 Lex_Str2 => LexTokenManager.Succ_Token) =
           LexTokenManager.Str_Eq then
            PushOperator (Binary, SP_Symbols.plus, VCGHeap, ExpnStack);
         else
            PushOperator (Binary, SP_Symbols.minus, VCGHeap, ExpnStack);
         end if;
         ModularizeIfNeeded (PrefixType, VCGHeap, ExpnStack);
      end if;

   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                              Lex_Str2 => LexTokenManager.First_Token) =
     LexTokenManager.Str_Eq
     or else LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                                  Lex_Str2 => LexTokenManager.Last_Token) =
     LexTokenManager.Str_Eq then
      if BaseFound and then Dictionary.TypeIsEnumeration (PrefixType) then
         Cells.Set_Symbol_Value (VCGHeap, PrefixCell, Dictionary.GetRootType (PrefixType));
         EliminateBase (CStacks.Top (VCGHeap, ExpnStack));
      end if;

   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                              Lex_Str2 => LexTokenManager.Range_Token) =
     LexTokenManager.Str_Eq then

      TransformRangeConstraint (VCGHeap, ExpnStack);

   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                              Lex_Str2 => LexTokenManager.Length_Token) =
     LexTokenManager.Str_Eq then
      ModelLengthAttribute;

   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                              Lex_Str2 => LexTokenManager.Max_Token) =
     LexTokenManager.Str_Eq
     or else LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                                  Lex_Str2 => LexTokenManager.Min_Token) =
     LexTokenManager.Str_Eq then
      ModelMinMax;

   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                              Lex_Str2 => LexTokenManager.Valid_Token) =
     LexTokenManager.Str_Eq then
      -- support for 'Valid in SPARK95
      -- using the ExpnCell 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
      ModelSimpleFunctionAttribute (StripToRootType => False);

   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => AttribName,
                                                              Lex_Str2 => LexTokenManager.Mod_Token) =
     LexTokenManager.Str_Eq then
      ModelModFunctionAttribute (PrefixType);

   else -- its a non-function, non-substitutable attribute
      if Cells.Get_Kind (VCGHeap, PrefixCell) = Cell_Storage.Reference then
         Cells.Set_Kind (VCGHeap, PrefixCell, Cell_Storage.Fixed_Var);
      end if;
   end if;
end UpAttributeDesignator;
