gcc/ada/sem_type.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             S E M _ T Y P E                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2006, 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 2,  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.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Atree;    use Atree;
  28 with Alloc;
  29 with Debug;    use Debug;
  30 with Einfo;    use Einfo;
  31 with Elists;   use Elists;
  32 with Nlists;   use Nlists;
  33 with Errout;   use Errout;
  34 with Lib;      use Lib;
  35 with Namet;    use Namet;
  36 with Opt;      use Opt;
  37 with Output;   use Output;
  38 with Rtsfind;  use Rtsfind;
  39 with Sem;      use Sem;
  40 with Sem_Ch6;  use Sem_Ch6;
  41 with Sem_Ch8;  use Sem_Ch8;
  42 with Sem_Util; use Sem_Util;
  43 with Stand;    use Stand;
  44 with Sinfo;    use Sinfo;
  45 with Snames;   use Snames;
  46 with Table;
  47 with Uintp;    use Uintp;
  48
  49 package body Sem_Type is
  50
  51    ---------------------
  52    -- Data Structures --
  53    ---------------------
  54
  55    --  The following data structures establish a mapping between nodes and
  56    --  their interpretations. An overloaded node has an entry in Interp_Map,
  57    --  which in turn contains a pointer into the All_Interp array. The
  58    --  interpretations of a given node are contiguous in All_Interp. Each
  59    --  set of interpretations is terminated with the marker No_Interp.
  60    --  In order to speed up the retrieval of the interpretations of an
  61    --  overloaded node, the Interp_Map table is accessed by means of a simple
  62    --  hashing scheme, and the entries in Interp_Map are chained. The heads
  63    --  of clash lists are stored in array Headers.
  64
  65    --              Headers        Interp_Map          All_Interp
  66
  67    --                 _            +-----+             +--------+
  68    --                |_|           |_____|         --->|interp1 |
  69    --                |_|---------->|node |         |   |interp2 |
  70    --                |_|           |index|---------|   |nointerp|
  71    --                |_|           |next |             |        |
  72    --                              |-----|             |        |
  73    --                              +-----+             +--------+
  74
  75    --  This scheme does not currently reclaim interpretations. In principle,
  76    --  after a unit is compiled, all overloadings have been resolved, and the
  77    --  candidate interpretations should be deleted. This should be easier
  78    --  now than with the previous scheme???
  79
  80    package All_Interp is new Table.Table (
  81      Table_Component_Type => Interp,
  82      Table_Index_Type     => Int,
  83      Table_Low_Bound      => 0,
  84      Table_Initial        => Alloc.All_Interp_Initial,
  85      Table_Increment      => Alloc.All_Interp_Increment,
  86      Table_Name           => "All_Interp");
  87
  88    type Interp_Ref is record
  89       Node  : Node_Id;
  90       Index : Interp_Index;
  91       Next  : Int;
  92    end record;
  93
  94    Header_Size : constant Int := 2 ** 12;
  95    No_Entry    : constant Int := -1;
  96    Headers     : array (0 .. Header_Size) of Int := (others => No_Entry);
  97
  98    package Interp_Map is new Table.Table (
  99      Table_Component_Type => Interp_Ref,
 100      Table_Index_Type     => Int,
 101      Table_Low_Bound      => 0,
 102      Table_Initial        => Alloc.Interp_Map_Initial,
 103      Table_Increment      => Alloc.Interp_Map_Increment,
 104      Table_Name           => "Interp_Map");
 105
 106    function Hash (N : Node_Id) return Int;
 107    --  A trivial hashing function for nodes, used to insert an overloaded
 108    --  node into the Interp_Map table.
 109
 110    -------------------------------------
 111    -- Handling of Overload Resolution --
 112    -------------------------------------
 113
 114    --  Overload resolution uses two passes over the syntax tree of a complete
 115    --  context. In the first, bottom-up pass, the types of actuals in calls
 116    --  are used to resolve possibly overloaded subprogram and operator names.
 117    --  In the second top-down pass, the type of the context (for example the
 118    --  condition in a while statement) is used to resolve a possibly ambiguous
 119    --  call, and the unique subprogram name in turn imposes a specific context
 120    --  on each of its actuals.
 121
 122    --  Most expressions are in fact unambiguous, and the bottom-up pass is
 123    --  sufficient  to resolve most everything. To simplify the common case,
 124    --  names and expressions carry a flag Is_Overloaded to indicate whether
 125    --  they have more than one interpretation. If the flag is off, then each
 126    --  name has already a unique meaning and type, and the bottom-up pass is
 127    --  sufficient (and much simpler).
 128
 129    --------------------------
 130    -- Operator Overloading --
 131    --------------------------
 132
 133    --  The visibility of operators is handled differently from that of
 134    --  other entities. We do not introduce explicit versions of primitive
 135    --  operators for each type definition. As a result, there is only one
 136    --  entity corresponding to predefined addition on all numeric types, etc.
 137    --  The back-end resolves predefined operators according to their type.
 138    --  The visibility of primitive operations then reduces to the visibility
 139    --  of the resulting type:  (a + b) is a legal interpretation of some
 140    --  primitive operator + if the type of the result (which must also be
 141    --  the type of a and b) is directly visible (i.e. either immediately
 142    --  visible or use-visible.)
 143
 144    --  User-defined operators are treated like other functions, but the
 145    --  visibility of these user-defined operations must be special-cased
 146    --  to determine whether they hide or are hidden by predefined operators.
 147    --  The form P."+" (x, y) requires additional handling.
 148
 149    --  Concatenation is treated more conventionally: for every one-dimensional
 150    --  array type we introduce a explicit concatenation operator. This is
 151    --  necessary to handle the case of (element & element => array) which
 152    --  cannot be handled conveniently if there is no explicit instance of
 153    --  resulting type of the operation.
 154
 155    -----------------------
 156    -- Local Subprograms --
 157    -----------------------
 158
 159    procedure All_Overloads;
 160    pragma Warnings (Off, All_Overloads);
 161    --  Debugging procedure: list full contents of Overloads table
 162
 163    procedure New_Interps (N : Node_Id);
 164    --  Initialize collection of interpretations for the given node, which is
 165    --  either an overloaded entity, or an operation whose arguments have
 166    --  multiple interpretations. Interpretations can be added to only one
 167    --  node at a time.
 168
 169    function Specific_Type (T1, T2 : Entity_Id) return Entity_Id;
 170    --  If T1 and T2 are compatible, return  the one that is not
 171    --  universal or is not a "class" type (any_character,  etc).
 172
 173    --------------------
 174    -- Add_One_Interp --
 175    --------------------
 176
 177    procedure Add_One_Interp
 178      (N         : Node_Id;
 179       E         : Entity_Id;
 180       T         : Entity_Id;
 181       Opnd_Type : Entity_Id := Empty)
 182    is
 183       Vis_Type : Entity_Id;
 184
 185       procedure Add_Entry (Name :  Entity_Id; Typ : Entity_Id);
 186       --  Add one interpretation to node. Node is already known to be
 187       --  overloaded. Add new interpretation if not hidden by previous
 188       --  one, and remove previous one if hidden by new one.
 189
 190       function Is_Universal_Operation (Op : Entity_Id) return Boolean;
 191       --  True if the entity is a predefined operator and the operands have
 192       --  a universal Interpretation.
 193
 194       ---------------
 195       -- Add_Entry --
 196       ---------------
 197
 198       procedure Add_Entry (Name :  Entity_Id; Typ : Entity_Id) is
 199          Index : Interp_Index;
 200          It    : Interp;
 201
 202       begin
 203          Get_First_Interp (N, Index, It);
 204          while Present (It.Nam) loop
 205
 206             --  A user-defined subprogram hides another declared at an outer
 207             --  level, or one that is use-visible. So return if previous
 208             --  definition hides new one (which is either in an outer
 209             --  scope, or use-visible). Note that for functions use-visible
 210             --  is the same as potentially use-visible. If new one hides
 211             --  previous one, replace entry in table of interpretations.
 212             --  If this is a universal operation, retain the operator in case
 213             --  preference rule applies.
 214
 215             if (((Ekind (Name) = E_Function or else Ekind (Name) = E_Procedure)
 216                  and then Ekind (Name) = Ekind (It.Nam))
 217                 or else (Ekind (Name) = E_Operator
 218               and then Ekind (It.Nam) = E_Function))
 219
 220               and then Is_Immediately_Visible (It.Nam)
 221               and then Type_Conformant (Name, It.Nam)
 222               and then Base_Type (It.Typ) = Base_Type (T)
 223             then
 224                if Is_Universal_Operation (Name) then
 225                   exit;
 226
 227                --  If node is an operator symbol, we have no actuals with
 228                --  which to check hiding, and this is done in full in the
 229                --  caller (Analyze_Subprogram_Renaming) so we include the
 230                --  predefined operator in any case.
 231
 232                elsif Nkind (N) = N_Operator_Symbol
 233                  or else (Nkind (N) = N_Expanded_Name
 234                             and then
 235                           Nkind (Selector_Name (N)) = N_Operator_Symbol)
 236                then
 237                   exit;
 238
 239                elsif not In_Open_Scopes (Scope (Name))
 240                  or else Scope_Depth (Scope (Name)) <=
 241                          Scope_Depth (Scope (It.Nam))
 242                then
 243                   --  If ambiguity within instance, and entity is not an
 244                   --  implicit operation, save for later disambiguation.
 245
 246                   if Scope (Name) = Scope (It.Nam)
 247                     and then not Is_Inherited_Operation (Name)
 248                     and then In_Instance
 249                   then
 250                      exit;
 251                   else
 252                      return;
 253                   end if;
 254
 255                else
 256                   All_Interp.Table (Index).Nam := Name;
 257                   return;
 258                end if;
 259
 260             --  Avoid making duplicate entries in overloads
 261
 262             elsif Name = It.Nam
 263               and then Base_Type (It.Typ) = Base_Type (T)
 264             then
 265                return;
 266
 267             --  Otherwise keep going
 268
 269             else
 270                Get_Next_Interp (Index, It);
 271             end if;
 272
 273          end loop;
 274
 275          --  On exit, enter new interpretation. The context, or a preference
 276          --  rule, will resolve the ambiguity on the second pass.
 277
 278          All_Interp.Table (All_Interp.Last) := (Name, Typ);
 279          All_Interp.Increment_Last;
 280          All_Interp.Table (All_Interp.Last) := No_Interp;
 281       end Add_Entry;
 282
 283       ----------------------------
 284       -- Is_Universal_Operation --
 285       ----------------------------
 286
 287       function Is_Universal_Operation (Op : Entity_Id) return Boolean is
 288          Arg : Node_Id;
 289
 290       begin
 291          if Ekind (Op) /= E_Operator then
 292             return False;
 293
 294          elsif Nkind (N) in N_Binary_Op then
 295             return Present (Universal_Interpretation (Left_Opnd (N)))
 296               and then Present (Universal_Interpretation (Right_Opnd (N)));
 297
 298          elsif Nkind (N) in N_Unary_Op then
 299             return Present (Universal_Interpretation (Right_Opnd (N)));
 300
 301          elsif Nkind (N) = N_Function_Call then
 302             Arg := First_Actual (N);
 303             while Present (Arg) loop
 304                if No (Universal_Interpretation (Arg)) then
 305                   return False;
 306                end if;
 307
 308                Next_Actual (Arg);
 309             end loop;
 310
 311             return True;
 312
 313          else
 314             return False;
 315          end if;
 316       end Is_Universal_Operation;
 317
 318    --  Start of processing for Add_One_Interp
 319
 320    begin
 321       --  If the interpretation is a predefined operator, verify that the
 322       --  result type is visible, or that the entity has already been
 323       --  resolved (case of an instantiation node that refers to a predefined
 324       --  operation, or an internally generated operator node, or an operator
 325       --  given as an expanded name). If the operator is a comparison or
 326       --  equality, it is the type of the operand that matters to determine
 327       --  whether the operator is visible. In an instance, the check is not
 328       --  performed, given that the operator was visible in the generic.
 329
 330       if Ekind (E) = E_Operator then
 331
 332          if Present (Opnd_Type) then
 333             Vis_Type := Opnd_Type;
 334          else
 335             Vis_Type := Base_Type (T);
 336          end if;
 337
 338          if In_Open_Scopes (Scope (Vis_Type))
 339            or else Is_Potentially_Use_Visible (Vis_Type)
 340            or else In_Use (Vis_Type)
 341            or else (In_Use (Scope (Vis_Type))
 342                       and then not Is_Hidden (Vis_Type))
 343            or else Nkind (N) = N_Expanded_Name
 344            or else (Nkind (N) in N_Op and then E = Entity (N))
 345            or else In_Instance
 346          then
 347             null;
 348
 349          --  If the node is given in functional notation and the prefix
 350          --  is an expanded name, then the operator is visible if the
 351          --  prefix is the scope of the result type as well. If the
 352          --  operator is (implicitly) defined in an extension of system,
 353          --  it is know to be valid (see Defined_In_Scope, sem_ch4.adb).
 354
 355          elsif Nkind (N) = N_Function_Call
 356            and then Nkind (Name (N)) = N_Expanded_Name
 357            and then (Entity (Prefix (Name (N))) = Scope (Base_Type (T))
 358                        or else Entity (Prefix (Name (N))) = Scope (Vis_Type)
 359                        or else Scope (Vis_Type) = System_Aux_Id)
 360          then
 361             null;
 362
 363          --  Save type for subsequent error message, in case no other
 364          --  interpretation is found.
 365
 366          else
 367             Candidate_Type := Vis_Type;
 368             return;
 369          end if;
 370
 371       --  In an instance, an abstract non-dispatching operation cannot
 372       --  be a candidate interpretation, because it could not have been
 373       --  one in the generic (it may be a spurious overloading in the
 374       --  instance).
 375
 376       elsif In_Instance
 377         and then Is_Abstract (E)
 378         and then not Is_Dispatching_Operation (E)
 379       then
 380          return;
 381
 382       --  An inherited interface operation that is implemented by some
 383       --  derived type does not participate in overload resolution, only
 384       --  the implementation operation does.
 385
 386       elsif Is_Hidden (E)
 387         and then Is_Subprogram (E)
 388         and then Present (Abstract_Interface_Alias (E))
 389       then
 390          --  Ada 2005 (AI-251): If this primitive operation corresponds with
 391          --  an inmediate ancestor interface there is no need to add it to the
 392          --  list of interpretations; the corresponding aliased primitive is
 393          --  also in this list of primitive operations and will be used instead
 394          --  because otherwise we have a dummy between the two subprograms that
 395          --  are in fact the same.
 396
 397          if Present (DTC_Entity (Abstract_Interface_Alias (E)))
 398            and then Etype (DTC_Entity (Abstract_Interface_Alias (E)))
 399                       /= RTE (RE_Tag)
 400          then
 401             Add_One_Interp (N, Abstract_Interface_Alias (E), T);
 402          end if;
 403
 404          return;
 405       end if;
 406
 407       --  If this is the first interpretation of N, N has type Any_Type.
 408       --  In that case place the new type on the node. If one interpretation
 409       --  already exists, indicate that the node is overloaded, and store
 410       --  both the previous and the new interpretation in All_Interp. If
 411       --  this is a later interpretation, just add it to the set.
 412
 413       if Etype (N) = Any_Type then
 414          if Is_Type (E) then
 415             Set_Etype (N, T);
 416
 417          else
 418             --  Record both the operator or subprogram name, and its type
 419
 420             if Nkind (N) in N_Op or else Is_Entity_Name (N) then
 421                Set_Entity (N, E);
 422             end if;
 423
 424             Set_Etype (N, T);
 425          end if;
 426
 427       --  Either there is no current interpretation in the table for any
 428       --  node or the interpretation that is present is for a different
 429       --  node. In both cases add a new interpretation to the table.
 430
 431       elsif Interp_Map.Last < 0
 432         or else
 433           (Interp_Map.Table (Interp_Map.Last).Node /= N
 434              and then not Is_Overloaded (N))
 435       then
 436          New_Interps (N);
 437
 438          if (Nkind (N) in N_Op or else Is_Entity_Name (N))
 439            and then Present (Entity (N))
 440          then
 441             Add_Entry (Entity (N), Etype (N));
 442
 443          elsif (Nkind (N) = N_Function_Call
 444                  or else Nkind (N) = N_Procedure_Call_Statement)
 445            and then (Nkind (Name (N)) = N_Operator_Symbol
 446                       or else Is_Entity_Name (Name (N)))
 447          then
 448             Add_Entry (Entity (Name (N)), Etype (N));
 449
 450          else
 451             --  Overloaded prefix in indexed or selected component,
 452             --  or call whose name is an expression or another call.
 453
 454             Add_Entry (Etype (N), Etype (N));
 455          end if;
 456
 457          Add_Entry (E, T);
 458
 459       else
 460          Add_Entry (E, T);
 461       end if;
 462    end Add_One_Interp;
 463
 464    -------------------
 465    -- All_Overloads --
 466    -------------------
 467
 468    procedure All_Overloads is
 469    begin
 470       for J in All_Interp.First .. All_Interp.Last loop
 471
 472          if Present (All_Interp.Table (J).Nam) then
 473             Write_Entity_Info (All_Interp.Table (J). Nam, " ");
 474          else
 475             Write_Str ("No Interp");
 476          end if;
 477
 478          Write_Str ("=================");
 479          Write_Eol;
 480       end loop;
 481    end All_Overloads;
 482
 483    ---------------------
 484    -- Collect_Interps --
 485    ---------------------
 486
 487    procedure Collect_Interps (N : Node_Id) is
 488       Ent          : constant Entity_Id := Entity (N);
 489       H            : Entity_Id;
 490       First_Interp : Interp_Index;
 491
 492    begin
 493       New_Interps (N);
 494
 495       --  Unconditionally add the entity that was initially matched
 496
 497       First_Interp := All_Interp.Last;
 498       Add_One_Interp (N, Ent, Etype (N));
 499
 500       --  For expanded name, pick up all additional entities from the
 501       --  same scope, since these are obviously also visible. Note that
 502       --  these are not necessarily contiguous on the homonym chain.
 503
 504       if Nkind (N) = N_Expanded_Name then
 505          H := Homonym (Ent);
 506          while Present (H) loop
 507             if Scope (H) = Scope (Entity (N)) then
 508                Add_One_Interp (N, H, Etype (H));
 509             end if;
 510
 511             H := Homonym (H);
 512          end loop;
 513
 514       --  Case of direct name
 515
 516       else
 517          --  First, search the homonym chain for directly visible entities
 518
 519          H := Current_Entity (Ent);
 520          while Present (H) loop
 521             exit when (not Is_Overloadable (H))
 522               and then Is_Immediately_Visible (H);
 523
 524             if Is_Immediately_Visible (H)
 525               and then H /= Ent
 526             then
 527                --  Only add interpretation if not hidden by an inner
 528                --  immediately visible one.
 529
 530                for J in First_Interp .. All_Interp.Last - 1 loop
 531
 532                   --  Current homograph is not hidden. Add to overloads
 533
 534                   if not Is_Immediately_Visible (All_Interp.Table (J).Nam) then
 535                      exit;
 536
 537                   --  Homograph is hidden, unless it is a predefined operator
 538
 539                   elsif Type_Conformant (H, All_Interp.Table (J).Nam) then
 540
 541                      --  A homograph in the same scope can occur within an
 542                      --  instantiation, the resulting ambiguity has to be
 543                      --  resolved later.
 544
 545                      if Scope (H) = Scope (Ent)
 546                         and then In_Instance
 547                         and then not Is_Inherited_Operation (H)
 548                      then
 549                         All_Interp.Table (All_Interp.Last) := (H, Etype (H));
 550                         All_Interp.Increment_Last;
 551                         All_Interp.Table (All_Interp.Last) := No_Interp;
 552                         goto Next_Homograph;
 553
 554                      elsif Scope (H) /= Standard_Standard then
 555                         goto Next_Homograph;
 556                      end if;
 557                   end if;
 558                end loop;
 559
 560                --  On exit, we know that current homograph is not hidden
 561
 562                Add_One_Interp (N, H, Etype (H));
 563
 564                if Debug_Flag_E then
 565                   Write_Str ("Add overloaded Interpretation ");
 566                   Write_Int (Int (H));
 567                   Write_Eol;
 568                end if;
 569             end if;
 570
 571             <<Next_Homograph>>
 572                H := Homonym (H);
 573          end loop;
 574
 575          --  Scan list of homographs for use-visible entities only
 576
 577          H := Current_Entity (Ent);
 578
 579          while Present (H) loop
 580             if Is_Potentially_Use_Visible (H)
 581               and then H /= Ent
 582               and then Is_Overloadable (H)
 583             then
 584                for J in First_Interp .. All_Interp.Last - 1 loop
 585
 586                   if not Is_Immediately_Visible (All_Interp.Table (J).Nam) then
 587                      exit;
 588
 589                   elsif Type_Conformant (H, All_Interp.Table (J).Nam) then
 590                      goto Next_Use_Homograph;
 591                   end if;
 592                end loop;
 593
 594                Add_One_Interp (N, H, Etype (H));
 595             end if;
 596
 597             <<Next_Use_Homograph>>
 598                H := Homonym (H);
 599          end loop;
 600       end if;
 601
 602       if All_Interp.Last = First_Interp + 1 then
 603
 604          --  The original interpretation is in fact not overloaded
 605
 606          Set_Is_Overloaded (N, False);
 607       end if;
 608    end Collect_Interps;
 609
 610    ------------
 611    -- Covers --
 612    ------------
 613
 614    function Covers (T1, T2 : Entity_Id) return Boolean is
 615
 616       BT1 : Entity_Id;
 617       BT2 : Entity_Id;
 618
 619       function Full_View_Covers (Typ1, Typ2 : Entity_Id) return Boolean;
 620       --  In an instance the proper view may not always be correct for
 621       --  private types, but private and full view are compatible. This
 622       --  removes spurious errors from nested instantiations that involve,
 623       --  among other things, types derived from private types.
 624
 625       ----------------------
 626       -- Full_View_Covers --
 627       ----------------------
 628
 629       function Full_View_Covers (Typ1, Typ2 : Entity_Id) return Boolean is
 630       begin
 631          return
 632            Is_Private_Type (Typ1)
 633              and then
 634               ((Present (Full_View (Typ1))
 635                     and then Covers (Full_View (Typ1), Typ2))
 636                  or else Base_Type (Typ1) = Typ2
 637                  or else Base_Type (Typ2) = Typ1);
 638       end Full_View_Covers;
 639
 640    --  Start of processing for Covers
 641
 642    begin
 643       --  If either operand missing, then this is an error, but ignore it (and
 644       --  pretend we have a cover) if errors already detected, since this may
 645       --  simply mean we have malformed trees.
 646
 647       if No (T1) or else No (T2) then
 648          if Total_Errors_Detected /= 0 then
 649             return True;
 650          else
 651             raise Program_Error;
 652          end if;
 653
 654       else
 655          BT1 := Base_Type (T1);
 656          BT2 := Base_Type (T2);
 657       end if;
 658
 659       --  Simplest case: same types are compatible, and types that have the
 660       --  same base type and are not generic actuals are compatible. Generic
 661       --  actuals  belong to their class but are not compatible with other
 662       --  types of their class, and in particular with other generic actuals.
 663       --  They are however compatible with their own subtypes, and itypes
 664       --  with the same base are compatible as well. Similarly, constrained
 665       --  subtypes obtained from expressions of an unconstrained nominal type
 666       --  are compatible with the base type (may lead to spurious ambiguities
 667       --  in obscure cases ???)
 668
 669       --  Generic actuals require special treatment to avoid spurious ambi-
 670       --  guities in an instance, when two formal types are instantiated with
 671       --  the same actual, so that different subprograms end up with the same
 672       --  signature in the instance.
 673
 674       if T1 = T2 then
 675          return True;
 676
 677       elsif  BT1 = BT2
 678         or else BT1 = T2
 679         or else BT2 = T1
 680       then
 681          if not Is_Generic_Actual_Type (T1) then
 682             return True;
 683          else
 684             return (not Is_Generic_Actual_Type (T2)
 685                      or else Is_Itype (T1)
 686                      or else Is_Itype (T2)
 687                      or else Is_Constr_Subt_For_U_Nominal (T1)
 688                      or else Is_Constr_Subt_For_U_Nominal (T2)
 689                      or else Scope (T1) /= Scope (T2));
 690          end if;
 691
 692       --  Literals are compatible with types in  a given "class"
 693
 694       elsif (T2 = Universal_Integer and then Is_Integer_Type (T1))
 695         or else (T2 = Universal_Real    and then Is_Real_Type (T1))
 696         or else (T2 = Universal_Fixed   and then Is_Fixed_Point_Type (T1))
 697         or else (T2 = Any_Fixed         and then Is_Fixed_Point_Type (T1))
 698         or else (T2 = Any_String        and then Is_String_Type (T1))
 699         or else (T2 = Any_Character     and then Is_Character_Type (T1))
 700         or else (T2 = Any_Access        and then Is_Access_Type (T1))
 701       then
 702          return True;
 703
 704       --  The context may be class wide
 705
 706       elsif Is_Class_Wide_Type (T1)
 707         and then Is_Ancestor (Root_Type (T1), T2)
 708       then
 709          return True;
 710
 711       elsif Is_Class_Wide_Type (T1)
 712         and then Is_Class_Wide_Type (T2)
 713         and then Base_Type (Etype (T1)) = Base_Type (Etype (T2))
 714       then
 715          return True;
 716
 717       --  Ada 2005 (AI-345): A class-wide abstract interface type T1 covers a
 718       --  task_type or protected_type implementing T1
 719
 720       elsif Ada_Version >= Ada_05
 721         and then Is_Class_Wide_Type (T1)
 722         and then Is_Interface (Etype (T1))
 723         and then Is_Concurrent_Type (T2)
 724         and then Interface_Present_In_Ancestor
 725                    (Typ   => Base_Type (T2),
 726                     Iface => Etype (T1))
 727       then
 728          return True;
 729
 730       --  Ada 2005 (AI-251): A class-wide abstract interface type T1 covers an
 731       --  object T2 implementing T1
 732
 733       elsif Ada_Version >= Ada_05
 734         and then Is_Class_Wide_Type (T1)
 735         and then Is_Interface (Etype (T1))
 736         and then Is_Tagged_Type (T2)
 737       then
 738          if Interface_Present_In_Ancestor (Typ => T2,
 739                                            Iface => Etype (T1))
 740          then
 741             return True;
 742
 743          elsif Present (Abstract_Interfaces (T2)) then
 744
 745             --  Ada 2005 (AI-251): A class-wide abstract interface type T1
 746             --  covers an object T2 that implements a direct derivation of T1.
 747
 748             declare
 749                E : Elmt_Id := First_Elmt (Abstract_Interfaces (T2));
 750             begin
 751                while Present (E) loop
 752                   if Is_Ancestor (Etype (T1), Node (E)) then
 753                      return True;
 754                   end if;
 755
 756                   Next_Elmt (E);
 757                end loop;
 758             end;
 759
 760             --  We should also check the case in which T1 is an ancestor of
 761             --  some implemented interface???
 762
 763             return False;
 764
 765          else
 766             return False;
 767          end if;
 768
 769       --  In a dispatching call the actual may be class-wide
 770
 771       elsif Is_Class_Wide_Type (T2)
 772         and then Base_Type (Root_Type (T2)) = Base_Type (T1)
 773       then
 774          return True;
 775
 776       --  Some contexts require a class of types rather than a specific type
 777
 778       elsif (T1 = Any_Integer and then Is_Integer_Type (T2))
 779         or else (T1 = Any_Boolean and then Is_Boolean_Type (T2))
 780         or else (T1 = Any_Real and then Is_Real_Type (T2))
 781         or else (T1 = Any_Fixed and then Is_Fixed_Point_Type (T2))
 782         or else (T1 = Any_Discrete and then Is_Discrete_Type (T2))
 783       then
 784          return True;
 785
 786       --  An aggregate is compatible with an array or record type
 787
 788       elsif T2 = Any_Composite
 789         and then Ekind (T1) in E_Array_Type .. E_Record_Subtype
 790       then
 791          return True;
 792
 793       --  If the expected type is an anonymous access, the designated type must
 794       --  cover that of the expression.
 795
 796       elsif Ekind (T1) = E_Anonymous_Access_Type
 797         and then Is_Access_Type (T2)
 798         and then Covers (Designated_Type (T1), Designated_Type (T2))
 799       then
 800          return True;
 801
 802       --  An Access_To_Subprogram is compatible with itself, or with an
 803       --  anonymous type created for an attribute reference Access.
 804
 805       elsif (Ekind (BT1) = E_Access_Subprogram_Type
 806                or else
 807              Ekind (BT1) = E_Access_Protected_Subprogram_Type)
 808         and then Is_Access_Type (T2)
 809         and then (not Comes_From_Source (T1)
 810                    or else not Comes_From_Source (T2))
 811         and then (Is_Overloadable (Designated_Type (T2))
 812                     or else
 813                   Ekind (Designated_Type (T2)) = E_Subprogram_Type)
 814         and then
 815           Type_Conformant (Designated_Type (T1), Designated_Type (T2))
 816         and then
 817           Mode_Conformant (Designated_Type (T1), Designated_Type (T2))
 818       then
 819          return True;
 820
 821       --  Ada 2005 (AI-254): An Anonymous_Access_To_Subprogram is compatible
 822       --  with itself, or with an anonymous type created for an attribute
 823       --  reference Access.
 824
 825       elsif (Ekind (BT1) = E_Anonymous_Access_Subprogram_Type
 826                or else
 827              Ekind (BT1)
 828                       = E_Anonymous_Access_Protected_Subprogram_Type)
 829         and then Is_Access_Type (T2)
 830         and then (not Comes_From_Source (T1)
 831                    or else not Comes_From_Source (T2))
 832         and then (Is_Overloadable (Designated_Type (T2))
 833                     or else
 834                   Ekind (Designated_Type (T2)) = E_Subprogram_Type)
 835         and then
 836            Type_Conformant (Designated_Type (T1), Designated_Type (T2))
 837         and then
 838            Mode_Conformant (Designated_Type (T1), Designated_Type (T2))
 839       then
 840          return True;
 841
 842       --  The context can be a remote access type, and the expression the
 843       --  corresponding source type declared in a categorized package, or
 844       --  viceversa.
 845
 846       elsif Is_Record_Type (T1)
 847         and then (Is_Remote_Call_Interface (T1)
 848                    or else Is_Remote_Types (T1))
 849         and then Present (Corresponding_Remote_Type (T1))
 850       then
 851          return Covers (Corresponding_Remote_Type (T1), T2);
 852
 853       elsif Is_Record_Type (T2)
 854         and then (Is_Remote_Call_Interface (T2)
 855                    or else Is_Remote_Types (T2))
 856         and then Present (Corresponding_Remote_Type (T2))
 857       then
 858          return Covers (Corresponding_Remote_Type (T2), T1);
 859
 860       elsif Ekind (T2) = E_Access_Attribute_Type
 861         and then (Ekind (BT1) = E_General_Access_Type
 862                     or else Ekind (BT1) = E_Access_Type)
 863         and then Covers (Designated_Type (T1), Designated_Type (T2))
 864       then
 865          --  If the target type is a RACW type while the source is an access
 866          --  attribute type, we are building a RACW that may be exported.
 867
 868          if Is_Remote_Access_To_Class_Wide_Type (BT1) then
 869             Set_Has_RACW (Current_Sem_Unit);
 870          end if;
 871
 872          return True;
 873
 874       elsif Ekind (T2) = E_Allocator_Type
 875         and then Is_Access_Type (T1)
 876       then
 877          return Covers (Designated_Type (T1), Designated_Type (T2))
 878           or else
 879             (From_With_Type (Designated_Type (T1))
 880               and then Covers (Designated_Type (T2), Designated_Type (T1)));
 881
 882       --  A boolean operation on integer literals is compatible with modular
 883       --  context.
 884
 885       elsif T2 = Any_Modular
 886         and then Is_Modular_Integer_Type (T1)
 887       then
 888          return True;
 889
 890       --  The actual type may be the result of a previous error
 891
 892       elsif Base_Type (T2) = Any_Type then
 893          return True;
 894
 895       --  A packed array type covers its corresponding non-packed type. This is
 896       --  not legitimate Ada, but allows the omission of a number of otherwise
 897       --  useless unchecked conversions, and since this can only arise in
 898       --  (known correct) expanded code, no harm is done
 899
 900       elsif Is_Array_Type (T2)
 901         and then Is_Packed (T2)
 902         and then T1 = Packed_Array_Type (T2)
 903       then
 904          return True;
 905
 906       --  Similarly an array type covers its corresponding packed array type
 907
 908       elsif Is_Array_Type (T1)
 909         and then Is_Packed (T1)
 910         and then T2 = Packed_Array_Type (T1)
 911       then
 912          return True;
 913
 914       --  In instances, or with types exported from instantiations, check
 915       --  whether a partial and a full view match. Verify that types are
 916       --  legal, to prevent cascaded errors.
 917
 918       elsif In_Instance
 919         and then
 920           (Full_View_Covers (T1, T2)
 921             or else Full_View_Covers (T2, T1))
 922       then
 923          return True;
 924
 925       elsif Is_Type (T2)
 926         and then Is_Generic_Actual_Type (T2)
 927         and then Full_View_Covers (T1, T2)
 928       then
 929          return True;
 930
 931       elsif Is_Type (T1)
 932         and then  Is_Generic_Actual_Type (T1)
 933         and then Full_View_Covers (T2, T1)
 934       then
 935          return True;
 936
 937       --  In the expansion of inlined bodies, types are compatible if they
 938       --  are structurally equivalent.
 939
 940       elsif In_Inlined_Body
 941         and then (Underlying_Type (T1) = Underlying_Type (T2)
 942                    or else (Is_Access_Type (T1)
 943                               and then Is_Access_Type (T2)
 944                               and then
 945                                 Designated_Type (T1) = Designated_Type (T2))
 946                    or else (T1 = Any_Access
 947                               and then Is_Access_Type (Underlying_Type (T2)))
 948                    or else (T2 = Any_Composite
 949                               and then
 950                                 Is_Composite_Type (Underlying_Type (T1))))
 951       then
 952          return True;
 953
 954       --  Ada 2005 (AI-50217): Additional branches to make the shadow entity
 955       --  compatible with its real entity.
 956
 957       elsif From_With_Type (T1) then
 958
 959          --  If the expected type is the non-limited view of a type, the
 960          --  expression may have the limited view.
 961
 962          if Ekind (T1) = E_Incomplete_Type then
 963             return Covers (Non_Limited_View (T1), T2);
 964
 965          elsif Ekind (T1) = E_Class_Wide_Type then
 966             return
 967               Covers (Class_Wide_Type (Non_Limited_View (Etype (T1))), T2);
 968          else
 969             return False;
 970          end if;
 971
 972       elsif From_With_Type (T2) then
 973
 974          --  If units in the context have Limited_With clauses on each other,
 975          --  either type might have a limited view. Checks performed elsewhere
 976          --  verify that the context type is the non-limited view.
 977
 978          if Ekind (T2) = E_Incomplete_Type then
 979             return Covers (T1, Non_Limited_View (T2));
 980
 981          elsif Ekind (T2) = E_Class_Wide_Type then
 982             return
 983               Covers (T1, Class_Wide_Type (Non_Limited_View (Etype (T2))));
 984          else
 985             return False;
 986          end if;
 987
 988       --  Otherwise it doesn't cover!
 989
 990       else
 991          return False;
 992       end if;
 993    end Covers;
 994
 995    ------------------
 996    -- Disambiguate --
 997    ------------------
 998
 999    function Disambiguate
1000      (N      : Node_Id;
1001       I1, I2 : Interp_Index;
1002       Typ    : Entity_Id)
1003       return   Interp
1004    is
1005       I           : Interp_Index;
1006       It          : Interp;
1007       It1, It2    : Interp;
1008       Nam1, Nam2  : Entity_Id;
1009       Predef_Subp : Entity_Id;
1010       User_Subp   : Entity_Id;
1011
1012       function Inherited_From_Actual (S : Entity_Id) return Boolean;
1013       --  Determine whether one of the candidates is an operation inherited by
1014       --  a type that is derived from an actual in an instantiation.
1015
1016       function In_Generic_Actual (Exp : Node_Id) return Boolean;
1017       --  Determine whether the expression is part of a generic actual. At
1018       --  the time the actual is resolved the scope is already that of the
1019       --  instance, but conceptually the resolution of the actual takes place
1020       --  in the enclosing context, and no special disambiguation rules should
1021       --  be applied.
1022
1023       function Is_Actual_Subprogram (S : Entity_Id) return Boolean;
1024       --  Determine whether a subprogram is an actual in an enclosing instance.
1025       --  An overloading between such a subprogram and one declared outside the
1026       --  instance is resolved in favor of the first, because it resolved in
1027       --  the generic.
1028
1029       function Matches (Actual, Formal : Node_Id) return Boolean;
1030       --  Look for exact type match in an instance, to remove spurious
1031       --  ambiguities when two formal types have the same actual.
1032
1033       function Standard_Operator return Boolean;
1034       --  Check whether subprogram is predefined operator declared in Standard.
1035       --  It may given by an operator name, or by an expanded name whose prefix
1036       --  is Standard.
1037
1038       function Remove_Conversions return Interp;
1039       --  Last chance for pathological cases involving comparisons on literals,
1040       --  and user overloadings of the same operator. Such pathologies have
1041       --  been removed from the ACVC, but still appear in two DEC tests, with
1042       --  the following notable quote from Ben Brosgol:
1043       --
1044       --  [Note: I disclaim all credit/responsibility/blame for coming up with
1045       --  this example; Robert Dewar brought it to our attention, since it is
1046       --  apparently found in the ACVC 1.5. I did not attempt to find the
1047       --  reason in the Reference Manual that makes the example legal, since I
1048       --  was too nauseated by it to want to pursue it further.]
1049       --
1050       --  Accordingly, this is not a fully recursive solution, but it handles
1051       --  DEC tests c460vsa, c460vsb. It also handles ai00136a, which pushes
1052       --  pathology in the other direction with calls whose multiple overloaded
1053       --  actuals make them truly unresolvable.
1054
1055       --  The new rules concerning abstract operations create additional need
1056       --  for special handling of expressions with universal operands, see
1057       --  comments to Has_Abstract_Interpretation below.
1058
1059       ------------------------
1060       --  In_Generic_Actual --
1061       ------------------------
1062
1063       function In_Generic_Actual (Exp : Node_Id) return Boolean is
1064          Par : constant Node_Id := Parent (Exp);
1065
1066       begin
1067          if No (Par) then
1068             return False;
1069
1070          elsif Nkind (Par) in N_Declaration then
1071             if Nkind (Par) = N_Object_Declaration
1072               or else Nkind (Par) = N_Object_Renaming_Declaration
1073             then
1074                return Present (Corresponding_Generic_Association (Par));
1075             else
1076                return False;
1077             end if;
1078
1079          elsif Nkind (Par) in N_Statement_Other_Than_Procedure_Call then
1080             return False;
1081
1082          else
1083             return In_Generic_Actual (Parent (Par));
1084          end if;
1085       end In_Generic_Actual;
1086
1087       ---------------------------
1088       -- Inherited_From_Actual --
1089       ---------------------------
1090
1091       function Inherited_From_Actual (S : Entity_Id) return Boolean is
1092          Par : constant Node_Id := Parent (S);
1093       begin
1094          if Nkind (Par) /= N_Full_Type_Declaration
1095            or else Nkind (Type_Definition (Par)) /= N_Derived_Type_Definition
1096          then
1097             return False;
1098          else
1099             return Is_Entity_Name (Subtype_Indication (Type_Definition (Par)))
1100               and then
1101                Is_Generic_Actual_Type (
1102                  Entity (Subtype_Indication (Type_Definition (Par))));
1103          end if;
1104       end Inherited_From_Actual;
1105
1106       --------------------------
1107       -- Is_Actual_Subprogram --
1108       --------------------------
1109
1110       function Is_Actual_Subprogram (S : Entity_Id) return Boolean is
1111       begin
1112          return In_Open_Scopes (Scope (S))
1113            and then
1114              (Is_Generic_Instance (Scope (S))
1115                 or else Is_Wrapper_Package (Scope (S)));
1116       end Is_Actual_Subprogram;
1117
1118       -------------
1119       -- Matches --
1120       -------------
1121
1122       function Matches (Actual, Formal : Node_Id) return Boolean is
1123          T1 : constant Entity_Id := Etype (Actual);
1124          T2 : constant Entity_Id := Etype (Formal);
1125       begin
1126          return T1 = T2
1127            or else
1128              (Is_Numeric_Type (T2)
1129                and then
1130              (T1 = Universal_Real or else T1 = Universal_Integer));
1131       end Matches;
1132
1133       ------------------------
1134       -- Remove_Conversions --
1135       ------------------------
1136
1137       function Remove_Conversions return Interp is
1138          I    : Interp_Index;
1139          It   : Interp;
1140          It1  : Interp;
1141          F1   : Entity_Id;
1142          Act1 : Node_Id;
1143          Act2 : Node_Id;
1144
1145          function Has_Abstract_Interpretation (N : Node_Id) return Boolean;
1146          --  If an operation has universal operands the universal operation
1147          --  is present among its interpretations. If there is an abstract
1148          --  interpretation for the operator, with a numeric result, this
1149          --  interpretation was already removed in sem_ch4, but the universal
1150          --  one is still visible. We must rescan the list of operators and
1151          --  remove the universal interpretation to resolve the ambiguity.
1152
1153          ---------------------------------
1154          -- Has_Abstract_Interpretation --
1155          ---------------------------------
1156
1157          function Has_Abstract_Interpretation (N : Node_Id) return Boolean is
1158             E : Entity_Id;
1159
1160          begin
1161             E := Current_Entity (N);
1162             while Present (E) loop
1163                if Is_Abstract (E)
1164                  and then Is_Numeric_Type (Etype (E))
1165                then
1166                   return True;
1167                else
1168                   E := Homonym (E);
1169                end if;
1170             end loop;
1171
1172             return False;
1173          end Has_Abstract_Interpretation;
1174
1175       --  Start of processing for Remove_Conversions
1176
1177       begin
1178          It1 := No_Interp;
1179
1180          Get_First_Interp (N, I, It);
1181          while Present (It.Typ) loop
1182             if not Is_Overloadable (It.Nam) then
1183                return No_Interp;
1184             end if;
1185
1186             F1 := First_Formal (It.Nam);
1187
1188             if No (F1) then
1189                return It1;
1190
1191             else
1192                if Nkind (N) = N_Function_Call
1193                  or else Nkind (N) = N_Procedure_Call_Statement
1194                then
1195                   Act1 := First_Actual (N);
1196
1197                   if Present (Act1) then
1198                      Act2 := Next_Actual (Act1);
1199                   else
1200                      Act2 := Empty;
1201                   end if;
1202
1203                elsif Nkind (N) in N_Unary_Op then
1204                   Act1 := Right_Opnd (N);
1205                   Act2 := Empty;
1206
1207                elsif Nkind (N) in N_Binary_Op then
1208                   Act1 := Left_Opnd (N);
1209                   Act2 := Right_Opnd (N);
1210
1211                else
1212                   return It1;
1213                end if;
1214
1215                if Nkind (Act1) in N_Op
1216                  and then Is_Overloaded (Act1)
1217                  and then (Nkind (Right_Opnd (Act1)) = N_Integer_Literal
1218                             or else Nkind (Right_Opnd (Act1)) = N_Real_Literal)
1219                  and then Has_Compatible_Type (Act1, Standard_Boolean)
1220                  and then Etype (F1) = Standard_Boolean
1221                then
1222                   --  If the two candidates are the original ones, the
1223                   --  ambiguity is real. Otherwise keep the original, further
1224                   --  calls to Disambiguate will take care of others in the
1225                   --  list of candidates.
1226
1227                   if It1 /= No_Interp then
1228                      if It = Disambiguate.It1
1229                        or else It = Disambiguate.It2
1230                      then
1231                         if It1 = Disambiguate.It1
1232                           or else It1 = Disambiguate.It2
1233                         then
1234                            return No_Interp;
1235                         else
1236                            It1 := It;
1237                         end if;
1238                      end if;
1239
1240                   elsif Present (Act2)
1241                     and then Nkind (Act2) in N_Op
1242                     and then Is_Overloaded (Act2)
1243                     and then (Nkind (Right_Opnd (Act1)) = N_Integer_Literal
1244                                 or else
1245                               Nkind (Right_Opnd (Act1)) = N_Real_Literal)
1246                     and then Has_Compatible_Type (Act2, Standard_Boolean)
1247                   then
1248                      --  The preference rule on the first actual is not
1249                      --  sufficient to disambiguate.
1250
1251                      goto Next_Interp;
1252
1253                   else
1254                      It1 := It;
1255                   end if;
1256
1257                elsif Nkind (Act1) in N_Op
1258                  and then Is_Overloaded (Act1)
1259                  and then Present (Universal_Interpretation (Act1))
1260                  and then Is_Numeric_Type (Etype (F1))
1261                  and then Ada_Version >= Ada_05
1262                  and then Has_Abstract_Interpretation (Act1)
1263                then
1264                   if It = Disambiguate.It1 then
1265                      return Disambiguate.It2;
1266                   elsif It = Disambiguate.It2 then
1267                      return Disambiguate.It1;
1268                   end if;
1269                end if;
1270             end if;
1271
1272             <<Next_Interp>>
1273                Get_Next_Interp (I, It);
1274          end loop;
1275
1276          --  After some error, a formal may have Any_Type and yield a spurious
1277          --  match. To avoid cascaded errors if possible, check for such a
1278          --  formal in either candidate.
1279
1280          if Serious_Errors_Detected > 0 then
1281             declare
1282                Formal : Entity_Id;
1283
1284             begin
1285                Formal := First_Formal (Nam1);
1286                while Present (Formal) loop
1287                   if Etype (Formal) = Any_Type then
1288                      return Disambiguate.It2;
1289                   end if;
1290
1291                   Next_Formal (Formal);
1292                end loop;
1293
1294                Formal := First_Formal (Nam2);
1295                while Present (Formal) loop
1296                   if Etype (Formal) = Any_Type then
1297                      return Disambiguate.It1;
1298                   end if;
1299
1300                   Next_Formal (Formal);
1301                end loop;
1302             end;
1303          end if;
1304
1305          return It1;
1306       end Remove_Conversions;
1307
1308       -----------------------
1309       -- Standard_Operator --
1310       -----------------------
1311
1312       function Standard_Operator return Boolean is
1313          Nam : Node_Id;
1314
1315       begin
1316          if Nkind (N) in N_Op then
1317             return True;
1318
1319          elsif Nkind (N) = N_Function_Call then
1320             Nam := Name (N);
1321
1322             if Nkind (Nam) /= N_Expanded_Name then
1323                return True;
1324             else
1325                return Entity (Prefix (Nam)) = Standard_Standard;
1326             end if;
1327          else
1328             return False;
1329          end if;
1330       end Standard_Operator;
1331
1332    --  Start of processing for Disambiguate
1333
1334    begin
1335       --  Recover the two legal interpretations
1336
1337       Get_First_Interp (N, I, It);
1338       while I /= I1 loop
1339          Get_Next_Interp (I, It);
1340       end loop;
1341
1342       It1  := It;
1343       Nam1 := It.Nam;
1344       while I /= I2 loop
1345          Get_Next_Interp (I, It);
1346       end loop;
1347
1348       It2  := It;
1349       Nam2 := It.Nam;
1350
1351       if Ada_Version < Ada_05 then
1352
1353          --  Check whether one of the entities is an Ada 2005 entity and we are
1354          --  operating in an earlier mode, in which case we discard the Ada
1355          --  2005 entity, so that we get proper Ada 95 overload resolution.
1356
1357          if Is_Ada_2005 (Nam1) then
1358             return It2;
1359          elsif Is_Ada_2005 (Nam2) then
1360             return It1;
1361          end if;
1362       end if;
1363
1364       --  If the context is universal, the predefined operator is preferred.
1365       --  This includes bounds in numeric type declarations, and expressions
1366       --  in type conversions. If no interpretation yields a universal type,
1367       --  then we must check whether the user-defined entity hides the prede-
1368       --  fined one.
1369
1370       if Chars (Nam1) in  Any_Operator_Name
1371         and then Standard_Operator
1372       then
1373          if        Typ = Universal_Integer
1374            or else Typ = Universal_Real
1375            or else Typ = Any_Integer
1376            or else Typ = Any_Discrete
1377            or else Typ = Any_Real
1378            or else Typ = Any_Type
1379          then
1380             --  Find an interpretation that yields the universal type, or else
1381             --  a predefined operator that yields a predefined numeric type.
1382
1383             declare
1384                Candidate : Interp := No_Interp;
1385
1386             begin
1387                Get_First_Interp (N, I, It);
1388                while Present (It.Typ) loop
1389                   if (Covers (Typ, It.Typ)
1390                         or else Typ = Any_Type)
1391                     and then
1392                      (It.Typ = Universal_Integer
1393                        or else It.Typ = Universal_Real)
1394                   then
1395                      return It;
1396
1397                   elsif Covers (Typ, It.Typ)
1398                     and then Scope (It.Typ) = Standard_Standard
1399                     and then Scope (It.Nam) = Standard_Standard
1400                     and then Is_Numeric_Type (It.Typ)
1401                   then
1402                      Candidate := It;
1403                   end if;
1404
1405                   Get_Next_Interp (I, It);
1406                end loop;
1407
1408                if Candidate /= No_Interp then
1409                   return Candidate;
1410                end if;
1411             end;
1412
1413          elsif Chars (Nam1) /= Name_Op_Not
1414            and then (Typ = Standard_Boolean or else Typ = Any_Boolean)
1415          then
1416             --  Equality or comparison operation. Choose predefined operator if
1417             --  arguments are universal. The node may be an operator, name, or
1418             --  a function call, so unpack arguments accordingly.
1419
1420             declare
1421                Arg1, Arg2 : Node_Id;
1422
1423             begin
1424                if Nkind (N) in N_Op then
1425                   Arg1 := Left_Opnd  (N);
1426                   Arg2 := Right_Opnd (N);
1427
1428                elsif Is_Entity_Name (N)
1429                  or else Nkind (N) = N_Operator_Symbol
1430                then
1431                   Arg1 := First_Entity (Entity (N));
1432                   Arg2 := Next_Entity (Arg1);
1433
1434                else
1435                   Arg1 := First_Actual (N);
1436                   Arg2 := Next_Actual (Arg1);
1437                end if;
1438
1439                if Present (Arg2)
1440                  and then Present (Universal_Interpretation (Arg1))
1441                  and then Universal_Interpretation (Arg2) =
1442                           Universal_Interpretation (Arg1)
1443                then
1444                   Get_First_Interp (N, I, It);
1445                   while Scope (It.Nam) /= Standard_Standard loop
1446                      Get_Next_Interp (I, It);
1447                   end loop;
1448
1449                   return It;
1450                end if;
1451             end;
1452          end if;
1453       end if;
1454
1455       --  If no universal interpretation, check whether user-defined operator
1456       --  hides predefined one, as well as other special cases. If the node
1457       --  is a range, then one or both bounds are ambiguous. Each will have
1458       --  to be disambiguated w.r.t. the context type. The type of the range
1459       --  itself is imposed by the context, so we can return either legal
1460       --  interpretation.
1461
1462       if Ekind (Nam1) = E_Operator then
1463          Predef_Subp := Nam1;
1464          User_Subp   := Nam2;
1465
1466       elsif Ekind (Nam2) = E_Operator then
1467          Predef_Subp := Nam2;
1468          User_Subp   := Nam1;
1469
1470       elsif Nkind (N) = N_Range then
1471          return It1;
1472
1473       --  If two user defined-subprograms are visible, it is a true ambiguity,
1474       --  unless one of them is an entry and the context is a conditional or
1475       --  timed entry call, or unless we are within an instance and this is
1476       --  results from two formals types with the same actual.
1477
1478       else
1479          if Nkind (N) = N_Procedure_Call_Statement
1480            and then Nkind (Parent (N)) = N_Entry_Call_Alternative
1481            and then N = Entry_Call_Statement (Parent (N))
1482          then
1483             if Ekind (Nam2) = E_Entry then
1484                return It2;
1485             elsif Ekind (Nam1) = E_Entry then
1486                return It1;
1487             else
1488                return No_Interp;
1489             end if;
1490
1491          --  If the ambiguity occurs within an instance, it is due to several
1492          --  formal types with the same actual. Look for an exact match between
1493          --  the types of the formals of the overloadable entities, and the
1494          --  actuals in the call, to recover the unambiguous match in the
1495          --  original generic.
1496
1497          --  The ambiguity can also be due to an overloading between a formal
1498          --  subprogram and a subprogram declared outside the generic. If the
1499          --  node is overloaded, it did not resolve to the global entity in
1500          --  the generic, and we choose the formal subprogram.
1501
1502          --  Finally, the ambiguity can be between an explicit subprogram and
1503          --  one inherited (with different defaults) from an actual. In this
1504          --  case the resolution was to the explicit declaration in the
1505          --  generic, and remains so in the instance.
1506
1507          elsif In_Instance
1508            and then not In_Generic_Actual (N)
1509          then
1510             if Nkind (N) = N_Function_Call
1511               or else Nkind (N) = N_Procedure_Call_Statement
1512             then
1513                declare
1514                   Actual  : Node_Id;
1515                   Formal  : Entity_Id;
1516                   Is_Act1 : constant Boolean := Is_Actual_Subprogram (Nam1);
1517                   Is_Act2 : constant Boolean := Is_Actual_Subprogram (Nam2);
1518
1519                begin
1520                   if Is_Act1 and then not Is_Act2 then
1521                      return It1;
1522
1523                   elsif Is_Act2 and then not Is_Act1 then
1524                      return It2;
1525
1526                   elsif Inherited_From_Actual (Nam1)
1527                     and then Comes_From_Source (Nam2)
1528                   then
1529                      return It2;
1530
1531                   elsif Inherited_From_Actual (Nam2)
1532                     and then Comes_From_Source (Nam1)
1533                   then
1534                      return It1;
1535                   end if;
1536
1537                   Actual := First_Actual (N);
1538                   Formal := First_Formal (Nam1);
1539                   while Present (Actual) loop
1540                      if Etype (Actual) /= Etype (Formal) then
1541                         return It2;
1542                      end if;
1543
1544                      Next_Actual (Actual);
1545                      Next_Formal (Formal);
1546                   end loop;
1547
1548                   return It1;
1549                end;
1550
1551             elsif Nkind (N) in N_Binary_Op then
1552                if Matches (Left_Opnd (N), First_Formal (Nam1))
1553                  and then
1554                    Matches (Right_Opnd (N), Next_Formal (First_Formal (Nam1)))
1555                then
1556                   return It1;
1557                else
1558                   return It2;
1559                end if;
1560
1561             elsif Nkind (N) in  N_Unary_Op then
1562                if Etype (Right_Opnd (N)) = Etype (First_Formal (Nam1)) then
1563                   return It1;
1564                else
1565                   return It2;
1566                end if;
1567
1568             else
1569                return Remove_Conversions;
1570             end if;
1571          else
1572             return Remove_Conversions;
1573          end if;
1574       end if;
1575
1576       --  an implicit concatenation operator on a string type cannot be
1577       --  disambiguated from the predefined concatenation. This can only
1578       --  happen with concatenation of string literals.
1579
1580       if Chars (User_Subp) = Name_Op_Concat
1581         and then Ekind (User_Subp) = E_Operator
1582         and then Is_String_Type (Etype (First_Formal (User_Subp)))
1583       then
1584          return No_Interp;
1585
1586       --  If the user-defined operator is in  an open scope, or in the scope
1587       --  of the resulting type, or given by an expanded name that names its
1588       --  scope, it hides the predefined operator for the type. Exponentiation
1589       --  has to be special-cased because the implicit operator does not have
1590       --  a symmetric signature, and may not be hidden by the explicit one.
1591
1592       elsif (Nkind (N) = N_Function_Call
1593               and then Nkind (Name (N)) = N_Expanded_Name
1594               and then (Chars (Predef_Subp) /= Name_Op_Expon
1595                           or else Hides_Op (User_Subp, Predef_Subp))
1596               and then Scope (User_Subp) = Entity (Prefix (Name (N))))
1597         or else Hides_Op (User_Subp, Predef_Subp)
1598       then
1599          if It1.Nam = User_Subp then
1600             return It1;
1601          else
1602             return It2;
1603          end if;
1604
1605       --  Otherwise, the predefined operator has precedence, or if the user-
1606       --  defined operation is directly visible we have a true ambiguity. If
1607       --  this is a fixed-point multiplication and division in Ada83 mode,
1608       --  exclude the universal_fixed operator, which often causes ambiguities
1609       --  in legacy code.
1610
1611       else
1612          if (In_Open_Scopes (Scope (User_Subp))
1613            or else Is_Potentially_Use_Visible (User_Subp))
1614            and then not In_Instance
1615          then
1616             if Is_Fixed_Point_Type (Typ)
1617               and then (Chars (Nam1) = Name_Op_Multiply
1618                           or else Chars (Nam1) = Name_Op_Divide)
1619               and then Ada_Version = Ada_83
1620             then
1621                if It2.Nam = Predef_Subp then
1622                   return It1;
1623                else
1624                   return It2;
1625                end if;
1626
1627             --  Ada 2005, AI-420: preference rule for "=" on Universal_Access
1628             --  states that the operator defined in Standard is not available
1629             --  if there is a user-defined equality with the proper signature,
1630             --  declared in the same declarative list as the type. The node
1631             --  may be an operator or a function call.
1632
1633             elsif (Chars (Nam1) = Name_Op_Eq
1634                      or else
1635                    Chars (Nam1) = Name_Op_Ne)
1636               and then Ada_Version >= Ada_05
1637               and then Etype (User_Subp) = Standard_Boolean
1638             then
1639                declare
1640                   Opnd : Node_Id;
1641                begin
1642                   if Nkind (N) = N_Function_Call then
1643                      Opnd := First_Actual (N);
1644                   else
1645                      Opnd := Left_Opnd (N);
1646                   end if;
1647
1648                   if Ekind (Etype (Opnd)) = E_Anonymous_Access_Type
1649                     and then
1650                      List_Containing (Parent (Designated_Type (Etype (Opnd))))
1651                        = List_Containing (Unit_Declaration_Node (User_Subp))
1652                   then
1653                      if It2.Nam = Predef_Subp then
1654                         return It1;
1655                      else
1656                         return It2;
1657                      end if;
1658                   else
1659                      return No_Interp;
1660                   end if;
1661                end;
1662
1663             else
1664                return No_Interp;
1665             end if;
1666
1667          elsif It1.Nam = Predef_Subp then
1668             return It1;
1669
1670          else
1671             return It2;
1672          end if;
1673       end if;
1674    end Disambiguate;
1675
1676    ---------------------
1677    -- End_Interp_List --
1678    ---------------------
1679
1680    procedure End_Interp_List is
1681    begin
1682       All_Interp.Table (All_Interp.Last) := No_Interp;
1683       All_Interp.Increment_Last;
1684    end End_Interp_List;
1685
1686    -------------------------
1687    -- Entity_Matches_Spec --
1688    -------------------------
1689
1690    function Entity_Matches_Spec (Old_S, New_S : Entity_Id) return Boolean is
1691    begin
1692       --  Simple case: same entity kinds, type conformance is required. A
1693       --  parameterless function can also rename a literal.
1694
1695       if Ekind (Old_S) = Ekind (New_S)
1696         or else (Ekind (New_S) = E_Function
1697                   and then Ekind (Old_S) = E_Enumeration_Literal)
1698       then
1699          return Type_Conformant (New_S, Old_S);
1700
1701       elsif Ekind (New_S) = E_Function
1702         and then Ekind (Old_S) = E_Operator
1703       then
1704          return Operator_Matches_Spec (Old_S, New_S);
1705
1706       elsif Ekind (New_S) = E_Procedure
1707         and then Is_Entry (Old_S)
1708       then
1709          return Type_Conformant (New_S, Old_S);
1710
1711       else
1712          return False;
1713       end if;
1714    end Entity_Matches_Spec;
1715
1716    ----------------------
1717    -- Find_Unique_Type --
1718    ----------------------
1719
1720    function Find_Unique_Type (L : Node_Id; R : Node_Id) return Entity_Id is
1721       T  : constant Entity_Id := Etype (L);
1722       I  : Interp_Index;
1723       It : Interp;
1724       TR : Entity_Id := Any_Type;
1725
1726    begin
1727       if Is_Overloaded (R) then
1728          Get_First_Interp (R, I, It);
1729          while Present (It.Typ) loop
1730             if Covers (T, It.Typ) or else Covers (It.Typ, T) then
1731
1732                --  If several interpretations are possible and L is universal,
1733                --  apply preference rule.
1734
1735                if TR /= Any_Type then
1736
1737                   if (T = Universal_Integer or else T = Universal_Real)
1738                     and then It.Typ = T
1739                   then
1740                      TR := It.Typ;
1741                   end if;
1742
1743                else
1744                   TR := It.Typ;
1745                end if;
1746             end if;
1747
1748             Get_Next_Interp (I, It);
1749          end loop;
1750
1751          Set_Etype (R, TR);
1752
1753       --  In the non-overloaded case, the Etype of R is already set correctly
1754
1755       else
1756          null;
1757       end if;
1758
1759       --  If one of the operands is Universal_Fixed, the type of the other
1760       --  operand provides the context.
1761
1762       if Etype (R) = Universal_Fixed then
1763          return T;
1764
1765       elsif T = Universal_Fixed then
1766          return Etype (R);
1767
1768       --  Ada 2005 (AI-230): Support the following operators:
1769
1770       --    function "="  (L, R : universal_access) return Boolean;
1771       --    function "/=" (L, R : universal_access) return Boolean;
1772
1773       --  Pool specific access types (E_Access_Type) are not covered by these
1774       --  operators because of the legality rule of 4.5.2(9.2): "The operands
1775       --  of the equality operators for universal_access shall be convertible
1776       --  to one another (see 4.6)". For example, considering the type decla-
1777       --  ration "type P is access Integer" and an anonymous access to Integer,
1778       --  P is convertible to "access Integer" by 4.6 (24.11-24.15), but there
1779       --  is no rule in 4.6 that allows "access Integer" to be converted to P.
1780
1781       elsif Ada_Version >= Ada_05
1782         and then Ekind (Etype (L)) = E_Anonymous_Access_Type
1783         and then Is_Access_Type (Etype (R))
1784         and then Ekind (Etype (R)) /= E_Access_Type
1785       then
1786          return Etype (L);
1787
1788       elsif Ada_Version >= Ada_05
1789         and then Ekind (Etype (R)) = E_Anonymous_Access_Type
1790         and then Is_Access_Type (Etype (L))
1791         and then Ekind (Etype (L)) /= E_Access_Type
1792       then
1793          return Etype (R);
1794
1795       else
1796          return Specific_Type (T, Etype (R));
1797       end if;
1798
1799    end Find_Unique_Type;
1800
1801    ----------------------
1802    -- Get_First_Interp --
1803    ----------------------
1804
1805    procedure Get_First_Interp
1806      (N  : Node_Id;
1807       I  : out Interp_Index;
1808       It : out Interp)
1809    is
1810       Map_Ptr : Int;
1811       Int_Ind : Interp_Index;
1812       O_N     : Node_Id;
1813
1814    begin
1815       --  If a selected component is overloaded because the selector has
1816       --  multiple interpretations, the node is a call to a protected
1817       --  operation or an indirect call. Retrieve the interpretation from
1818       --  the selector name. The selected component may be overloaded as well
1819       --  if the prefix is overloaded. That case is unchanged.
1820
1821       if Nkind (N) = N_Selected_Component
1822         and then Is_Overloaded (Selector_Name (N))
1823       then
1824          O_N := Selector_Name (N);
1825       else
1826          O_N := N;
1827       end if;
1828
1829       Map_Ptr := Headers (Hash (O_N));
1830       while Present (Interp_Map.Table (Map_Ptr).Node) loop
1831          if Interp_Map.Table (Map_Ptr).Node = O_N then
1832             Int_Ind := Interp_Map.Table (Map_Ptr).Index;
1833             It := All_Interp.Table (Int_Ind);
1834             I := Int_Ind;
1835             return;
1836          else
1837             Map_Ptr := Interp_Map.Table (Map_Ptr).Next;
1838          end if;
1839       end loop;
1840
1841       --  Procedure should never be called if the node has no interpretations
1842
1843       raise Program_Error;
1844    end Get_First_Interp;
1845
1846    ---------------------
1847    -- Get_Next_Interp --
1848    ---------------------
1849
1850    procedure Get_Next_Interp (I : in out Interp_Index; It : out Interp) is
1851    begin
1852       I  := I + 1;
1853       It := All_Interp.Table (I);
1854    end Get_Next_Interp;
1855
1856    -------------------------
1857    -- Has_Compatible_Type --
1858    -------------------------
1859
1860    function Has_Compatible_Type
1861      (N    : Node_Id;
1862       Typ  : Entity_Id)
1863       return Boolean
1864    is
1865       I  : Interp_Index;
1866       It : Interp;
1867
1868    begin
1869       if N = Error then
1870          return False;
1871       end if;
1872
1873       if Nkind (N) = N_Subtype_Indication
1874         or else not Is_Overloaded (N)
1875       then
1876          return
1877            Covers (Typ, Etype (N))
1878
1879             --  Ada 2005 (AI-345) The context may be a synchronized interface.
1880             --  If the type is already frozen use the corresponding_record
1881             --  to check whether it is a proper descendant.
1882
1883            or else
1884              (Is_Concurrent_Type (Etype (N))
1885                 and then Present (Corresponding_Record_Type (Etype (N)))
1886                 and then Covers (Typ, Corresponding_Record_Type (Etype (N))))
1887
1888            or else
1889              (not Is_Tagged_Type (Typ)
1890                 and then Ekind (Typ) /= E_Anonymous_Access_Type
1891                 and then Covers (Etype (N), Typ));
1892
1893       else
1894          Get_First_Interp (N, I, It);
1895          while Present (It.Typ) loop
1896             if (Covers (Typ, It.Typ)
1897                   and then
1898                     (Scope (It.Nam) /= Standard_Standard
1899                        or else not Is_Invisible_Operator (N, Base_Type (Typ))))
1900
1901                --  Ada 2005 (AI-345)
1902
1903               or else
1904                 (Is_Concurrent_Type (It.Typ)
1905                   and then Present (Corresponding_Record_Type
1906                                                              (Etype (It.Typ)))
1907                   and then Covers (Typ, Corresponding_Record_Type
1908                                                              (Etype (It.Typ))))
1909
1910               or else (not Is_Tagged_Type (Typ)
1911                          and then Ekind (Typ) /= E_Anonymous_Access_Type
1912                          and then Covers (It.Typ, Typ))
1913             then
1914                return True;
1915             end if;
1916
1917             Get_Next_Interp (I, It);
1918          end loop;
1919
1920          return False;
1921       end if;
1922    end Has_Compatible_Type;
1923
1924    ----------
1925    -- Hash --
1926    ----------
1927
1928    function Hash (N : Node_Id) return Int is
1929    begin
1930       --  Nodes have a size that is power of two, so to select significant
1931       --  bits only we remove the low-order bits.
1932
1933       return ((Int (N) / 2 ** 5) mod Header_Size);
1934    end Hash;
1935
1936    --------------
1937    -- Hides_Op --
1938    --------------
1939
1940    function Hides_Op (F : Entity_Id; Op : Entity_Id) return Boolean is
1941       Btyp : constant Entity_Id := Base_Type (Etype (First_Formal (F)));
1942    begin
1943       return Operator_Matches_Spec (Op, F)
1944         and then (In_Open_Scopes (Scope (F))
1945                     or else Scope (F) = Scope (Btyp)
1946                     or else (not In_Open_Scopes (Scope (Btyp))
1947                               and then not In_Use (Btyp)
1948                               and then not In_Use (Scope (Btyp))));
1949    end Hides_Op;
1950
1951    ------------------------
1952    -- Init_Interp_Tables --
1953    ------------------------
1954
1955    procedure Init_Interp_Tables is
1956    begin
1957       All_Interp.Init;
1958       Interp_Map.Init;
1959       Headers := (others => No_Entry);
1960    end Init_Interp_Tables;
1961
1962    -----------------------------------
1963    -- Interface_Present_In_Ancestor --
1964    -----------------------------------
1965
1966    function Interface_Present_In_Ancestor
1967      (Typ   : Entity_Id;
1968       Iface : Entity_Id) return Boolean
1969    is
1970       Target_Typ : Entity_Id;
1971
1972       function Iface_Present_In_Ancestor (Typ : Entity_Id) return Boolean;
1973       --  Returns True if Typ or some ancestor of Typ implements Iface
1974
1975       function Iface_Present_In_Ancestor (Typ : Entity_Id) return Boolean is
1976          E    : Entity_Id;
1977          AI   : Entity_Id;
1978          Elmt : Elmt_Id;
1979
1980       begin
1981          if Typ = Iface then
1982             return True;
1983          end if;
1984
1985          --  Handle private types
1986
1987          if Present (Full_View (Typ))
1988            and then not Is_Concurrent_Type (Full_View (Typ))
1989          then
1990             E := Full_View (Typ);
1991          else
1992             E := Typ;
1993          end if;
1994
1995          loop
1996             if Present (Abstract_Interfaces (E))
1997               and then Present (Abstract_Interfaces (E))
1998               and then not Is_Empty_Elmt_List (Abstract_Interfaces (E))
1999             then
2000                Elmt := First_Elmt (Abstract_Interfaces (E));
2001                while Present (Elmt) loop
2002                   AI := Node (Elmt);
2003
2004                   if AI = Iface or else Is_Ancestor (Iface, AI) then
2005                      return True;
2006                   end if;
2007
2008                   Next_Elmt (Elmt);
2009                end loop;
2010             end if;
2011
2012             exit when Etype (E) = E
2013
2014                --  Handle private types
2015
2016                or else (Present (Full_View (Etype (E)))
2017                          and then Full_View (Etype (E)) = E);
2018
2019             --  Check if the current type is a direct derivation of the
2020             --  interface
2021
2022             if Etype (E) = Iface then
2023                return True;
2024             end if;
2025
2026             --  Climb to the immediate ancestor handling private types
2027
2028             if Present (Full_View (Etype (E))) then
2029                E := Full_View (Etype (E));
2030             else
2031                E := Etype (E);
2032             end if;
2033          end loop;
2034
2035          return False;
2036       end Iface_Present_In_Ancestor;
2037
2038    --  Start of processing for Interface_Present_In_Ancestor
2039
2040    begin
2041       if Is_Access_Type (Typ) then
2042          Target_Typ := Etype (Directly_Designated_Type (Typ));
2043       else
2044          Target_Typ := Typ;
2045       end if;
2046
2047       --  In case of concurrent types we can't use the Corresponding Record_Typ
2048       --  to look for the interface because it is built by the expander (and
2049       --  hence it is not always available). For this reason we traverse the
2050       --  list of interfaces (available in the parent of the concurrent type)
2051
2052       if Is_Concurrent_Type (Target_Typ) then
2053          if Present (Interface_List (Parent (Target_Typ))) then
2054             declare
2055                AI : Node_Id;
2056
2057             begin
2058                AI := First (Interface_List (Parent (Target_Typ)));
2059                while Present (AI) loop
2060                   if Etype (AI) = Iface then
2061                      return True;
2062
2063                   elsif Present (Abstract_Interfaces (Etype (AI)))
2064                      and then Iface_Present_In_Ancestor (Etype (AI))
2065                   then
2066                      return True;
2067                   end if;
2068
2069                   Next (AI);
2070                end loop;
2071             end;
2072          end if;
2073
2074          return False;
2075       end if;
2076
2077       if Is_Class_Wide_Type (Target_Typ) then
2078          Target_Typ := Etype (Target_Typ);
2079       end if;
2080
2081       if Ekind (Target_Typ) = E_Incomplete_Type then
2082          pragma Assert (Present (Non_Limited_View (Target_Typ)));
2083          Target_Typ := Non_Limited_View (Target_Typ);
2084
2085          --  Protect the frontend against previously detected errors
2086
2087          if Ekind (Target_Typ) = E_Incomplete_Type then
2088             return False;
2089          end if;
2090       end if;
2091
2092       return Iface_Present_In_Ancestor (Target_Typ);
2093    end Interface_Present_In_Ancestor;
2094
2095    ---------------------
2096    -- Intersect_Types --
2097    ---------------------
2098
2099    function Intersect_Types (L, R : Node_Id) return Entity_Id is
2100       Index : Interp_Index;
2101       It    : Interp;
2102       Typ   : Entity_Id;
2103
2104       function Check_Right_Argument (T : Entity_Id) return Entity_Id;
2105       --  Find interpretation of right arg that has type compatible with T
2106
2107       --------------------------
2108       -- Check_Right_Argument --
2109       --------------------------
2110
2111       function Check_Right_Argument (T : Entity_Id) return Entity_Id is
2112          Index : Interp_Index;
2113          It    : Interp;
2114          T2    : Entity_Id;
2115
2116       begin
2117          if not Is_Overloaded (R) then
2118             return Specific_Type (T, Etype (R));
2119
2120          else
2121             Get_First_Interp (R, Index, It);
2122             loop
2123                T2 := Specific_Type (T, It.Typ);
2124
2125                if T2 /= Any_Type then
2126                   return T2;
2127                end if;
2128
2129                Get_Next_Interp (Index, It);
2130                exit when No (It.Typ);
2131             end loop;
2132
2133             return Any_Type;
2134          end if;
2135       end Check_Right_Argument;
2136
2137    --  Start processing for Intersect_Types
2138
2139    begin
2140       if Etype (L) = Any_Type or else Etype (R) = Any_Type then
2141          return Any_Type;
2142       end if;
2143
2144       if not Is_Overloaded (L) then
2145          Typ := Check_Right_Argument (Etype (L));
2146
2147       else
2148          Typ := Any_Type;
2149          Get_First_Interp (L, Index, It);
2150          while Present (It.Typ) loop
2151             Typ := Check_Right_Argument (It.Typ);
2152             exit when Typ /= Any_Type;
2153             Get_Next_Interp (Index, It);
2154          end loop;
2155
2156       end if;
2157
2158       --  If Typ is Any_Type, it means no compatible pair of types was found
2159
2160       if Typ = Any_Type then
2161          if Nkind (Parent (L)) in N_Op then
2162             Error_Msg_N ("incompatible types for operator", Parent (L));
2163
2164          elsif Nkind (Parent (L)) = N_Range then
2165             Error_Msg_N ("incompatible types given in constraint", Parent (L));
2166
2167          --  Ada 2005 (AI-251): Complete the error notification
2168
2169          elsif Is_Class_Wide_Type (Etype (R))
2170              and then Is_Interface (Etype (Class_Wide_Type (Etype (R))))
2171          then
2172             Error_Msg_NE ("(Ada 2005) does not implement interface }",
2173                           L, Etype (Class_Wide_Type (Etype (R))));
2174
2175          else
2176             Error_Msg_N ("incompatible types", Parent (L));
2177          end if;
2178       end if;
2179
2180       return Typ;
2181    end Intersect_Types;
2182
2183    -----------------
2184    -- Is_Ancestor --
2185    -----------------
2186
2187    function Is_Ancestor (T1, T2 : Entity_Id) return Boolean is
2188       Par : Entity_Id;
2189
2190    begin
2191       if Base_Type (T1) = Base_Type (T2) then
2192          return True;
2193
2194       elsif Is_Private_Type (T1)
2195         and then Present (Full_View (T1))
2196         and then Base_Type (T2) = Base_Type (Full_View (T1))
2197       then
2198          return True;
2199
2200       else
2201          Par := Etype (T2);
2202
2203          loop
2204             --  If there was a error on the type declaration, do not recurse
2205
2206             if Error_Posted (Par) then
2207                return False;
2208
2209             elsif Base_Type (T1) = Base_Type (Par)
2210               or else (Is_Private_Type (T1)
2211                          and then Present (Full_View (T1))
2212                          and then Base_Type (Par) = Base_Type (Full_View (T1)))
2213             then
2214                return True;
2215
2216             elsif Is_Private_Type (Par)
2217               and then Present (Full_View (Par))
2218               and then Full_View (Par) = Base_Type (T1)
2219             then
2220                return True;
2221
2222             elsif Etype (Par) /= Par then
2223                Par := Etype (Par);
2224             else
2225                return False;
2226             end if;
2227          end loop;
2228       end if;
2229    end Is_Ancestor;
2230
2231    ---------------------------
2232    -- Is_Invisible_Operator --
2233    ---------------------------
2234
2235    function Is_Invisible_Operator
2236      (N    : Node_Id;
2237       T    : Entity_Id)
2238       return Boolean
2239    is
2240       Orig_Node : constant Node_Id := Original_Node (N);
2241
2242    begin
2243       if Nkind (N) not in N_Op then
2244          return False;
2245
2246       elsif not Comes_From_Source (N) then
2247          return False;
2248
2249       elsif No (Universal_Interpretation (Right_Opnd (N))) then
2250          return False;
2251
2252       elsif Nkind (N) in N_Binary_Op
2253         and then No (Universal_Interpretation (Left_Opnd (N)))
2254       then
2255          return False;
2256
2257       else return
2258         Is_Numeric_Type (T)
2259           and then not In_Open_Scopes (Scope (T))
2260           and then not Is_Potentially_Use_Visible (T)
2261           and then not In_Use (T)
2262           and then not In_Use (Scope (T))
2263           and then
2264             (Nkind (Orig_Node) /= N_Function_Call
2265               or else Nkind (Name (Orig_Node)) /= N_Expanded_Name
2266               or else Entity (Prefix (Name (Orig_Node))) /= Scope (T))
2267
2268           and then not In_Instance;
2269       end if;
2270    end Is_Invisible_Operator;
2271
2272    -------------------
2273    -- Is_Subtype_Of --
2274    -------------------
2275
2276    function Is_Subtype_Of (T1 : Entity_Id; T2 : Entity_Id) return Boolean is
2277       S : Entity_Id;
2278
2279    begin
2280       S := Ancestor_Subtype (T1);
2281       while Present (S) loop
2282          if S = T2 then
2283             return True;
2284          else
2285             S := Ancestor_Subtype (S);
2286          end if;
2287       end loop;
2288
2289       return False;
2290    end Is_Subtype_Of;
2291
2292    ------------------
2293    -- List_Interps --
2294    ------------------
2295
2296    procedure List_Interps (Nam : Node_Id; Err : Node_Id) is
2297       Index : Interp_Index;
2298       It    : Interp;
2299
2300    begin
2301       Get_First_Interp (Nam, Index, It);
2302       while Present (It.Nam) loop
2303          if Scope (It.Nam) = Standard_Standard
2304            and then Scope (It.Typ) /= Standard_Standard
2305          then
2306             Error_Msg_Sloc := Sloc (Parent (It.Typ));
2307             Error_Msg_NE ("   & (inherited) declared#!", Err, It.Nam);
2308
2309          else
2310             Error_Msg_Sloc := Sloc (It.Nam);
2311             Error_Msg_NE ("   & declared#!", Err, It.Nam);
2312          end if;
2313
2314          Get_Next_Interp (Index, It);
2315       end loop;
2316    end List_Interps;
2317
2318    -----------------
2319    -- New_Interps --
2320    -----------------
2321
2322    procedure New_Interps (N : Node_Id)  is
2323       Map_Ptr : Int;
2324
2325    begin
2326       All_Interp.Increment_Last;
2327       All_Interp.Table (All_Interp.Last) := No_Interp;
2328
2329       Map_Ptr := Headers (Hash (N));
2330
2331       if Map_Ptr = No_Entry then
2332
2333          --  Place new node at end of table
2334
2335          Interp_Map.Increment_Last;
2336          Headers (Hash (N)) := Interp_Map.Last;
2337
2338       else
2339          --   Place node at end of chain, or locate its previous entry
2340
2341          loop
2342             if Interp_Map.Table (Map_Ptr).Node = N then
2343
2344                --  Node is already in the table, and is being rewritten.
2345                --  Start a new interp section, retain hash link.
2346
2347                Interp_Map.Table (Map_Ptr).Node  := N;
2348                Interp_Map.Table (Map_Ptr).Index := All_Interp.Last;
2349                Set_Is_Overloaded (N, True);
2350                return;
2351
2352             else
2353                exit when Interp_Map.Table (Map_Ptr).Next = No_Entry;
2354                Map_Ptr := Interp_Map.Table (Map_Ptr).Next;
2355             end if;
2356          end loop;
2357
2358          --  Chain the new node
2359
2360          Interp_Map.Increment_Last;
2361          Interp_Map.Table (Map_Ptr).Next := Interp_Map.Last;
2362       end if;
2363
2364       Interp_Map.Table (Interp_Map.Last) := (N, All_Interp.Last, No_Entry);
2365       Set_Is_Overloaded (N, True);
2366    end New_Interps;
2367
2368    ---------------------------
2369    -- Operator_Matches_Spec --
2370    ---------------------------
2371
2372    function Operator_Matches_Spec (Op, New_S : Entity_Id) return Boolean is
2373       Op_Name : constant Name_Id   := Chars (Op);
2374       T       : constant Entity_Id := Etype (New_S);
2375       New_F   : Entity_Id;
2376       Old_F   : Entity_Id;
2377       Num     : Int;
2378       T1      : Entity_Id;
2379       T2      : Entity_Id;
2380
2381    begin
2382       --  To verify that a predefined operator matches a given signature,
2383       --  do a case analysis of the operator classes. Function can have one
2384       --  or two formals and must have the proper result type.
2385
2386       New_F := First_Formal (New_S);
2387       Old_F := First_Formal (Op);
2388       Num := 0;
2389       while Present (New_F) and then Present (Old_F) loop
2390          Num := Num + 1;
2391          Next_Formal (New_F);
2392          Next_Formal (Old_F);
2393       end loop;
2394
2395       --  Definite mismatch if different number of parameters
2396
2397       if Present (Old_F) or else Present (New_F) then
2398          return False;
2399
2400       --  Unary operators
2401
2402       elsif Num = 1 then
2403          T1 := Etype (First_Formal (New_S));
2404
2405          if Op_Name = Name_Op_Subtract
2406            or else Op_Name = Name_Op_Add
2407            or else Op_Name = Name_Op_Abs
2408          then
2409             return Base_Type (T1) = Base_Type (T)
2410               and then Is_Numeric_Type (T);
2411
2412          elsif Op_Name = Name_Op_Not then
2413             return Base_Type (T1) = Base_Type (T)
2414               and then Valid_Boolean_Arg (Base_Type (T));
2415
2416          else
2417             return False;
2418          end if;
2419
2420       --  Binary operators
2421
2422       else
2423          T1 := Etype (First_Formal (New_S));
2424          T2 := Etype (Next_Formal (First_Formal (New_S)));
2425
2426          if Op_Name =  Name_Op_And or else Op_Name = Name_Op_Or
2427            or else Op_Name = Name_Op_Xor
2428          then
2429             return Base_Type (T1) = Base_Type (T2)
2430               and then Base_Type (T1) = Base_Type (T)
2431               and then Valid_Boolean_Arg (Base_Type (T));
2432
2433          elsif Op_Name = Name_Op_Eq or else Op_Name = Name_Op_Ne then
2434             return Base_Type (T1) = Base_Type (T2)
2435               and then not Is_Limited_Type (T1)
2436               and then Is_Boolean_Type (T);
2437
2438          elsif Op_Name = Name_Op_Lt or else Op_Name = Name_Op_Le
2439            or else Op_Name = Name_Op_Gt or else Op_Name = Name_Op_Ge
2440          then
2441             return Base_Type (T1) = Base_Type (T2)
2442               and then Valid_Comparison_Arg (T1)
2443               and then Is_Boolean_Type (T);
2444
2445          elsif Op_Name = Name_Op_Add or else Op_Name = Name_Op_Subtract then
2446             return Base_Type (T1) = Base_Type (T2)
2447               and then Base_Type (T1) = Base_Type (T)
2448               and then Is_Numeric_Type (T);
2449
2450          --  for division and multiplication, a user-defined function does
2451          --  not match the predefined universal_fixed operation, except in
2452          --  Ada83 mode.
2453
2454          elsif Op_Name = Name_Op_Divide then
2455             return (Base_Type (T1) = Base_Type (T2)
2456               and then Base_Type (T1) = Base_Type (T)
2457               and then Is_Numeric_Type (T)
2458               and then (not Is_Fixed_Point_Type (T)
2459                          or else Ada_Version = Ada_83))
2460
2461             --  Mixed_Mode operations on fixed-point types
2462
2463               or else (Base_Type (T1) = Base_Type (T)
2464                         and then Base_Type (T2) = Base_Type (Standard_Integer)
2465                         and then Is_Fixed_Point_Type (T))
2466
2467             --  A user defined operator can also match (and hide) a mixed
2468             --  operation on universal literals.
2469
2470               or else (Is_Integer_Type (T2)
2471                         and then Is_Floating_Point_Type (T1)
2472                         and then Base_Type (T1) = Base_Type (T));
2473
2474          elsif Op_Name = Name_Op_Multiply then
2475             return (Base_Type (T1) = Base_Type (T2)
2476               and then Base_Type (T1) = Base_Type (T)
2477               and then Is_Numeric_Type (T)
2478               and then (not Is_Fixed_Point_Type (T)
2479                          or else Ada_Version = Ada_83))
2480
2481             --  Mixed_Mode operations on fixed-point types
2482
2483               or else (Base_Type (T1) = Base_Type (T)
2484                         and then Base_Type (T2) = Base_Type (Standard_Integer)
2485                         and then Is_Fixed_Point_Type (T))
2486
2487               or else (Base_Type (T2) = Base_Type (T)
2488                         and then Base_Type (T1) = Base_Type (Standard_Integer)
2489                         and then Is_Fixed_Point_Type (T))
2490
2491               or else (Is_Integer_Type (T2)
2492                         and then Is_Floating_Point_Type (T1)
2493                         and then Base_Type (T1) = Base_Type (T))
2494
2495               or else (Is_Integer_Type (T1)
2496                         and then Is_Floating_Point_Type (T2)
2497                         and then Base_Type (T2) = Base_Type (T));
2498
2499          elsif Op_Name = Name_Op_Mod or else Op_Name = Name_Op_Rem then
2500             return Base_Type (T1) = Base_Type (T2)
2501               and then Base_Type (T1) = Base_Type (T)
2502               and then Is_Integer_Type (T);
2503
2504          elsif Op_Name = Name_Op_Expon then
2505             return Base_Type (T1) = Base_Type (T)
2506               and then Is_Numeric_Type (T)
2507               and then Base_Type (T2) = Base_Type (Standard_Integer);
2508
2509          elsif Op_Name = Name_Op_Concat then
2510             return Is_Array_Type (T)
2511               and then (Base_Type (T) = Base_Type (Etype (Op)))
2512               and then (Base_Type (T1) = Base_Type (T)
2513                          or else
2514                         Base_Type (T1) = Base_Type (Component_Type (T)))
2515               and then (Base_Type (T2) = Base_Type (T)
2516                          or else
2517                         Base_Type (T2) = Base_Type (Component_Type (T)));
2518
2519          else
2520             return False;
2521          end if;
2522       end if;
2523    end Operator_Matches_Spec;
2524
2525    -------------------
2526    -- Remove_Interp --
2527    -------------------
2528
2529    procedure Remove_Interp (I : in out Interp_Index) is
2530       II : Interp_Index;
2531
2532    begin
2533       --  Find end of Interp list and copy downward to erase the discarded one
2534
2535       II := I + 1;
2536       while Present (All_Interp.Table (II).Typ) loop
2537          II := II + 1;
2538       end loop;
2539
2540       for J in I + 1 .. II loop
2541          All_Interp.Table (J - 1) := All_Interp.Table (J);
2542       end loop;
2543
2544       --  Back up interp. index to insure that iterator will pick up next
2545       --  available interpretation.
2546
2547       I := I - 1;
2548    end Remove_Interp;
2549
2550    ------------------
2551    -- Save_Interps --
2552    ------------------
2553
2554    procedure Save_Interps (Old_N : Node_Id; New_N : Node_Id) is
2555       Map_Ptr : Int;
2556       O_N     : Node_Id := Old_N;
2557
2558    begin
2559       if Is_Overloaded (Old_N) then
2560          if Nkind (Old_N) = N_Selected_Component
2561            and then Is_Overloaded (Selector_Name (Old_N))
2562          then
2563             O_N := Selector_Name (Old_N);
2564          end if;
2565
2566          Map_Ptr := Headers (Hash (O_N));
2567
2568          while Interp_Map.Table (Map_Ptr).Node /= O_N loop
2569             Map_Ptr := Interp_Map.Table (Map_Ptr).Next;
2570             pragma Assert (Map_Ptr /= No_Entry);
2571          end loop;
2572
2573          New_Interps (New_N);
2574          Interp_Map.Table (Interp_Map.Last).Index :=
2575            Interp_Map.Table (Map_Ptr).Index;
2576       end if;
2577    end Save_Interps;
2578
2579    -------------------
2580    -- Specific_Type --
2581    -------------------
2582
2583    function Specific_Type (T1, T2 : Entity_Id) return Entity_Id is
2584       B1 : constant Entity_Id := Base_Type (T1);
2585       B2 : constant Entity_Id := Base_Type (T2);
2586
2587       function Is_Remote_Access (T : Entity_Id) return Boolean;
2588       --  Check whether T is the equivalent type of a remote access type.
2589       --  If distribution is enabled, T is a legal context for Null.
2590
2591       ----------------------
2592       -- Is_Remote_Access --
2593       ----------------------
2594
2595       function Is_Remote_Access (T : Entity_Id) return Boolean is
2596       begin
2597          return Is_Record_Type (T)
2598            and then (Is_Remote_Call_Interface (T)
2599                       or else Is_Remote_Types (T))
2600            and then Present (Corresponding_Remote_Type (T))
2601            and then Is_Access_Type (Corresponding_Remote_Type (T));
2602       end Is_Remote_Access;
2603
2604    --  Start of processing for Specific_Type
2605
2606    begin
2607       if T1 = Any_Type or else T2 = Any_Type then
2608          return Any_Type;
2609       end if;
2610
2611       if B1 = B2 then
2612          return B1;
2613
2614       elsif False
2615         or else (T1 = Universal_Integer and then Is_Integer_Type (T2))
2616         or else (T1 = Universal_Real    and then Is_Real_Type (T2))
2617         or else (T1 = Universal_Fixed   and then Is_Fixed_Point_Type (T2))
2618         or else (T1 = Any_Fixed         and then Is_Fixed_Point_Type (T2))
2619       then
2620          return B2;
2621
2622       elsif False
2623         or else (T2 = Universal_Integer and then Is_Integer_Type (T1))
2624         or else (T2 = Universal_Real    and then Is_Real_Type (T1))
2625         or else (T2 = Universal_Fixed   and then Is_Fixed_Point_Type (T1))
2626         or else (T2 = Any_Fixed         and then Is_Fixed_Point_Type (T1))
2627       then
2628          return B1;
2629
2630       elsif T2 = Any_String and then Is_String_Type (T1) then
2631          return B1;
2632
2633       elsif T1 = Any_String and then Is_String_Type (T2) then
2634          return B2;
2635
2636       elsif T2 = Any_Character and then Is_Character_Type (T1) then
2637          return B1;
2638
2639       elsif T1 = Any_Character and then Is_Character_Type (T2) then
2640          return B2;
2641
2642       elsif T1 = Any_Access
2643         and then (Is_Access_Type (T2) or else Is_Remote_Access (T2))
2644       then
2645          return T2;
2646
2647       elsif T2 = Any_Access
2648         and then (Is_Access_Type (T1) or else Is_Remote_Access (T1))
2649       then
2650          return T1;
2651
2652       elsif T2 = Any_Composite
2653         and then Ekind (T1) in E_Array_Type .. E_Record_Subtype
2654       then
2655          return T1;
2656
2657       elsif T1 = Any_Composite
2658         and then Ekind (T2) in E_Array_Type .. E_Record_Subtype
2659       then
2660          return T2;
2661
2662       elsif T1 = Any_Modular and then Is_Modular_Integer_Type (T2) then
2663          return T2;
2664
2665       elsif T2 = Any_Modular and then Is_Modular_Integer_Type (T1) then
2666          return T1;
2667
2668       --  ----------------------------------------------------------
2669       --  Special cases for equality operators (all other predefined
2670       --  operators can never apply to tagged types)
2671       --  ----------------------------------------------------------
2672
2673       --  Ada 2005 (AI-251): T1 and T2 are class-wide types, and T2 is an
2674       --  interface
2675
2676       elsif Is_Class_Wide_Type (T1)
2677         and then Is_Class_Wide_Type (T2)
2678         and then Is_Interface (Etype (T2))
2679       then
2680          return T1;
2681
2682       --  Ada 2005 (AI-251): T1 is a concrete type that implements the
2683       --  class-wide interface T2
2684
2685       elsif Is_Class_Wide_Type (T2)
2686         and then Is_Interface (Etype (T2))
2687         and then Interface_Present_In_Ancestor (Typ => T1,
2688                                                 Iface => Etype (T2))
2689       then
2690          return T1;
2691
2692       elsif Is_Class_Wide_Type (T1)
2693         and then Is_Ancestor (Root_Type (T1), T2)
2694       then
2695          return T1;
2696
2697       elsif Is_Class_Wide_Type (T2)
2698         and then Is_Ancestor (Root_Type (T2), T1)
2699       then
2700          return T2;
2701
2702       elsif (Ekind (B1) = E_Access_Subprogram_Type
2703                or else
2704              Ekind (B1) = E_Access_Protected_Subprogram_Type)
2705         and then Ekind (Designated_Type (B1)) /= E_Subprogram_Type
2706         and then Is_Access_Type (T2)
2707       then
2708          return T2;
2709
2710       elsif (Ekind (B2) = E_Access_Subprogram_Type
2711                or else
2712              Ekind (B2) = E_Access_Protected_Subprogram_Type)
2713         and then Ekind (Designated_Type (B2)) /= E_Subprogram_Type
2714         and then Is_Access_Type (T1)
2715       then
2716          return T1;
2717
2718       elsif (Ekind (T1) = E_Allocator_Type
2719               or else Ekind (T1) = E_Access_Attribute_Type
2720               or else Ekind (T1) = E_Anonymous_Access_Type)
2721         and then Is_Access_Type (T2)
2722       then
2723          return T2;
2724
2725       elsif (Ekind (T2) = E_Allocator_Type
2726               or else Ekind (T2) = E_Access_Attribute_Type
2727               or else Ekind (T2) = E_Anonymous_Access_Type)
2728         and then Is_Access_Type (T1)
2729       then
2730          return T1;
2731
2732       --  If none of the above cases applies, types are not compatible
2733
2734       else
2735          return Any_Type;
2736       end if;
2737    end Specific_Type;
2738
2739    -----------------------
2740    -- Valid_Boolean_Arg --
2741    -----------------------
2742
2743    --  In addition to booleans and arrays of booleans, we must include
2744    --  aggregates as valid boolean arguments, because in the first pass of
2745    --  resolution their components are not examined. If it turns out not to be
2746    --  an aggregate of booleans, this will be diagnosed in Resolve.
2747    --  Any_Composite must be checked for prior to the array type checks because
2748    --  Any_Composite does not have any associated indexes.
2749
2750    function Valid_Boolean_Arg (T : Entity_Id) return Boolean is
2751    begin
2752       return Is_Boolean_Type (T)
2753         or else T = Any_Composite
2754         or else (Is_Array_Type (T)
2755                   and then T /= Any_String
2756                   and then Number_Dimensions (T) = 1
2757                   and then Is_Boolean_Type (Component_Type (T))
2758                   and then (not Is_Private_Composite (T)
2759                              or else In_Instance)
2760                   and then (not Is_Limited_Composite (T)
2761                              or else In_Instance))
2762         or else Is_Modular_Integer_Type (T)
2763         or else T = Universal_Integer;
2764    end Valid_Boolean_Arg;
2765
2766    --------------------------
2767    -- Valid_Comparison_Arg --
2768    --------------------------
2769
2770    function Valid_Comparison_Arg (T : Entity_Id) return Boolean is
2771    begin
2772
2773       if T = Any_Composite then
2774          return False;
2775       elsif Is_Discrete_Type (T)
2776         or else Is_Real_Type (T)
2777       then
2778          return True;
2779       elsif Is_Array_Type (T)
2780           and then Number_Dimensions (T) = 1
2781           and then Is_Discrete_Type (Component_Type (T))
2782           and then (not Is_Private_Composite (T)
2783                      or else In_Instance)
2784           and then (not Is_Limited_Composite (T)
2785                      or else In_Instance)
2786       then
2787          return True;
2788       elsif Is_String_Type (T) then
2789          return True;
2790       else
2791          return False;
2792       end if;
2793    end Valid_Comparison_Arg;
2794
2795    ---------------------
2796    -- Write_Overloads --
2797    ---------------------
2798
2799    procedure Write_Overloads (N : Node_Id) is
2800       I   : Interp_Index;
2801       It  : Interp;
2802       Nam : Entity_Id;
2803
2804    begin
2805       if not Is_Overloaded (N) then
2806          Write_Str ("Non-overloaded entity ");
2807          Write_Eol;
2808          Write_Entity_Info (Entity (N), " ");
2809
2810       else
2811          Get_First_Interp (N, I, It);
2812          Write_Str ("Overloaded entity ");
2813          Write_Eol;
2814          Write_Str ("      Name           Type");
2815          Write_Eol;
2816          Write_Str ("===============================");
2817          Write_Eol;
2818          Nam := It.Nam;
2819
2820          while Present (Nam) loop
2821             Write_Int (Int (Nam));
2822             Write_Str ("   ");
2823             Write_Name (Chars (Nam));
2824             Write_Str ("   ");
2825             Write_Int (Int (It.Typ));
2826             Write_Str ("   ");
2827             Write_Name (Chars (It.Typ));
2828             Write_Eol;
2829             Get_Next_Interp (I, It);
2830             Nam := It.Nam;
2831          end loop;
2832       end if;
2833    end Write_Overloads;
2834
2835    ----------------------
2836    -- Write_Interp_Ref --
2837    ----------------------
2838
2839    procedure Write_Interp_Ref (Map_Ptr : Int) is
2840    begin
2841       Write_Str (" Node:  ");
2842       Write_Int (Int (Interp_Map.Table (Map_Ptr).Node));
2843       Write_Str (" Index: ");
2844       Write_Int (Int (Interp_Map.Table (Map_Ptr).Index));
2845       Write_Str (" Next:  ");
2846       Write_Int (Int (Interp_Map.Table (Map_Ptr).Next));
2847       Write_Eol;
2848    end Write_Interp_Ref;
2849
2850 end Sem_Type;