| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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; |
