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-2012, 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 33with Atree; use Atree; 34with Snames; use Snames; 35 36package body Sinfo.CN is 37 38 use Atree.Unchecked_Access; 39 -- This package is one of the few packages which is allowed to make direct 40 -- references to tree nodes (since it is in the business of providing a 41 -- higher level of tree access which other clients are expected to use and 42 -- which implements checks). 43 44 ------------------------------------------------------------ 45 -- Change_Character_Literal_To_Defining_Character_Literal -- 46 ------------------------------------------------------------ 47 48 procedure Change_Character_Literal_To_Defining_Character_Literal 49 (N : in out Node_Id) 50 is 51 begin 52 Set_Nkind (N, N_Defining_Character_Literal); 53 N := Extend_Node (N); 54 end Change_Character_Literal_To_Defining_Character_Literal; 55 56 ------------------------------------ 57 -- Change_Conversion_To_Unchecked -- 58 ------------------------------------ 59 60 procedure Change_Conversion_To_Unchecked (N : Node_Id) is 61 begin 62 Set_Do_Overflow_Check (N, False); 63 Set_Do_Tag_Check (N, False); 64 Set_Do_Length_Check (N, False); 65 Set_Nkind (N, N_Unchecked_Type_Conversion); 66 end Change_Conversion_To_Unchecked; 67 68 ---------------------------------------------- 69 -- Change_Identifier_To_Defining_Identifier -- 70 ---------------------------------------------- 71 72 procedure Change_Identifier_To_Defining_Identifier (N : in out Node_Id) is 73 begin 74 Set_Nkind (N, N_Defining_Identifier); 75 N := Extend_Node (N); 76 end Change_Identifier_To_Defining_Identifier; 77 78 --------------------------------------------- 79 -- Change_Name_To_Procedure_Call_Statement -- 80 --------------------------------------------- 81 82 procedure Change_Name_To_Procedure_Call_Statement (N : Node_Id) is 83 begin 84 -- Case of Indexed component, which is a procedure call with arguments 85 86 if Nkind (N) = N_Indexed_Component then 87 declare 88 Prefix_Node : constant Node_Id := Prefix (N); 89 Exprs_Node : constant List_Id := Expressions (N); 90 91 begin 92 Change_Node (N, N_Procedure_Call_Statement); 93 Set_Name (N, Prefix_Node); 94 Set_Parameter_Associations (N, Exprs_Node); 95 end; 96 97 -- Case of function call node, which is a really a procedure call 98 99 elsif Nkind (N) = N_Function_Call then 100 declare 101 Fname_Node : constant Node_Id := Name (N); 102 Params_List : constant List_Id := Parameter_Associations (N); 103 104 begin 105 Change_Node (N, N_Procedure_Call_Statement); 106 Set_Name (N, Fname_Node); 107 Set_Parameter_Associations (N, Params_List); 108 end; 109 110 -- Case of call to attribute that denotes a procedure. Here we just 111 -- leave the attribute reference unchanged. 112 113 elsif Nkind (N) = N_Attribute_Reference 114 and then Is_Procedure_Attribute_Name (Attribute_Name (N)) 115 then 116 null; 117 118 -- All other cases of names are parameterless procedure calls 119 120 else 121 declare 122 Name_Node : constant Node_Id := Relocate_Node (N); 123 begin 124 Change_Node (N, N_Procedure_Call_Statement); 125 Set_Name (N, Name_Node); 126 end; 127 end if; 128 end Change_Name_To_Procedure_Call_Statement; 129 130 -------------------------------------------------------- 131 -- Change_Operator_Symbol_To_Defining_Operator_Symbol -- 132 -------------------------------------------------------- 133 134 procedure Change_Operator_Symbol_To_Defining_Operator_Symbol 135 (N : in out Node_Id) 136 is 137 begin 138 Set_Nkind (N, N_Defining_Operator_Symbol); 139 Set_Node2 (N, Empty); -- Clear unused Str2 field 140 N := Extend_Node (N); 141 end Change_Operator_Symbol_To_Defining_Operator_Symbol; 142 143 ---------------------------------------------- 144 -- Change_Operator_Symbol_To_String_Literal -- 145 ---------------------------------------------- 146 147 procedure Change_Operator_Symbol_To_String_Literal (N : Node_Id) is 148 begin 149 Set_Nkind (N, N_String_Literal); 150 Set_Node1 (N, Empty); -- clear Name1 field 151 end Change_Operator_Symbol_To_String_Literal; 152 153 ------------------------------------------------ 154 -- Change_Selected_Component_To_Expanded_Name -- 155 ------------------------------------------------ 156 157 procedure Change_Selected_Component_To_Expanded_Name (N : Node_Id) is 158 begin 159 Set_Nkind (N, N_Expanded_Name); 160 Set_Chars (N, Chars (Selector_Name (N))); 161 end Change_Selected_Component_To_Expanded_Name; 162 163end Sinfo.CN; 164