1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 -- Token scan routines.
30 -- Error recovery: none of the T_xxx or TF_xxx routines raise Error_Resync
35 type Position is (SC, BC, AP);
36 -- Specify position of error message (see Error_Msg_SC/BC/AP)
38 -----------------------
39 -- Local Subprograms --
40 -----------------------
42 procedure Check_Token (T : Token_Type; P : Position);
43 pragma Inline (Check_Token);
44 -- Called by T_xx routines to check for reserved keyword token. P is the
45 -- position of the error message if the token is missing (see Wrong_Token)
47 procedure Wrong_Token (T : Token_Type; P : Position);
48 -- Called when scanning a reserved keyword when the keyword is not
49 -- present. T is the token type for the keyword, and P indicates the
50 -- position to be used to place a message relative to the current
51 -- token if the keyword is not located nearby.
57 procedure Check_Token (T : Token_Type; P : Position) is
73 Check_Token (Tok_Abort, SC);
82 if Token = Tok_Arrow then
85 -- A little recovery helper, accept then in place of =>
87 elsif Token = Tok_Then then
88 Error_Msg_BC ("missing ""=>""");
89 Scan; -- past THEN used in place of =>
91 elsif Token = Tok_Colon_Equal then
92 Error_Msg_SC (""":="" should be ""=>""");
93 Scan; -- past := used in place of =>
96 Error_Msg_AP ("missing ""=>""");
106 Check_Token (Tok_At, SC);
115 Check_Token (Tok_Body, BC);
124 if Token = Tok_Box then
127 Error_Msg_AP ("missing ""<>""");
137 if Token = Tok_Colon then
140 Error_Msg_AP ("missing "":""");
148 procedure T_Colon_Equal is
150 if Token = Tok_Colon_Equal then
153 elsif Token = Tok_Equal then
154 Error_Msg_SC ("""="" should be "":=""");
157 elsif Token = Tok_Colon then
158 Error_Msg_SC (""":"" should be "":=""");
161 elsif Token = Tok_Is then
162 Error_Msg_SC ("IS should be "":=""");
166 Error_Msg_AP ("missing "":=""");
176 if Token = Tok_Comma then
180 if Token = Tok_Pragma then
184 if Token = Tok_Comma then
187 Error_Msg_AP ("missing "",""");
191 if Token = Tok_Pragma then
200 procedure T_Dot_Dot is
202 if Token = Tok_Dot_Dot then
205 Error_Msg_AP ("missing ""..""");
215 Check_Token (Tok_For, AP);
218 -----------------------
219 -- T_Greater_Greater --
220 -----------------------
222 procedure T_Greater_Greater is
224 if Token = Tok_Greater_Greater then
227 Error_Msg_AP ("missing "">>""");
229 end T_Greater_Greater;
235 procedure T_Identifier is
237 if Token = Tok_Identifier then
239 elsif Token in Token_Class_Literal then
240 Error_Msg_SC ("identifier expected");
243 Error_Msg_AP ("identifier expected");
253 Check_Token (Tok_In, AP);
262 if Token = Tok_Is then
265 Ignore (Tok_Semicolon);
267 -- Allow OF, => or = to substitute for IS with complaint
269 elsif Token = Tok_Arrow
270 or else Token = Tok_Of
271 or else Token = Tok_Equal
273 Error_Msg_SC ("missing IS");
274 Scan; -- token used in place of IS
276 Wrong_Token (Tok_Is, AP);
279 while Token = Tok_Is loop
280 Error_Msg_SC ("extra IS ignored");
289 procedure T_Left_Paren is
291 if Token = Tok_Left_Paren then
294 Error_Msg_AP ("missing ""(""");
304 if Token = Tok_Do then
305 Error_Msg_SC ("LOOP expected");
308 Check_Token (Tok_Loop, AP);
318 Check_Token (Tok_Mod, AP);
327 Check_Token (Tok_New, AP);
336 Check_Token (Tok_Of, AP);
345 Check_Token (Tok_Or, AP);
352 procedure T_Private is
354 Check_Token (Tok_Private, SC);
363 Check_Token (Tok_Range, AP);
370 procedure T_Record is
372 Check_Token (Tok_Record, AP);
379 procedure T_Right_Paren is
381 if Token = Tok_Right_Paren then
384 Error_Msg_AP ("missing "")""");
392 procedure T_Semicolon is
395 if Token = Tok_Semicolon then
398 if Token = Tok_Semicolon then
399 Error_Msg_SC ("extra "";"" ignored");
403 elsif Token = Tok_Colon then
404 Error_Msg_SC (""":"" should be "";""");
407 elsif Token = Tok_Comma then
408 Error_Msg_SC (""","" should be "";""");
411 elsif Token = Tok_Dot then
412 Error_Msg_SC ("""."" should be "";""");
415 -- An interesting little kludge here. If the previous token is a
416 -- semicolon, then there is no way that we can legitimately need
417 -- another semicolon. This could only arise in an error situation
418 -- where an error has already been signalled. By simply ignoring
419 -- the request for a semicolon in this case, we avoid some spurious
420 -- missing semicolon messages.
422 elsif Prev_Token = Tok_Semicolon then
425 -- If the current token is | then this is a reasonable
426 -- place to suggest the possibility of a "C" confusion :-)
428 elsif Token = Tok_Vertical_Bar then
429 Error_Msg_SC ("unexpected occurrence of ""'|"", did you mean OR'?");
430 Resync_Past_Semicolon;
432 -- Otherwise we really do have a missing semicolon
435 Error_Msg_AP ("|missing "";""");
447 Check_Token (Tok_Then, AP);
456 Check_Token (Tok_Type, BC);
465 Check_Token (Tok_Use, SC);
474 Check_Token (Tok_When, SC);
483 Check_Token (Tok_With, BC);
490 procedure TF_Arrow is
491 Scan_State : Saved_Scan_State;
494 if Token = Tok_Arrow then
495 Scan; -- skip arrow and we are done
497 elsif Token = Tok_Colon_Equal then
498 T_Arrow; -- Let T_Arrow give the message
501 T_Arrow; -- give missing arrow message
502 Save_Scan_State (Scan_State); -- at start of junk tokens
505 if Prev_Token_Ptr < Current_Line_Start
506 or else Token = Tok_Semicolon
507 or else Token = Tok_EOF
509 Restore_Scan_State (Scan_State); -- to where we were!
513 Scan; -- continue search!
515 if Token = Tok_Arrow then
528 Scan_State : Saved_Scan_State;
531 if Token = Tok_Is then
532 T_Is; -- past IS and we are done
534 -- Allow OF or => or = in place of IS (with error message)
537 or else Token = Tok_Arrow
538 or else Token = Tok_Equal
540 T_Is; -- give missing IS message and skip bad token
543 T_Is; -- give missing IS message
544 Save_Scan_State (Scan_State); -- at start of junk tokens
547 if Prev_Token_Ptr < Current_Line_Start
548 or else Token = Tok_Semicolon
549 or else Token = Tok_EOF
551 Restore_Scan_State (Scan_State); -- to where we were!
555 Scan; -- continue search!
558 or else Token = Tok_Of
559 or else Token = Tok_Arrow
561 Scan; -- past IS or OF or =>
573 Scan_State : Saved_Scan_State;
576 if Token = Tok_Loop then
577 Scan; -- past LOOP and we are done
579 -- Allow DO or THEN in place of LOOP
581 elsif Token = Tok_Then or else Token = Tok_Do then
582 T_Loop; -- give missing LOOP message
585 T_Loop; -- give missing LOOP message
586 Save_Scan_State (Scan_State); -- at start of junk tokens
589 if Prev_Token_Ptr < Current_Line_Start
590 or else Token = Tok_Semicolon
591 or else Token = Tok_EOF
593 Restore_Scan_State (Scan_State); -- to where we were!
597 Scan; -- continue search!
599 if Token = Tok_Loop or else Token = Tok_Then then
600 Scan; -- past loop or then (message already generated)
611 procedure TF_Return is
612 Scan_State : Saved_Scan_State;
615 if Token = Tok_Return then
616 Scan; -- skip RETURN and we are done
619 Error_Msg_SC ("missing RETURN");
620 Save_Scan_State (Scan_State); -- at start of junk tokens
623 if Prev_Token_Ptr < Current_Line_Start
624 or else Token = Tok_Semicolon
625 or else Token = Tok_EOF
627 Restore_Scan_State (Scan_State); -- to where we were!
631 Scan; -- continue search!
633 if Token = Tok_Return then
645 procedure TF_Semicolon is
646 Scan_State : Saved_Scan_State;
649 if Token = Tok_Semicolon then
653 -- An interesting little kludge here. If the previous token is a
654 -- semicolon, then there is no way that we can legitimately need
655 -- another semicolon. This could only arise in an error situation
656 -- where an error has already been signalled. By simply ignoring
657 -- the request for a semicolon in this case, we avoid some spurious
658 -- missing semicolon messages.
660 elsif Prev_Token = Tok_Semicolon then
664 if Token = Tok_Pragma then
667 if Token = Tok_Semicolon then
673 T_Semicolon; -- give missing semicolon message
674 Save_Scan_State (Scan_State); -- at start of junk tokens
677 if Prev_Token_Ptr < Current_Line_Start
678 or else Token = Tok_EOF
680 Restore_Scan_State (Scan_State); -- to where we were
684 Scan; -- continue search
686 if Token = Tok_Semicolon then
690 elsif Token in Token_Class_After_SM then
702 Scan_State : Saved_Scan_State;
705 if Token = Tok_Then then
706 Scan; -- past THEN and we are done
709 T_Then; -- give missing THEN message
710 Save_Scan_State (Scan_State); -- at start of junk tokens
713 if Prev_Token_Ptr < Current_Line_Start
714 or else Token = Tok_Semicolon
715 or else Token = Tok_EOF
717 Restore_Scan_State (Scan_State); -- to where we were
721 Scan; -- continue search!
723 if Token = Tok_Then then
736 Scan_State : Saved_Scan_State;
739 if Token = Tok_Use then
740 Scan; -- past USE and we are done
743 T_Use; -- give USE expected message
744 Save_Scan_State (Scan_State); -- at start of junk tokens
747 if Prev_Token_Ptr < Current_Line_Start
748 or else Token = Tok_Semicolon
749 or else Token = Tok_EOF
751 Restore_Scan_State (Scan_State); -- to where we were
755 Scan; -- continue search!
757 if Token = Tok_Use then
769 procedure Wrong_Token (T : Token_Type; P : Position) is
770 Missing : constant String := "missing ";
771 Image : constant String := Token_Type'Image (T);
772 Tok_Name : constant String := Image (5 .. Image'Length);
773 M : String (1 .. Missing'Length + Tok_Name'Length);
776 -- Set M to Missing & Tok_Name.
778 M (1 .. Missing'Length) := Missing;
779 M (Missing'Length + 1 .. M'Last) := Tok_Name;
781 if Token = Tok_Semicolon then
785 Error_Msg_SP ("extra "";"" ignored");
791 elsif Token = Tok_Comma then
795 Error_Msg_SP ("extra "","" ignored");
804 when SC => Error_Msg_SC (M);
805 when BC => Error_Msg_BC (M);
806 when AP => Error_Msg_AP (M);