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