gcc/ada/aspects.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              A S P E C T S                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2010-2019, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Atree;    use Atree;
  33 with Einfo;    use Einfo;
  34 with Nlists;   use Nlists;
  35 with Sinfo;    use Sinfo;
  36 with Tree_IO;  use Tree_IO;
  37
  38 with GNAT.HTable;
  39
  40 package body Aspects is
  41
  42    --  The following array indicates aspects that a subtype inherits from its
  43    --  base type. True means that the subtype inherits the aspect from its base
  44    --  type. False means it is not inherited.
  45
  46    Base_Aspect : constant array (Aspect_Id) of Boolean :=
  47      (Aspect_Atomic                  => True,
  48       Aspect_Atomic_Components       => True,
  49       Aspect_Constant_Indexing       => True,
  50       Aspect_Default_Iterator        => True,
  51       Aspect_Discard_Names           => True,
  52       Aspect_Independent_Components  => True,
  53       Aspect_Iterator_Element        => True,
  54       Aspect_Type_Invariant          => True,
  55       Aspect_Unchecked_Union         => True,
  56       Aspect_Variable_Indexing       => True,
  57       Aspect_Volatile                => True,
  58       Aspect_Volatile_Full_Access    => True,
  59       others                         => False);
  60
  61    --  The following array indicates type aspects that are inherited and apply
  62    --  to the class-wide type as well.
  63
  64    Inherited_Aspect : constant array (Aspect_Id) of Boolean :=
  65      (Aspect_Constant_Indexing    => True,
  66       Aspect_Default_Iterator     => True,
  67       Aspect_Implicit_Dereference => True,
  68       Aspect_Iterator_Element     => True,
  69       Aspect_Remote_Types         => True,
  70       Aspect_Variable_Indexing    => True,
  71       others                      => False);
  72
  73    procedure Set_Aspect_Specifications_No_Check (N : Node_Id; L : List_Id);
  74    --  Same as Set_Aspect_Specifications, but does not contain the assertion
  75    --  that checks that N does not already have aspect specifications. This
  76    --  subprogram is supposed to be used as a part of Tree_Read. When reading
  77    --  tree, first read nodes with their basic properties (as Atree.Tree_Read),
  78    --  this includes reading the Has_Aspects flag for each node, then we reed
  79    --  all the list tables and only after that we call Tree_Read for Aspects.
  80    --  That is, when reading the tree, the list of aspects is attached to the
  81    --  node that already has Has_Aspects flag set ON.
  82
  83    ------------------------------------------
  84    -- Hash Table for Aspect Specifications --
  85    ------------------------------------------
  86
  87    type AS_Hash_Range is range 0 .. 510;
  88    --  Size of hash table headers
  89
  90    function AS_Hash (F : Node_Id) return AS_Hash_Range;
  91    --  Hash function for hash table
  92
  93    function AS_Hash (F : Node_Id) return AS_Hash_Range is
  94    begin
  95       return AS_Hash_Range (F mod 511);
  96    end AS_Hash;
  97
  98    package Aspect_Specifications_Hash_Table is new
  99      GNAT.HTable.Simple_HTable
 100        (Header_Num => AS_Hash_Range,
 101         Element    => List_Id,
 102         No_Element => No_List,
 103         Key        => Node_Id,
 104         Hash       => AS_Hash,
 105         Equal      => "=");
 106
 107    -------------------------------------
 108    -- Hash Table for Aspect Id Values --
 109    -------------------------------------
 110
 111    type AI_Hash_Range is range 0 .. 112;
 112    --  Size of hash table headers
 113
 114    function AI_Hash (F : Name_Id) return AI_Hash_Range;
 115    --  Hash function for hash table
 116
 117    function AI_Hash (F : Name_Id) return AI_Hash_Range is
 118    begin
 119       return AI_Hash_Range (F mod 113);
 120    end AI_Hash;
 121
 122    package Aspect_Id_Hash_Table is new
 123      GNAT.HTable.Simple_HTable
 124        (Header_Num => AI_Hash_Range,
 125         Element    => Aspect_Id,
 126         No_Element => No_Aspect,
 127         Key        => Name_Id,
 128         Hash       => AI_Hash,
 129         Equal      => "=");
 130
 131    ---------------------------
 132    -- Aspect_Specifications --
 133    ---------------------------
 134
 135    function Aspect_Specifications (N : Node_Id) return List_Id is
 136    begin
 137       if Has_Aspects (N) then
 138          return Aspect_Specifications_Hash_Table.Get (N);
 139       else
 140          return No_List;
 141       end if;
 142    end Aspect_Specifications;
 143
 144    --------------------------------
 145    -- Aspects_On_Body_Or_Stub_OK --
 146    --------------------------------
 147
 148    function Aspects_On_Body_Or_Stub_OK (N : Node_Id) return Boolean is
 149       Aspect  : Node_Id;
 150       Aspects : List_Id;
 151
 152    begin
 153       --  The routine should be invoked on a body [stub] with aspects
 154
 155       pragma Assert (Has_Aspects (N));
 156       pragma Assert (Nkind (N) in N_Body_Stub
 157                        or else Nkind_In (N, N_Entry_Body,
 158                                             N_Package_Body,
 159                                             N_Protected_Body,
 160                                             N_Subprogram_Body,
 161                                             N_Task_Body));
 162
 163       --  Look through all aspects and see whether they can be applied to a
 164       --  body [stub].
 165
 166       Aspects := Aspect_Specifications (N);
 167       Aspect  := First (Aspects);
 168       while Present (Aspect) loop
 169          if not Aspect_On_Body_Or_Stub_OK (Get_Aspect_Id (Aspect)) then
 170             return False;
 171          end if;
 172
 173          Next (Aspect);
 174       end loop;
 175
 176       return True;
 177    end Aspects_On_Body_Or_Stub_OK;
 178
 179    ----------------------
 180    -- Exchange_Aspects --
 181    ----------------------
 182
 183    procedure Exchange_Aspects (N1 : Node_Id; N2 : Node_Id) is
 184    begin
 185       pragma Assert
 186         (Permits_Aspect_Specifications (N1)
 187            and then Permits_Aspect_Specifications (N2));
 188
 189       --  Perform the exchange only when both nodes have lists to be swapped
 190
 191       if Has_Aspects (N1) and then Has_Aspects (N2) then
 192          declare
 193             L1 : constant List_Id := Aspect_Specifications (N1);
 194             L2 : constant List_Id := Aspect_Specifications (N2);
 195          begin
 196             Set_Parent (L1, N2);
 197             Set_Parent (L2, N1);
 198             Aspect_Specifications_Hash_Table.Set (N1, L2);
 199             Aspect_Specifications_Hash_Table.Set (N2, L1);
 200          end;
 201       end if;
 202    end Exchange_Aspects;
 203
 204    -----------------
 205    -- Find_Aspect --
 206    -----------------
 207
 208    function Find_Aspect (Id : Entity_Id; A : Aspect_Id) return Node_Id is
 209       Decl  : Node_Id;
 210       Item  : Node_Id;
 211       Owner : Entity_Id;
 212       Spec  : Node_Id;
 213
 214    begin
 215       Owner := Id;
 216
 217       --  Handle various cases of base or inherited aspects for types
 218
 219       if Is_Type (Id) then
 220          if Base_Aspect (A) then
 221             Owner := Base_Type (Owner);
 222          end if;
 223
 224          if Is_Class_Wide_Type (Owner) and then Inherited_Aspect (A) then
 225             Owner := Root_Type (Owner);
 226          end if;
 227
 228          if Is_Private_Type (Owner)
 229             and then Present (Full_View (Owner))
 230             and then not Operational_Aspect (A)
 231          then
 232             Owner := Full_View (Owner);
 233          end if;
 234       end if;
 235
 236       --  Search the representation items for the desired aspect
 237
 238       Item := First_Rep_Item (Owner);
 239       while Present (Item) loop
 240          if Nkind (Item) = N_Aspect_Specification
 241            and then Get_Aspect_Id (Item) = A
 242          then
 243             return Item;
 244          end if;
 245
 246          Next_Rep_Item (Item);
 247       end loop;
 248
 249       --  Note that not all aspects are added to the chain of representation
 250       --  items. In such cases, search the list of aspect specifications. First
 251       --  find the declaration node where the aspects reside. This is usually
 252       --  the parent or the parent of the parent.
 253
 254       Decl := Parent (Owner);
 255       if not Permits_Aspect_Specifications (Decl) then
 256          Decl := Parent (Decl);
 257       end if;
 258
 259       --  Search the list of aspect specifications for the desired aspect
 260
 261       if Permits_Aspect_Specifications (Decl) then
 262          Spec := First (Aspect_Specifications (Decl));
 263          while Present (Spec) loop
 264             if Get_Aspect_Id (Spec) = A then
 265                return Spec;
 266             end if;
 267
 268             Next (Spec);
 269          end loop;
 270       end if;
 271
 272       --  The entity does not carry any aspects or the desired aspect was not
 273       --  found.
 274
 275       return Empty;
 276    end Find_Aspect;
 277
 278    --------------------------
 279    -- Find_Value_Of_Aspect --
 280    --------------------------
 281
 282    function Find_Value_Of_Aspect
 283      (Id : Entity_Id;
 284       A  : Aspect_Id) return Node_Id
 285    is
 286       Spec : constant Node_Id := Find_Aspect (Id, A);
 287
 288    begin
 289       if Present (Spec) then
 290          if A = Aspect_Default_Iterator then
 291             return Expression (Aspect_Rep_Item (Spec));
 292          else
 293             return Expression (Spec);
 294          end if;
 295       end if;
 296
 297       return Empty;
 298    end Find_Value_Of_Aspect;
 299
 300    -------------------
 301    -- Get_Aspect_Id --
 302    -------------------
 303
 304    function Get_Aspect_Id (Name : Name_Id) return Aspect_Id is
 305    begin
 306       return Aspect_Id_Hash_Table.Get (Name);
 307    end Get_Aspect_Id;
 308
 309    function Get_Aspect_Id (Aspect : Node_Id) return Aspect_Id is
 310    begin
 311       pragma Assert (Nkind (Aspect) = N_Aspect_Specification);
 312       return Aspect_Id_Hash_Table.Get (Chars (Identifier (Aspect)));
 313    end Get_Aspect_Id;
 314
 315    ----------------
 316    -- Has_Aspect --
 317    ----------------
 318
 319    function Has_Aspect (Id : Entity_Id; A : Aspect_Id) return Boolean is
 320    begin
 321       return Present (Find_Aspect (Id, A));
 322    end Has_Aspect;
 323
 324    ------------------
 325    -- Move_Aspects --
 326    ------------------
 327
 328    procedure Move_Aspects (From : Node_Id; To : Node_Id) is
 329       pragma Assert (not Has_Aspects (To));
 330    begin
 331       if Has_Aspects (From) then
 332          Set_Aspect_Specifications (To, Aspect_Specifications (From));
 333          Aspect_Specifications_Hash_Table.Remove (From);
 334          Set_Has_Aspects (From, False);
 335       end if;
 336    end Move_Aspects;
 337
 338    ---------------------------
 339    -- Move_Or_Merge_Aspects --
 340    ---------------------------
 341
 342    procedure Move_Or_Merge_Aspects (From : Node_Id; To : Node_Id) is
 343       procedure Relocate_Aspect (Asp : Node_Id);
 344       --  Move aspect specification Asp to the aspect specifications of node To
 345
 346       ---------------------
 347       -- Relocate_Aspect --
 348       ---------------------
 349
 350       procedure Relocate_Aspect (Asp : Node_Id) is
 351          Asps : List_Id;
 352
 353       begin
 354          if Has_Aspects (To) then
 355             Asps := Aspect_Specifications (To);
 356
 357          --  Create a new aspect specification list for node To
 358
 359          else
 360             Asps := New_List;
 361             Set_Aspect_Specifications (To, Asps);
 362             Set_Has_Aspects (To);
 363          end if;
 364
 365          --  Remove the aspect from its original owner and relocate it to node
 366          --  To.
 367
 368          Remove (Asp);
 369          Append (Asp, Asps);
 370       end Relocate_Aspect;
 371
 372       --  Local variables
 373
 374       Asp      : Node_Id;
 375       Asp_Id   : Aspect_Id;
 376       Next_Asp : Node_Id;
 377
 378    --  Start of processing for Move_Or_Merge_Aspects
 379
 380    begin
 381       if Has_Aspects (From) then
 382          Asp := First (Aspect_Specifications (From));
 383          while Present (Asp) loop
 384
 385             --  Store the next aspect now as a potential relocation will alter
 386             --  the contents of the list.
 387
 388             Next_Asp := Next (Asp);
 389
 390             --  When moving or merging aspects from a subprogram body stub that
 391             --  also acts as a spec, relocate only those aspects that may apply
 392             --  to a body [stub]. Note that a precondition must also be moved
 393             --  to the proper body as the pre/post machinery expects it to be
 394             --  there.
 395
 396             if Nkind (From) = N_Subprogram_Body_Stub
 397               and then No (Corresponding_Spec_Of_Stub (From))
 398             then
 399                Asp_Id := Get_Aspect_Id (Asp);
 400
 401                if Aspect_On_Body_Or_Stub_OK (Asp_Id)
 402                  or else Asp_Id = Aspect_Pre
 403                  or else Asp_Id = Aspect_Precondition
 404                then
 405                   Relocate_Aspect (Asp);
 406                end if;
 407
 408             --  When moving or merging aspects from a single concurrent type
 409             --  declaration, relocate only those aspects that may apply to the
 410             --  anonymous object created for the type.
 411
 412             --  Note: It is better to use Is_Single_Concurrent_Type_Declaration
 413             --  here, but Aspects and Sem_Util have incompatible licenses.
 414
 415             elsif Nkind_In
 416                     (Original_Node (From), N_Single_Protected_Declaration,
 417                                            N_Single_Task_Declaration)
 418             then
 419                Asp_Id := Get_Aspect_Id (Asp);
 420
 421                if Aspect_On_Anonymous_Object_OK (Asp_Id) then
 422                   Relocate_Aspect (Asp);
 423                end if;
 424
 425             --  Default case - relocate the aspect to its new owner
 426
 427             else
 428                Relocate_Aspect (Asp);
 429             end if;
 430
 431             Asp := Next_Asp;
 432          end loop;
 433
 434          --  The relocations may have left node From's aspect specifications
 435          --  list empty. If this is the case, simply remove the aspects.
 436
 437          if Is_Empty_List (Aspect_Specifications (From)) then
 438             Remove_Aspects (From);
 439          end if;
 440       end if;
 441    end Move_Or_Merge_Aspects;
 442
 443    -----------------------------------
 444    -- Permits_Aspect_Specifications --
 445    -----------------------------------
 446
 447    Has_Aspect_Specifications_Flag : constant array (Node_Kind) of Boolean :=
 448      (N_Abstract_Subprogram_Declaration        => True,
 449       N_Component_Declaration                  => True,
 450       N_Entry_Body                             => True,
 451       N_Entry_Declaration                      => True,
 452       N_Exception_Declaration                  => True,
 453       N_Exception_Renaming_Declaration         => True,
 454       N_Expression_Function                    => True,
 455       N_Formal_Abstract_Subprogram_Declaration => True,
 456       N_Formal_Concrete_Subprogram_Declaration => True,
 457       N_Formal_Object_Declaration              => True,
 458       N_Formal_Package_Declaration             => True,
 459       N_Formal_Type_Declaration                => True,
 460       N_Full_Type_Declaration                  => True,
 461       N_Function_Instantiation                 => True,
 462       N_Generic_Package_Declaration            => True,
 463       N_Generic_Renaming_Declaration           => True,
 464       N_Generic_Subprogram_Declaration         => True,
 465       N_Object_Declaration                     => True,
 466       N_Object_Renaming_Declaration            => True,
 467       N_Package_Body                           => True,
 468       N_Package_Body_Stub                      => True,
 469       N_Package_Declaration                    => True,
 470       N_Package_Instantiation                  => True,
 471       N_Package_Specification                  => True,
 472       N_Package_Renaming_Declaration           => True,
 473       N_Private_Extension_Declaration          => True,
 474       N_Private_Type_Declaration               => True,
 475       N_Procedure_Instantiation                => True,
 476       N_Protected_Body                         => True,
 477       N_Protected_Body_Stub                    => True,
 478       N_Protected_Type_Declaration             => True,
 479       N_Single_Protected_Declaration           => True,
 480       N_Single_Task_Declaration                => True,
 481       N_Subprogram_Body                        => True,
 482       N_Subprogram_Body_Stub                   => True,
 483       N_Subprogram_Declaration                 => True,
 484       N_Subprogram_Renaming_Declaration        => True,
 485       N_Subtype_Declaration                    => True,
 486       N_Task_Body                              => True,
 487       N_Task_Body_Stub                         => True,
 488       N_Task_Type_Declaration                  => True,
 489       others                                   => False);
 490
 491    function Permits_Aspect_Specifications (N : Node_Id) return Boolean is
 492    begin
 493       return Has_Aspect_Specifications_Flag (Nkind (N));
 494    end Permits_Aspect_Specifications;
 495
 496    --------------------
 497    -- Remove_Aspects --
 498    --------------------
 499
 500    procedure Remove_Aspects (N : Node_Id) is
 501    begin
 502       if Has_Aspects (N) then
 503          Aspect_Specifications_Hash_Table.Remove (N);
 504          Set_Has_Aspects (N, False);
 505       end if;
 506    end Remove_Aspects;
 507
 508    -----------------
 509    -- Same_Aspect --
 510    -----------------
 511
 512    --  Table used for Same_Aspect, maps aspect to canonical aspect
 513
 514    Canonical_Aspect : constant array (Aspect_Id) of Aspect_Id :=
 515    (No_Aspect                           => No_Aspect,
 516     Aspect_Abstract_State               => Aspect_Abstract_State,
 517     Aspect_Address                      => Aspect_Address,
 518     Aspect_Alignment                    => Aspect_Alignment,
 519     Aspect_All_Calls_Remote             => Aspect_All_Calls_Remote,
 520     Aspect_Annotate                     => Aspect_Annotate,
 521     Aspect_Async_Readers                => Aspect_Async_Readers,
 522     Aspect_Async_Writers                => Aspect_Async_Writers,
 523     Aspect_Asynchronous                 => Aspect_Asynchronous,
 524     Aspect_Atomic                       => Aspect_Atomic,
 525     Aspect_Atomic_Components            => Aspect_Atomic_Components,
 526     Aspect_Attach_Handler               => Aspect_Attach_Handler,
 527     Aspect_Bit_Order                    => Aspect_Bit_Order,
 528     Aspect_Component_Size               => Aspect_Component_Size,
 529     Aspect_Constant_After_Elaboration   => Aspect_Constant_After_Elaboration,
 530     Aspect_Constant_Indexing            => Aspect_Constant_Indexing,
 531     Aspect_Contract_Cases               => Aspect_Contract_Cases,
 532     Aspect_Convention                   => Aspect_Convention,
 533     Aspect_CPU                          => Aspect_CPU,
 534     Aspect_Default_Component_Value      => Aspect_Default_Component_Value,
 535     Aspect_Default_Initial_Condition    => Aspect_Default_Initial_Condition,
 536     Aspect_Default_Iterator             => Aspect_Default_Iterator,
 537     Aspect_Default_Storage_Pool         => Aspect_Default_Storage_Pool,
 538     Aspect_Default_Value                => Aspect_Default_Value,
 539     Aspect_Depends                      => Aspect_Depends,
 540     Aspect_Dimension                    => Aspect_Dimension,
 541     Aspect_Dimension_System             => Aspect_Dimension_System,
 542     Aspect_Disable_Controlled           => Aspect_Disable_Controlled,
 543     Aspect_Discard_Names                => Aspect_Discard_Names,
 544     Aspect_Dispatching_Domain           => Aspect_Dispatching_Domain,
 545     Aspect_Dynamic_Predicate            => Aspect_Predicate,
 546     Aspect_Effective_Reads              => Aspect_Effective_Reads,
 547     Aspect_Effective_Writes             => Aspect_Effective_Writes,
 548     Aspect_Elaborate_Body               => Aspect_Elaborate_Body,
 549     Aspect_Export                       => Aspect_Export,
 550     Aspect_Extensions_Visible           => Aspect_Extensions_Visible,
 551     Aspect_External_Name                => Aspect_External_Name,
 552     Aspect_External_Tag                 => Aspect_External_Tag,
 553     Aspect_Favor_Top_Level              => Aspect_Favor_Top_Level,
 554     Aspect_Ghost                        => Aspect_Ghost,
 555     Aspect_Global                       => Aspect_Global,
 556     Aspect_Implicit_Dereference         => Aspect_Implicit_Dereference,
 557     Aspect_Import                       => Aspect_Import,
 558     Aspect_Independent                  => Aspect_Independent,
 559     Aspect_Independent_Components       => Aspect_Independent_Components,
 560     Aspect_Inline                       => Aspect_Inline,
 561     Aspect_Inline_Always                => Aspect_Inline,
 562     Aspect_Initial_Condition            => Aspect_Initial_Condition,
 563     Aspect_Initializes                  => Aspect_Initializes,
 564     Aspect_Input                        => Aspect_Input,
 565     Aspect_Interrupt_Handler            => Aspect_Interrupt_Handler,
 566     Aspect_Interrupt_Priority           => Aspect_Priority,
 567     Aspect_Invariant                    => Aspect_Invariant,
 568     Aspect_Iterable                     => Aspect_Iterable,
 569     Aspect_Iterator_Element             => Aspect_Iterator_Element,
 570     Aspect_Link_Name                    => Aspect_Link_Name,
 571     Aspect_Linker_Section               => Aspect_Linker_Section,
 572     Aspect_Lock_Free                    => Aspect_Lock_Free,
 573     Aspect_Machine_Radix                => Aspect_Machine_Radix,
 574     Aspect_Max_Entry_Queue_Depth        => Aspect_Max_Entry_Queue_Depth,
 575     Aspect_Max_Entry_Queue_Length       => Aspect_Max_Entry_Queue_Length,
 576     Aspect_Max_Queue_Length             => Aspect_Max_Queue_Length,
 577     Aspect_No_Caching                   => Aspect_No_Caching,
 578     Aspect_No_Elaboration_Code_All      => Aspect_No_Elaboration_Code_All,
 579     Aspect_No_Inline                    => Aspect_No_Inline,
 580     Aspect_No_Return                    => Aspect_No_Return,
 581     Aspect_No_Tagged_Streams            => Aspect_No_Tagged_Streams,
 582     Aspect_Obsolescent                  => Aspect_Obsolescent,
 583     Aspect_Object_Size                  => Aspect_Object_Size,
 584     Aspect_Output                       => Aspect_Output,
 585     Aspect_Pack                         => Aspect_Pack,
 586     Aspect_Part_Of                      => Aspect_Part_Of,
 587     Aspect_Persistent_BSS               => Aspect_Persistent_BSS,
 588     Aspect_Post                         => Aspect_Post,
 589     Aspect_Postcondition                => Aspect_Post,
 590     Aspect_Pre                          => Aspect_Pre,
 591     Aspect_Precondition                 => Aspect_Pre,
 592     Aspect_Predicate                    => Aspect_Predicate,
 593     Aspect_Predicate_Failure            => Aspect_Predicate_Failure,
 594     Aspect_Preelaborate                 => Aspect_Preelaborate,
 595     Aspect_Preelaborable_Initialization => Aspect_Preelaborable_Initialization,
 596     Aspect_Priority                     => Aspect_Priority,
 597     Aspect_Pure                         => Aspect_Pure,
 598     Aspect_Pure_Function                => Aspect_Pure_Function,
 599     Aspect_Refined_Depends              => Aspect_Refined_Depends,
 600     Aspect_Refined_Global               => Aspect_Refined_Global,
 601     Aspect_Refined_Post                 => Aspect_Refined_Post,
 602     Aspect_Refined_State                => Aspect_Refined_State,
 603     Aspect_Remote_Access_Type           => Aspect_Remote_Access_Type,
 604     Aspect_Remote_Call_Interface        => Aspect_Remote_Call_Interface,
 605     Aspect_Remote_Types                 => Aspect_Remote_Types,
 606     Aspect_Read                         => Aspect_Read,
 607     Aspect_Relative_Deadline            => Aspect_Relative_Deadline,
 608     Aspect_Scalar_Storage_Order         => Aspect_Scalar_Storage_Order,
 609     Aspect_Secondary_Stack_Size         => Aspect_Secondary_Stack_Size,
 610     Aspect_Shared                       => Aspect_Atomic,
 611     Aspect_Shared_Passive               => Aspect_Shared_Passive,
 612     Aspect_Simple_Storage_Pool          => Aspect_Simple_Storage_Pool,
 613     Aspect_Simple_Storage_Pool_Type     => Aspect_Simple_Storage_Pool_Type,
 614     Aspect_Size                         => Aspect_Size,
 615     Aspect_Small                        => Aspect_Small,
 616     Aspect_SPARK_Mode                   => Aspect_SPARK_Mode,
 617     Aspect_Static_Predicate             => Aspect_Predicate,
 618     Aspect_Storage_Pool                 => Aspect_Storage_Pool,
 619     Aspect_Storage_Size                 => Aspect_Storage_Size,
 620     Aspect_Stream_Size                  => Aspect_Stream_Size,
 621     Aspect_Suppress                     => Aspect_Suppress,
 622     Aspect_Suppress_Debug_Info          => Aspect_Suppress_Debug_Info,
 623     Aspect_Suppress_Initialization      => Aspect_Suppress_Initialization,
 624     Aspect_Synchronization              => Aspect_Synchronization,
 625     Aspect_Test_Case                    => Aspect_Test_Case,
 626     Aspect_Thread_Local_Storage         => Aspect_Thread_Local_Storage,
 627     Aspect_Type_Invariant               => Aspect_Invariant,
 628     Aspect_Unchecked_Union              => Aspect_Unchecked_Union,
 629     Aspect_Unimplemented                => Aspect_Unimplemented,
 630     Aspect_Universal_Aliasing           => Aspect_Universal_Aliasing,
 631     Aspect_Universal_Data               => Aspect_Universal_Data,
 632     Aspect_Unmodified                   => Aspect_Unmodified,
 633     Aspect_Unreferenced                 => Aspect_Unreferenced,
 634     Aspect_Unreferenced_Objects         => Aspect_Unreferenced_Objects,
 635     Aspect_Unsuppress                   => Aspect_Unsuppress,
 636     Aspect_Variable_Indexing            => Aspect_Variable_Indexing,
 637     Aspect_Value_Size                   => Aspect_Value_Size,
 638     Aspect_Volatile                     => Aspect_Volatile,
 639     Aspect_Volatile_Components          => Aspect_Volatile_Components,
 640     Aspect_Volatile_Full_Access         => Aspect_Volatile_Full_Access,
 641     Aspect_Volatile_Function            => Aspect_Volatile_Function,
 642     Aspect_Warnings                     => Aspect_Warnings,
 643     Aspect_Write                        => Aspect_Write);
 644
 645    function Same_Aspect (A1 : Aspect_Id; A2 : Aspect_Id) return Boolean is
 646    begin
 647       return Canonical_Aspect (A1) = Canonical_Aspect (A2);
 648    end Same_Aspect;
 649
 650    -------------------------------
 651    -- Set_Aspect_Specifications --
 652    -------------------------------
 653
 654    procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id) is
 655    begin
 656       pragma Assert (Permits_Aspect_Specifications (N));
 657       pragma Assert (not Has_Aspects (N));
 658       pragma Assert (L /= No_List);
 659
 660       Set_Has_Aspects (N);
 661       Set_Parent (L, N);
 662       Aspect_Specifications_Hash_Table.Set (N, L);
 663    end Set_Aspect_Specifications;
 664
 665    ----------------------------------------
 666    -- Set_Aspect_Specifications_No_Check --
 667    ----------------------------------------
 668
 669    procedure Set_Aspect_Specifications_No_Check (N : Node_Id; L : List_Id) is
 670    begin
 671       pragma Assert (Permits_Aspect_Specifications (N));
 672       pragma Assert (L /= No_List);
 673
 674       Set_Has_Aspects (N);
 675       Set_Parent (L, N);
 676       Aspect_Specifications_Hash_Table.Set (N, L);
 677    end Set_Aspect_Specifications_No_Check;
 678
 679    ---------------
 680    -- Tree_Read --
 681    ---------------
 682
 683    procedure Tree_Read is
 684       Node : Node_Id;
 685       List : List_Id;
 686    begin
 687       loop
 688          Tree_Read_Int (Int (Node));
 689          Tree_Read_Int (Int (List));
 690          exit when List = No_List;
 691          Set_Aspect_Specifications_No_Check (Node, List);
 692       end loop;
 693    end Tree_Read;
 694
 695    ----------------
 696    -- Tree_Write --
 697    ----------------
 698
 699    procedure Tree_Write is
 700       Node : Node_Id := Empty;
 701       List : List_Id;
 702    begin
 703       Aspect_Specifications_Hash_Table.Get_First (Node, List);
 704       loop
 705          Tree_Write_Int (Int (Node));
 706          Tree_Write_Int (Int (List));
 707          exit when List = No_List;
 708          Aspect_Specifications_Hash_Table.Get_Next (Node, List);
 709       end loop;
 710    end Tree_Write;
 711
 712 --  Package initialization sets up Aspect Id hash table
 713
 714 begin
 715    for J in Aspect_Id loop
 716       Aspect_Id_Hash_Table.Set (Aspect_Names (J), J);
 717    end loop;
 718 end Aspects;