Subversion Repositories openrisc_me

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

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                              S E M _ C H 4                               --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --

--                                                                          --

-- GNAT is free software;  you can  redistribute it  and/or modify it under --

-- terms of the  GNU General Public License as published  by the Free Soft- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --

-- for  more details.  You should have  received  a copy of the GNU General --

-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

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

with Atree;    use Atree;

with Debug;    use Debug;

with Einfo;    use Einfo;

with Elists;   use Elists;

with Errout;   use Errout;

with Exp_Util; use Exp_Util;

with Fname;    use Fname;

with Itypes;   use Itypes;

with Lib;      use Lib;

with Lib.Xref; use Lib.Xref;

with Namet;    use Namet;

with Namet.Sp; use Namet.Sp;

with Nlists;   use Nlists;

with Nmake;    use Nmake;

with Opt;      use Opt;

with Output;   use Output;

with Restrict; use Restrict;

with Rident;   use Rident;

with Sem;      use Sem;

with Sem_Aux;  use Sem_Aux;

with Sem_Cat;  use Sem_Cat;

with Sem_Ch3;  use Sem_Ch3;

with Sem_Ch6;  use Sem_Ch6;

with Sem_Ch8;  use Sem_Ch8;

with Sem_SCIL; use Sem_SCIL;

with Sem_Disp; use Sem_Disp;

with Sem_Dist; use Sem_Dist;

with Sem_Eval; use Sem_Eval;

with Sem_Res;  use Sem_Res;

with Sem_Util; use Sem_Util;

with Sem_Type; use Sem_Type;

with Stand;    use Stand;

with Sinfo;    use Sinfo;

with Snames;   use Snames;

with Tbuild;   use Tbuild;

package body Sem_Ch4 is

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

   -- Local Subprograms --

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

   procedure Analyze_Concatenation_Rest (N : Node_Id);

   --  Does the "rest" of the work of Analyze_Concatenation, after the left

   --  operand has been analyzed. See Analyze_Concatenation for details.

   procedure Analyze_Expression (N : Node_Id);

   --  For expressions that are not names, this is just a call to analyze.

   --  If the expression is a name, it may be a call to a parameterless

   --  function, and if so must be converted into an explicit call node

   --  and analyzed as such. This deproceduring must be done during the first

   --  pass of overload resolution, because otherwise a procedure call with

   --  overloaded actuals may fail to resolve.

   procedure Analyze_Operator_Call (N : Node_Id; Op_Id : Entity_Id);

   --  Analyze a call of the form "+"(x, y), etc. The prefix of the call

   --  is an operator name or an expanded name whose selector is an operator

   --  name, and one possible interpretation is as a predefined operator.

   procedure Analyze_Overloaded_Selected_Component (N : Node_Id);

   --  If the prefix of a selected_component is overloaded, the proper

   --  interpretation that yields a record type with the proper selector

   --  name must be selected.

   procedure Analyze_User_Defined_Binary_Op (N : Node_Id; Op_Id : Entity_Id);

   --  Procedure to analyze a user defined binary operator, which is resolved

   --  like a function, but instead of a list of actuals it is presented

   --  with the left and right operands of an operator node.

   procedure Analyze_User_Defined_Unary_Op (N : Node_Id; Op_Id : Entity_Id);

   --  Procedure to analyze a user defined unary operator, which is resolved

   --  like a function, but instead of a list of actuals, it is presented with

   --  the operand of the operator node.

   procedure Ambiguous_Operands (N : Node_Id);

   --  for equality, membership, and comparison operators with overloaded

   --  arguments, list possible interpretations.

   procedure Analyze_One_Call

      (N          : Node_Id;

       Nam        : Entity_Id;

       Report     : Boolean;

       Success    : out Boolean;

       Skip_First : Boolean := False);

   --  Check one interpretation of an overloaded subprogram name for

   --  compatibility with the types of the actuals in a call. If there is a

   --  single interpretation which does not match, post error if Report is

   --  set to True.

   --

   --  Nam is the entity that provides the formals against which the actuals

   --  are checked. Nam is either the name of a subprogram, or the internal

   --  subprogram type constructed for an access_to_subprogram. If the actuals

   --  are compatible with Nam, then Nam is added to the list of candidate

   --  interpretations for N, and Success is set to True.

   --

   --  The flag Skip_First is used when analyzing a call that was rewritten

   --  from object notation. In this case the first actual may have to receive

   --  an explicit dereference, depending on the first formal of the operation

   --  being called. The caller will have verified that the object is legal

   --  for the call. If the remaining parameters match, the first parameter

   --  will rewritten as a dereference if needed, prior to completing analysis.

   procedure Check_Misspelled_Selector

     (Prefix : Entity_Id;

      Sel    : Node_Id);

   --  Give possible misspelling diagnostic if Sel is likely to be a mis-

   --  spelling of one of the selectors of the Prefix. This is called by

   --  Analyze_Selected_Component after producing an invalid selector error

   --  message.

   function Defined_In_Scope (T : Entity_Id; S : Entity_Id) return Boolean;

   --  Verify that type T is declared in scope S. Used to find interpretations

   --  for operators given by expanded names. This is abstracted as a separate

   --  function to handle extensions to System, where S is System, but T is

   --  declared in the extension.

   procedure Find_Arithmetic_Types

     (L, R  : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  L and R are the operands of an arithmetic operator. Find

   --  consistent pairs of interpretations for L and R that have a

   --  numeric type consistent with the semantics of the operator.

   procedure Find_Comparison_Types

     (L, R  : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  L and R are operands of a comparison operator. Find consistent

   --  pairs of interpretations for L and R.

   procedure Find_Concatenation_Types

     (L, R  : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  For the four varieties of concatenation

   procedure Find_Equality_Types

     (L, R  : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  Ditto for equality operators

   procedure Find_Boolean_Types

     (L, R  : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  Ditto for binary logical operations

   procedure Find_Negation_Types

     (R     : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  Find consistent interpretation for operand of negation operator

   procedure Find_Non_Universal_Interpretations

     (N     : Node_Id;

      R     : Node_Id;

      Op_Id : Entity_Id;

      T1    : Entity_Id);

   --  For equality and comparison operators, the result is always boolean,

   --  and the legality of the operation is determined from the visibility

   --  of the operand types. If one of the operands has a universal interpre-

   --  tation,  the legality check uses some compatible non-universal

   --  interpretation of the other operand. N can be an operator node, or

   --  a function call whose name is an operator designator.

   function Find_Primitive_Operation (N : Node_Id) return Boolean;

   --  Find candidate interpretations for the name Obj.Proc when it appears

   --  in a subprogram renaming declaration.

   procedure Find_Unary_Types

     (R     : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  Unary arithmetic types: plus, minus, abs

   procedure Check_Arithmetic_Pair

     (T1, T2 : Entity_Id;

      Op_Id  : Entity_Id;

      N      : Node_Id);

   --  Subsidiary procedure to Find_Arithmetic_Types. T1 and T2 are valid

   --  types for left and right operand. Determine whether they constitute

   --  a valid pair for the given operator, and record the corresponding

   --  interpretation of the operator node. The node N may be an operator

   --  node (the usual case) or a function call whose prefix is an operator

   --  designator. In both cases Op_Id is the operator name itself.

   procedure Diagnose_Call (N : Node_Id; Nam : Node_Id);

   --  Give detailed information on overloaded call where none of the

   --  interpretations match. N is the call node, Nam the designator for

   --  the overloaded entity being called.

   function Junk_Operand (N : Node_Id) return Boolean;

   --  Test for an operand that is an inappropriate entity (e.g. a package

   --  name or a label). If so, issue an error message and return True. If

   --  the operand is not an inappropriate entity kind, return False.

   procedure Operator_Check (N : Node_Id);

   --  Verify that an operator has received some valid interpretation. If none

   --  was found, determine whether a use clause would make the operation

   --  legal. The variable Candidate_Type (defined in Sem_Type) is set for

   --  every type compatible with the operator, even if the operator for the

   --  type is not directly visible. The routine uses this type to emit a more

   --  informative message.

   function Process_Implicit_Dereference_Prefix

     (E : Entity_Id;

      P : Node_Id) return Entity_Id;

   --  Called when P is the prefix of an implicit dereference, denoting an

   --  object E. The function returns the designated type of the prefix, taking

   --  into account that the designated type of an anonymous access type may be

   --  a limited view, when the non-limited view is visible.

   --  If in semantics only mode (-gnatc or generic), the function also records

   --  that the prefix is a reference to E, if any. Normally, such a reference

   --  is generated only when the implicit dereference is expanded into an

   --  explicit one, but for consistency we must generate the reference when

   --  expansion is disabled as well.

   procedure Remove_Abstract_Operations (N : Node_Id);

   --  Ada 2005: implementation of AI-310. An abstract non-dispatching

   --  operation is not a candidate interpretation.

   function Try_Indexed_Call

     (N          : Node_Id;

      Nam        : Entity_Id;

      Typ        : Entity_Id;

      Skip_First : Boolean) return Boolean;

   --  If a function has defaults for all its actuals, a call to it may in fact

   --  be an indexing on the result of the call. Try_Indexed_Call attempts the

   --  interpretation as an indexing, prior to analysis as a call. If both are

   --  possible, the node is overloaded with both interpretations (same symbol

   --  but two different types). If the call is written in prefix form, the

   --  prefix becomes the first parameter in the call, and only the remaining

   --  actuals must be checked for the presence of defaults.

   function Try_Indirect_Call

     (N   : Node_Id;

      Nam : Entity_Id;

      Typ : Entity_Id) return Boolean;

   --  Similarly, a function F that needs no actuals can return an access to a

   --  subprogram, and the call F (X) interpreted as F.all (X). In this case

   --  the call may be overloaded with both interpretations.

   function Try_Object_Operation (N : Node_Id) return Boolean;

   --  Ada 2005 (AI-252): Support the object.operation notation

   procedure wpo (T : Entity_Id);

   pragma Warnings (Off, wpo);

   --  Used for debugging: obtain list of primitive operations even if

   --  type is not frozen and dispatch table is not built yet.

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

   -- Ambiguous_Operands --

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

   procedure Ambiguous_Operands (N : Node_Id) is

      procedure List_Operand_Interps (Opnd : Node_Id);

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

      -- List_Operand_Interps --

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

      procedure List_Operand_Interps (Opnd : Node_Id) is

         Nam   : Node_Id;

         Err   : Node_Id := N;

      begin

         if Is_Overloaded (Opnd) then

            if Nkind (Opnd) in N_Op then

               Nam := Opnd;

            elsif Nkind (Opnd) = N_Function_Call then

               Nam := Name (Opnd);

            else

               return;

            end if;

         else

            return;

         end if;

         if Opnd = Left_Opnd (N) then

            Error_Msg_N

              ("\left operand has the following interpretations", N);

         else

            Error_Msg_N

              ("\right operand has the following interpretations", N);

            Err := Opnd;

         end if;

         List_Interps (Nam, Err);

      end List_Operand_Interps;

   --  Start of processing for Ambiguous_Operands

   begin

      if Nkind (N) in N_Membership_Test then

         Error_Msg_N ("ambiguous operands for membership",  N);

      elsif Nkind_In (N, N_Op_Eq, N_Op_Ne) then

         Error_Msg_N ("ambiguous operands for equality",  N);

      else

         Error_Msg_N ("ambiguous operands for comparison",  N);

      end if;

      if All_Errors_Mode then

         List_Operand_Interps (Left_Opnd  (N));

         List_Operand_Interps (Right_Opnd (N));

      else

         Error_Msg_N ("\use -gnatf switch for details", N);

      end if;

   end Ambiguous_Operands;

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

   -- Analyze_Aggregate --

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

   --  Most of the analysis of Aggregates requires that the type be known,

   --  and is therefore put off until resolution.

   procedure Analyze_Aggregate (N : Node_Id) is

   begin

      if No (Etype (N)) then

         Set_Etype (N, Any_Composite);

      end if;

   end Analyze_Aggregate;

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

   -- Analyze_Allocator --

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

   procedure Analyze_Allocator (N : Node_Id) is

      Loc      : constant Source_Ptr := Sloc (N);

      Sav_Errs : constant Nat        := Serious_Errors_Detected;

      E        : Node_Id             := Expression (N);

      Acc_Type : Entity_Id;

      Type_Id  : Entity_Id;

   begin

      --  In accordance with H.4(7), the No_Allocators restriction only applies

      --  to user-written allocators.

      if Comes_From_Source (N) then

         Check_Restriction (No_Allocators, N);

      end if;

      if Nkind (E) = N_Qualified_Expression then

         Acc_Type := Create_Itype (E_Allocator_Type, N);

         Set_Etype (Acc_Type, Acc_Type);

         Find_Type (Subtype_Mark (E));

         --  Analyze the qualified expression, and apply the name resolution

         --  rule given in  4.7 (3).

         Analyze (E);

         Type_Id := Etype (E);

         Set_Directly_Designated_Type (Acc_Type, Type_Id);

         Resolve (Expression (E), Type_Id);

         if Is_Limited_Type (Type_Id)

           and then Comes_From_Source (N)

           and then not In_Instance_Body

         then

            if not OK_For_Limited_Init (Type_Id, Expression (E)) then

               Error_Msg_N ("initialization not allowed for limited types", N);

               Explain_Limited_Type (Type_Id, N);

            end if;

         end if;

         --  A qualified expression requires an exact match of the type,

         --  class-wide matching is not allowed.

         --  if Is_Class_Wide_Type (Type_Id)

         --    and then Base_Type

         --       (Etype (Expression (E))) /= Base_Type (Type_Id)

         --  then

         --     Wrong_Type (Expression (E), Type_Id);

         --  end if;

         Check_Non_Static_Context (Expression (E));

         --  We don't analyze the qualified expression itself because it's

         --  part of the allocator

         Set_Etype  (E, Type_Id);

      --  Case where allocator has a subtype indication

      else

         declare

            Def_Id   : Entity_Id;

            Base_Typ : Entity_Id;

         begin

            --  If the allocator includes a N_Subtype_Indication then a

            --  constraint is present, otherwise the node is a subtype mark.

            --  Introduce an explicit subtype declaration into the tree

            --  defining some anonymous subtype and rewrite the allocator to

            --  use this subtype rather than the subtype indication.

            --  It is important to introduce the explicit subtype declaration

            --  so that the bounds of the subtype indication are attached to

            --  the tree in case the allocator is inside a generic unit.

            if Nkind (E) = N_Subtype_Indication then

               --  A constraint is only allowed for a composite type in Ada

               --  95. In Ada 83, a constraint is also allowed for an

               --  access-to-composite type, but the constraint is ignored.

               Find_Type (Subtype_Mark (E));

               Base_Typ := Entity (Subtype_Mark (E));

               if Is_Elementary_Type (Base_Typ) then

                  if not (Ada_Version = Ada_83

                           and then Is_Access_Type (Base_Typ))

                  then

                     Error_Msg_N ("constraint not allowed here", E);

                     if Nkind (Constraint (E)) =

                       N_Index_Or_Discriminant_Constraint

                     then

                        Error_Msg_N -- CODEFIX

                          ("\if qualified expression was meant, " &

                              "use apostrophe", Constraint (E));

                     end if;

                  end if;

                  --  Get rid of the bogus constraint:

                  Rewrite (E, New_Copy_Tree (Subtype_Mark (E)));

                  Analyze_Allocator (N);

                  return;

               --  Ada 2005, AI-363: if the designated type has a constrained

               --  partial view, it cannot receive a discriminant constraint,

               --  and the allocated object is unconstrained.

               elsif Ada_Version >= Ada_05

                 and then Has_Constrained_Partial_View (Base_Typ)

               then

                  Error_Msg_N

                    ("constraint no allowed when type " &

                      "has a constrained partial view", Constraint (E));

               end if;

               if Expander_Active then

                  Def_Id :=

                    Make_Defining_Identifier (Loc, New_Internal_Name ('S'));

                  Insert_Action (E,

                    Make_Subtype_Declaration (Loc,

                      Defining_Identifier => Def_Id,

                      Subtype_Indication  => Relocate_Node (E)));

                  if Sav_Errs /= Serious_Errors_Detected

                    and then Nkind (Constraint (E)) =

                               N_Index_Or_Discriminant_Constraint

                  then

                     Error_Msg_N -- CODEFIX

                       ("if qualified expression was meant, " &

                           "use apostrophe!", Constraint (E));

                  end if;

                  E := New_Occurrence_Of (Def_Id, Loc);

                  Rewrite (Expression (N), E);

               end if;

            end if;

            Type_Id := Process_Subtype (E, N);

            Acc_Type := Create_Itype (E_Allocator_Type, N);

            Set_Etype                    (Acc_Type, Acc_Type);

            Set_Directly_Designated_Type (Acc_Type, Type_Id);

            Check_Fully_Declared (Type_Id, N);

            --  Ada 2005 (AI-231): If the designated type is itself an access

            --  type that excludes null, its default initialization will

            --  be a null object, and we can insert an unconditional raise

            --  before the allocator.

            if Can_Never_Be_Null (Type_Id) then

               declare

                  Not_Null_Check : constant Node_Id :=

                                     Make_Raise_Constraint_Error (Sloc (E),

                                       Reason => CE_Null_Not_Allowed);

               begin

                  if Expander_Active then

                     Insert_Action (N, Not_Null_Check);

                     Analyze (Not_Null_Check);

                  else

                     Error_Msg_N ("null value not allowed here?", E);

                  end if;

               end;

            end if;

            --  Check restriction against dynamically allocated protected

            --  objects. Note that when limited aggregates are supported,

            --  a similar test should be applied to an allocator with a

            --  qualified expression ???

            if Is_Protected_Type (Type_Id) then

               Check_Restriction (No_Protected_Type_Allocators, N);

            end if;

            --  Check for missing initialization. Skip this check if we already

            --  had errors on analyzing the allocator, since in that case these

            --  are probably cascaded errors.

            if Is_Indefinite_Subtype (Type_Id)

              and then Serious_Errors_Detected = Sav_Errs

            then

               if Is_Class_Wide_Type (Type_Id) then

                  Error_Msg_N

                    ("initialization required in class-wide allocation", N);

               else

                  if Ada_Version < Ada_05

                    and then Is_Limited_Type (Type_Id)

                  then

                     Error_Msg_N ("unconstrained allocation not allowed", N);

                     if Is_Array_Type (Type_Id) then

                        Error_Msg_N

                          ("\constraint with array bounds required", N);

                     elsif Has_Unknown_Discriminants (Type_Id) then

                        null;

                     else pragma Assert (Has_Discriminants (Type_Id));

                        Error_Msg_N

                          ("\constraint with discriminant values required", N);

                     end if;

                  --  Limited Ada 2005 and general non-limited case

                  else

                     Error_Msg_N

                       ("uninitialized unconstrained allocation not allowed",

                        N);

                     if Is_Array_Type (Type_Id) then

                        Error_Msg_N

                          ("\qualified expression or constraint with " &

                           "array bounds required", N);

                     elsif Has_Unknown_Discriminants (Type_Id) then

                        Error_Msg_N ("\qualified expression required", N);

                     else pragma Assert (Has_Discriminants (Type_Id));

                        Error_Msg_N

                          ("\qualified expression or constraint with " &

                           "discriminant values required", N);

                     end if;

                  end if;

               end if;

            end if;

         end;

      end if;

      if Is_Abstract_Type (Type_Id) then

         Error_Msg_N ("cannot allocate abstract object", E);

      end if;

      if Has_Task (Designated_Type (Acc_Type)) then

         Check_Restriction (No_Tasking, N);

         Check_Restriction (Max_Tasks, N);

         Check_Restriction (No_Task_Allocators, N);

      end if;

      --  If the No_Streams restriction is set, check that the type of the

      --  object is not, and does not contain, any subtype derived from

      --  Ada.Streams.Root_Stream_Type. Note that we guard the call to

      --  Has_Stream just for efficiency reasons. There is no point in

      --  spending time on a Has_Stream check if the restriction is not set.

      if Restrictions.Set (No_Streams) then

         if Has_Stream (Designated_Type (Acc_Type)) then

            Check_Restriction (No_Streams, N);

         end if;

      end if;

      Set_Etype (N, Acc_Type);

      if not Is_Library_Level_Entity (Acc_Type) then

         Check_Restriction (No_Local_Allocators, N);

      end if;

      if Serious_Errors_Detected > Sav_Errs then

         Set_Error_Posted (N);

         Set_Etype (N, Any_Type);

      end if;

   end Analyze_Allocator;

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

   -- Analyze_Arithmetic_Op --

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

   procedure Analyze_Arithmetic_Op (N : Node_Id) is

      L     : constant Node_Id := Left_Opnd (N);

      R     : constant Node_Id := Right_Opnd (N);

      Op_Id : Entity_Id;

   begin

      Candidate_Type := Empty;

      Analyze_Expression (L);

      Analyze_Expression (R);

      --  If the entity is already set, the node is the instantiation of a

      --  generic node with a non-local reference, or was manufactured by a

      --  call to Make_Op_xxx. In either case the entity is known to be valid,

      --  and we do not need to collect interpretations, instead we just get

      --  the single possible interpretation.

      Op_Id := Entity (N);

      if Present (Op_Id) then

         if Ekind (Op_Id) = E_Operator then

            if Nkind_In (N, N_Op_Divide, N_Op_Mod, N_Op_Multiply, N_Op_Rem)

              and then Treat_Fixed_As_Integer (N)

            then

               null;

            else

               Set_Etype (N, Any_Type);

               Find_Arithmetic_Types (L, R, Op_Id, N);

            end if;

         else

            Set_Etype (N, Any_Type);

            Add_One_Interp (N, Op_Id, Etype (Op_Id));

         end if;

      --  Entity is not already set, so we do need to collect interpretations

      else

         Op_Id := Get_Name_Entity_Id (Chars (N));

         Set_Etype (N, Any_Type);

         while Present (Op_Id) loop

            if Ekind (Op_Id) = E_Operator

              and then Present (Next_Entity (First_Entity (Op_Id)))

            then

               Find_Arithmetic_Types (L, R, Op_Id, N);

            --  The following may seem superfluous, because an operator cannot

            --  be generic, but this ignores the cleverness of the author of

            --  ACVC bc1013a.

            elsif Is_Overloadable (Op_Id) then

               Analyze_User_Defined_Binary_Op (N, Op_Id);

            end if;

            Op_Id := Homonym (Op_Id);

         end loop;

      end if;

      Operator_Check (N);

   end Analyze_Arithmetic_Op;

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

   -- Analyze_Call --

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

   --  Function, procedure, and entry calls are checked here. The Name in

   --  the call may be overloaded. The actuals have been analyzed and may

   --  themselves be overloaded. On exit from this procedure, the node N

   --  may have zero, one or more interpretations. In the first case an

   --  error message is produced. In the last case, the node is flagged

   --  as overloaded and the interpretations are collected in All_Interp.

   --  If the name is an Access_To_Subprogram, it cannot be overloaded, but

   --  the type-checking is similar to that of other calls.

   procedure Analyze_Call (N : Node_Id) is

      Actuals : constant List_Id := Parameter_Associations (N);

      Nam     : Node_Id;

      X       : Interp_Index;

      It      : Interp;

      Nam_Ent : Entity_Id;

      Success : Boolean := False;

      Deref : Boolean := False;

      --  Flag indicates whether an interpretation of the prefix is a

      --  parameterless call that returns an access_to_subprogram.

      function Name_Denotes_Function return Boolean;

      --  If the type of the name is an access to subprogram, this may be the

      --  type of a name, or the return type of the function being called. If

      --  the name is not an entity then it can denote a protected function.

      --  Until we distinguish Etype from Return_Type, we must use this routine

      --  to resolve the meaning of the name in the call.

      procedure No_Interpretation;

      --  Output error message when no valid interpretation exists

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

      -- Name_Denotes_Function --

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

      function Name_Denotes_Function return Boolean is

      begin

         if Is_Entity_Name (Nam) then

            return Ekind (Entity (Nam)) = E_Function;

         elsif Nkind (Nam) = N_Selected_Component then

            return Ekind (Entity (Selector_Name (Nam))) = E_Function;

         else

            return False;

         end if;

      end Name_Denotes_Function;

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

      -- No_Interpretation --

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

      procedure No_Interpretation is

         L : constant Boolean   := Is_List_Member (N);

         K : constant Node_Kind := Nkind (Parent (N));

      begin

         --  If the node is in a list whose parent is not an expression then it

         --  must be an attempted procedure call.

         if L and then K not in N_Subexpr then

            if Ekind (Entity (Nam)) = E_Generic_Procedure then

               Error_Msg_NE

                 ("must instantiate generic procedure& before call",

                  Nam, Entity (Nam));

            else

               Error_Msg_N

                 ("procedure or entry name expected", Nam);

            end if;

         --  Check for tasking cases where only an entry call will do

         elsif not L

           and then Nkind_In (K, N_Entry_Call_Alternative,

                                 N_Triggering_Alternative)

         then

            Error_Msg_N ("entry name expected", Nam);

         --  Otherwise give general error message

         else

            Error_Msg_N ("invalid prefix in call", Nam);

         end if;

      end No_Interpretation;

   --  Start of processing for Analyze_Call

   begin

      --  Initialize the type of the result of the call to the error type,

      --  which will be reset if the type is successfully resolved.

      Set_Etype (N, Any_Type);