gcc/ada/sinfo-cn.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             S I N F O . C N                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2023, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  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 COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 --  This child package of Sinfo contains some routines that permit in place
  27 --  alteration of existing tree nodes by changing the value in the Nkind
  28 --  field. Since Nkind functions logically in a manner similar to a variant
  29 --  record discriminant part, such alterations cannot be permitted in a
  30 --  general manner, but in some specific cases, the fields of related nodes
  31 --  have been deliberately layed out in a manner that permits such alteration.
  32
  33 with Atree;          use Atree;
  34 with Snames;         use Snames;
  35 with Sinfo.Nodes;    use Sinfo.Nodes;
  36 with Sinfo.Utils;    use Sinfo.Utils;
  37
  38 package body Sinfo.CN is
  39
  40    ------------------------------------------------------------
  41    -- Change_Character_Literal_To_Defining_Character_Literal --
  42    ------------------------------------------------------------
  43
  44    procedure Change_Character_Literal_To_Defining_Character_Literal
  45      (N : Node_Id)
  46    is
  47    begin
  48       Reinit_Field_To_Zero (N, F_Char_Literal_Value);
  49       Extend_Node (N);
  50    end Change_Character_Literal_To_Defining_Character_Literal;
  51
  52    ------------------------------------
  53    -- Change_Conversion_To_Unchecked --
  54    ------------------------------------
  55
  56    procedure Change_Conversion_To_Unchecked (N : Node_Id) is
  57    begin
  58       Set_Do_Overflow_Check (N, False);
  59       Set_Do_Length_Check (N, False);
  60       Mutate_Nkind (N, N_Unchecked_Type_Conversion);
  61    end Change_Conversion_To_Unchecked;
  62
  63    ----------------------------------------------
  64    -- Change_Identifier_To_Defining_Identifier --
  65    ----------------------------------------------
  66
  67    procedure Change_Identifier_To_Defining_Identifier (N : Node_Id) is
  68    begin
  69       Extend_Node (N);
  70    end Change_Identifier_To_Defining_Identifier;
  71
  72    ---------------------------------------------
  73    -- Change_Name_To_Procedure_Call_Statement --
  74    ---------------------------------------------
  75
  76    procedure Change_Name_To_Procedure_Call_Statement (N : Node_Id) is
  77    begin
  78       --  Case of Indexed component, which is a procedure call with arguments
  79
  80       if Nkind (N) = N_Indexed_Component then
  81          declare
  82             Prefix_Node : constant Node_Id := Prefix (N);
  83             Exprs_Node  : constant List_Id := Expressions (N);
  84
  85          begin
  86             Change_Node (N, N_Procedure_Call_Statement);
  87             Set_Name (N, Prefix_Node);
  88             Set_Parameter_Associations (N, Exprs_Node);
  89          end;
  90
  91       --  Case of function call node, which is a really a procedure call
  92
  93       elsif Nkind (N) = N_Function_Call then
  94          declare
  95             Fname_Node  : constant Node_Id := Name (N);
  96             Params_List : constant List_Id := Parameter_Associations (N);
  97
  98          begin
  99             Change_Node (N, N_Procedure_Call_Statement);
 100             Set_Name (N, Fname_Node);
 101             Set_Parameter_Associations (N, Params_List);
 102          end;
 103
 104       --  Case of call to attribute that denotes a procedure. Here we just
 105       --  leave the attribute reference unchanged.
 106
 107       elsif Nkind (N) = N_Attribute_Reference
 108         and then Is_Procedure_Attribute_Name (Attribute_Name (N))
 109       then
 110          null;
 111
 112       --  All other cases of names are parameterless procedure calls
 113
 114       else
 115          declare
 116             Name_Node : constant Node_Id := Relocate_Node (N);
 117          begin
 118             Change_Node (N, N_Procedure_Call_Statement);
 119             Set_Name (N, Name_Node);
 120          end;
 121       end if;
 122    end Change_Name_To_Procedure_Call_Statement;
 123
 124    --------------------------------------------------------
 125    -- Change_Operator_Symbol_To_Defining_Operator_Symbol --
 126    --------------------------------------------------------
 127
 128    procedure Change_Operator_Symbol_To_Defining_Operator_Symbol
 129      (N : Node_Id)
 130    is
 131    begin
 132       Reinit_Field_To_Zero (N, F_Strval);
 133       Extend_Node (N);
 134    end Change_Operator_Symbol_To_Defining_Operator_Symbol;
 135
 136    ----------------------------------------------
 137    -- Change_Operator_Symbol_To_String_Literal --
 138    ----------------------------------------------
 139
 140    procedure Change_Operator_Symbol_To_String_Literal (N : Node_Id) is
 141    begin
 142       Reinit_Field_To_Zero (N, F_Chars);
 143       Set_Entity (N, Empty);
 144       Mutate_Nkind (N, N_String_Literal);
 145    end Change_Operator_Symbol_To_String_Literal;
 146
 147    ------------------------------------------------
 148    -- Change_Selected_Component_To_Expanded_Name --
 149    ------------------------------------------------
 150
 151    procedure Change_Selected_Component_To_Expanded_Name (N : Node_Id) is
 152    begin
 153       Mutate_Nkind (N, N_Expanded_Name);
 154       Set_Chars (N, Chars (Selector_Name (N)));
 155    end Change_Selected_Component_To_Expanded_Name;
 156
 157 end Sinfo.CN;