Geek Gadgets 1

home *** CD-ROM | disk | FTP | other *** search

/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / par-ch2.adb < prev next >

Wrap

Text File | 1996-09-28 | 12KB | 368 lines

------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- P A R . C H 2 -- -- -- -- B o d y -- -- -- -- $Revision: 1.28 $ -- -- -- -- Copyright (c) 1992,1993,1994 NYU, All Rights Reserved -- -- -- -- 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, 675 Mass Ave, Cambridge, MA 02139, USA. -- -- -- ------------------------------------------------------------------------------ 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 return Node_Id is Ident_Node : Node_Id; begin -- All set if we do indeed have an identifier if Token = Tok_Identifier then 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 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; 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; Ident_Node := P_Identifier; Set_Chars (Pragma_Node, Pragma_Name); Delete_Node (Ident_Node); -- 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; 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 Token in Token_Class_Desig then if Token_Name = Chars (SIS_Labl) then SIS_Entry_Active := False; end if; end if; end if; Append (P_Pragma_Argument_Association, Pragma_Argument_Associations (Pragma_Node)); exit when Token /= Tok_Comma; Scan; -- past comma end loop; T_Right_Paren; end if; Semicolon_Loc := Token_Ptr; if Token /= Tok_Semicolon then T_Semicolon; Resync_Past_Semicolon; else Scan; -- past semicolon end if; if Is_Pragma_Name (Chars (Pragma_Node)) then return Par.Prag (Pragma_Node, Semicolon_Loc); else Error_Msg_Node_1 := Pragma_Node; Error_Msg ("unrecognized pragma&?!", Sloc (Pragma_Node)); return Error; 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 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 begin while Token = Tok_Pragma loop Append (P_Pragma, List); 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;