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 --                                                                          --
  10 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  11 --                                                                          --
  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.                                                      --
  22 --                                                                          --
  23 -- GNAT was originally developed  by the GNAT team at  New York University. --
  24 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  25 --                                                                          --
  26 ------------------------------------------------------------------------------
  27
  28 pragma Style_Checks (All_Checks);
  29 --  Turn off subprogram body ordering check. Subprograms are in order
  30 --  by RM section rather than alphabetical
  31
  32 separate (Par)
  33 package body Ch13 is
  34
  35    --  Local functions, used only in this chapter
  36
  37    function P_Component_Clause return Node_Id;
  38    function P_Mod_Clause return Node_Id;
  39
  40    --------------------------------------------
  41    -- 13.1  Representation Clause (also I.7) --
  42    --------------------------------------------
  43
  44    --  REPRESENTATION_CLAUSE ::=
  45    --    ATTRIBUTE_DEFINITION_CLAUSE
  46    --  | ENUMERATION_REPRESENTATION_CLAUSE
  47    --  | RECORD_REPRESENTATION_CLAUSE
  48    --  | AT_CLAUSE
  49
  50    --  ATTRIBUTE_DEFINITION_CLAUSE ::=
  51    --    for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
  52    --  | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
  53
  54    --  Note: in Ada 83, the expression must be a simple expression
  55
  56    --  AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
  57
  58    --  Note: in Ada 83, the expression must be a simple expression
  59
  60    --  ENUMERATION_REPRESENTATION_CLAUSE ::=
  61    --    for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
  62
  63    --  ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
  64
  65    --  RECORD_REPRESENTATION_CLAUSE ::=
  66    --    for first_subtype_LOCAL_NAME use
  67    --      record [MOD_CLAUSE]
  68    --        {COMPONENT_CLAUSE}
  69    --      end record;
  70
  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 ???
  73
  74    --  The caller has checked that the initial token is FOR
  75
  76    --  Error recovery: cannot raise Error_Resync, if an error occurs,
  77    --  the scan is repositioned past the next semicolon.
  78
  79    function P_Representation_Clause return Node_Id is
  80       For_Loc         : Source_Ptr;
  81       Name_Node       : Node_Id;
  82       Prefix_Node     : Node_Id;
  83       Attr_Name       : Name_Id;
  84       Identifier_Node : Node_Id;
  85       Rep_Clause_Node : Node_Id;
  86       Expr_Node       : Node_Id;
  87       Record_Items    : List_Id;
  88
  89    begin
  90       For_Loc := Token_Ptr;
  91       Scan; -- past FOR
  92
  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!
  95
  96       Identifier_Node := P_Identifier;
  97
  98       --  Check case of qualified name to give good error message
  99
 100       if Token = Tok_Dot then
 101          Error_Msg_SC
 102             ("representation clause requires simple name!");
 103
 104          loop
 105             exit when Token /= Tok_Dot;
 106             Scan; -- past dot
 107             Discard_Junk_Node (P_Identifier);
 108          end loop;
 109       end if;
 110
 111       --  Attribute Definition Clause
 112
 113       if Token = Tok_Apostrophe then
 114
 115          --  Allow local names of the form a'b'.... This enables
 116          --  us to parse class-wide streams attributes correctly.
 117
 118          Name_Node := Identifier_Node;
 119          while Token = Tok_Apostrophe loop
 120
 121             Scan; -- past apostrophe
 122
 123             Identifier_Node := Token_Node;
 124             Attr_Name := No_Name;
 125
 126             if Token = Tok_Identifier then
 127                Attr_Name := Token_Name;
 128
 129                if not Is_Attribute_Name (Attr_Name) then
 130                   Signal_Bad_Attribute;
 131                end if;
 132
 133                if Style_Check then
 134                   Style.Check_Attribute_Name (False);
 135                end if;
 136
 137             --  Here for case of attribute designator is not an identifier
 138
 139             else
 140                if Token = Tok_Delta then
 141                   Attr_Name := Name_Delta;
 142
 143                elsif Token = Tok_Digits then
 144                   Attr_Name := Name_Digits;
 145
 146                elsif Token = Tok_Access then
 147                   Attr_Name := Name_Access;
 148
 149                else
 150                   Error_Msg_AP ("attribute designator expected");
 151                   raise Error_Resync;
 152                end if;
 153
 154                if Style_Check then
 155                   Style.Check_Attribute_Name (True);
 156                end if;
 157             end if;
 158
 159             --  We come here with an OK attribute scanned, and the
 160             --  corresponding Attribute identifier node stored in Ident_Node.
 161
 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);
 166             Scan;
 167          end loop;
 168
 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);
 172          T_Use;
 173
 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);
 177
 178       else
 179          TF_Use;
 180          Rep_Clause_Node := Empty;
 181
 182          --  AT follows USE (At Clause)
 183
 184          if Token = Tok_At then
 185             Scan; -- past AT
 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);
 191
 192          --  RECORD follows USE (Record Representation Clause)
 193
 194          elsif Token = Tok_Record then
 195             Record_Items := P_Pragmas_Opt;
 196             Rep_Clause_Node :=
 197               New_Node (N_Record_Representation_Clause, For_Loc);
 198             Set_Identifier (Rep_Clause_Node, Identifier_Node);
 199
 200             Push_Scope_Stack;
 201             Scope.Table (Scope.Last).Etyp := E_Record;
 202             Scope.Table (Scope.Last).Ecol := Start_Column;
 203             Scope.Table (Scope.Last).Sloc := Token_Ptr;
 204             Scan; -- past RECORD
 205             Record_Items := P_Pragmas_Opt;
 206
 207             --  Possible Mod Clause
 208
 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;
 213             end if;
 214
 215             if No (Record_Items) then
 216                Record_Items := New_List;
 217             end if;
 218
 219             Set_Component_Clauses (Rep_Clause_Node, Record_Items);
 220
 221             --  Loop through component clauses
 222
 223             loop
 224                if Token not in Token_Class_Name then
 225                   exit when Check_End;
 226                end if;
 227
 228                Append (P_Component_Clause, Record_Items);
 229                P_Pragmas_Opt (Record_Items);
 230             end loop;
 231
 232          --  Left paren follows USE (Enumeration Representation Clause)
 233
 234          elsif Token = Tok_Left_Paren then
 235             Rep_Clause_Node :=
 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);
 239
 240          --  Some other token follows FOR (invalid representation clause)
 241
 242          else
 243             Error_Msg_SC ("invalid representation clause");
 244             raise Error_Resync;
 245          end if;
 246       end if;
 247
 248       TF_Semicolon;
 249       return Rep_Clause_Node;
 250
 251    exception
 252       when Error_Resync =>
 253          Resync_Past_Semicolon;
 254          return Error;
 255
 256    end P_Representation_Clause;
 257
 258    ----------------------
 259    -- 13.1  Local Name --
 260    ----------------------
 261
 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???
 266
 267    ---------------------------
 268    -- 13.1  At Clause (I.7) --
 269    ---------------------------
 270
 271    --  Parsed by P_Representation_Clause (13.1)
 272
 273    ---------------------------------------
 274    -- 13.3  Attribute Definition Clause --
 275    ---------------------------------------
 276
 277    --  Parsed by P_Representation_Clause (13.1)
 278
 279    ---------------------------------------------
 280    -- 13.4  Enumeration Representation Clause --
 281    ---------------------------------------------
 282
 283    --  Parsed by P_Representation_Clause (13.1)
 284
 285    ---------------------------------
 286    -- 13.4  Enumeration Aggregate --
 287    ---------------------------------
 288
 289    --  Parsed by P_Representation_Clause (13.1)
 290
 291    ------------------------------------------
 292    -- 13.5.1  Record Representation Clause --
 293    ------------------------------------------
 294
 295    --  Parsed by P_Representation_Clause (13.1)
 296
 297    ------------------------------
 298    -- 13.5.1  Mod Clause (I.8) --
 299    ------------------------------
 300
 301    --  MOD_CLAUSE ::= at mod static_EXPRESSION;
 302
 303    --  Note: in Ada 83, the expression must be a simple expression
 304
 305    --  The caller has checked that the initial Token is AT
 306
 307    --  Error recovery: cannot raise Error_Resync
 308
 309    --  Note: the caller is responsible for setting the Pragmas_Before field
 310
 311    function P_Mod_Clause return Node_Id is
 312       Mod_Node  : Node_Id;
 313       Expr_Node : Node_Id;
 314
 315    begin
 316       Mod_Node := New_Node (N_Mod_Clause, Token_Ptr);
 317       Scan; -- past AT
 318       T_Mod;
 319       Expr_Node := P_Expression_No_Right_Paren;
 320       Check_Simple_Expression_In_Ada_83 (Expr_Node);
 321       Set_Expression (Mod_Node, Expr_Node);
 322       TF_Semicolon;
 323       return Mod_Node;
 324    end P_Mod_Clause;
 325
 326    ------------------------------
 327    -- 13.5.1  Component Clause --
 328    ------------------------------
 329
 330    --  COMPONENT_CLAUSE ::=
 331    --    COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
 332    --      range FIRST_BIT .. LAST_BIT;
 333
 334    --  COMPONENT_CLAUSE_COMPONENT_NAME ::=
 335    --    component_DIRECT_NAME
 336    --  | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
 337    --  | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
 338
 339    --  POSITION ::= static_EXPRESSION
 340
 341    --  Note: in Ada 83, the expression must be a simple expression
 342
 343    --  FIRST_BIT ::= static_SIMPLE_EXPRESSION
 344    --  LAST_BIT ::= static_SIMPLE_EXPRESSION
 345
 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
 348
 349    --  Error recovery: cannot raise Error_Resync
 350
 351    function P_Component_Clause return Node_Id is
 352       Component_Node : Node_Id;
 353       Comp_Name      : Node_Id;
 354       Expr_Node      : Node_Id;
 355
 356    begin
 357       Component_Node := New_Node (N_Component_Clause, Token_Ptr);
 358       Comp_Name := P_Name;
 359
 360       if Nkind (Comp_Name) = N_Identifier
 361         or else Nkind (Comp_Name) = N_Attribute_Reference
 362       then
 363          Set_Component_Name (Component_Node, Comp_Name);
 364       else
 365          Error_Msg_N
 366            ("component name must be direct name or attribute", Comp_Name);
 367          Set_Component_Name (Component_Node, Error);
 368       end if;
 369
 370       Set_Sloc (Component_Node, Token_Ptr);
 371       T_At;
 372       Expr_Node := P_Expression_No_Right_Paren;
 373       Check_Simple_Expression_In_Ada_83 (Expr_Node);
 374       Set_Position (Component_Node, Expr_Node);
 375       T_Range;
 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);
 379       T_Dot_Dot;
 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);
 383       TF_Semicolon;
 384       return Component_Node;
 385    end P_Component_Clause;
 386
 387    ----------------------
 388    -- 13.5.1  Position --
 389    ----------------------
 390
 391    --  Parsed by P_Component_Clause (13.5.1)
 392
 393    -----------------------
 394    -- 13.5.1  First Bit --
 395    -----------------------
 396
 397    --  Parsed by P_Component_Clause (13.5.1)
 398
 399    ----------------------
 400    -- 13.5.1  Last Bit --
 401    ----------------------
 402
 403    --  Parsed by P_Component_Clause (13.5.1)
 404
 405    --------------------------
 406    -- 13.8  Code Statement --
 407    --------------------------
 408
 409    --  CODE_STATEMENT ::= QUALIFIED_EXPRESSION
 410
 411    --  On entry the caller has scanned the SUBTYPE_MARK (passed in as the
 412    --  single argument, and the scan points to the apostrophe.
 413
 414    --  Error recovery: can raise Error_Resync
 415
 416    function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is
 417       Node1 : Node_Id;
 418
 419    begin
 420       Scan; -- past apostrophe
 421
 422       --  If left paren, then we have a possible code statement
 423
 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));
 427          TF_Semicolon;
 428          return Node1;
 429
 430       --  Otherwise we have an illegal range attribute. Note that P_Name
 431       --  ensures that Token = Tok_Range is the only possibility left here.
 432
 433       else -- Token = Tok_Range
 434          Error_Msg_SC ("RANGE attribute illegal here!");
 435          raise Error_Resync;
 436       end if;
 437
 438    end P_Code_Statement;
 439
 440 end Ch13;