1------------------------------------------------------------------------------ 2-- -- 3-- ASIS-for-GNAT COMPONENTS -- 4-- -- 5-- A S I S . E X T E N S I O N S -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 1995-2015, Free Software Foundation, Inc. -- 10-- -- 11-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it -- 12-- under terms of the GNU General Public License as published by the Free -- 13-- Software Foundation; either version 3, or (at your option) any later -- 14-- version. ASIS-for-GNAT is distributed in the hope that it will be -- 15-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of -- 16-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- -- 19-- -- 20-- -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception distributed with GNAT; see -- 24-- the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- ASIS-for-GNAT was originally developed by the ASIS-for-GNAT team at the -- 28-- Software Engineering Laboratory of the Swiss Federal Institute of -- 29-- Technology (LGL-EPFL) in Lausanne, Switzerland, in cooperation with the -- 30-- Scientific Research Computer Center of Moscow State University (SRCC -- 31-- MSU), Russia, with funding partially provided by grants from the Swiss -- 32-- National Science Foundation and the Swiss Academy of Engineering -- 33-- Sciences. ASIS-for-GNAT is now maintained by AdaCore -- 34-- (http://www.adacore.com). -- 35-- -- 36------------------------------------------------------------------------------ 37 38pragma Ada_2012; 39 40-- This package contains some ASIS extensions which are needed by the ASIS 41-- implementation for GNAT itself, or which are considered to be useful for 42-- ASIS applications. 43-- 44-- Most of these extensions may be implemented as secondary ASIS queries, 45-- but we often use some optimization based on direct traversal of the GNAT 46-- tree. 47 48-- In this package we follow the GNAT, but not ASIS coding and documentation 49-- style, but for some queries we use the ASIS-style lists of Appropriate, 50-- Expected and Returned kinds. 51 52with Ada.Containers.Hashed_Sets; 53with Ada.Unchecked_Deallocation; 54 55with Asis.Elements; use Asis.Elements; 56with Asis.Text; use Asis.Text; 57 58with GNAT.OS_Lib; use GNAT.OS_Lib; 59 60package Asis.Extensions is 61 62 ------------------------ 63 -- Element containers -- 64 ------------------------ 65 66 function Elements_Hash_Wrapper 67 (E : Asis.Element) 68 return Ada.Containers.Hash_Type; 69 -- Wrapper for Asis.Elements.Hash to be used in the instantiation of 70 -- Ada.Containers.Hashed_Sets 71 72 package Element_Containers is new Ada.Containers.Hashed_Sets 73 (Element_Type => Asis.Element, 74 Hash => Elements_Hash_Wrapper, 75 Equivalent_Elements => Asis.Elements.Is_Equal, 76 "=" => Asis.Elements.Is_Equal); 77 78 ----------------------- 79 -- List Access Types -- 80 ----------------------- 81 82 type Element_List_Access is access Element_List; 83 type Compilation_Unit_List_Access is access Compilation_Unit_List; 84 85 procedure Free is new Ada.Unchecked_Deallocation 86 (Element_List, Element_List_Access); 87 88 procedure Free is new Ada.Unchecked_Deallocation 89 (Compilation_Unit_List, Compilation_Unit_List_Access); 90 91 ---------------------------------- 92 -- Access to Program_Text Type -- 93 ---------------------------------- 94 95 type Program_Text_Access is access Program_Text; 96 procedure Free is new Ada.Unchecked_Deallocation 97 (Program_Text, Program_Text_Access); 98 99 --------------------------- 100 -- Tree creation routine -- 101 --------------------------- 102 103 procedure Compile 104 (Source_File : String_Access; 105 Args : Argument_List; 106 Success : out Boolean; 107 GCC : String_Access := null; 108 Use_GPRBUILD : Boolean := False; 109 Result_In_Current_Dir : Boolean := True; 110 Compiler_Out : String := ""; 111 All_Warnings_Off : Boolean := True; 112 Display_Call : Boolean := False); 113 -- Calls GNAT to create the tree file. The command to create the tree is 114 -- defined by the GCC parameter, if the actual for it is null, the standard 115 -- 'gcc' command is used'. 116 -- 117 -- If Use_GPRBUILD is ON (and GCC is not null) it treats the command to be 118 -- called as gprbuild, otherwise it treats it as gcc (native or cross) and 119 -- forms the list of option for the generated call accordingly. It forms 120 -- argument string for the called program that has the following structure: 121 -- 122 -- - if Use_GPRBUILD is OFF: 123 -- 124 -- -c -gnatct -gnatws -gnatyN -x ada <Args> & <Source_File> 125 -- 126 -- (except in case of calling GNAAMP, for GNAAMP '-x ada' is not set); 127 -- 128 -- - if Use_GPRBUILD is ON 129 -- 130 -- -c -q -f <Args> <Source_File> -cargs -gnatct -gnatws -gnatyN -o obj_file 131 -- 132 -- If All_Warnings_Off is OFF, '-gnatws -gnatyN' are not used. 133 -- 134 -- Result_In_Current_Dir is taken into account only Use_GPRBUILD is ON. If 135 -- This flag is OFF, '-o obj_file' is not used. obj_file is Source_File 136 -- with the suffix replaced '.o' (or appended with '.o' if it does not 137 -- have a suffix) and prepended to the full path to the current directory. 138 -- 139 -- So there is no need to set these options as a part of the value of Args 140 -- parameter (basically Args contains only needed -I, -gnatA, -gnatec 141 -- options, and project file in case of the GPRBUILD call) GCC parameter 142 -- should contain the full path to [cross]gcc (or gprbuild) to be used to 143 -- create the tree (use GNAT.OS_Lib.Locate_Exec_On_Path in the client code 144 -- to detect this path). If this parameter is not set, the standard 145 -- gcc/GNAT installation is used (even if Use_GPRBUILD is set ON). Success 146 -- is set ON if the required tree has been created without detecting any 147 -- compilation errors. Otherwise it is set OFF. 148 -- 149 -- If Compiler_Out is a non-empty string, this string is treated as the 150 -- name of a text file to redirect the compiler output into (if the file 151 -- does not exist, it is created). Otherwise the compiler output is 152 -- sent to Stderr 153 -- 154 -- If Display_Call is ON, outputs into Stderr the command used to call 155 -- GNAT. 156 157 ------------------------------------------------------ 158 -- Placeholders for Traverse_Element instantiations -- 159 ------------------------------------------------------ 160 161 -- If you do not need the state of traversing, and if you do not need 162 -- actual for Post-Operation in this case (this is the common case for 163 -- many situations when some simple traversing is required), the following 164 -- declarations may be used: 165 166 type No_State is (Not_Used); 167 -- Placeholder for the State_Information formal type 168 169 procedure No_Op 170 (Element : Asis.Element; 171 Control : in out Traverse_Control; 172 State : in out No_State); 173 -- Placeholder for the formal Post_Operation procedure 174 175 -------------------- 176 -- Test functions -- 177 -------------------- 178 179 function Is_Assertion (Element : Asis.Element) return Boolean; 180 -- Checks if the argument element is an assertion. The definition of 181 -- assertion is based on the definition of the GNAT-specific pragma 182 -- Assertion_Policy (see GNAT Reference Manual): any aspect definition or 183 -- any pragma that can be specified by a parameter if this pragma is 184 -- considered as assertion. Returns False for any unexpected argument. 185 -- 186 -- Expected Elenebt_Kinds: 187 -- A_Pragma 188 -- 189 -- Expected Definition_Kinds: 190 -- An_Aspect_Specification 191 192 function Is_RCI_Unit (C : Asis.Compilation_Unit) return Boolean; 193 -- Checks if the argument compilation is a remote call interface (RCI) 194 -- unit (See E.2.3). Returns False for any unexpected element. 195 -- 196 -- Expected Unit_Kinds: 197 -- A_Package 198 -- A_Procedure_Body 199 -- A_Function_Body 200 -- A_Generic_Package 201 202 function Acts_As_Spec (Declaration : Asis.Element) return Boolean; 203 -- Checks if its argument is a subprogram body declaration for which no 204 -- separate subprogram declaration exists. Returns False for any 205 -- unexpected argument 206 -- 207 -- Expected Declaration_Kinds: 208 -- A_Procedure_Body_Declaration 209 -- A_Function_Body_Declaration 210 -- An_Expression_Function_Declaration 211 -- A_Procedure_Body_Stub 212 -- A_Function_Body_Stub 213 214 function Is_Aspect_Mark (Element : Asis.Element) return Boolean; 215 -- Checks if Element is an aspect mark from aspect_specification. 216 -- Returns False for any unexpected Element 217 -- 218 -- Expected Expression_Kinds 219 -- An_Identifier 220 -- 221 -- Expected Attribute_Kinds 222 -- A_Class_Attribute 223 224 function Is_Aspect_Specific_Name (Element : Asis.Element) return Boolean; 225 -- Checks if Element is an identifier or a character literal specific for 226 -- some aspect definition. Returns False for any unexpected Element 227 -- 228 -- Expected Expression_Kinds 229 -- A_Character_Literal 230 -- An_Identifier 231 232 function Is_Call_Through_Access_To_Subprogram 233 (Call : Asis.Element) 234 return Boolean; 235 -- Checks if the argument is a function or procedure call when a called 236 -- subprogram is defined by access-to-subprogram value. 237 -- Returns False for any unexpected Element 238 -- 239 -- Expected Statement_Kinds: 240 -- A_Procedure_Call_Statement 241 -- 242 -- Expected Expression_Kinds: 243 -- A_Function_Call 244 245 function Is_Class_Wide 246 (Declaration : Asis.Declaration) 247 return Boolean; 248 -- Checks if the argument subtype is a subtype of some class-wide type. 249 -- Returns False for any unexpected Element 250 -- 251 -- Expected Declaration_Kinds: 252 -- A_Subtype_Declaration 253 254 function Is_Default_For_Null_Procedure 255 (Reference : Asis.Element) 256 return Boolean; 257 -- Checks if Reference is a reference for the default actual that is used 258 -- in expanded generic for a null procedure. Returns False for any 259 -- unexpected argument. 260 -- 261 -- Expected Expression_Kinds: 262 -- An_Identifier 263 264 function Is_Definite_Subtype (Declaration : Asis.Element) return Boolean; 265 -- Checks if an argument is a declaration of a definite subtype (that is, 266 -- if for a given type/subtype declaration this function return true, then 267 -- it is possible to define an object of this (sub)type without imposing 268 -- any constraint. Returns False for any unexpected argument. 269 -- 270 -- Expected Declaration_Kinds: 271 -- An_Ordinary_Type_Declaration 272 -- A_Task_Type_Declaration 273 -- A_Protected_Type_Declaration 274 -- A_Private_Type_Declaration 275 -- A_Private_Extension_Declaration 276 -- A_Subtype_Declaration 277 -- A_Formal_Type_Declaration 278 279 function Is_From_SPARK_Aspect (E : Asis.Element) return Boolean; 280 -- Checks if the argument is from the aspect specification that is specific 281 -- for SPARK 2014. The code in such aspect specifications is an Ada 282 -- extension, it does not follow the language visibility rules, so it may 283 -- contain names that have no definition. 284 285 function Is_Renaming_As_Body (Declaration : Asis.Element) return Boolean; 286 -- Checks if its argument is a renaming-as-body declaration. 287 -- 288 -- 289 -- Expected Element_Kinds: 290 -- A_Procedure_Renaning_Declaration 291 -- A_Function_Renaming_Declaration 292 293 function Is_Completed (Declaration : Asis.Element) return Boolean; 294 -- Checks is its argument (which is expected to be a declaration requiring 295 -- completion) has a completion in its enclosed ASIS Context. 296 -- 297 -- Expected Element_Kinds (this list is not complete ???) 298 -- A_Procedure_Declaration 299 -- A_Function_Declaration 300 301 function Is_Bool_Eq_Declaration 302 (Declaration : Asis.Element) 303 return Boolean; 304 -- Checks if Declaration is a declaration of the equality operation 305 -- returning the predefined boolean type that implicitly declares "/=" 306 -- (See RM 95). Returns False for any unexpected element 307 -- 308 -- Expected Declaration_Kinds 309 -- A_Function_Declaration 310 -- A_Function_Body_Declaration 311 -- A_Function_Renaming_Declaration 312 313 function Is_Implicit_Neq_Declaration 314 (Declaration : Asis.Element) 315 return Boolean; 316 -- Checks if Declaration is an implicit declaration of "/=" operator that 317 -- is declared as a consequence of some Is_Bool_Eq_Declaration declaration 318 -- (See RM 95). Returns False for any unexpected element 319 -- 320 -- Expected Declaration_Kinds 321 -- A_Function_Declaration 322 323 function Is_Tagged_Type_Eq 324 (Declaration : Asis.Element) 325 return Boolean; 326 -- Checks if Declaration is a Is_Bool_Eq_Declaration that corresponds to 327 -- a tagged type and is a dispatching operation for it or the declaration 328 -- of the corresponding complementary implicit "/=" operation (for a 329 -- tagged type). Returns False for any unexpected element. 330 -- 331 -- Expected Declaration_Kinds 332 -- A_Function_Declaration 333 334 function Is_Overriding_Operation 335 (Declaration : Asis.Element) 336 return Boolean; 337 -- Checks if the argument is a subprogram declaration or subprogram 338 -- instantiation that overrides a user-defined type primitive operation. 339 -- Always returns False for Is_Part_Of_Inherited arguments. Returns False 340 -- for any unexpected element. Note that this function checks operation 341 -- overriding, but not only operation hiding 342 -- 343 -- Expected Declaration_Kinds 344 -- A_Procedure_Declaration 345 -- A_Function_Declaration 346 -- A_Procedure_Instantiation 347 -- A_Function_Instantiation 348 -- A_Procedure_Body_Declaration 349 -- A_Function_Body_Declaration 350 -- A_Null_Procedure_Declaration 351 -- A_Procedure_Renaming_Declaration 352 -- A_Function_Renaming_Declaration 353 354 function Is_Predefined_Operator 355 (Operator : Asis.Element) 356 return Boolean; 357 -- Checks if the argument is a reference to a predefined operator. 358 -- Returns False for any unexpected Element 359 -- 360 -- Expected Expression_Kinds: 361 -- An_Operator_Symbol 362 363 function Is_Label (Defining_Name : Asis.Defining_Name) return Boolean; 364 -- Check if the argument is a statement label 365 366 function Is_True_Expression 367 (Expression : Asis.Expression) 368 return Boolean; 369 -- Checks if Expression is an expression in Ada sense, that is if it 370 -- is an expression as defined in RM 4.4, and the type of this expression 371 -- can be represented in ASIS. For An_Expression Element for which 372 -- Is_True_Expression is False, the Corresponding_Expression_Type query 373 -- should yield Nil_Element. Note that this function returns False for an 374 -- expression having anonymous access type. 375 -- 376 -- Expected Element_Kinds: 377 -- An_Expression 378 379 function Has_Anonymous_Type 380 (Expression : Asis.Expression) 381 return Boolean; 382 -- Assuming that Is_True_Expression (Expression) checks if Expression has 383 -- an anonymous type (that is, the type of the expression is not defined 384 -- by some type declaration in the program code. If for some expression 385 -- Has_Anonymous_Type returns True, the Corresponding_Expression_Type query 386 -- should yield Nil_Element for it. 387 388 function Is_Static (Element : Asis.Element) return Boolean; 389 -- Checks if Element represent a static expression or a static range 390 -- constraint. "Static" is considered in the GNAT sense, that is if the 391 -- compiler computes it during the compilation time. We believe, 392 -- that GNAT notions of a static expression and a static range are close 393 -- to the corresponding definitions in RM 95, but we can not guarantee 394 -- this. Returns False for any unexpected Element 395 -- 396 -- Expected Element_Kinds: 397 -- An_Expression for which Is_True_Expression yields True. 398 -- 399 -- Expected Constraint_Kinds: 400 -- A_Range_Attribute_Reference 401 402 function Has_Enumeration_Type 403 (Expression : Asis.Expression) 404 return Boolean; 405 -- Checks if Expression has some enumeration type (including types derived 406 -- from enumeration types). Returns False for any unexpected Element 407 -- 408 -- Expected Element_Kinds: 409 -- An_Expression for which Is_True_Expression yields True. 410 411 function Has_Integer_Type (Expression : Asis.Expression) return Boolean; 412 -- Checks if Expression has some integer type (including types derived 413 -- from integer types). Returns False for any unexpected Element 414 -- 415 -- Expected Element_Kinds: 416 -- An_Expression for which Is_True_Expression yields True. 417 418 function Is_Check_Name 419 (Reference : Asis.Expression) 420 return Boolean; 421 -- Check if Reference denotes a check (either predefined of introduced by 422 -- a GNAT Check_Name pragma. The Reference is expected to be of 423 -- An_Identifier kind. Returns False for any unexpected argument. 424 425 function Is_Uniquely_Defined 426 (Reference : Asis.Expression) 427 return Boolean; 428 -- Check if Reference has a unique definition. The Reference is expected 429 -- to be of An_Identifier, A_Character_Literal, An_Enumeration_Literal or 430 -- An_Operator_Symbol kind, that is, of the same kind as the argument of 431 -- Asis.Expressions.Corresponding_Name_Definition). This test may be used 432 -- to prevent calls of Asis.Expressions.Corresponding_Name_Definition and 433 -- Asis.Expressions.Corresponding_Name_Declaration which raise 434 -- ASIS_Inappropriate_Element (see the documentation of these queries). 435 -- Returns False for any unexpected argument. 436 -- 437 -- Expected Element_Kinds: 438 -- An_Identifier 439 -- An_Operator_Symbol 440 -- A_Character_Literal 441 -- An_Enumeration_Literal 442 443 function Is_Private (Declaration : Asis.Element) return Boolean; 444 -- Checks if Declaration is located in the private part of a package, 445 -- a generic package, a task or protected type or object declaration. 446 -- If Declaration is located in the visible part of such a construct, but 447 -- this enclosing construct is itself located in some private part 448 -- (immediately or being nested in some other constructs), this function 449 -- also returns True. Returns False for any unexpected argument. 450 -- 451 -- Because of the performance reasons the implementation of this 452 -- function is based on the direct traversal of the GNAT tree, so it is not 453 -- an ASIS secondary query. 454 -- 455 -- Expected Element_Kinds: 456 -- A_Declaration 457 -- 458 -- Expected Declaration_Kinds 459 -- All except A_Loop_Parameter_Specification 460 -- A_Generalized_Iterator_Specification 461 -- An_Element_Iterator_Specification 462 463 function Is_Exported (Defining_Name : Asis.Defining_Name) return Boolean; 464 -- Checks if pragma Export is applied to the argument entity. In case if 465 -- this entity is from a subprogram body declaration, this check is made 466 -- for the entity from the corresponding subprogram spec (if any) 467 -- 468 -- Because of the performance reasons the implementation of this 469 -- function is based on the direct traversal of the GNAT tree, so it is not 470 -- an ASIS secondary query. 471 -- 472 -- Expected Element_Kinds: 473 -- A_Defining_Name 474 475 --------------------- 476 -- Run-Time checks -- 477 --------------------- 478 479 type Run_Time_Checks is 480 (Do_Accessibility_Check, 481 Do_Discriminant_Check, 482 Do_Division_Check, 483 Do_Length_Check, 484 Do_Overflow_Check, 485 Do_Range_Check, 486 Do_Storage_Check, 487 Do_Tag_Check); 488 489 type Run_Time_Check_Set is array (Run_Time_Checks) of Boolean; 490 491 Empty_Check_Set : constant Run_Time_Check_Set := (others => False); 492 493 function Needed_Checks 494 (Element : Asis.Element) 495 return Run_Time_Check_Set; 496 -- Any Element is accepted. The returned array represents a set of run-time 497 -- checks that are needed for the argument Element. If the check is needed, 498 -- the corresponding component of the result is set ON, and OFF otherwise. 499 500 ----------------------------------------------------- 501 -- Modified versions of the "primary" ASIS queries -- 502 ----------------------------------------------------- 503 504 function Get_Call_Parameters 505 (Call : Asis.Element; 506 Normalized : Boolean := False) 507 return Asis.Element_List; 508 -- Returns the parameter list from the call. Combines the functionality of 509 -- Asis.Statements.Call_Statement_Parameters and 510 -- Asis.Expressions.Function_Call_Parameters 511 -- 512 -- Appropriate Expression_Kinds: 513 -- A_Function_Call 514 -- 515 -- Appropriate Statement_Kinds: 516 -- An_Entry_Call_Statement 517 -- A_Procedure_Call_Statement 518 -- 519 -- Returns Element_Kinds: 520 -- A_Parameter_Association 521 522 -- The rest of this section contains the modified versions of the queries 523 -- defined in the standard ASIS packages. The names of these modified 524 -- versions may or may not be the same as in the "core" ASIS 525 526 ----------------------- 527 -- Asis.Declarations -- 528 ----------------------- 529 530 function Formal_Subprogram_Default 531 (Declaration : Asis.Generic_Formal_Parameter) 532 return Asis.Expression; 533 -- This is a modified version of the query Formal_Subprogram_Default 534 -- adjusted for use in the implementation of Asis.Elements.Traverse_Element 535 -- generic procedure. Similarly to that ASIS query, it returns the name 536 -- appearing after the reserved word IS in the given generic for 537 -- A_Name_Default Element, but if its argument is of another kind from 538 -- Default_Kinds, it returns Nil_Element instead of raising 539 -- ASIS_Inappropriate_Element. 540 -- 541 -- Appropriate Declaration_Kinds: 542 -- A_Formal_Function_Declaration 543 -- A_Formal_Procedure_Declaration 544 -- 545 -- Returns Element_Kinds: 546 -- An_Expression 547 548 function Primitive_Owner 549 (Declaration : Asis.Declaration) 550 return Asis.Type_Definition; 551 -- In the case that Declaration the explicit declaration of a subprogram 552 -- which Is_Dispatching_Operation for some tagged type, this function 553 -- returns the type definition for which it is a primitive operation. (Note 554 -- that a subprogram declaration may be a primitive operation for more than 555 -- one type, but it may be a primitive operation for at most one tagged 556 -- type. Note also, that for implicitly declared dispatching operations 557 -- the primary ASIS query Asis.Declarations.Corresponding_Type may be used 558 -- to find the type which "owns" the operation). Returns Nil_Element in all 559 -- other cases. 560 -- 561 -- In case of a (non-tagged!) private type that has a tagged full view, a 562 -- type operation declared in visible part is classified as 563 -- Is_Dispatching_Operation, and this function will return private 564 -- non-tagged type definition. 565 -- 566 -- Appropriate Declaration_Kinds (should be the same as expected kinds 567 -- for Asis.Declarations.Is_Dispatching_Operation): 568 -- A_Procedure_Declaration 569 -- A_Function_Declaration 570 -- An_Expression_Function_Declaration 571 -- A_Procedure_Renaming_Declaration 572 -- A_Function_Renaming_Declaration 573 -- A_Null_Procedure_Declaration 574 -- A_Procedure_Body_Declaration 575 -- A_Function_Body_Declaration 576 -- A_Procedure_Body_Stub 577 -- A_Function_Body_Stub 578 -- 579 -- Returns Definition_Kinds: 580 -- A_Private_Type_Definition 581 -- A_Tagged_Private_Type_Definition 582 -- A_Private_Extension_Definition 583 -- A_Task_Definition 584 -- A_Protected_Definition 585 -- 586 -- Returns Type_Kinds: 587 -- A_Derived_Record_Extension_Definition 588 -- A_Tagged_Record_Type_Definition 589 -- 590 -- Returns Element_Kinds 591 -- Not_An_Element 592 593 ---------------------- 594 -- Asis.Expressions -- 595 ---------------------- 596 597 function Corresponding_Called_Function_Unwound 598 (Expression : Asis.Expression) 599 return Asis.Declaration; 600 -- A modification of Asis.Expressions.Corresponding_Called_Function which 601 -- unwinds all the renamings in the case where the function name in the 602 -- argument function call is defined by a renaming declaration. This 603 -- function returns the declaration of the called function *entity*. 604 -- 605 -- Appropriate Expression_Kinds: 606 -- A_Function_Call 607 -- 608 -- Returns Declaration_Kinds: 609 -- Not_A_Declaration 610 -- A_Function_Declaration 611 -- A_Function_Body_Declaration 612 -- A_Function_Body_Stub 613 -- A_Function_Renaming_Declaration 614 -- A_Function_Instantiation 615 -- A_Formal_Function_Declaration 616 617 function Corresponding_Called_Function_Unwinded 618 (Expression : Asis.Expression) 619 return Asis.Declaration renames 620 Corresponding_Called_Function_Unwound; 621 -- For upward compatibility we have to keep the old ungrammatical names of 622 -- this function 623 624 --------------------- 625 -- Asis.Statements -- 626 --------------------- 627 628 function Corresponding_Called_Entity_Unwound 629 (Statement : Asis.Statement) 630 return Asis.Declaration; 631 632 -- A modification of Asis.Statements.Corresponding_Called_Entity which 633 -- unwinds all the renamings in the case where the procedure or entry name 634 -- in the argument call is defined by a renaming declaration. This function 635 -- returns the declaration of the callable *entity*. 636 -- 637 -- Appropriate Statement_Kinds: 638 -- An_Entry_Call_Statement 639 -- A_Procedure_Call_Statement 640 -- 641 -- Returns Declaration_Kinds: 642 -- Not_A_Declaration 643 -- A_Procedure_Declaration 644 -- A_Procedure_Body_Declaration 645 -- A_Procedure_Body_Stub 646 -- A_Procedure_Renaming_Declaration 647 -- A_Procedure_Instantiation 648 -- A_Formal_Procedure_Declaration 649 -- An_Entry_Declaration 650 651 function Corresponding_Called_Entity_Unwinded 652 (Statement : Asis.Statement) 653 return Asis.Declaration renames 654 Corresponding_Called_Entity_Unwound; 655 -- For upward compatibility we have to keep the old ungrammatical names of 656 -- this function 657 658 ------------------- 659 -- Asis.Elements -- 660 ------------------- 661 662 function Pragmas_After 663 (Compilation_Unit : Asis.Compilation_Unit; 664 Include_Pragmas : Boolean := True) 665 return Asis.Pragma_Element_List; 666 -- Returns the list of pragmas the appear immediately following the 667 -- Compilation_Unit, for example: 668 -- with G; 669 -- procedure P is new G; 670 -- pragma Pure (P); 671 672 -------------------------------------- 673 -- Extensions of ASIS functionality -- 674 -------------------------------------- 675 676 ---------------------------- 677 -- Asis.Compilation_Units -- 678 ---------------------------- 679 680 function CU_Requires_Body (Right : Asis.Compilation_Unit) return Boolean; 681 -- Similar to Asis.Compilation_Units.Is_Body_Required, but also checks 682 -- library subprogram declarations and library generic subprogram 683 -- declarations. For (generic) library subprogram declarations, 684 -- returns True unless the subprogram is completed by pragma Import. 685 686 function Is_Obsolete (Right : Asis.Compilation_Unit) return Boolean; 687 -- Checks if the argument unit, Right, is obsolete. A unit is not 688 -- obsolete, if the source for this unit is available and if it 689 -- is the same as the source used for creating the trees. All 690 -- unit kinds are expected, except nil, unknown and nonexistent 691 -- units. Always returns True for any non-expected unit. In case 692 -- of '-SA' Context, always returns False for any expected unit. 693 694 type Source_File_Statuses is ( 695 -- Status of the source file corresponding to a given unit 696 697 No_File_Status, 698 -- Nil value, used for nil, non-existent, and unknown units 699 700 Absent, 701 -- No source file available. This is always the case for the 702 -- predefined Standard package, nil, unknown and non-existent 703 -- units. 704 705 Older, 706 -- The available source file is older then the source used 707 -- to create tree files 708 709 Newer, 710 -- The available source file is newer then the source used 711 -- to create tree files 712 713 Up_To_Date); 714 -- The available source file is the same as the source used 715 -- to create tree files 716 717 function Source_File_Status 718 (Right : Asis.Compilation_Unit) 719 return Source_File_Statuses; 720 -- Checks the status of the source file for the argument unit. 721 722 function Is_Main_Unit_In_Tree 723 (Right : Asis.Compilation_Unit) 724 return Boolean; 725 -- Checks if the argument unit, Right, is a main unit from some compilation 726 -- which has created a tree within the set of tree files making up the 727 -- enclosing Context of this unit. 728 729 function Main_Unit_In_Current_Tree 730 (The_Context : Asis.Context) 731 return Asis.Compilation_Unit; 732 -- If the tree currently accessed by ASIS is from the set of trees making 733 -- up The_Context, then this function returns the corresponding main unit, 734 -- that is, the Compilation_Unit corresponding to the source file which 735 -- has been compiled to create this tree file. Otherwise (this also 736 -- includes the case when the currently accessed tree is null tree), 737 -- returns the main unit for the first tree in the set of trees making up 738 -- The_Context (the meaning of the notion "the first tree" is 739 -- implementation-dependent), and if this set is empty, returns 740 -- Nil_Compilation_Unit. 741 -- 742 -- This function does not check if the argument Context is open. 743 -- 744 -- This function is practically useful for "-C1" Contexts 745 746 function Compilation_Dependencies 747 (Main_Unit : Asis.Compilation_Unit) 748 return Asis.Compilation_Unit_List; 749 -- Provides the full list of units upon which Main_Unit depends 750 -- in the GNAT compilation system. The kind of dependencies 751 -- reported by this query combine semantic dependencies as 752 -- defined by RM 95 and GNAT-specific dependencies. Main_Unit 753 -- should be recompiled if any of the units from the returned 754 -- list has been changed. 755 -- 756 -- Main_Unit should be a main unit from some compilation which 757 -- has created a tree file from the set of tree files making up 758 -- the enclosing Context of Main_Unit. 759 -- 760 -- ASIS_Inappropriate_Compilation_Unit is raised if Main_Unit 761 -- does not satisfy this restriction. 762 -- 763 -- Note, that this query is supposed to be used for ASIS Contexts 764 -- representing complete Ada partitions, otherwise it may return 765 -- formally correct, but meaningless results. 766 -- 767 -- The interface of this query is still subject to design discussions??? 768 -- In particular, some limitations may be imposed on appropriate unit 769 -- kinds, or a special parameter may be added to filter out some parts 770 -- of the result 771 -- 772 -- Appropriate Unit_Kinds: 773 -- A_Procedure 774 -- A_Function 775 -- A_Package 776 -- A_Generic_Procedure 777 -- A_Generic_Function 778 -- A_Generic_Package 779 -- 780 -- A_Procedure_Instance 781 -- A_Function_Instance 782 -- A_Package_Instance 783 -- 784 -- A_Procedure_Renaming 785 -- A_Function_Renaming 786 -- A_Package_Renaming 787 -- 788 -- A_Generic_Procedure_Renaming 789 -- A_Generic_Function_Renaming 790 -- A_Generic_Package_Renaming 791 -- 792 -- A_Procedure_Body 793 -- A_Function_Body 794 -- A_Package_Body 795 -- 796 -- A_Procedure_Body_Subunit 797 -- A_Function_Body_Subunit 798 -- A_Package_Body_Subunit 799 -- A_Task_Body_Subunit 800 -- A_Protected_Body_Subunit 801 -- 802 -- Returns Unit_Kinds: 803 -- A_Procedure 804 -- A_Function 805 -- A_Package 806 -- A_Generic_Procedure 807 -- A_Generic_Function 808 -- A_Generic_Package 809 -- 810 -- A_Procedure_Instance 811 -- A_Function_Instance 812 -- A_Package_Instance 813 -- 814 -- A_Procedure_Renaming 815 -- A_Function_Renaming 816 -- A_Package_Renaming 817 -- 818 -- A_Generic_Procedure_Renaming 819 -- A_Generic_Function_Renaming 820 -- A_Generic_Package_Renaming 821 -- 822 -- A_Procedure_Body 823 -- A_Function_Body 824 -- A_Package_Body 825 -- 826 -- A_Procedure_Body_Subunit 827 -- A_Function_Body_Subunit 828 -- A_Package_Body_Subunit 829 -- A_Task_Body_Subunit 830 -- A_Protected_Body_Subunit 831 832 function Original_Text_Name 833 (Compilation_Unit : Asis.Compilation_Unit) 834 return Wide_String; 835 -- In case if the source of the Compilation_Unit contains a 836 -- Source_Reference pragma, returns the file name from this pragma, 837 -- otherwise returns the same result as Asis.Compilation_Units.Text_Name 838 -- 839 -- All Unit_Kinds are appropriate. 840 841 function Is_Sub_Package_Implemented_As_Child_Unit 842 (Compilation_Unit : Asis.Compilation_Unit) 843 return Boolean; 844 -- Internally, the GNAT implementation treats subpackages of Ada.Text_IO, 845 -- such as Integer_IO, as implicit child units rather local packages 846 -- defined in the specification of Ada.Text_IO. They would have undoubtedly 847 -- been designed this way if child units had been available in the original 848 -- design of Ada. This has the advantage that code for these units is only 849 -- processed and loaded if used. At the compiler level, the difference is 850 -- made entirely invisible to the Ada program, so this transformation is 851 -- completely conforming to the RM. The situation with Ada.Wide_Text_IO and 852 -- Ada.Wide_Wide_Text_IO is the same, see the documentation of these 853 -- packages for full details. 854 -- 855 -- But at the ASIS level, it is not practical to hide this transformation, 856 -- so an ASIS application can see that this is happening, and the 857 -- application itself must handle this as necessary. This query can be used 858 -- to identify ASIS Compilation Units that represents specs and bodies 859 -- of private children of predefined Ada text input-output packages that 860 -- implements the optimization described above. 861 -- 862 -- Note that reverting this GNAT transformation (if needed) is not obvious. 863 -- You may have an ASIS Context that contains a spec and a body of a 864 -- private child of a Standard text IO package, but only a spec of this 865 -- Standard text IO package. So, if an application wants to mimic the code 866 -- of the Standard text input-output package, it is possible to get from 867 -- the private child spec into the spec of the input-output package, but 868 -- not from the private child body into the body of the package because 869 -- there is no such a body in the Context. So this is completely up to 870 -- an ASIS application how to deal with such private children. 871 872 ------------------------------------- 873 -- Extensions to Asis.Declarations -- 874 ------------------------------------- 875 876 function First_Name (Dcl : Asis.Element) return Asis.Element; 877 -- Returns the first defining name from an argument declaration. Is 878 -- equivalent to 879 -- 880 -- Names (Dcl) (Names (Dcl)'First) 881 -- 882 -- Appropriate Element_Kinds: 883 -- A_Declaration 884 -- 885 -- Returns Element_Kinds 886 -- A_Defining_Name 887 888 function Corresponding_Overridden_Operation 889 (Declaration : Asis.Declaration) 890 return Asis.Declaration; 891 -- In case if Is_Overriding_Operation (Declaration) is True, returns the 892 -- declaration of the subprogram that is overridden by Declaration (it may 893 -- be explicit or implicit declaration). Otherwise returns Nil_Element. 894 -- Note, that this query knows nothing about multiple inheritance! 895 -- 896 -- Appropriate Declaration_Kinds: 897 -- A_Procedure_Declaration 898 -- A_Function_Declaration 899 -- A_Procedure_Instantiation 900 -- A_Function_Instantiation 901 -- A_Procedure_Body_Declaration 902 -- A_Function_Body_Declaration 903 -- A_Null_Procedure_Declaration 904 -- A_Procedure_Renaming_Declaration 905 -- A_Function_Renaming_Declaration 906 -- 907 -- Returns Declaration_Kinds: 908 -- A_Procedure_Declaration 909 -- A_Function_Declaration 910 -- A_Procedure_Instantiation 911 -- A_Function_Instantiation 912 -- A_Procedure_Body_Declaration 913 -- A_Function_Body_Declaration 914 -- A_Null_Procedure_Declaration 915 -- A_Procedure_Renaming_Declaration 916 -- A_Function_Renaming_Declaration 917 918 function Corresponding_Overridden_Operations 919 (Declaration : Asis.Declaration) 920 return Asis.Element_List; 921 -- The difference with the previous Corresponding_Overridden_Operation 922 -- in case of multiple inheritance this query returns all the operations 923 -- of the parent type and all the interface types from which the owner 924 -- of the argument primitive is derived. Returns Nil_Element_List if 925 -- not Is_Overriding_Operation (Declaration). 926 -- 927 -- Not implemented yet!!! 928 -- 929 -- Appropriate Declaration_Kinds: 930 -- A_Procedure_Declaration 931 -- A_Function_Declaration 932 -- A_Procedure_Instantiation 933 -- A_Function_Instantiation 934 -- A_Procedure_Body_Declaration 935 -- A_Function_Body_Declaration 936 -- A_Procedure_Renaming_Declaration 937 -- A_Function_Renaming_Declaration 938 -- 939 -- Returns Declaration_Kinds: 940 -- A_Procedure_Declaration 941 -- A_Function_Declaration 942 -- A_Procedure_Instantiation 943 -- A_Function_Instantiation 944 -- A_Procedure_Body_Declaration 945 -- A_Function_Body_Declaration 946 -- A_Procedure_Renaming_Declaration 947 -- A_Function_Renaming_Declaration 948 949 function Has_Controlling_Result 950 (Declaration : Asis.Declaration) 951 return Boolean; 952 -- In case if argument function declaration tests True with 953 -- Is_Dispatching_Operation, checks if the argument function has a 954 -- dispatching result. Returns true for any unexpected argument and for any 955 -- declaration that tests False with Is_Dispatching_Operation. Also returns 956 -- False if an argument declaration is a completion of another declaration. 957 -- 958 -- Expected Element_Kinds: 959 -- A_Function_Declaration 960 -- An_Expression_Function_Declaration 961 -- A_Function_Renaming_Declaration 962 -- A_Function_Body_Declaration 963 -- A_Function_Body_Stub 964 965 function Controlling_Parameters 966 (Declaration : Asis.Declaration) 967 return Asis.Element_List; 968 -- In case if argument subprogram declaration tests True with 969 -- Is_Dispatching_Operation, returns the list of controlling parameter 970 -- specifications (this list can be empty in case of a function having 971 -- controlling result). Returns Nil_Element_List if the argument 972 -- declaration tests False with Is_Dispatching_Operation. Also returns 973 -- Nil_Element_List if an argument declaration is a completion of another 974 -- declaration. 975 -- 976 -- Appropriate Declaration_Kinds: 977 -- A_Procedure_Declaration 978 -- A_Function_Declaration 979 -- An_Expression_Function_Declaration 980 -- A_Procedure_Renaming_Declaration 981 -- A_Function_Renaming_Declaration 982 -- A_Null_Procedure_Declaration 983 -- A_Procedure_Body_Declaration 984 -- A_Function_Body_Declaration 985 -- A_Procedure_Body_Stub 986 -- A_Function_Body_Stub 987 -- 988 -- 989 -- Returns Declaration_Kinds: 990 -- A_Parameter_Specification 991 992 ------------------------------------ 993 -- Extensions to Asis.Definitions -- 994 ------------------------------------ 995 996 function Inherited_Type_Operators 997 (Type_Definition : Asis.Type_Definition) 998 return Asis.Declaration_List; 999 -- Returns a list of user-defined operator functions inherited by this 1000 -- type. (Each operator function in the result list has parameter (s) or 1001 -- (and) result of the argument type. 1002 -- This function is used in the implementation of 1003 -- Asis.Definitions.Corresponding_Type_Operators, that's why the list of 1004 -- appropriate kinds include type definitions that can not have any 1005 -- inherited declarations associated with them. For these arguments 1006 -- Nil_Element_List is returned. For non-null result each component of the 1007 -- result list Is_Part_Of_Implicit and Is_part_Of_Inherited 1008 -- 1009 -- Appropriate Definition_Kinds: 1010 -- A_Type_Definition 1011 -- A_Formal_Type_Declaration 1012 -- A_Private_Type_Definition 1013 -- A_Tagged_Private_Type_Definition 1014 -- A_Private_Extension_Definition 1015 -- A_Task_Definition 1016 -- A_Protected_Definition 1017 -- 1018 -- Returns Declaration_Kinds: 1019 -- A_Function_Declaration 1020 1021 function Explicit_Type_Operators 1022 (Type_Definition : Asis.Type_Definition) 1023 return Asis.Declaration_List; 1024 -- If the argument is of A_Formal_Type_Definition kind, returns a list of 1025 -- formal operator function from the same formal part that have a parameter 1026 -- or return the result of this formal type. Otherwise returns a list of 1027 -- explicitly declared operator functions that are primitive operations 1028 -- of the argument type 1029 -- 1030 -- Appropriate Definition_Kinds: 1031 -- A_Type_Definition 1032 -- A_Formal_Type_Declaration 1033 -- A_Private_Type_Definition 1034 -- A_Tagged_Private_Type_Definition 1035 -- A_Private_Extension_Definition 1036 -- A_Task_Definition 1037 -- A_Protected_Definition 1038 -- 1039 -- Returns Declaration_Kinds: 1040 -- A_Function_Declaration 1041 -- A_Function_Body_Declaration 1042 -- A_Function_Body_Stub 1043 -- A_Function_Renaming_Declaration 1044 -- A_Function_Instantiation 1045 -- A_Formal_Function_Declaration 1046 1047 function Corresponding_Parent_Subtype_Unwind_Base 1048 (Type_Definition : Asis.Type_Definition) 1049 return Asis.Declaration; 1050 -- This query differs from Asis.Definitions,Corresponding_Parent_Subtype 1051 -- in the following. If the argument type definition contains the ('Base) 1052 -- attribute reference as the parent subtype mark, it gets to the prefix 1053 -- of this attribute and applies 1054 -- Asis.Declarations.Corresponding_First_Subtype to it. 1055 1056 ------------------------------------ 1057 -- Extensions to Asis.Expressions -- 1058 ------------------------------------ 1059 1060 function Full_Name_Image 1061 (Expression : Asis.Expression) 1062 return Program_Text; 1063 -- Similar to Asis.Expressions.Name_Image, but also works on full expanded 1064 -- names 1065 1066 function Denotation 1067 (Reference : Asis.Expression) 1068 return Asis.Defining_Name; 1069 -- Returns the defining name denoted by Reference. Same as 1070 -- Corresponding_Name_Definition, except it works for A_Selected_Component. 1071 1072 function Normalize_Reference (Ref : Asis.Element) return Asis.Element; 1073 -- This function is supposed to be called for the ASIS Elements 1074 -- representing a subtype mark. A subtype mark can be represented by 1075 -- an Element of one of the tree following kinds: 1076 -- 1077 -- An_Identifier 1078 -- A_Selected_Component 1079 -- An_Attribute_Reference 1080 -- 1081 -- This function "prepares" its argument for applying the ASIS 1082 -- Corresponding_Name_Definition and Corresponding_Name_Declaration 1083 -- queries, that is, returns its argument if it is of An_Identifier kind, 1084 -- returns the selector of the argument if it is of A_Selected_Component 1085 -- kind, and applies itself to the attribute prefix in case of 1086 -- An_Attribute_Reference 1087 1088 function Corresponding_First_Definition 1089 (Defining_Name : Asis.Defining_Name) 1090 return Asis.Defining_Name; 1091 -- In case there is more than one defining occurrence of an argument 1092 -- Defining_Name representing the same view of the same entity (such as a 1093 -- defining unit name for a program unit for which separate spec and body 1094 -- are present and a formal parameter name for a generic subprogram or 1095 -- subprogram having a separate spec) this function returns the first 1096 -- defining occurrence which actually introduces the corresponding entity. 1097 -- If there are only one defining occurrence of the argument Name, or if 1098 -- for some reason the first defining occurrence cannot be returned, the 1099 -- argument name is returned. 1100 -- 1101 -- Appropriate Element kinds: 1102 -- A_Defining_Name 1103 -- 1104 -- Returns Element kinds: 1105 -- A_Defining_Name 1106 1107 function Corresponding_Body_Parameter_Definition 1108 (Defining_Name : Asis.Defining_Name) 1109 return Asis.Defining_Name; 1110 -- When applying to a defining name which is a name of a formal parameter 1111 -- of a subprogram, this function returns the defining name of this 1112 -- parameter from a subprogram body. If there is no body for this 1113 -- subprogram, Nil_Element is returned. If Defining_Name is not a 1114 -- defining name of a formal subprogram parameter, Nil_Element is 1115 -- returned. 1116 -- 1117 -- Appropriate Element kinds: 1118 -- A_Defining_Identifier 1119 -- 1120 -- Returns Element kinds: 1121 -- A_Defining_Identifier 1122 -- Not_An_Element 1123 1124 function Static_Expression_Value_Image 1125 (Expression : Asis.Expression) 1126 return Wide_String; 1127 -- PARTIALLY IMPLEMENTED!!! 1128 -- Computes the value of Expression (which should be a static expression!) 1129 -- and represents it as a (wide) string. For enumeration expressions, the 1130 -- image of the Pos value of the defining enumeration or character literal 1131 -- corresponding to the value of the expression is returned (see 1132 -- Asis.Declarations.Position_Number_Image query). 1133 -- 1134 -- For ASIS Expression Elements for which Is_True_Expression yields False 1135 -- and empty string is returned 1136 -- 1137 -- For non-static expressions, an empty string is returned. 1138 -- 1139 -- Currently this function is implemented only for discrete and string 1140 -- types. For other types an empty string is returned. 1141 -- 1142 -- Appropriate Element_Kinds: 1143 -- An_Expression 1144 1145 function Static_Range_Low_Bound_Value_Image 1146 (Range_Element : Asis.Range_Constraint) 1147 return Wide_String; 1148 -- PARTIALLY IMPLEMENTED!!! 1149 -- For A_Range_Attribute_Reference constraint defining by a static range, 1150 -- this function computes the value of the corresponding low bound and 1151 -- represents it as a (wide) string. For enumeration ranges, the 1152 -- image of the Pos value of the defining enumeration or character literal 1153 -- corresponding to the value of the low bound is returned (see 1154 -- Asis.Extensions.Static_Expression_Value_Image and 1155 -- Asis.Declarations.Position_Number_Image queries). 1156 -- 1157 -- For non-static expressions ranges, an empty string is returned. 1158 -- 1159 -- Currently this function is implemented only for discrete types. For 1160 -- other types an empty string is returned. 1161 -- 1162 -- Appropriate Constraint_Kinds: 1163 -- A_Range_Attribute_Reference 1164 1165 function Static_Range_High_Bound_Value_Image 1166 (Range_Element : Asis.Range_Constraint) 1167 return Wide_String; 1168 -- PARTIALLY IMPLEMENTED!!! 1169 -- For A_Range_Attribute_Reference constraint defining by a static range, 1170 -- this function computes the value of the corresponding high bound and 1171 -- represents it as a (wide) string. For enumeration ranges, the 1172 -- image of the Pos value of the defining enumeration or character literal 1173 -- corresponding to the value of the high bound is returned (see 1174 -- Asis.Extensions.Static_Expression_Value_Image and 1175 -- Asis.Declarations.Position_Number_Image queries). 1176 -- 1177 -- For non-static expressions ranges, an empty string is returned. 1178 -- 1179 -- Currently this function is implemented only for discrete types. For 1180 -- other types an empty string is returned. 1181 -- 1182 -- Appropriate Constraint_Kinds: 1183 -- A_Range_Attribute_Reference 1184 -- 1185 -- Appropriate Discrete_Range_Kinds: 1186 -- A_Discrete_Range_Attribute_Reference 1187 1188 ----------------------------- 1189 -- Extensions to Asis.Text -- 1190 ----------------------------- 1191 1192 function Element_Span_In_Template 1193 (Element : Asis.Element) 1194 return Asis.Text.Span; 1195 -- If Is_Part_Of_Instance is True for the argument Element, then this 1196 -- function returns the span of the corresponding piece of code in the 1197 -- generic template. Otherwise a Nil_Span is returned. Nil_Span is also 1198 -- returned if Is_Part_Of_Implicit Element is True for Element. 1199 1200 function Element_Image_In_Template 1201 (Element : Asis.Element) 1202 return Program_Text; 1203 -- If Is_Part_Of_Instancce is True for the argument Element, then this 1204 -- function returns the image of the corresponding piece of code in the 1205 -- generic template. Otherwise a null string is returned. A null string 1206 -- is also returned if Is_Part_Of_Implicit_ELement is true for Element 1207 1208 function Original_Line_Number 1209 (Element : Asis.Element; 1210 Compiled_Line : Line_Number_Positive) 1211 return Line_Number; 1212 -- If the enclosing compilation unit of the argument Element contains a 1213 -- Source_Reference pragma, this function converts the line number of 1214 -- the file which actually was compiled ("physical" file) into the 1215 -- corresponding line number in the original file. For the line containing 1216 -- a Source_Reference pragma zero is returned. 1217 -- 1218 -- Returns 0 if not Is_Text_Available(Element). 1219 -- 1220 -- Raises ASIS_Inappropriate_Line_Number if Is_Text_Available(Element) and 1221 -- Compiled_Line is greater than the maximum line number of the compiled 1222 -- file 1223 1224 -------------------------------- 1225 -- General_Purpose Extensions -- 1226 -------------------------------- 1227 1228 function Get_Last_Component (E : Asis.Element) return Asis.Element; 1229 -- Returns the right-most direct component of its argument. Returns 1230 -- Nil_Element if its argument has no components. It is an error to 1231 -- call this function for Nil_Element 1232 1233 function Components (E : Asis.Element) return Asis.Element_List; 1234 -- Returns the list of all the first-level components of its argument. 1235 -- Nil_Element is returned for a terminal component. 1236 -- The implementation 1237 -- of this function is not very effective - we do not use any dynamic 1238 -- element lists, we simply compute the components twice - first time 1239 -- to get to know the overall number of components, and second 1240 -- time to fill in the result Element_List 1241 1242 generic 1243 type From is (<>); 1244 type To is (<>); 1245 Default : To; 1246 package Generic_Enum_Conversion is 1247 1248 -- Elaboration of an instance body creates a table, which is efficient 1249 -- only if this is instantiated at library level. 1250 1251 function Convert (X : From) return To; 1252 -- Converts X to a same-named value of type To. If there is no such 1253 -- value, returns Default. This is essentially doing 1254 -- "To'Value (From'Image (X))", except more efficiently. 1255 -- For example if "type From is (Red, Orange, Yellow);" 1256 -- and "type To is (Green, Amber, Red);" then 1257 -- Convert (Red) returns Red, and Convert (Orange) returns Default. 1258 1259 end Generic_Enum_Conversion; 1260 1261end Asis.Extensions; 1262