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