gcc/ada/scans.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                S C A N S                                 --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2016, 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 3,  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.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Snames; use Snames;
  33
  34 package body Scans is
  35
  36    -----------------------------
  37    -- Initialize_Ada_Keywords --
  38    -----------------------------
  39
  40    procedure Initialize_Ada_Keywords is
  41       procedure Set_Reserved (N : Name_Id; T : Token_Type);
  42       pragma Inline (Set_Reserved);
  43       --  Set given name as a reserved word (T is the corresponding token)
  44
  45       ------------------
  46       -- Set_Reserved --
  47       ------------------
  48
  49       procedure Set_Reserved (N : Name_Id; T : Token_Type) is
  50       begin
  51          --  Set up Token_Type values in Names table entries for reserved
  52          --  words. We use the Pos value of the Token_Type value. Note that
  53          --  Is_Keyword_Name relies on the fact that Token_Type'Val (0) is not
  54          --  a reserved word.
  55
  56          Set_Name_Table_Byte (N, Token_Type'Pos (T));
  57       end Set_Reserved;
  58
  59    --  Start of processing for Initialize_Ada_Keywords
  60
  61    begin
  62       --  Establish reserved words
  63
  64       Set_Reserved (Name_Abort,     Tok_Abort);
  65       Set_Reserved (Name_Abs,       Tok_Abs);
  66       Set_Reserved (Name_Abstract,  Tok_Abstract);
  67       Set_Reserved (Name_Accept,    Tok_Accept);
  68       Set_Reserved (Name_Access,    Tok_Access);
  69       Set_Reserved (Name_And,       Tok_And);
  70       Set_Reserved (Name_Aliased,   Tok_Aliased);
  71       Set_Reserved (Name_All,       Tok_All);
  72       Set_Reserved (Name_Array,     Tok_Array);
  73       Set_Reserved (Name_At,        Tok_At);
  74       Set_Reserved (Name_Begin,     Tok_Begin);
  75       Set_Reserved (Name_Body,      Tok_Body);
  76       Set_Reserved (Name_Case,      Tok_Case);
  77       Set_Reserved (Name_Constant,  Tok_Constant);
  78       Set_Reserved (Name_Declare,   Tok_Declare);
  79       Set_Reserved (Name_Delay,     Tok_Delay);
  80       Set_Reserved (Name_Delta,     Tok_Delta);
  81       Set_Reserved (Name_Digits,    Tok_Digits);
  82       Set_Reserved (Name_Do,        Tok_Do);
  83       Set_Reserved (Name_Else,      Tok_Else);
  84       Set_Reserved (Name_Elsif,     Tok_Elsif);
  85       Set_Reserved (Name_End,       Tok_End);
  86       Set_Reserved (Name_Entry,     Tok_Entry);
  87       Set_Reserved (Name_Exception, Tok_Exception);
  88       Set_Reserved (Name_Exit,      Tok_Exit);
  89       Set_Reserved (Name_For,       Tok_For);
  90       Set_Reserved (Name_Function,  Tok_Function);
  91       Set_Reserved (Name_Generic,   Tok_Generic);
  92       Set_Reserved (Name_Goto,      Tok_Goto);
  93       Set_Reserved (Name_If,        Tok_If);
  94       Set_Reserved (Name_In,        Tok_In);
  95       Set_Reserved (Name_Is,        Tok_Is);
  96       Set_Reserved (Name_Limited,   Tok_Limited);
  97       Set_Reserved (Name_Loop,      Tok_Loop);
  98       Set_Reserved (Name_Mod,       Tok_Mod);
  99       Set_Reserved (Name_New,       Tok_New);
 100       Set_Reserved (Name_Not,       Tok_Not);
 101       Set_Reserved (Name_Null,      Tok_Null);
 102       Set_Reserved (Name_Of,        Tok_Of);
 103       Set_Reserved (Name_Or,        Tok_Or);
 104       Set_Reserved (Name_Others,    Tok_Others);
 105       Set_Reserved (Name_Out,       Tok_Out);
 106       Set_Reserved (Name_Package,   Tok_Package);
 107       Set_Reserved (Name_Pragma,    Tok_Pragma);
 108       Set_Reserved (Name_Private,   Tok_Private);
 109       Set_Reserved (Name_Procedure, Tok_Procedure);
 110       Set_Reserved (Name_Protected, Tok_Protected);
 111       Set_Reserved (Name_Raise,     Tok_Raise);
 112       Set_Reserved (Name_Range,     Tok_Range);
 113       Set_Reserved (Name_Record,    Tok_Record);
 114       Set_Reserved (Name_Rem,       Tok_Rem);
 115       Set_Reserved (Name_Renames,   Tok_Renames);
 116       Set_Reserved (Name_Requeue,   Tok_Requeue);
 117       Set_Reserved (Name_Return,    Tok_Return);
 118       Set_Reserved (Name_Reverse,   Tok_Reverse);
 119       Set_Reserved (Name_Select,    Tok_Select);
 120       Set_Reserved (Name_Separate,  Tok_Separate);
 121       Set_Reserved (Name_Subtype,   Tok_Subtype);
 122       Set_Reserved (Name_Tagged,    Tok_Tagged);
 123       Set_Reserved (Name_Task,      Tok_Task);
 124       Set_Reserved (Name_Terminate, Tok_Terminate);
 125       Set_Reserved (Name_Then,      Tok_Then);
 126       Set_Reserved (Name_Type,      Tok_Type);
 127       Set_Reserved (Name_Until,     Tok_Until);
 128       Set_Reserved (Name_Use,       Tok_Use);
 129       Set_Reserved (Name_When,      Tok_When);
 130       Set_Reserved (Name_While,     Tok_While);
 131       Set_Reserved (Name_With,      Tok_With);
 132       Set_Reserved (Name_Xor,       Tok_Xor);
 133
 134       --  Ada 2005 reserved words
 135
 136       Set_Reserved (Name_Interface,    Tok_Interface);
 137       Set_Reserved (Name_Overriding,   Tok_Overriding);
 138       Set_Reserved (Name_Synchronized, Tok_Synchronized);
 139
 140       --  Ada 2012 reserved words
 141
 142       Set_Reserved (Name_Some, Tok_Some);
 143    end Initialize_Ada_Keywords;
 144
 145    ------------------
 146    -- Keyword_Name --
 147    ------------------
 148
 149    function Keyword_Name (Token : Token_Type) return Name_Id is
 150       Tok : String := Token'Img;
 151       pragma Assert (Tok (1 .. 4) = "TOK_");
 152       Name : String renames Tok (5 .. Tok'Last);
 153
 154    begin
 155       --  Convert to lower case. We don't want to add a dependence on a
 156       --  general-purpose To_Lower routine, so we convert "by hand" here.
 157       --  All keywords use 7-bit ASCII letters only, so this works.
 158
 159       for J in Name'Range loop
 160          pragma Assert (Name (J) in 'A' .. 'Z');
 161          Name (J) :=
 162            Character'Val (Character'Pos (Name (J)) +
 163              (Character'Pos ('a') - Character'Pos ('A')));
 164       end loop;
 165
 166       return Name_Find (Name);
 167    end Keyword_Name;
 168
 169    ------------------------
 170    -- Restore_Scan_State --
 171    ------------------------
 172
 173    procedure Restore_Scan_State (Saved_State : Saved_Scan_State) is
 174    begin
 175       Scan_Ptr                 := Saved_State.Save_Scan_Ptr;
 176       Token                    := Saved_State.Save_Token;
 177       Token_Ptr                := Saved_State.Save_Token_Ptr;
 178       Current_Line_Start       := Saved_State.Save_Current_Line_Start;
 179       Start_Column             := Saved_State.Save_Start_Column;
 180       Checksum                 := Saved_State.Save_Checksum;
 181       First_Non_Blank_Location := Saved_State.Save_First_Non_Blank_Location;
 182       Token_Node               := Saved_State.Save_Token_Node;
 183       Token_Name               := Saved_State.Save_Token_Name;
 184       Prev_Token               := Saved_State.Save_Prev_Token;
 185       Prev_Token_Ptr           := Saved_State.Save_Prev_Token_Ptr;
 186    end Restore_Scan_State;
 187
 188    ---------------------
 189    -- Save_Scan_State --
 190    ---------------------
 191
 192    procedure Save_Scan_State (Saved_State : out Saved_Scan_State) is
 193    begin
 194       Saved_State.Save_Scan_Ptr                 := Scan_Ptr;
 195       Saved_State.Save_Token                    := Token;
 196       Saved_State.Save_Token_Ptr                := Token_Ptr;
 197       Saved_State.Save_Current_Line_Start       := Current_Line_Start;
 198       Saved_State.Save_Start_Column             := Start_Column;
 199       Saved_State.Save_Checksum                 := Checksum;
 200       Saved_State.Save_First_Non_Blank_Location := First_Non_Blank_Location;
 201       Saved_State.Save_Token_Node               := Token_Node;
 202       Saved_State.Save_Token_Name               := Token_Name;
 203       Saved_State.Save_Prev_Token               := Prev_Token;
 204       Saved_State.Save_Prev_Token_Ptr           := Prev_Token_Ptr;
 205    end Save_Scan_State;
 206
 207 end Scans;