1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 pragma Style_Checks
(All_Checks
);
29 -- Turn off subprogram body ordering check. Subprograms are in order
30 -- by RM section rather than alphabetical
35 -- Local functions, used only in this chapter
37 function P_Component_Clause
return Node_Id
;
38 function P_Mod_Clause
return Node_Id
;
40 --------------------------------------------
41 -- 13.1 Representation Clause (also I.7) --
42 --------------------------------------------
44 -- REPRESENTATION_CLAUSE ::=
45 -- ATTRIBUTE_DEFINITION_CLAUSE
46 -- | ENUMERATION_REPRESENTATION_CLAUSE
47 -- | RECORD_REPRESENTATION_CLAUSE
50 -- ATTRIBUTE_DEFINITION_CLAUSE ::=
51 -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
52 -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
54 -- Note: in Ada 83, the expression must be a simple expression
56 -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
58 -- Note: in Ada 83, the expression must be a simple expression
60 -- ENUMERATION_REPRESENTATION_CLAUSE ::=
61 -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
63 -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
65 -- RECORD_REPRESENTATION_CLAUSE ::=
66 -- for first_subtype_LOCAL_NAME use
67 -- record [MOD_CLAUSE]
71 -- Note: for now we allow only a direct name as the local name in the
72 -- above constructs. This probably needs changing later on ???
74 -- The caller has checked that the initial token is FOR
76 -- Error recovery: cannot raise Error_Resync, if an error occurs,
77 -- the scan is repositioned past the next semicolon.
79 function P_Representation_Clause
return Node_Id
is
82 Prefix_Node
: Node_Id
;
84 Identifier_Node
: Node_Id
;
85 Rep_Clause_Node
: Node_Id
;
87 Record_Items
: List_Id
;
93 -- Note that the name in a representation clause is always a simple
94 -- name, even in the attribute case, see AI-300 which made this so!
96 Identifier_Node
:= P_Identifier
;
98 -- Check case of qualified name to give good error message
100 if Token
= Tok_Dot
then
102 ("representation clause requires simple name!");
105 exit when Token
/= Tok_Dot
;
107 Discard_Junk_Node
(P_Identifier
);
111 -- Attribute Definition Clause
113 if Token
= Tok_Apostrophe
then
115 -- Allow local names of the form a'b'.... This enables
116 -- us to parse class-wide streams attributes correctly.
118 Name_Node
:= Identifier_Node
;
119 while Token
= Tok_Apostrophe
loop
121 Scan
; -- past apostrophe
123 Identifier_Node
:= Token_Node
;
124 Attr_Name
:= No_Name
;
126 if Token
= Tok_Identifier
then
127 Attr_Name
:= Token_Name
;
129 if not Is_Attribute_Name
(Attr_Name
) then
130 Signal_Bad_Attribute
;
134 Style
.Check_Attribute_Name
(False);
137 -- Here for case of attribute designator is not an identifier
140 if Token
= Tok_Delta
then
141 Attr_Name
:= Name_Delta
;
143 elsif Token
= Tok_Digits
then
144 Attr_Name
:= Name_Digits
;
146 elsif Token
= Tok_Access
then
147 Attr_Name
:= Name_Access
;
150 Error_Msg_AP
("attribute designator expected");
155 Style
.Check_Attribute_Name
(True);
159 -- We come here with an OK attribute scanned, and the
160 -- corresponding Attribute identifier node stored in Ident_Node.
162 Prefix_Node
:= Name_Node
;
163 Name_Node
:= New_Node
(N_Attribute_Reference
, Prev_Token_Ptr
);
164 Set_Prefix
(Name_Node
, Prefix_Node
);
165 Set_Attribute_Name
(Name_Node
, Attr_Name
);
169 Rep_Clause_Node
:= New_Node
(N_Attribute_Definition_Clause
, For_Loc
);
170 Set_Name
(Rep_Clause_Node
, Prefix_Node
);
171 Set_Chars
(Rep_Clause_Node
, Attr_Name
);
174 Expr_Node
:= P_Expression_No_Right_Paren
;
175 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
176 Set_Expression
(Rep_Clause_Node
, Expr_Node
);
180 Rep_Clause_Node
:= Empty
;
182 -- AT follows USE (At Clause)
184 if Token
= Tok_At
then
186 Rep_Clause_Node
:= New_Node
(N_At_Clause
, For_Loc
);
187 Set_Identifier
(Rep_Clause_Node
, Identifier_Node
);
188 Expr_Node
:= P_Expression_No_Right_Paren
;
189 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
190 Set_Expression
(Rep_Clause_Node
, Expr_Node
);
192 -- RECORD follows USE (Record Representation Clause)
194 elsif Token
= Tok_Record
then
195 Record_Items
:= P_Pragmas_Opt
;
197 New_Node
(N_Record_Representation_Clause
, For_Loc
);
198 Set_Identifier
(Rep_Clause_Node
, Identifier_Node
);
201 Scope
.Table
(Scope
.Last
).Etyp
:= E_Record
;
202 Scope
.Table
(Scope
.Last
).Ecol
:= Start_Column
;
203 Scope
.Table
(Scope
.Last
).Sloc
:= Token_Ptr
;
205 Record_Items
:= P_Pragmas_Opt
;
207 -- Possible Mod Clause
209 if Token
= Tok_At
then
210 Set_Mod_Clause
(Rep_Clause_Node
, P_Mod_Clause
);
211 Set_Pragmas_Before
(Mod_Clause
(Rep_Clause_Node
), Record_Items
);
212 Record_Items
:= P_Pragmas_Opt
;
215 if No
(Record_Items
) then
216 Record_Items
:= New_List
;
219 Set_Component_Clauses
(Rep_Clause_Node
, Record_Items
);
221 -- Loop through component clauses
224 if Token
not in Token_Class_Name
then
228 Append
(P_Component_Clause
, Record_Items
);
229 P_Pragmas_Opt
(Record_Items
);
232 -- Left paren follows USE (Enumeration Representation Clause)
234 elsif Token
= Tok_Left_Paren
then
236 New_Node
(N_Enumeration_Representation_Clause
, For_Loc
);
237 Set_Identifier
(Rep_Clause_Node
, Identifier_Node
);
238 Set_Array_Aggregate
(Rep_Clause_Node
, P_Aggregate
);
240 -- Some other token follows FOR (invalid representation clause)
243 Error_Msg_SC
("invalid representation clause");
249 return Rep_Clause_Node
;
253 Resync_Past_Semicolon
;
256 end P_Representation_Clause
;
258 ----------------------
259 -- 13.1 Local Name --
260 ----------------------
262 -- Local name is always parsed by its parent. In the case of its use in
263 -- pragmas, the check for a local name is handled in Par.Prag and allows
264 -- all the possible forms of local name. For the uses in chapter 13, we
265 -- currently only allow a direct name, but this should probably change???
267 ---------------------------
268 -- 13.1 At Clause (I.7) --
269 ---------------------------
271 -- Parsed by P_Representation_Clause (13.1)
273 ---------------------------------------
274 -- 13.3 Attribute Definition Clause --
275 ---------------------------------------
277 -- Parsed by P_Representation_Clause (13.1)
279 ---------------------------------------------
280 -- 13.4 Enumeration Representation Clause --
281 ---------------------------------------------
283 -- Parsed by P_Representation_Clause (13.1)
285 ---------------------------------
286 -- 13.4 Enumeration Aggregate --
287 ---------------------------------
289 -- Parsed by P_Representation_Clause (13.1)
291 ------------------------------------------
292 -- 13.5.1 Record Representation Clause --
293 ------------------------------------------
295 -- Parsed by P_Representation_Clause (13.1)
297 ------------------------------
298 -- 13.5.1 Mod Clause (I.8) --
299 ------------------------------
301 -- MOD_CLAUSE ::= at mod static_EXPRESSION;
303 -- Note: in Ada 83, the expression must be a simple expression
305 -- The caller has checked that the initial Token is AT
307 -- Error recovery: cannot raise Error_Resync
309 -- Note: the caller is responsible for setting the Pragmas_Before field
311 function P_Mod_Clause
return Node_Id
is
316 Mod_Node
:= New_Node
(N_Mod_Clause
, Token_Ptr
);
319 Expr_Node
:= P_Expression_No_Right_Paren
;
320 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
321 Set_Expression
(Mod_Node
, Expr_Node
);
326 ------------------------------
327 -- 13.5.1 Component Clause --
328 ------------------------------
330 -- COMPONENT_CLAUSE ::=
331 -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
332 -- range FIRST_BIT .. LAST_BIT;
334 -- COMPONENT_CLAUSE_COMPONENT_NAME ::=
335 -- component_DIRECT_NAME
336 -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
337 -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
339 -- POSITION ::= static_EXPRESSION
341 -- Note: in Ada 83, the expression must be a simple expression
343 -- FIRST_BIT ::= static_SIMPLE_EXPRESSION
344 -- LAST_BIT ::= static_SIMPLE_EXPRESSION
346 -- Note: the AARM V2.0 grammar has an error at this point, it uses
347 -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
349 -- Error recovery: cannot raise Error_Resync
351 function P_Component_Clause
return Node_Id
is
352 Component_Node
: Node_Id
;
357 Component_Node
:= New_Node
(N_Component_Clause
, Token_Ptr
);
360 if Nkind
(Comp_Name
) = N_Identifier
361 or else Nkind
(Comp_Name
) = N_Attribute_Reference
363 Set_Component_Name
(Component_Node
, Comp_Name
);
366 ("component name must be direct name or attribute", Comp_Name
);
367 Set_Component_Name
(Component_Node
, Error
);
370 Set_Sloc
(Component_Node
, Token_Ptr
);
372 Expr_Node
:= P_Expression_No_Right_Paren
;
373 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
374 Set_Position
(Component_Node
, Expr_Node
);
376 Expr_Node
:= P_Expression_No_Right_Paren
;
377 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
378 Set_First_Bit
(Component_Node
, Expr_Node
);
380 Expr_Node
:= P_Expression_No_Right_Paren
;
381 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
382 Set_Last_Bit
(Component_Node
, Expr_Node
);
384 return Component_Node
;
385 end P_Component_Clause
;
387 ----------------------
388 -- 13.5.1 Position --
389 ----------------------
391 -- Parsed by P_Component_Clause (13.5.1)
393 -----------------------
394 -- 13.5.1 First Bit --
395 -----------------------
397 -- Parsed by P_Component_Clause (13.5.1)
399 ----------------------
400 -- 13.5.1 Last Bit --
401 ----------------------
403 -- Parsed by P_Component_Clause (13.5.1)
405 --------------------------
406 -- 13.8 Code Statement --
407 --------------------------
409 -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION
411 -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the
412 -- single argument, and the scan points to the apostrophe.
414 -- Error recovery: can raise Error_Resync
416 function P_Code_Statement
(Subtype_Mark
: Node_Id
) return Node_Id
is
420 Scan
; -- past apostrophe
422 -- If left paren, then we have a possible code statement
424 if Token
= Tok_Left_Paren
then
425 Node1
:= New_Node
(N_Code_Statement
, Sloc
(Subtype_Mark
));
426 Set_Expression
(Node1
, P_Qualified_Expression
(Subtype_Mark
));
430 -- Otherwise we have an illegal range attribute. Note that P_Name
431 -- ensures that Token = Tok_Range is the only possibility left here.
433 else -- Token = Tok_Range
434 Error_Msg_SC
("RANGE attribute illegal here!");
438 end P_Code_Statement
;