------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- P A R . C H 2 -- -- -- -- B o d y -- -- -- -- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ pragma Style_Checks (All_Checks); -- Turn off subprogram body ordering check. Subprograms are in order -- by RM section rather than alphabetical separate (Par) package body Ch2 is -- Local functions, used only in this chapter function P_Pragma_Argument_Association return Node_Id; --------------------- -- 2.3 Identifier -- --------------------- -- IDENTIFIER ::= LETTER {[UNDERLINE] LETTER_OR_DIGIT} -- LETTER_OR_DIGIT ::= IDENTIFIER_LETTER | DIGIT -- An IDENTIFIER shall not be a reserved word -- Error recovery: can raise Error_Resync (cannot return Error) function P_Identifier (C : Id_Check := None) return Node_Id is Ident_Node : Node_Id; begin -- All set if we do indeed have an identifier if Token = Tok_Identifier then -- Ada 2005 (AI-284): Compiling in Ada95 mode we notify -- that interface, overriding, and synchronized are -- new reserved words if Ada_Version = Ada_95 then if Token_Name = Name_Overriding or else Token_Name = Name_Synchronized or else (Token_Name = Name_Interface and then Prev_Token /= Tok_Pragma) then Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node); end if; end if; Ident_Node := Token_Node; Scan; -- past Identifier return Ident_Node; -- If we have a reserved identifier, manufacture an identifier with -- a corresponding name after posting an appropriate error message elsif Is_Reserved_Identifier (C) then Scan_Reserved_Identifier (Force_Msg => False); Ident_Node := Token_Node; Scan; -- past the node return Ident_Node; -- Otherwise we have junk that cannot be interpreted as an identifier else T_Identifier; -- to give message raise Error_Resync; end if; end P_Identifier; -------------------------- -- 2.3 Letter Or Digit -- -------------------------- -- Parsed by P_Identifier (2.3) -------------------------- -- 2.4 Numeric Literal -- -------------------------- -- NUMERIC_LITERAL ::= DECIMAL_LITERAL | BASED_LITERAL -- Numeric literal is returned by the scanner as either -- Tok_Integer_Literal or Tok_Real_Literal ---------------------------- -- 2.4.1 Decimal Literal -- ---------------------------- -- DECIMAL_LITERAL ::= NUMERAL [.NUMERAL] [EXPONENT] -- Handled by scanner as part of numeric lIteral handing (see 2.4) -------------------- -- 2.4.1 Numeral -- -------------------- -- NUMERAL ::= DIGIT {[UNDERLINE] DIGIT} -- Handled by scanner as part of numeric literal handling (see 2.4) --------------------- -- 2.4.1 Exponent -- --------------------- -- EXPONENT ::= E [+] NUMERAL | E - NUMERAL -- Handled by scanner as part of numeric literal handling (see 2.4) -------------------------- -- 2.4.2 Based Literal -- -------------------------- -- BASED_LITERAL ::= -- BASE # BASED_NUMERAL [.BASED_NUMERAL] # [EXPONENT] -- Handled by scanner as part of numeric literal handling (see 2.4) ----------------- -- 2.4.2 Base -- ----------------- -- BASE ::= NUMERAL -- Handled by scanner as part of numeric literal handling (see 2.4) -------------------------- -- 2.4.2 Based Numeral -- -------------------------- -- BASED_NUMERAL ::= -- EXTENDED_DIGIT {[UNDERLINE] EXTENDED_DIGIT} -- Handled by scanner as part of numeric literal handling (see 2.4) --------------------------- -- 2.4.2 Extended Digit -- --------------------------- -- EXTENDED_DIGIT ::= DIGIT | A | B | C | D | E | F -- Handled by scanner as part of numeric literal handling (see 2.4) ---------------------------- -- 2.5 Character Literal -- ---------------------------- -- CHARACTER_LITERAL ::= ' GRAPHIC_CHARACTER ' -- Handled by the scanner and returned as Tok_Character_Literal ------------------------- -- 2.6 String Literal -- ------------------------- -- STRING LITERAL ::= "{STRING_ELEMENT}" -- Handled by the scanner and returned as Tok_Character_Literal -- or if the string looks like an operator as Tok_Operator_Symbol. ------------------------- -- 2.6 String Element -- ------------------------- -- STRING_ELEMENT ::= "" | non-quotation_mark_GRAPHIC_CHARACTER -- A STRING_ELEMENT is either a pair of quotation marks ("), -- or a single GRAPHIC_CHARACTER other than a quotation mark. -- Handled by scanner as part of string literal handling (see 2.4) ------------------ -- 2.7 Comment -- ------------------ -- A COMMENT starts with two adjacent hyphens and extends up to the -- end of the line. A COMMENT may appear on any line of a program. -- Handled by the scanner which simply skips past encountered comments ----------------- -- 2.8 Pragma -- ----------------- -- PRAGMA ::= pragma IDENTIFIER -- [(PRAGMA_ARGUMENT_ASSOCIATION {, PRAGMA_ARGUMENT_ASSOCIATION})]; -- The caller has checked that the initial token is PRAGMA -- Error recovery: cannot raise Error_Resync -- One special piece of processing is needed in this routine. As described -- in the section on "Handling semicolon used in place of IS" in module -- Parse, the parser detects the case of missing subprogram bodies to -- allow recovery from this syntactic error. Pragma INTERFACE (and, for -- Ada 95, pragma IMPORT) can appear in place of the body. The parser must -- recognize the use of these two pragmas in this context, otherwise it -- will think there are missing bodies, and try to change ; to IS, when -- in fact the bodies ARE present, supplied by these pragmas. function P_Pragma return Node_Id is Interface_Check_Required : Boolean := False; -- Set True if check of pragma INTERFACE is required Import_Check_Required : Boolean := False; -- Set True if check of pragma IMPORT is required Arg_Count : Int := 0; -- Number of argument associations processed Pragma_Node : Node_Id; Pragma_Name : Name_Id; Semicolon_Loc : Source_Ptr; Ident_Node : Node_Id; Assoc_Node : Node_Id; Result : Node_Id; procedure Skip_Pragma_Semicolon; -- Skip past semicolon at end of pragma --------------------------- -- Skip_Pragma_Semicolon -- --------------------------- procedure Skip_Pragma_Semicolon is begin if Token /= Tok_Semicolon then T_Semicolon; Resync_Past_Semicolon; else Scan; -- past semicolon end if; end Skip_Pragma_Semicolon; -- Start of processing for P_Pragma begin Pragma_Node := New_Node (N_Pragma, Token_Ptr); Scan; -- past PRAGMA Pragma_Name := Token_Name; if Style_Check then Style.Check_Pragma_Name; end if; -- Ada 2005 (AI-284): INTERFACE is a new reserved word but it is -- allowed as a pragma name. if Ada_Version >= Ada_05 and then Token = Tok_Interface then Pragma_Name := Name_Interface; Ident_Node := Token_Node; Scan; -- past INTERFACE else Ident_Node := P_Identifier; Delete_Node (Ident_Node); end if; Set_Chars (Pragma_Node, Pragma_Name); -- See if special INTERFACE/IMPORT check is required if SIS_Entry_Active then Interface_Check_Required := (Pragma_Name = Name_Interface); Import_Check_Required := (Pragma_Name = Name_Import); else Interface_Check_Required := False; Import_Check_Required := False; end if; -- Scan arguments. We assume that arguments are present if there is -- a left paren, or if a semicolon is missing and there is another -- token on the same line as the pragma name. if Token = Tok_Left_Paren or else (Token /= Tok_Semicolon and then not Token_Is_At_Start_Of_Line) then Set_Pragma_Argument_Associations (Pragma_Node, New_List); T_Left_Paren; loop Arg_Count := Arg_Count + 1; Assoc_Node := P_Pragma_Argument_Association; if Arg_Count = 2 and then (Interface_Check_Required or else Import_Check_Required) then -- Here is where we cancel the SIS active status if this pragma -- supplies a body for the currently active subprogram spec. if Nkind (Expression (Assoc_Node)) in N_Direct_Name and then Chars (Expression (Assoc_Node)) = Chars (SIS_Labl) then SIS_Entry_Active := False; end if; end if; Append (Assoc_Node, Pragma_Argument_Associations (Pragma_Node)); exit when Token /= Tok_Comma; Scan; -- past comma end loop; -- If we have := for pragma Debug, it is worth special casing -- the error message (it is easy to think of pragma Debug as -- taking a statement, and an assignment statement is the most -- likely candidate for this error) if Token = Tok_Colon_Equal and then Pragma_Name = Name_Debug then Error_Msg_SC ("argument for pragma Debug must be procedure call"); Resync_To_Semicolon; -- Normal case, we expect a right paren here else T_Right_Paren; end if; end if; Semicolon_Loc := Token_Ptr; -- Now we have two tasks left, we need to scan out the semicolon -- following the pragma, and we have to call Par.Prag to process -- the pragma. Normally we do them in this order, however, there -- is one exception namely pragma Style_Checks where we like to -- skip the semicolon after processing the pragma, since that way -- the style checks for the scanning of the semicolon follow the -- settings of the pragma. -- You might think we could just unconditionally do things in -- the opposite order, but there are other pragmas, notably the -- case of pragma Source_File_Name, which assume the semicolon -- is already scanned out. if Chars (Pragma_Node) = Name_Style_Checks then Result := Par.Prag (Pragma_Node, Semicolon_Loc); Skip_Pragma_Semicolon; return Result; else Skip_Pragma_Semicolon; return Par.Prag (Pragma_Node, Semicolon_Loc); end if; exception when Error_Resync => Resync_Past_Semicolon; return Error; end P_Pragma; -- This routine is called if a pragma is encountered in an inappropriate -- position, the pragma is scanned out and control returns to continue. -- The caller has checked that the initial token is pragma -- Error recovery: cannot raise Error_Resync procedure P_Pragmas_Misplaced is begin while Token = Tok_Pragma loop Error_Msg_SC ("pragma not allowed here"); Discard_Junk_Node (P_Pragma); end loop; end P_Pragmas_Misplaced; -- This function is called to scan out an optional sequence of pragmas. -- If no pragmas are found, then No_List is returned. -- Error recovery: Cannot raise Error_Resync function P_Pragmas_Opt return List_Id is L : List_Id; begin if Token = Tok_Pragma then L := New_List; P_Pragmas_Opt (L); return L; else return No_List; end if; end P_Pragmas_Opt; -- This procedure is called to scan out an optional sequence of pragmas. -- Any pragmas found are appended to the list provided as an argument. -- Error recovery: Cannot raise Error_Resync procedure P_Pragmas_Opt (List : List_Id) is P : Node_Id; begin while Token = Tok_Pragma loop P := P_Pragma; if Chars (P) = Name_Assert or else Chars (P) = Name_Debug then Error_Msg_Name_1 := Chars (P); Error_Msg_N ("pragma% must be in declaration/statement context", P); else Append (P, List); end if; end loop; end P_Pragmas_Opt; -------------------------------------- -- 2.8 Pragma_Argument Association -- -------------------------------------- -- PRAGMA_ARGUMENT_ASSOCIATION ::= -- [pragma_argument_IDENTIFIER =>] NAME -- | [pragma_argument_IDENTIFIER =>] EXPRESSION -- Error recovery: cannot raise Error_Resync function P_Pragma_Argument_Association return Node_Id is Scan_State : Saved_Scan_State; Pragma_Arg_Node : Node_Id; Identifier_Node : Node_Id; begin Pragma_Arg_Node := New_Node (N_Pragma_Argument_Association, Token_Ptr); Set_Chars (Pragma_Arg_Node, No_Name); if Token = Tok_Identifier then Identifier_Node := Token_Node; Save_Scan_State (Scan_State); -- at Identifier Scan; -- past Identifier if Token = Tok_Arrow then Scan; -- past arrow Set_Chars (Pragma_Arg_Node, Chars (Identifier_Node)); Delete_Node (Identifier_Node); else Restore_Scan_State (Scan_State); -- to Identifier end if; end if; Set_Expression (Pragma_Arg_Node, P_Expression); return Pragma_Arg_Node; end P_Pragma_Argument_Association; end Ch2;