gcc/ada/par-ch2.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              P A R . C H 2                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision$
  10 --                                                                          --
  11 --          Copyright (C) 1992-2002 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 Ch2 is
  35
  36    --  Local functions, used only in this chapter
  37
  38    function P_Pragma_Argument_Association return Node_Id;
  39
  40    ---------------------
  41    -- 2.3  Identifier --
  42    ---------------------
  43
  44    --  IDENTIFIER ::= LETTER {[UNDERLINE] LETTER_OR_DIGIT}
  45
  46    --  LETTER_OR_DIGIT ::= IDENTIFIER_LETTER | DIGIT
  47
  48    --  An IDENTIFIER shall not be a reserved word
  49
  50    --  Error recovery: can raise Error_Resync (cannot return Error)
  51
  52    function P_Identifier return Node_Id is
  53       Ident_Node : Node_Id;
  54
  55    begin
  56       --  All set if we do indeed have an identifier
  57
  58       if Token = Tok_Identifier then
  59          Ident_Node := Token_Node;
  60          Scan; -- past Identifier
  61          return Ident_Node;
  62
  63       --  If we have a reserved identifier, manufacture an identifier with
  64       --  a corresponding name after posting an appropriate error message
  65
  66       elsif Is_Reserved_Identifier then
  67          Scan_Reserved_Identifier (Force_Msg => False);
  68          Ident_Node := Token_Node;
  69          Scan; -- past the node
  70          return Ident_Node;
  71
  72       --  Otherwise we have junk that cannot be interpreted as an identifier
  73
  74       else
  75          T_Identifier; -- to give message
  76          raise Error_Resync;
  77       end if;
  78    end P_Identifier;
  79
  80    --------------------------
  81    -- 2.3  Letter Or Digit --
  82    --------------------------
  83
  84    --  Parsed by P_Identifier (2.3)
  85
  86    --------------------------
  87    -- 2.4  Numeric Literal --
  88    --------------------------
  89
  90    --  NUMERIC_LITERAL ::= DECIMAL_LITERAL | BASED_LITERAL
  91
  92    --  Numeric literal is returned by the scanner as either
  93    --  Tok_Integer_Literal or Tok_Real_Literal
  94
  95    ----------------------------
  96    -- 2.4.1  Decimal Literal --
  97    ----------------------------
  98
  99    --  DECIMAL_LITERAL ::= NUMERAL [.NUMERAL] [EXPONENT]
 100
 101    --  Handled by scanner as part of numeric lIteral handing (see 2.4)
 102
 103    --------------------
 104    -- 2.4.1  Numeral --
 105    --------------------
 106
 107    --  NUMERAL ::= DIGIT {[UNDERLINE] DIGIT}
 108
 109    --  Handled by scanner as part of numeric literal handling (see 2.4)
 110
 111    ---------------------
 112    -- 2.4.1  Exponent --
 113    ---------------------
 114
 115    --  EXPONENT ::= E [+] NUMERAL | E - NUMERAL
 116
 117    --  Handled by scanner as part of numeric literal handling (see 2.4)
 118
 119    --------------------------
 120    -- 2.4.2  Based Literal --
 121    --------------------------
 122
 123    --  BASED_LITERAL ::=
 124    --   BASE # BASED_NUMERAL [.BASED_NUMERAL] # [EXPONENT]
 125
 126    --  Handled by scanner as part of numeric literal handling (see 2.4)
 127
 128    -----------------
 129    -- 2.4.2  Base --
 130    -----------------
 131
 132    --  BASE ::= NUMERAL
 133
 134    --  Handled by scanner as part of numeric literal handling (see 2.4)
 135
 136    --------------------------
 137    -- 2.4.2  Based Numeral --
 138    --------------------------
 139
 140    --  BASED_NUMERAL ::=
 141    --    EXTENDED_DIGIT {[UNDERLINE] EXTENDED_DIGIT}
 142
 143    --  Handled by scanner as part of numeric literal handling (see 2.4)
 144
 145    ---------------------------
 146    -- 2.4.2  Extended Digit --
 147    ---------------------------
 148
 149    --  EXTENDED_DIGIT ::= DIGIT | A | B | C | D | E | F
 150
 151    --  Handled by scanner as part of numeric literal handling (see 2.4)
 152
 153    ----------------------------
 154    -- 2.5  Character Literal --
 155    ----------------------------
 156
 157    --  CHARACTER_LITERAL ::= ' GRAPHIC_CHARACTER '
 158
 159    --  Handled by the scanner and returned as Tok_Character_Literal
 160
 161    -------------------------
 162    -- 2.6  String Literal --
 163    -------------------------
 164
 165    --  STRING LITERAL ::= "{STRING_ELEMENT}"
 166
 167    --  Handled by the scanner and returned as Tok_Character_Literal
 168    --  or if the string looks like an operator as Tok_Operator_Symbol.
 169
 170    -------------------------
 171    -- 2.6  String Element --
 172    -------------------------
 173
 174    --  STRING_ELEMENT ::= "" | non-quotation_mark_GRAPHIC_CHARACTER
 175
 176    --  A STRING_ELEMENT is either a pair of quotation marks ("),
 177    --  or a single GRAPHIC_CHARACTER other than a quotation mark.
 178
 179    --  Handled by scanner as part of string literal handling (see 2.4)
 180
 181    ------------------
 182    -- 2.7  Comment --
 183    ------------------
 184
 185    --  A COMMENT starts with two adjacent hyphens and extends up to the
 186    --  end of the line. A COMMENT may appear on any line of a program.
 187
 188    --  Handled by the scanner which simply skips past encountered comments
 189
 190    -----------------
 191    -- 2.8  Pragma --
 192    -----------------
 193
 194    --  PRAGMA ::= pragma IDENTIFIER
 195    --    [(PRAGMA_ARGUMENT_ASSOCIATION {, PRAGMA_ARGUMENT_ASSOCIATION})];
 196
 197    --  The caller has checked that the initial token is PRAGMA
 198
 199    --  Error recovery: cannot raise Error_Resync
 200
 201    --  One special piece of processing is needed in this routine. As described
 202    --  in the section on "Handling semicolon used in place of IS" in module
 203    --  Parse, the parser detects the case of missing subprogram bodies to
 204    --  allow recovery from this syntactic error. Pragma INTERFACE (and, for
 205    --  Ada 95, pragma IMPORT) can appear in place of the body. The parser must
 206    --  recognize the use of these two pragmas in this context, otherwise it
 207    --  will think there are missing bodies, and try to change ; to IS, when
 208    --  in fact the bodies ARE present, supplied by these pragmas.
 209
 210    function P_Pragma return Node_Id is
 211
 212       Interface_Check_Required : Boolean := False;
 213       --  Set True if check of pragma INTERFACE is required
 214
 215       Import_Check_Required : Boolean := False;
 216       --  Set True if check of pragma IMPORT is required
 217
 218       Arg_Count : Int := 0;
 219       --  Number of argument associations processed
 220
 221       Pragma_Node   : Node_Id;
 222       Pragma_Name   : Name_Id;
 223       Semicolon_Loc : Source_Ptr;
 224       Ident_Node    : Node_Id;
 225       Assoc_Node    : Node_Id;
 226       Result        : Node_Id;
 227
 228       procedure Skip_Pragma_Semicolon;
 229       --  Skip past semicolon at end of pragma
 230
 231       ---------------------------
 232       -- Skip_Pragma_Semicolon --
 233       ---------------------------
 234
 235       procedure Skip_Pragma_Semicolon is
 236       begin
 237          if Token /= Tok_Semicolon then
 238             T_Semicolon;
 239             Resync_Past_Semicolon;
 240          else
 241             Scan; -- past semicolon
 242          end if;
 243       end Skip_Pragma_Semicolon;
 244
 245    --  Start of processing for P_Pragma
 246
 247    begin
 248       Pragma_Node := New_Node (N_Pragma, Token_Ptr);
 249       Scan; -- past PRAGMA
 250       Pragma_Name := Token_Name;
 251
 252       if Style_Check then
 253          Style.Check_Pragma_Name;
 254       end if;
 255
 256       Ident_Node := P_Identifier;
 257       Set_Chars (Pragma_Node, Pragma_Name);
 258       Delete_Node (Ident_Node);
 259
 260       --  See if special INTERFACE/IMPORT check is required
 261
 262       if SIS_Entry_Active then
 263          Interface_Check_Required := (Pragma_Name = Name_Interface);
 264          Import_Check_Required    := (Pragma_Name = Name_Import);
 265       else
 266          Interface_Check_Required := False;
 267          Import_Check_Required    := False;
 268       end if;
 269
 270       --  Scan arguments. We assume that arguments are present if there is
 271       --  a left paren, or if a semicolon is missing and there is another
 272       --  token on the same line as the pragma name.
 273
 274       if Token = Tok_Left_Paren
 275         or else (Token /= Tok_Semicolon
 276                    and then not Token_Is_At_Start_Of_Line)
 277       then
 278          Set_Pragma_Argument_Associations (Pragma_Node, New_List);
 279          T_Left_Paren;
 280
 281          loop
 282             Arg_Count := Arg_Count + 1;
 283             Assoc_Node := P_Pragma_Argument_Association;
 284
 285             if Arg_Count = 2
 286               and then (Interface_Check_Required or else Import_Check_Required)
 287             then
 288                --  Here is where we cancel the SIS active status if this pragma
 289                --  supplies a body for the currently active subprogram spec.
 290
 291                if Nkind (Expression (Assoc_Node)) in N_Direct_Name
 292                  and then Chars (Expression (Assoc_Node)) = Chars (SIS_Labl)
 293                then
 294                   SIS_Entry_Active := False;
 295                end if;
 296             end if;
 297
 298             Append (Assoc_Node, Pragma_Argument_Associations (Pragma_Node));
 299             exit when Token /= Tok_Comma;
 300             Scan; -- past comma
 301          end loop;
 302
 303          T_Right_Paren;
 304       end if;
 305
 306       Semicolon_Loc := Token_Ptr;
 307
 308       --  Now we have two tasks left, we need to scan out the semicolon
 309       --  following the pragma, and we have to call Par.Prag to process
 310       --  the pragma. Normally we do them in this order, however, there
 311       --  is one exception namely pragma Style_Checks where we like to
 312       --  skip the semicolon after processing the pragma, since that way
 313       --  the style checks for the scanning of the semicolon follow the
 314       --  settings of the pragma.
 315
 316       --  You might think we could just unconditionally do things in
 317       --  the opposite order, but there are other pragmas, notably the
 318       --  case of pragma Source_File_Name, which assume the semicolon
 319       --  is already scanned out.
 320
 321       if Chars (Pragma_Node) = Name_Style_Checks then
 322          Result := Par.Prag (Pragma_Node, Semicolon_Loc);
 323          Skip_Pragma_Semicolon;
 324          return Result;
 325       else
 326          Skip_Pragma_Semicolon;
 327          return Par.Prag (Pragma_Node, Semicolon_Loc);
 328       end if;
 329
 330    exception
 331       when Error_Resync =>
 332          Resync_Past_Semicolon;
 333          return Error;
 334
 335    end P_Pragma;
 336
 337    --  This routine is called if a pragma is encountered in an inappropriate
 338    --  position, the pragma is scanned out and control returns to continue.
 339
 340    --  The caller has checked that the initial token is pragma
 341
 342    --  Error recovery: cannot raise Error_Resync
 343
 344    procedure P_Pragmas_Misplaced is
 345    begin
 346       while Token = Tok_Pragma loop
 347          Error_Msg_SC ("pragma not allowed here");
 348          Discard_Junk_Node (P_Pragma);
 349       end loop;
 350    end P_Pragmas_Misplaced;
 351
 352    --  This function is called to scan out an optional sequence of pragmas.
 353    --  If no pragmas are found, then No_List is returned.
 354
 355    --  Error recovery: Cannot raise Error_Resync
 356
 357    function P_Pragmas_Opt return List_Id is
 358       L : List_Id;
 359
 360    begin
 361       if Token = Tok_Pragma then
 362          L := New_List;
 363          P_Pragmas_Opt (L);
 364          return L;
 365
 366       else
 367          return No_List;
 368       end if;
 369    end P_Pragmas_Opt;
 370
 371    --  This procedure is called to scan out an optional sequence of pragmas.
 372    --  Any pragmas found are appended to the list provided as an argument.
 373
 374    --  Error recovery: Cannot raise Error_Resync
 375
 376    procedure P_Pragmas_Opt (List : List_Id) is
 377       P : Node_Id;
 378
 379    begin
 380       while Token = Tok_Pragma loop
 381          P := P_Pragma;
 382
 383          if Chars (P) = Name_Assert or else Chars (P) = Name_Debug then
 384             Error_Msg_Name_1 := Chars (P);
 385             Error_Msg_N
 386               ("pragma% must be in declaration/statement context", P);
 387          else
 388             Append (P, List);
 389          end if;
 390       end loop;
 391    end P_Pragmas_Opt;
 392
 393    --------------------------------------
 394    -- 2.8  Pragma_Argument Association --
 395    --------------------------------------
 396
 397    --  PRAGMA_ARGUMENT_ASSOCIATION ::=
 398    --    [pragma_argument_IDENTIFIER =>] NAME
 399    --  | [pragma_argument_IDENTIFIER =>] EXPRESSION
 400
 401    --  Error recovery: cannot raise Error_Resync
 402
 403    function P_Pragma_Argument_Association return Node_Id is
 404       Scan_State      : Saved_Scan_State;
 405       Pragma_Arg_Node : Node_Id;
 406       Identifier_Node : Node_Id;
 407
 408    begin
 409       Pragma_Arg_Node := New_Node (N_Pragma_Argument_Association, Token_Ptr);
 410       Set_Chars (Pragma_Arg_Node, No_Name);
 411
 412       if Token = Tok_Identifier then
 413          Identifier_Node := Token_Node;
 414          Save_Scan_State (Scan_State); -- at Identifier
 415          Scan; -- past Identifier
 416
 417          if Token = Tok_Arrow then
 418             Scan; -- past arrow
 419             Set_Chars (Pragma_Arg_Node, Chars (Identifier_Node));
 420             Delete_Node (Identifier_Node);
 421          else
 422             Restore_Scan_State (Scan_State); -- to Identifier
 423          end if;
 424       end if;
 425
 426       Set_Expression (Pragma_Arg_Node, P_Expression);
 427       return Pragma_Arg_Node;
 428
 429    end P_Pragma_Argument_Association;
 430
 431 end Ch2;