Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/sinfo-cn.adb @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
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 | |
33 with Atree; use Atree; | |
34 with Snames; use Snames; | |
35 | |
36 package 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 | |
163 end Sinfo.CN; |