blob: 4d49e7af7385261ca858665f6b1a247978adc2d2 [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P A R . T C H K --
-- --
-- B o d y --
-- --
-- $Revision: 1.37 $
-- --
-- Copyright (C) 1992-2001 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- Token scan routines.
-- Error recovery: none of the T_xxx or TF_xxx routines raise Error_Resync
separate (Par)
package body Tchk is
type Position is (SC, BC, AP);
-- Specify position of error message (see Error_Msg_SC/BC/AP)
-----------------------
-- Local Subprograms --
-----------------------
procedure Check_Token (T : Token_Type; P : Position);
pragma Inline (Check_Token);
-- Called by T_xx routines to check for reserved keyword token. P is the
-- position of the error message if the token is missing (see Wrong_Token)
procedure Wrong_Token (T : Token_Type; P : Position);
-- Called when scanning a reserved keyword when the keyword is not
-- present. T is the token type for the keyword, and P indicates the
-- position to be used to place a message relative to the current
-- token if the keyword is not located nearby.
-----------------
-- Check_Token --
-----------------
procedure Check_Token (T : Token_Type; P : Position) is
begin
if Token = T then
Scan;
return;
else
Wrong_Token (T, P);
end if;
end Check_Token;
-------------
-- T_Abort --
-------------
procedure T_Abort is
begin
Check_Token (Tok_Abort, SC);
end T_Abort;
-------------
-- T_Arrow --
-------------
procedure T_Arrow is
begin
if Token = Tok_Arrow then
Scan;
-- A little recovery helper, accept then in place of =>
elsif Token = Tok_Then then
Error_Msg_BC ("missing ""=>""");
Scan; -- past THEN used in place of =>
elsif Token = Tok_Colon_Equal then
Error_Msg_SC (""":="" should be ""=>""");
Scan; -- past := used in place of =>
else
Error_Msg_AP ("missing ""=>""");
end if;
end T_Arrow;
----------
-- T_At --
----------
procedure T_At is
begin
Check_Token (Tok_At, SC);
end T_At;
------------
-- T_Body --
------------
procedure T_Body is
begin
Check_Token (Tok_Body, BC);
end T_Body;
-----------
-- T_Box --
-----------
procedure T_Box is
begin
if Token = Tok_Box then
Scan;
else
Error_Msg_AP ("missing ""<>""");
end if;
end T_Box;
-------------
-- T_Colon --
-------------
procedure T_Colon is
begin
if Token = Tok_Colon then
Scan;
else
Error_Msg_AP ("missing "":""");
end if;
end T_Colon;
-------------------
-- T_Colon_Equal --
-------------------
procedure T_Colon_Equal is
begin
if Token = Tok_Colon_Equal then
Scan;
elsif Token = Tok_Equal then
Error_Msg_SC ("""="" should be "":=""");
Scan;
elsif Token = Tok_Colon then
Error_Msg_SC (""":"" should be "":=""");
Scan;
elsif Token = Tok_Is then
Error_Msg_SC ("IS should be "":=""");
Scan;
else
Error_Msg_AP ("missing "":=""");
end if;
end T_Colon_Equal;
-------------
-- T_Comma --
-------------
procedure T_Comma is
begin
if Token = Tok_Comma then
Scan;
else
if Token = Tok_Pragma then
P_Pragmas_Misplaced;
end if;
if Token = Tok_Comma then
Scan;
else
Error_Msg_AP ("missing "",""");
end if;
end if;
if Token = Tok_Pragma then
P_Pragmas_Misplaced;
end if;
end T_Comma;
---------------
-- T_Dot_Dot --
---------------
procedure T_Dot_Dot is
begin
if Token = Tok_Dot_Dot then
Scan;
else
Error_Msg_AP ("missing ""..""");
end if;
end T_Dot_Dot;
-----------
-- T_For --
-----------
procedure T_For is
begin
Check_Token (Tok_For, AP);
end T_For;
-----------------------
-- T_Greater_Greater --
-----------------------
procedure T_Greater_Greater is
begin
if Token = Tok_Greater_Greater then
Scan;
else
Error_Msg_AP ("missing "">>""");
end if;
end T_Greater_Greater;
------------------
-- T_Identifier --
------------------
procedure T_Identifier is
begin
if Token = Tok_Identifier then
Scan;
elsif Token in Token_Class_Literal then
Error_Msg_SC ("identifier expected");
Scan;
else
Error_Msg_AP ("identifier expected");
end if;
end T_Identifier;
----------
-- T_In --
----------
procedure T_In is
begin
Check_Token (Tok_In, AP);
end T_In;
----------
-- T_Is --
----------
procedure T_Is is
begin
if Token = Tok_Is then
Scan;
Ignore (Tok_Semicolon);
-- Allow OF, => or = to substitute for IS with complaint
elsif Token = Tok_Arrow
or else Token = Tok_Of
or else Token = Tok_Equal
then
Error_Msg_SC ("missing IS");
Scan; -- token used in place of IS
else
Wrong_Token (Tok_Is, AP);
end if;
while Token = Tok_Is loop
Error_Msg_SC ("extra IS ignored");
Scan;
end loop;
end T_Is;
------------------
-- T_Left_Paren --
------------------
procedure T_Left_Paren is
begin
if Token = Tok_Left_Paren then
Scan;
else
Error_Msg_AP ("missing ""(""");
end if;
end T_Left_Paren;
------------
-- T_Loop --
------------
procedure T_Loop is
begin
if Token = Tok_Do then
Error_Msg_SC ("LOOP expected");
Scan;
else
Check_Token (Tok_Loop, AP);
end if;
end T_Loop;
-----------
-- T_Mod --
-----------
procedure T_Mod is
begin
Check_Token (Tok_Mod, AP);
end T_Mod;
-----------
-- T_New --
-----------
procedure T_New is
begin
Check_Token (Tok_New, AP);
end T_New;
----------
-- T_Of --
----------
procedure T_Of is
begin
Check_Token (Tok_Of, AP);
end T_Of;
----------
-- T_Or --
----------
procedure T_Or is
begin
Check_Token (Tok_Or, AP);
end T_Or;
---------------
-- T_Private --
---------------
procedure T_Private is
begin
Check_Token (Tok_Private, SC);
end T_Private;
-------------
-- T_Range --
-------------
procedure T_Range is
begin
Check_Token (Tok_Range, AP);
end T_Range;
--------------
-- T_Record --
--------------
procedure T_Record is
begin
Check_Token (Tok_Record, AP);
end T_Record;
-------------------
-- T_Right_Paren --
-------------------
procedure T_Right_Paren is
begin
if Token = Tok_Right_Paren then
Scan;
else
Error_Msg_AP ("missing "")""");
end if;
end T_Right_Paren;
-----------------
-- T_Semicolon --
-----------------
procedure T_Semicolon is
begin
if Token = Tok_Semicolon then
Scan;
if Token = Tok_Semicolon then
Error_Msg_SC ("extra "";"" ignored");
Scan;
end if;
elsif Token = Tok_Colon then
Error_Msg_SC (""":"" should be "";""");
Scan;
elsif Token = Tok_Comma then
Error_Msg_SC (""","" should be "";""");
Scan;
elsif Token = Tok_Dot then
Error_Msg_SC ("""."" should be "";""");
Scan;
-- An interesting little kludge here. If the previous token is a
-- semicolon, then there is no way that we can legitimately need
-- another semicolon. This could only arise in an error situation
-- where an error has already been signalled. By simply ignoring
-- the request for a semicolon in this case, we avoid some spurious
-- missing semicolon messages.
elsif Prev_Token = Tok_Semicolon then
return;
-- If the current token is | then this is a reasonable
-- place to suggest the possibility of a "C" confusion :-)
elsif Token = Tok_Vertical_Bar then
Error_Msg_SC ("unexpected occurrence of ""|"", did you mean OR'?");
Resync_Past_Semicolon;
-- Otherwise we really do have a missing semicolon
else
Error_Msg_AP ("missing "";""");
return;
end if;
end T_Semicolon;
------------
-- T_Then --
------------
procedure T_Then is
begin
Check_Token (Tok_Then, AP);
end T_Then;
------------
-- T_Type --
------------
procedure T_Type is
begin
Check_Token (Tok_Type, BC);
end T_Type;
-----------
-- T_Use --
-----------
procedure T_Use is
begin
Check_Token (Tok_Use, SC);
end T_Use;
------------
-- T_When --
------------
procedure T_When is
begin
Check_Token (Tok_When, SC);
end T_When;
------------
-- T_With --
------------
procedure T_With is
begin
Check_Token (Tok_With, BC);
end T_With;
--------------
-- TF_Arrow --
--------------
procedure TF_Arrow is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Arrow then
Scan; -- skip arrow and we are done
elsif Token = Tok_Colon_Equal then
T_Arrow; -- Let T_Arrow give the message
else
T_Arrow; -- give missing arrow message
Save_Scan_State (Scan_State); -- at start of junk tokens
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); -- to where we were!
return;
end if;
Scan; -- continue search!
if Token = Tok_Arrow then
Scan; -- past arrow
return;
end if;
end loop;
end if;
end TF_Arrow;
-----------
-- TF_Is --
-----------
procedure TF_Is is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Is then
T_Is; -- past IS and we are done
-- Allow OF or => or = in place of IS (with error message)
elsif Token = Tok_Of
or else Token = Tok_Arrow
or else Token = Tok_Equal
then
T_Is; -- give missing IS message and skip bad token
else
T_Is; -- give missing IS message
Save_Scan_State (Scan_State); -- at start of junk tokens
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); -- to where we were!
return;
end if;
Scan; -- continue search!
if Token = Tok_Is
or else Token = Tok_Of
or else Token = Tok_Arrow
then
Scan; -- past IS or OF or =>
return;
end if;
end loop;
end if;
end TF_Is;
-------------
-- TF_Loop --
-------------
procedure TF_Loop is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Loop then
Scan; -- past LOOP and we are done
-- Allow DO or THEN in place of LOOP
elsif Token = Tok_Then or else Token = Tok_Do then
T_Loop; -- give missing LOOP message
else
T_Loop; -- give missing LOOP message
Save_Scan_State (Scan_State); -- at start of junk tokens
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); -- to where we were!
return;
end if;
Scan; -- continue search!
if Token = Tok_Loop or else Token = Tok_Then then
Scan; -- past loop or then (message already generated)
return;
end if;
end loop;
end if;
end TF_Loop;
--------------
-- TF_Return--
--------------
procedure TF_Return is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Return then
Scan; -- skip RETURN and we are done
else
Error_Msg_SC ("missing RETURN");
Save_Scan_State (Scan_State); -- at start of junk tokens
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); -- to where we were!
return;
end if;
Scan; -- continue search!
if Token = Tok_Return then
Scan; -- past RETURN
return;
end if;
end loop;
end if;
end TF_Return;
------------------
-- TF_Semicolon --
------------------
procedure TF_Semicolon is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Semicolon then
T_Semicolon;
return;
-- An interesting little kludge here. If the previous token is a
-- semicolon, then there is no way that we can legitimately need
-- another semicolon. This could only arise in an error situation
-- where an error has already been signalled. By simply ignoring
-- the request for a semicolon in this case, we avoid some spurious
-- missing semicolon messages.
elsif Prev_Token = Tok_Semicolon then
return;
else
if Token = Tok_Pragma then
P_Pragmas_Misplaced;
if Token = Tok_Semicolon then
T_Semicolon;
return;
end if;
end if;
T_Semicolon; -- give missing semicolon message
Save_Scan_State (Scan_State); -- at start of junk tokens
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); -- to where we were
return;
end if;
Scan; -- continue search
if Token = Tok_Semicolon then
T_Semicolon;
return;
elsif Token in Token_Class_After_SM then
return;
end if;
end loop;
end if;
end TF_Semicolon;
-------------
-- TF_Then --
-------------
procedure TF_Then is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Then then
Scan; -- past THEN and we are done
else
T_Then; -- give missing THEN message
Save_Scan_State (Scan_State); -- at start of junk tokens
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); -- to where we were
return;
end if;
Scan; -- continue search!
if Token = Tok_Then then
Scan; -- past THEN
return;
end if;
end loop;
end if;
end TF_Then;
------------
-- TF_Use --
------------
procedure TF_Use is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Use then
Scan; -- past USE and we are done
else
T_Use; -- give USE expected message
Save_Scan_State (Scan_State); -- at start of junk tokens
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); -- to where we were
return;
end if;
Scan; -- continue search!
if Token = Tok_Use then
Scan; -- past use
return;
end if;
end loop;
end if;
end TF_Use;
-----------------
-- Wrong_Token --
-----------------
procedure Wrong_Token (T : Token_Type; P : Position) is
Missing : constant String := "missing ";
Image : constant String := Token_Type'Image (T);
Tok_Name : constant String := Image (5 .. Image'Length);
M : String (1 .. Missing'Length + Tok_Name'Length);
begin
-- Set M to Missing & Tok_Name.
M (1 .. Missing'Length) := Missing;
M (Missing'Length + 1 .. M'Last) := Tok_Name;
if Token = Tok_Semicolon then
Scan;
if Token = T then
Error_Msg_SP ("extra "";"" ignored");
Scan;
else
Error_Msg_SP (M);
end if;
elsif Token = Tok_Comma then
Scan;
if Token = T then
Error_Msg_SP ("extra "","" ignored");
Scan;
else
Error_Msg_SP (M);
end if;
else
case P is
when SC => Error_Msg_SC (M);
when BC => Error_Msg_BC (M);
when AP => Error_Msg_AP (M);
end case;
end if;
end Wrong_Token;
end Tchk;