gcc/ada/par-ch13.adb

   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 ------------------------------------------------------------------------------
  25
  26 pragma Style_Checks (All_Checks);
  27 --  Turn off subprogram body ordering check. Subprograms are in order
  28 --  by RM section rather than alphabetical
  29
  30 separate (Par)
  31 package body Ch13 is
  32
  33    --  Local functions, used only in this chapter
  34
  35    function P_Component_Clause return Node_Id;
  36    function P_Mod_Clause return Node_Id;
  37
  38    --------------------------------------------
  39    -- 13.1  Representation Clause (also I.7) --
  40    --------------------------------------------
  41
  42    --  REPRESENTATION_CLAUSE ::=
  43    --    ATTRIBUTE_DEFINITION_CLAUSE
  44    --  | ENUMERATION_REPRESENTATION_CLAUSE
  45    --  | RECORD_REPRESENTATION_CLAUSE
  46    --  | AT_CLAUSE
  47
  48    --  ATTRIBUTE_DEFINITION_CLAUSE ::=
  49    --    for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
  50    --  | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
  51
  52    --  Note: in Ada 83, the expression must be a simple expression
  53
  54    --  AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
  55
  56    --  Note: in Ada 83, the expression must be a simple expression
  57
  58    --  ENUMERATION_REPRESENTATION_CLAUSE ::=
  59    --    for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
  60
  61    --  ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
  62
  63    --  RECORD_REPRESENTATION_CLAUSE ::=
  64    --    for first_subtype_LOCAL_NAME use
  65    --      record [MOD_CLAUSE]
  66    --        {COMPONENT_CLAUSE}
  67    --      end record;
  68
  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 ???
  71
  72    --  The caller has checked that the initial token is FOR
  73
  74    --  Error recovery: cannot raise Error_Resync, if an error occurs,
  75    --  the scan is repositioned past the next semicolon.
  76
  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;
  86
  87    begin
  88       For_Loc := Token_Ptr;
  89       Scan; -- past FOR
  90
  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!
  93
  94       Identifier_Node := P_Identifier (C_Use);
  95
  96       --  Check case of qualified name to give good error message
  97
  98       if Token = Tok_Dot then
  99          Error_Msg_SC
 100             ("representation clause requires simple name!");
 101
 102          loop
 103             exit when Token /= Tok_Dot;
 104             Scan; -- past dot
 105             Discard_Junk_Node (P_Identifier);
 106          end loop;
 107       end if;
 108
 109       --  Attribute Definition Clause
 110
 111       if Token = Tok_Apostrophe then
 112
 113          --  Allow local names of the form a'b'.... This enables
 114          --  us to parse class-wide streams attributes correctly.
 115
 116          Name_Node := Identifier_Node;
 117          while Token = Tok_Apostrophe loop
 118
 119             Scan; -- past apostrophe
 120
 121             Identifier_Node := Token_Node;
 122             Attr_Name := No_Name;
 123
 124             if Token = Tok_Identifier then
 125                Attr_Name := Token_Name;
 126
 127                if not Is_Attribute_Name (Attr_Name) then
 128                   Signal_Bad_Attribute;
 129                end if;
 130
 131                if Style_Check then
 132                   Style.Check_Attribute_Name (False);
 133                end if;
 134
 135             --  Here for case of attribute designator is not an identifier
 136
 137             else
 138                if Token = Tok_Delta then
 139                   Attr_Name := Name_Delta;
 140
 141                elsif Token = Tok_Digits then
 142                   Attr_Name := Name_Digits;
 143
 144                elsif Token = Tok_Access then
 145                   Attr_Name := Name_Access;
 146
 147                else
 148                   Error_Msg_AP ("attribute designator expected");
 149                   raise Error_Resync;
 150                end if;
 151
 152                if Style_Check then
 153                   Style.Check_Attribute_Name (True);
 154                end if;
 155             end if;
 156
 157             --  We come here with an OK attribute scanned, and the
 158             --  corresponding Attribute identifier node stored in Ident_Node.
 159
 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;
 166
 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;
 171
 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);
 175
 176       else
 177          TF_Use;
 178          Rep_Clause_Node := Empty;
 179
 180          --  AT follows USE (At Clause)
 181
 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);
 189
 190          --  RECORD follows USE (Record Representation Clause)
 191
 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);
 197
 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;
 204
 205             --  Possible Mod Clause
 206
 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;
 212
 213             if No (Record_Items) then
 214                Record_Items := New_List;
 215             end if;
 216
 217             Set_Component_Clauses (Rep_Clause_Node, Record_Items);
 218
 219             --  Loop through component clauses
 220
 221             loop
 222                if Token not in Token_Class_Name then
 223                   exit when Check_End;
 224                end if;
 225
 226                Append (P_Component_Clause, Record_Items);
 227                P_Pragmas_Opt (Record_Items);
 228             end loop;
 229
 230          --  Left paren follows USE (Enumeration Representation Clause)
 231
 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);
 237
 238          --  Some other token follows FOR (invalid representation clause)
 239
 240          else
 241             Error_Msg_SC ("invalid representation clause");
 242             raise Error_Resync;
 243          end if;
 244       end if;
 245
 246       TF_Semicolon;
 247       return Rep_Clause_Node;
 248
 249    exception
 250       when Error_Resync =>
 251          Resync_Past_Semicolon;
 252          return Error;
 253
 254    end P_Representation_Clause;
 255
 256    ----------------------
 257    -- 13.1  Local Name --
 258    ----------------------
 259
 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???
 264
 265    ---------------------------
 266    -- 13.1  At Clause (I.7) --
 267    ---------------------------
 268
 269    --  Parsed by P_Representation_Clause (13.1)
 270
 271    ---------------------------------------
 272    -- 13.3  Attribute Definition Clause --
 273    ---------------------------------------
 274
 275    --  Parsed by P_Representation_Clause (13.1)
 276
 277    ---------------------------------------------
 278    -- 13.4  Enumeration Representation Clause --
 279    ---------------------------------------------
 280
 281    --  Parsed by P_Representation_Clause (13.1)
 282
 283    ---------------------------------
 284    -- 13.4  Enumeration Aggregate --
 285    ---------------------------------
 286
 287    --  Parsed by P_Representation_Clause (13.1)
 288
 289    ------------------------------------------
 290    -- 13.5.1  Record Representation Clause --
 291    ------------------------------------------
 292
 293    --  Parsed by P_Representation_Clause (13.1)
 294
 295    ------------------------------
 296    -- 13.5.1  Mod Clause (I.8) --
 297    ------------------------------
 298
 299    --  MOD_CLAUSE ::= at mod static_EXPRESSION;
 300
 301    --  Note: in Ada 83, the expression must be a simple expression
 302
 303    --  The caller has checked that the initial Token is AT
 304
 305    --  Error recovery: cannot raise Error_Resync
 306
 307    --  Note: the caller is responsible for setting the Pragmas_Before field
 308
 309    function P_Mod_Clause return Node_Id is
 310       Mod_Node  : Node_Id;
 311       Expr_Node : Node_Id;
 312
 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;
 323
 324    ------------------------------
 325    -- 13.5.1  Component Clause --
 326    ------------------------------
 327
 328    --  COMPONENT_CLAUSE ::=
 329    --    COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
 330    --      range FIRST_BIT .. LAST_BIT;
 331
 332    --  COMPONENT_CLAUSE_COMPONENT_NAME ::=
 333    --    component_DIRECT_NAME
 334    --  | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
 335    --  | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
 336
 337    --  POSITION ::= static_EXPRESSION
 338
 339    --  Note: in Ada 83, the expression must be a simple expression
 340
 341    --  FIRST_BIT ::= static_SIMPLE_EXPRESSION
 342    --  LAST_BIT ::= static_SIMPLE_EXPRESSION
 343
 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
 346
 347    --  Error recovery: cannot raise Error_Resync
 348
 349    function P_Component_Clause return Node_Id is
 350       Component_Node : Node_Id;
 351       Comp_Name      : Node_Id;
 352       Expr_Node      : Node_Id;
 353
 354    begin
 355       Component_Node := New_Node (N_Component_Clause, Token_Ptr);
 356       Comp_Name := P_Name;
 357
 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;
 367
 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;
 384
 385    ----------------------
 386    -- 13.5.1  Position --
 387    ----------------------
 388
 389    --  Parsed by P_Component_Clause (13.5.1)
 390
 391    -----------------------
 392    -- 13.5.1  First Bit --
 393    -----------------------
 394
 395    --  Parsed by P_Component_Clause (13.5.1)
 396
 397    ----------------------
 398    -- 13.5.1  Last Bit --
 399    ----------------------
 400
 401    --  Parsed by P_Component_Clause (13.5.1)
 402
 403    --------------------------
 404    -- 13.8  Code Statement --
 405    --------------------------
 406
 407    --  CODE_STATEMENT ::= QUALIFIED_EXPRESSION
 408
 409    --  On entry the caller has scanned the SUBTYPE_MARK (passed in as the
 410    --  single argument, and the scan points to the apostrophe.
 411
 412    --  Error recovery: can raise Error_Resync
 413
 414    function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is
 415       Node1 : Node_Id;
 416
 417    begin
 418       Scan; -- past apostrophe
 419
 420       --  If left paren, then we have a possible code statement
 421
 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;
 427
 428       --  Otherwise we have an illegal range attribute. Note that P_Name
 429       --  ensures that Token = Tok_Range is the only possibility left here.
 430
 431       else -- Token = Tok_Range
 432          Error_Msg_SC ("RANGE attribute illegal here!");
 433          raise Error_Resync;
 434       end if;
 435
 436    end P_Code_Statement;
 437
 438 end Ch13;