Daily bump.
[official-gcc.git] / gcc / ada / par-ch13.adb
blob4eecd3624082c34fe84ab734ea91873190d1dac2
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P A R . C H 1 3 --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2007, 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 ------------------------------------------------------------------------------
26 pragma Style_Checks (All_Checks);
27 -- Turn off subprogram body ordering check. Subprograms are in order
28 -- by RM section rather than alphabetical
30 separate (Par)
31 package body Ch13 is
33 -- Local functions, used only in this chapter
35 function P_Component_Clause return Node_Id;
36 function P_Mod_Clause return Node_Id;
38 --------------------------------------------
39 -- 13.1 Representation Clause (also I.7) --
40 --------------------------------------------
42 -- REPRESENTATION_CLAUSE ::=
43 -- ATTRIBUTE_DEFINITION_CLAUSE
44 -- | ENUMERATION_REPRESENTATION_CLAUSE
45 -- | RECORD_REPRESENTATION_CLAUSE
46 -- | AT_CLAUSE
48 -- ATTRIBUTE_DEFINITION_CLAUSE ::=
49 -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
50 -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
52 -- Note: in Ada 83, the expression must be a simple expression
54 -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
56 -- Note: in Ada 83, the expression must be a simple expression
58 -- ENUMERATION_REPRESENTATION_CLAUSE ::=
59 -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
61 -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
63 -- RECORD_REPRESENTATION_CLAUSE ::=
64 -- for first_subtype_LOCAL_NAME use
65 -- record [MOD_CLAUSE]
66 -- {COMPONENT_CLAUSE}
67 -- end record;
69 -- Note: for now we allow only a direct name as the local name in the
70 -- above constructs. This probably needs changing later on ???
72 -- The caller has checked that the initial token is FOR
74 -- Error recovery: cannot raise Error_Resync, if an error occurs,
75 -- the scan is repositioned past the next semicolon.
77 function P_Representation_Clause return Node_Id is
78 For_Loc : Source_Ptr;
79 Name_Node : Node_Id;
80 Prefix_Node : Node_Id;
81 Attr_Name : Name_Id;
82 Identifier_Node : Node_Id;
83 Rep_Clause_Node : Node_Id;
84 Expr_Node : Node_Id;
85 Record_Items : List_Id;
87 begin
88 For_Loc := Token_Ptr;
89 Scan; -- past FOR
91 -- Note that the name in a representation clause is always a simple
92 -- name, even in the attribute case, see AI-300 which made this so!
94 Identifier_Node := P_Identifier (C_Use);
96 -- Check case of qualified name to give good error message
98 if Token = Tok_Dot then
99 Error_Msg_SC
100 ("representation clause requires simple name!");
102 loop
103 exit when Token /= Tok_Dot;
104 Scan; -- past dot
105 Discard_Junk_Node (P_Identifier);
106 end loop;
107 end if;
109 -- Attribute Definition Clause
111 if Token = Tok_Apostrophe then
113 -- Allow local names of the form a'b'.... This enables
114 -- us to parse class-wide streams attributes correctly.
116 Name_Node := Identifier_Node;
117 while Token = Tok_Apostrophe loop
119 Scan; -- past apostrophe
121 Identifier_Node := Token_Node;
122 Attr_Name := No_Name;
124 if Token = Tok_Identifier then
125 Attr_Name := Token_Name;
127 if not Is_Attribute_Name (Attr_Name) then
128 Signal_Bad_Attribute;
129 end if;
131 if Style_Check then
132 Style.Check_Attribute_Name (False);
133 end if;
135 -- Here for case of attribute designator is not an identifier
137 else
138 if Token = Tok_Delta then
139 Attr_Name := Name_Delta;
141 elsif Token = Tok_Digits then
142 Attr_Name := Name_Digits;
144 elsif Token = Tok_Access then
145 Attr_Name := Name_Access;
147 else
148 Error_Msg_AP ("attribute designator expected");
149 raise Error_Resync;
150 end if;
152 if Style_Check then
153 Style.Check_Attribute_Name (True);
154 end if;
155 end if;
157 -- We come here with an OK attribute scanned, and the
158 -- corresponding Attribute identifier node stored in Ident_Node.
160 Prefix_Node := Name_Node;
161 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
162 Set_Prefix (Name_Node, Prefix_Node);
163 Set_Attribute_Name (Name_Node, Attr_Name);
164 Scan;
165 end loop;
167 Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc);
168 Set_Name (Rep_Clause_Node, Prefix_Node);
169 Set_Chars (Rep_Clause_Node, Attr_Name);
170 T_Use;
172 Expr_Node := P_Expression_No_Right_Paren;
173 Check_Simple_Expression_In_Ada_83 (Expr_Node);
174 Set_Expression (Rep_Clause_Node, Expr_Node);
176 else
177 TF_Use;
178 Rep_Clause_Node := Empty;
180 -- AT follows USE (At Clause)
182 if Token = Tok_At then
183 Scan; -- past AT
184 Rep_Clause_Node := New_Node (N_At_Clause, For_Loc);
185 Set_Identifier (Rep_Clause_Node, Identifier_Node);
186 Expr_Node := P_Expression_No_Right_Paren;
187 Check_Simple_Expression_In_Ada_83 (Expr_Node);
188 Set_Expression (Rep_Clause_Node, Expr_Node);
190 -- RECORD follows USE (Record Representation Clause)
192 elsif Token = Tok_Record then
193 Record_Items := P_Pragmas_Opt;
194 Rep_Clause_Node :=
195 New_Node (N_Record_Representation_Clause, For_Loc);
196 Set_Identifier (Rep_Clause_Node, Identifier_Node);
198 Push_Scope_Stack;
199 Scope.Table (Scope.Last).Etyp := E_Record;
200 Scope.Table (Scope.Last).Ecol := Start_Column;
201 Scope.Table (Scope.Last).Sloc := Token_Ptr;
202 Scan; -- past RECORD
203 Record_Items := P_Pragmas_Opt;
205 -- Possible Mod Clause
207 if Token = Tok_At then
208 Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause);
209 Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items);
210 Record_Items := P_Pragmas_Opt;
211 end if;
213 if No (Record_Items) then
214 Record_Items := New_List;
215 end if;
217 Set_Component_Clauses (Rep_Clause_Node, Record_Items);
219 -- Loop through component clauses
221 loop
222 if Token not in Token_Class_Name then
223 exit when Check_End;
224 end if;
226 Append (P_Component_Clause, Record_Items);
227 P_Pragmas_Opt (Record_Items);
228 end loop;
230 -- Left paren follows USE (Enumeration Representation Clause)
232 elsif Token = Tok_Left_Paren then
233 Rep_Clause_Node :=
234 New_Node (N_Enumeration_Representation_Clause, For_Loc);
235 Set_Identifier (Rep_Clause_Node, Identifier_Node);
236 Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate);
238 -- Some other token follows FOR (invalid representation clause)
240 else
241 Error_Msg_SC ("invalid representation clause");
242 raise Error_Resync;
243 end if;
244 end if;
246 TF_Semicolon;
247 return Rep_Clause_Node;
249 exception
250 when Error_Resync =>
251 Resync_Past_Semicolon;
252 return Error;
254 end P_Representation_Clause;
256 ----------------------
257 -- 13.1 Local Name --
258 ----------------------
260 -- Local name is always parsed by its parent. In the case of its use in
261 -- pragmas, the check for a local name is handled in Par.Prag and allows
262 -- all the possible forms of local name. For the uses in chapter 13, we
263 -- currently only allow a direct name, but this should probably change???
265 ---------------------------
266 -- 13.1 At Clause (I.7) --
267 ---------------------------
269 -- Parsed by P_Representation_Clause (13.1)
271 ---------------------------------------
272 -- 13.3 Attribute Definition Clause --
273 ---------------------------------------
275 -- Parsed by P_Representation_Clause (13.1)
277 ---------------------------------------------
278 -- 13.4 Enumeration Representation Clause --
279 ---------------------------------------------
281 -- Parsed by P_Representation_Clause (13.1)
283 ---------------------------------
284 -- 13.4 Enumeration Aggregate --
285 ---------------------------------
287 -- Parsed by P_Representation_Clause (13.1)
289 ------------------------------------------
290 -- 13.5.1 Record Representation Clause --
291 ------------------------------------------
293 -- Parsed by P_Representation_Clause (13.1)
295 ------------------------------
296 -- 13.5.1 Mod Clause (I.8) --
297 ------------------------------
299 -- MOD_CLAUSE ::= at mod static_EXPRESSION;
301 -- Note: in Ada 83, the expression must be a simple expression
303 -- The caller has checked that the initial Token is AT
305 -- Error recovery: cannot raise Error_Resync
307 -- Note: the caller is responsible for setting the Pragmas_Before field
309 function P_Mod_Clause return Node_Id is
310 Mod_Node : Node_Id;
311 Expr_Node : Node_Id;
313 begin
314 Mod_Node := New_Node (N_Mod_Clause, Token_Ptr);
315 Scan; -- past AT
316 T_Mod;
317 Expr_Node := P_Expression_No_Right_Paren;
318 Check_Simple_Expression_In_Ada_83 (Expr_Node);
319 Set_Expression (Mod_Node, Expr_Node);
320 TF_Semicolon;
321 return Mod_Node;
322 end P_Mod_Clause;
324 ------------------------------
325 -- 13.5.1 Component Clause --
326 ------------------------------
328 -- COMPONENT_CLAUSE ::=
329 -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
330 -- range FIRST_BIT .. LAST_BIT;
332 -- COMPONENT_CLAUSE_COMPONENT_NAME ::=
333 -- component_DIRECT_NAME
334 -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
335 -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
337 -- POSITION ::= static_EXPRESSION
339 -- Note: in Ada 83, the expression must be a simple expression
341 -- FIRST_BIT ::= static_SIMPLE_EXPRESSION
342 -- LAST_BIT ::= static_SIMPLE_EXPRESSION
344 -- Note: the AARM V2.0 grammar has an error at this point, it uses
345 -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
347 -- Error recovery: cannot raise Error_Resync
349 function P_Component_Clause return Node_Id is
350 Component_Node : Node_Id;
351 Comp_Name : Node_Id;
352 Expr_Node : Node_Id;
354 begin
355 Component_Node := New_Node (N_Component_Clause, Token_Ptr);
356 Comp_Name := P_Name;
358 if Nkind (Comp_Name) = N_Identifier
359 or else Nkind (Comp_Name) = N_Attribute_Reference
360 then
361 Set_Component_Name (Component_Node, Comp_Name);
362 else
363 Error_Msg_N
364 ("component name must be direct name or attribute", Comp_Name);
365 Set_Component_Name (Component_Node, Error);
366 end if;
368 Set_Sloc (Component_Node, Token_Ptr);
369 T_At;
370 Expr_Node := P_Expression_No_Right_Paren;
371 Check_Simple_Expression_In_Ada_83 (Expr_Node);
372 Set_Position (Component_Node, Expr_Node);
373 T_Range;
374 Expr_Node := P_Expression_No_Right_Paren;
375 Check_Simple_Expression_In_Ada_83 (Expr_Node);
376 Set_First_Bit (Component_Node, Expr_Node);
377 T_Dot_Dot;
378 Expr_Node := P_Expression_No_Right_Paren;
379 Check_Simple_Expression_In_Ada_83 (Expr_Node);
380 Set_Last_Bit (Component_Node, Expr_Node);
381 TF_Semicolon;
382 return Component_Node;
383 end P_Component_Clause;
385 ----------------------
386 -- 13.5.1 Position --
387 ----------------------
389 -- Parsed by P_Component_Clause (13.5.1)
391 -----------------------
392 -- 13.5.1 First Bit --
393 -----------------------
395 -- Parsed by P_Component_Clause (13.5.1)
397 ----------------------
398 -- 13.5.1 Last Bit --
399 ----------------------
401 -- Parsed by P_Component_Clause (13.5.1)
403 --------------------------
404 -- 13.8 Code Statement --
405 --------------------------
407 -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION
409 -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the
410 -- single argument, and the scan points to the apostrophe.
412 -- Error recovery: can raise Error_Resync
414 function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is
415 Node1 : Node_Id;
417 begin
418 Scan; -- past apostrophe
420 -- If left paren, then we have a possible code statement
422 if Token = Tok_Left_Paren then
423 Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark));
424 Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark));
425 TF_Semicolon;
426 return Node1;
428 -- Otherwise we have an illegal range attribute. Note that P_Name
429 -- ensures that Token = Tok_Range is the only possibility left here.
431 else -- Token = Tok_Range
432 Error_Msg_SC ("RANGE attribute illegal here!");
433 raise Error_Resync;
434 end if;
436 end P_Code_Statement;
438 end Ch13;