path: root/gcc/ada/sem_ch2.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              S E M _ C H 2                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2024, 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 Einfo;          use Einfo;
with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils;    use Einfo.Utils;
with Errout;         use Errout;
with Ghost;          use Ghost;
with Mutably_Tagged; use Mutably_Tagged;
with Namet;          use Namet;
with Nlists;         use Nlists;
with Opt;            use Opt;
with Restrict;       use Restrict;
with Rident;         use Rident;
with Sem;            use Sem;
with Sem_Ch8;        use Sem_Ch8;
with Sem_Dim;        use Sem_Dim;
with Sem_Res;        use Sem_Res;
with Sem_Type;       use Sem_Type;
with Sinfo;          use Sinfo;
with Sinfo.Nodes;    use Sinfo.Nodes;
with Sinfo.Utils;    use Sinfo.Utils;
with Stand;          use Stand;
with Uintp;          use Uintp;

package body Sem_Ch2 is

   -------------------------------
   -- Analyze_Character_Literal --
   -------------------------------

   procedure Analyze_Character_Literal (N : Node_Id) is
   begin
      --  The type is eventually inherited from the context. If expansion
      --  has already established the proper type, do not modify it.

      if No (Etype (N)) then
         Set_Etype (N, Any_Character);
      end if;

      Set_Is_Static_Expression (N);

      if Comes_From_Source (N)
        and then not In_Character_Range (UI_To_CC (Char_Literal_Value (N)))
      then
         Check_Restriction (No_Wide_Characters, N);
      end if;
   end Analyze_Character_Literal;

   ------------------------
   -- Analyze_Identifier --
   ------------------------

   procedure Analyze_Identifier (N : Node_Id) is
   begin
      --  Ignore call if prior errors, and identifier has no name, since
      --  this is the result of some kind of previous error generating a
      --  junk identifier.

      if not Is_Valid_Name (Chars (N)) and then Total_Errors_Detected /= 0 then
         return;
      else
         Find_Direct_Name (N);
      end if;

      --  Generate a conversion when we see an expanded mutably tagged type

      if Is_Mutably_Tagged_CW_Equivalent_Type (Etype (N)) then
         Make_Mutably_Tagged_Conversion (N);
      end if;

      --  A Ghost entity must appear in a specific context. Only do this
      --  checking on non-overloaded expressions, as otherwise we need to
      --  wait for resolution, and the checking is done in Resolve_Entity_Name.

      if Nkind (N) in N_Expanded_Name | N_Identifier
        and then Present (Entity (N))
        and then Is_Ghost_Entity (Entity (N))
        and then not Is_Overloaded (N)
      then
         Check_Ghost_Context (Entity (N), N);
      end if;

      Analyze_Dimension (N);
   end Analyze_Identifier;

   -----------------------------
   -- Analyze_Integer_Literal --
   -----------------------------

   procedure Analyze_Integer_Literal (N : Node_Id) is
   begin
      --  As a lexical element, an integer literal has type Universal_Integer,
      --  i.e., is compatible with any integer type. This is semantically
      --  consistent and simplifies type checking and subsequent constant
      --  folding when needed. An exception is caused by 64-bit modular types,
      --  whose upper bound is not representable in a nonstatic context that
      --  will use 64-bit integers at run time. For such cases, we need to
      --  preserve the information that the analyzed literal has that modular
      --  type. For simplicity, we preserve the information for all integer
      --  literals that result from a modular operation. This happens after
      --  prior analysis (or construction) of the literal, and after type
      --  checking and resolution.

      if No (Etype (N)) or else not Is_Modular_Integer_Type (Etype (N)) then
         Set_Etype (N, Universal_Integer);
      end if;

      Set_Is_Static_Expression (N);
   end Analyze_Integer_Literal;

   -----------------------------------------
   -- Analyze_Interpolated_String_Literal --
   -----------------------------------------

   procedure Analyze_Interpolated_String_Literal (N : Node_Id) is

      procedure Check_Ambiguous_Call (Func_Call : Node_Id);
      --  Examine the interpretations of the call to the given function call
      --  and report the location of each interpretation.

      --------------------------
      -- Check_Ambiguous_Call --
      --------------------------

      procedure Check_Ambiguous_Call (Func_Call : Node_Id) is

         procedure Report_Interpretation (Nam : Entity_Id; Typ : Entity_Id);
         --  Report an interpretation of the function call. When calling a
         --  standard operator, use the location of the type, which may be
         --  user-defined.

         ---------------------------
         -- Report_Interpretation --
         ---------------------------

         procedure Report_Interpretation (Nam : Entity_Id; Typ : Entity_Id) is
         begin
            if Sloc (Nam) = Standard_Location then
               Error_Msg_Sloc := Sloc (Typ);
            else
               Error_Msg_Sloc := Sloc (Nam);
            end if;

            if Nkind (Parent (Nam)) = N_Full_Type_Declaration then
               Error_Msg_N
                 ("\\possible interpretation (inherited)#!", Func_Call);
            else
               Error_Msg_N ("\\possible interpretation#!", Func_Call);
            end if;
         end Report_Interpretation;

      --  Start of processing for Check_Ambiguous_Call

      begin
         Check_Parameterless_Call (Func_Call);

         if Is_Overloaded (Func_Call) then
            declare
               I   : Interp_Index;
               I1  : Interp_Index;
               It  : Interp;
               It1 : Interp;
               N1  : Entity_Id;
               T1  : Entity_Id;

            begin
               --  Remove procedure calls, as they cannot syntactically appear
               --  in interpolated expressions. These calls were not removed by
               --  type checking because interpolated expressions do not impose
               --  a context type.

               Get_First_Interp (Func_Call, I, It);
               while Present (It.Nam) loop
                  if It.Typ = Standard_Void_Type then
                     Remove_Interp (I);
                  end if;

                  Get_Next_Interp (I, It);
               end loop;

               Get_First_Interp (Func_Call, I, It);

               if No (It.Nam) then
                  Error_Msg_N ("illegal expression", Func_Call);
                  return;
               end if;

               I1  := I;
               It1 := It;

               --  The node may be labeled overloaded, but still contain only
               --  one interpretation because others were discarded earlier. If
               --  this is the case, retain the single interpretation.

               Get_Next_Interp (I, It);

               if Present (It.Typ) then
                  N1  := It1.Nam;
                  T1  := It1.Typ;

                  It1 := Disambiguate
                           (N   => Func_Call,
                            I1  => I1,
                            I2  => I,
                            Typ => Any_Type);

                  if It1 = No_Interp then
                     Error_Msg_NE ("ambiguous call to&", Func_Call,
                       Entity (Name (Func_Call)));

                     --  Report the first two interpretations

                     Report_Interpretation (It.Nam, It.Typ);
                     Report_Interpretation (N1, T1);

                     return;
                  end if;
               end if;

               Set_Etype (Func_Call, It1.Typ);
            end;
         end if;
      end Check_Ambiguous_Call;

      --  Local variables

      Str_Elem : Node_Id;

   --  Start of processing for Analyze_Interpolated_String_Literal

   begin
      Set_Etype (N, Any_String);

      Str_Elem := First (Expressions (N));
      while Present (Str_Elem) loop
         Analyze (Str_Elem);

         --  The parser has split the contents of the interpolated string
         --  into its components. For example, f"before {expr} after" is
         --  stored in the list of expressions of N as follows:
         --     first = "before " (is_interpolated_string_literal)
         --      next =  expr
         --      next = " after"  (is_interpolated_string_literal)
         --
         --  No further action is needed for string literals with the
         --  attribute Is_Interpolated_String_Literal set, as they are
         --  components of the interpolated string literal. The type of
         --  these components will be determined by the context when
         --  resolved (see Expand_N_Interpolated_String_Literal). The
         --  rest of the components in the list of expressions of N are
         --  the root nodes of the interpolated expressions.

         if Nkind (Str_Elem) = N_String_Literal
           and then Is_Interpolated_String_Literal (Str_Elem)
         then
            null;

         elsif Nkind (Str_Elem) = N_Function_Call then
            Check_Ambiguous_Call (Str_Elem);

         --  Before analyzed, a function call that has parameters is an
         --  N_Indexed_Component node, and a call to a function that has
         --  no parameters is an N_Identifier or an N_Expanded_Name node.
         --  If the analysis could not rewrite it as N_Function_Call, it
         --  indicates that ambiguity may have been encountered.

         elsif Nkind (Str_Elem) in N_Identifier | N_Expanded_Name
           and then Ekind (Entity (Str_Elem)) = E_Function
         then
            Check_Ambiguous_Call (Str_Elem);

         --  Report common errors

         elsif Nkind (Str_Elem) = N_String_Literal then

            --  No further action needed for components of the interpolated
            --  string literal; its type will be imposed by its context when
            --  resolved.

            if Is_Interpolated_String_Literal (Str_Elem) then
               null;

            else
               Error_Msg_N
                 ("ambiguous string literal in interpolated expression",
                  Str_Elem);
               Error_Msg_N
                 ("\\possible interpretation 'Ada.'String type!",
                  Str_Elem);
               Error_Msg_N
                 ("\\possible interpretation 'Ada.'Wide_'String type!",
                  Str_Elem);
               Error_Msg_N
                 ("\\possible interpretation 'Ada.'Wide_'Wide_'String"
                  & " type!", Str_Elem);
               Error_Msg_N
                 ("\\must use a qualified expression", Str_Elem);
            end if;

         elsif Nkind (Str_Elem) = N_Character_Literal then
            Error_Msg_N
              ("ambiguous character literal in interpolated expression",
               Str_Elem);
            Error_Msg_N
              ("\\possible interpretation 'Ada.'Character type!",
               Str_Elem);
            Error_Msg_N
              ("\\possible interpretation 'Ada.'Wide_'Character type!",
               Str_Elem);
            Error_Msg_N
              ("\\possible interpretation 'Ada.'Wide_'Wide_'Character"
               & " type!", Str_Elem);
            Error_Msg_N
              ("\\must use a qualified expression", Str_Elem);

         elsif Nkind (Str_Elem) in N_Integer_Literal
                                 | N_Real_Literal
         then
            Error_Msg_N
              ("ambiguous number in interpolated expression",
               Str_Elem);
            Error_Msg_N
              ("\\must use a qualified expression", Str_Elem);

         elsif Nkind (Str_Elem) = N_Interpolated_String_Literal then
            Error_Msg_N ("nested interpolated string not allowed", Str_Elem);

         elsif Etype (Str_Elem) in Any_Type
                                 | Any_Array
                                 | Any_Composite
                                 | Any_Discrete
                                 | Any_Fixed
                                 | Any_Integer
                                 | Any_Modular
                                 | Any_Numeric
                                 | Any_Real
                                 | Any_String
                                 | Universal_Integer
                                 | Universal_Real
                                 | Universal_Fixed
                                 | Universal_Access
         then
            Error_Msg_N ("ambiguous interpolated expression", Str_Elem);
         end if;

         Next (Str_Elem);
      end loop;
   end Analyze_Interpolated_String_Literal;

   --------------------------
   -- Analyze_Real_Literal --
   --------------------------

   procedure Analyze_Real_Literal (N : Node_Id) is
   begin
      Set_Etype (N, Universal_Real);
      Set_Is_Static_Expression (N);
   end Analyze_Real_Literal;

   ----------------------------
   -- Analyze_String_Literal --
   ----------------------------

   procedure Analyze_String_Literal (N : Node_Id) is
   begin
      --  The type is eventually inherited from the context. If expansion
      --  has already established the proper type, do not modify it.

      if No (Etype (N)) then
         Set_Etype (N, Any_String);
      end if;

      --  String literals are static in Ada 95. Note that if the subtype
      --  turns out to be non-static, then the Is_Static_Expression flag
      --  will be reset in Eval_String_Literal.

      if Ada_Version >= Ada_95 then
         Set_Is_Static_Expression (N);
      end if;

      if Comes_From_Source (N) and then Has_Wide_Character (N) then
         Check_Restriction (No_Wide_Characters, N);
      end if;
   end Analyze_String_Literal;

end Sem_Ch2;