1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 pragma Style_Checks
(All_Checks
);
28 -- Turn off subprogram body ordering check. Subprograms are in order
29 -- by RM section rather than alphabetical
34 -- Local functions, used only in this chapter
36 function P_Component_Clause
return Node_Id
;
37 function P_Mod_Clause
return Node_Id
;
39 --------------------------------------------
40 -- 13.1 Representation Clause (also I.7) --
41 --------------------------------------------
43 -- REPRESENTATION_CLAUSE ::=
44 -- ATTRIBUTE_DEFINITION_CLAUSE
45 -- | ENUMERATION_REPRESENTATION_CLAUSE
46 -- | RECORD_REPRESENTATION_CLAUSE
49 -- ATTRIBUTE_DEFINITION_CLAUSE ::=
50 -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
51 -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
53 -- Note: in Ada 83, the expression must be a simple expression
55 -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
57 -- Note: in Ada 83, the expression must be a simple expression
59 -- ENUMERATION_REPRESENTATION_CLAUSE ::=
60 -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
62 -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
64 -- RECORD_REPRESENTATION_CLAUSE ::=
65 -- for first_subtype_LOCAL_NAME use
66 -- record [MOD_CLAUSE]
70 -- Note: for now we allow only a direct name as the local name in the
71 -- above constructs. This probably needs changing later on ???
73 -- The caller has checked that the initial token is FOR
75 -- Error recovery: cannot raise Error_Resync, if an error occurs,
76 -- the scan is repositioned past the next semicolon.
78 function P_Representation_Clause
return Node_Id
is
81 Prefix_Node
: Node_Id
;
83 Identifier_Node
: Node_Id
;
84 Rep_Clause_Node
: Node_Id
;
86 Record_Items
: List_Id
;
92 -- Note that the name in a representation clause is always a simple
93 -- name, even in the attribute case, see AI-300 which made this so!
95 Identifier_Node
:= P_Identifier
(C_Use
);
97 -- Check case of qualified name to give good error message
99 if Token
= Tok_Dot
then
101 ("representation clause requires simple name!");
104 exit when Token
/= Tok_Dot
;
106 Discard_Junk_Node
(P_Identifier
);
110 -- Attribute Definition Clause
112 if Token
= Tok_Apostrophe
then
114 -- Allow local names of the form a'b'.... This enables
115 -- us to parse class-wide streams attributes correctly.
117 Name_Node
:= Identifier_Node
;
118 while Token
= Tok_Apostrophe
loop
120 Scan
; -- past apostrophe
122 Identifier_Node
:= Token_Node
;
123 Attr_Name
:= No_Name
;
125 if Token
= Tok_Identifier
then
126 Attr_Name
:= Token_Name
;
128 if not Is_Attribute_Name
(Attr_Name
) then
129 Signal_Bad_Attribute
;
133 Style
.Check_Attribute_Name
(False);
136 -- Here for case of attribute designator is not an identifier
139 if Token
= Tok_Delta
then
140 Attr_Name
:= Name_Delta
;
142 elsif Token
= Tok_Digits
then
143 Attr_Name
:= Name_Digits
;
145 elsif Token
= Tok_Access
then
146 Attr_Name
:= Name_Access
;
149 Error_Msg_AP
("attribute designator expected");
154 Style
.Check_Attribute_Name
(True);
158 -- We come here with an OK attribute scanned, and the
159 -- corresponding Attribute identifier node stored in Ident_Node.
161 Prefix_Node
:= Name_Node
;
162 Name_Node
:= New_Node
(N_Attribute_Reference
, Prev_Token_Ptr
);
163 Set_Prefix
(Name_Node
, Prefix_Node
);
164 Set_Attribute_Name
(Name_Node
, Attr_Name
);
168 Rep_Clause_Node
:= New_Node
(N_Attribute_Definition_Clause
, For_Loc
);
169 Set_Name
(Rep_Clause_Node
, Prefix_Node
);
170 Set_Chars
(Rep_Clause_Node
, Attr_Name
);
173 Expr_Node
:= P_Expression_No_Right_Paren
;
174 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
175 Set_Expression
(Rep_Clause_Node
, Expr_Node
);
179 Rep_Clause_Node
:= Empty
;
181 -- AT follows USE (At Clause)
183 if Token
= Tok_At
then
185 Rep_Clause_Node
:= New_Node
(N_At_Clause
, For_Loc
);
186 Set_Identifier
(Rep_Clause_Node
, Identifier_Node
);
187 Expr_Node
:= P_Expression_No_Right_Paren
;
188 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
189 Set_Expression
(Rep_Clause_Node
, Expr_Node
);
191 -- RECORD follows USE (Record Representation Clause)
193 elsif Token
= Tok_Record
then
194 Record_Items
:= P_Pragmas_Opt
;
196 New_Node
(N_Record_Representation_Clause
, For_Loc
);
197 Set_Identifier
(Rep_Clause_Node
, Identifier_Node
);
200 Scope
.Table
(Scope
.Last
).Etyp
:= E_Record
;
201 Scope
.Table
(Scope
.Last
).Ecol
:= Start_Column
;
202 Scope
.Table
(Scope
.Last
).Sloc
:= Token_Ptr
;
204 Record_Items
:= P_Pragmas_Opt
;
206 -- Possible Mod Clause
208 if Token
= Tok_At
then
209 Set_Mod_Clause
(Rep_Clause_Node
, P_Mod_Clause
);
210 Set_Pragmas_Before
(Mod_Clause
(Rep_Clause_Node
), Record_Items
);
211 Record_Items
:= P_Pragmas_Opt
;
214 if No
(Record_Items
) then
215 Record_Items
:= New_List
;
218 Set_Component_Clauses
(Rep_Clause_Node
, Record_Items
);
220 -- Loop through component clauses
223 if Token
not in Token_Class_Name
then
227 Append
(P_Component_Clause
, Record_Items
);
228 P_Pragmas_Opt
(Record_Items
);
231 -- Left paren follows USE (Enumeration Representation Clause)
233 elsif Token
= Tok_Left_Paren
then
235 New_Node
(N_Enumeration_Representation_Clause
, For_Loc
);
236 Set_Identifier
(Rep_Clause_Node
, Identifier_Node
);
237 Set_Array_Aggregate
(Rep_Clause_Node
, P_Aggregate
);
239 -- Some other token follows FOR (invalid representation clause)
242 Error_Msg_SC
("invalid representation clause");
248 return Rep_Clause_Node
;
252 Resync_Past_Semicolon
;
255 end P_Representation_Clause
;
257 ----------------------
258 -- 13.1 Local Name --
259 ----------------------
261 -- Local name is always parsed by its parent. In the case of its use in
262 -- pragmas, the check for a local name is handled in Par.Prag and allows
263 -- all the possible forms of local name. For the uses in chapter 13, we
264 -- currently only allow a direct name, but this should probably change???
266 ---------------------------
267 -- 13.1 At Clause (I.7) --
268 ---------------------------
270 -- Parsed by P_Representation_Clause (13.1)
272 ---------------------------------------
273 -- 13.3 Attribute Definition Clause --
274 ---------------------------------------
276 -- Parsed by P_Representation_Clause (13.1)
278 ---------------------------------------------
279 -- 13.4 Enumeration Representation Clause --
280 ---------------------------------------------
282 -- Parsed by P_Representation_Clause (13.1)
284 ---------------------------------
285 -- 13.4 Enumeration Aggregate --
286 ---------------------------------
288 -- Parsed by P_Representation_Clause (13.1)
290 ------------------------------------------
291 -- 13.5.1 Record Representation Clause --
292 ------------------------------------------
294 -- Parsed by P_Representation_Clause (13.1)
296 ------------------------------
297 -- 13.5.1 Mod Clause (I.8) --
298 ------------------------------
300 -- MOD_CLAUSE ::= at mod static_EXPRESSION;
302 -- Note: in Ada 83, the expression must be a simple expression
304 -- The caller has checked that the initial Token is AT
306 -- Error recovery: cannot raise Error_Resync
308 -- Note: the caller is responsible for setting the Pragmas_Before field
310 function P_Mod_Clause
return Node_Id
is
315 Mod_Node
:= New_Node
(N_Mod_Clause
, Token_Ptr
);
318 Expr_Node
:= P_Expression_No_Right_Paren
;
319 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
320 Set_Expression
(Mod_Node
, Expr_Node
);
325 ------------------------------
326 -- 13.5.1 Component Clause --
327 ------------------------------
329 -- COMPONENT_CLAUSE ::=
330 -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
331 -- range FIRST_BIT .. LAST_BIT;
333 -- COMPONENT_CLAUSE_COMPONENT_NAME ::=
334 -- component_DIRECT_NAME
335 -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
336 -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
338 -- POSITION ::= static_EXPRESSION
340 -- Note: in Ada 83, the expression must be a simple expression
342 -- FIRST_BIT ::= static_SIMPLE_EXPRESSION
343 -- LAST_BIT ::= static_SIMPLE_EXPRESSION
345 -- Note: the AARM V2.0 grammar has an error at this point, it uses
346 -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
348 -- Error recovery: cannot raise Error_Resync
350 function P_Component_Clause
return Node_Id
is
351 Component_Node
: Node_Id
;
356 Component_Node
:= New_Node
(N_Component_Clause
, Token_Ptr
);
359 if Nkind
(Comp_Name
) = N_Identifier
360 or else Nkind
(Comp_Name
) = N_Attribute_Reference
362 Set_Component_Name
(Component_Node
, Comp_Name
);
365 ("component name must be direct name or attribute", Comp_Name
);
366 Set_Component_Name
(Component_Node
, Error
);
369 Set_Sloc
(Component_Node
, Token_Ptr
);
371 Expr_Node
:= P_Expression_No_Right_Paren
;
372 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
373 Set_Position
(Component_Node
, Expr_Node
);
375 Expr_Node
:= P_Expression_No_Right_Paren
;
376 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
377 Set_First_Bit
(Component_Node
, Expr_Node
);
379 Expr_Node
:= P_Expression_No_Right_Paren
;
380 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
381 Set_Last_Bit
(Component_Node
, Expr_Node
);
383 return Component_Node
;
384 end P_Component_Clause
;
386 ----------------------
387 -- 13.5.1 Position --
388 ----------------------
390 -- Parsed by P_Component_Clause (13.5.1)
392 -----------------------
393 -- 13.5.1 First Bit --
394 -----------------------
396 -- Parsed by P_Component_Clause (13.5.1)
398 ----------------------
399 -- 13.5.1 Last Bit --
400 ----------------------
402 -- Parsed by P_Component_Clause (13.5.1)
404 --------------------------
405 -- 13.8 Code Statement --
406 --------------------------
408 -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION
410 -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the
411 -- single argument, and the scan points to the apostrophe.
413 -- Error recovery: can raise Error_Resync
415 function P_Code_Statement
(Subtype_Mark
: Node_Id
) return Node_Id
is
419 Scan
; -- past apostrophe
421 -- If left paren, then we have a possible code statement
423 if Token
= Tok_Left_Paren
then
424 Node1
:= New_Node
(N_Code_Statement
, Sloc
(Subtype_Mark
));
425 Set_Expression
(Node1
, P_Qualified_Expression
(Subtype_Mark
));
429 -- Otherwise we have an illegal range attribute. Note that P_Name
430 -- ensures that Token = Tok_Range is the only possibility left here.
432 else -- Token = Tok_Range
433 Error_Msg_SC
("RANGE attribute illegal here!");
437 end P_Code_Statement
;