1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 -- Token scan routines.
29 -- Error recovery: none of the T_xxx or TF_xxx routines raise Error_Resync
34 type Position is (SC, BC, AP);
35 -- Specify position of error message (see Error_Msg_SC/BC/AP)
37 -----------------------
38 -- Local Subprograms --
39 -----------------------
41 procedure Check_Token (T : Token_Type; P : Position);
42 pragma Inline (Check_Token);
43 -- Called by T_xx routines to check for reserved keyword token. P is the
44 -- position of the error message if the token is missing (see Wrong_Token)
46 procedure Wrong_Token (T : Token_Type; P : Position);
47 -- Called when scanning a reserved keyword when the keyword is not
48 -- present. T is the token type for the keyword, and P indicates the
49 -- position to be used to place a message relative to the current
50 -- token if the keyword is not located nearby.
56 procedure Check_Token (T : Token_Type; P : Position) is
72 Check_Token (Tok_Abort, SC);
81 if Token = Tok_Arrow then
84 -- A little recovery helper, accept then in place of =>
86 elsif Token = Tok_Then then
87 Error_Msg_BC ("missing ""=>""");
88 Scan; -- past THEN used in place of =>
90 elsif Token = Tok_Colon_Equal then
91 Error_Msg_SC (""":="" should be ""=>""");
92 Scan; -- past := used in place of =>
95 Error_Msg_AP ("missing ""=>""");
105 Check_Token (Tok_At, SC);
114 Check_Token (Tok_Body, BC);
123 if Token = Tok_Box then
126 Error_Msg_AP ("missing ""<>""");
136 if Token = Tok_Colon then
139 Error_Msg_AP ("missing "":""");
147 procedure T_Colon_Equal is
149 if Token = Tok_Colon_Equal then
152 elsif Token = Tok_Equal then
153 Error_Msg_SC ("""="" should be "":=""");
156 elsif Token = Tok_Colon then
157 Error_Msg_SC (""":"" should be "":=""");
160 elsif Token = Tok_Is then
161 Error_Msg_SC ("IS should be "":=""");
165 Error_Msg_AP ("missing "":=""");
175 if Token = Tok_Comma then
179 if Token = Tok_Pragma then
183 if Token = Tok_Comma then
186 Error_Msg_AP ("missing "",""");
190 if Token = Tok_Pragma then
199 procedure T_Dot_Dot is
201 if Token = Tok_Dot_Dot then
204 Error_Msg_AP ("missing ""..""");
214 Check_Token (Tok_For, AP);
217 -----------------------
218 -- T_Greater_Greater --
219 -----------------------
221 procedure T_Greater_Greater is
223 if Token = Tok_Greater_Greater then
226 Error_Msg_AP ("missing "">>""");
228 end T_Greater_Greater;
234 procedure T_Identifier is
236 if Token = Tok_Identifier then
238 elsif Token in Token_Class_Literal then
239 Error_Msg_SC ("identifier expected");
242 Error_Msg_AP ("identifier expected");
252 Check_Token (Tok_In, AP);
261 if Token = Tok_Is then
264 Ignore (Tok_Semicolon);
266 -- Allow OF, => or = to substitute for IS with complaint
268 elsif Token = Tok_Arrow
269 or else Token = Tok_Of
270 or else Token = Tok_Equal
272 Error_Msg_SC ("missing IS");
273 Scan; -- token used in place of IS
275 Wrong_Token (Tok_Is, AP);
278 while Token = Tok_Is loop
279 Error_Msg_SC ("extra IS ignored");
288 procedure T_Left_Paren is
290 if Token = Tok_Left_Paren then
293 Error_Msg_AP ("missing ""(""");
303 if Token = Tok_Do then
304 Error_Msg_SC ("LOOP expected");
307 Check_Token (Tok_Loop, AP);
317 Check_Token (Tok_Mod, AP);
326 Check_Token (Tok_New, AP);
335 Check_Token (Tok_Of, AP);
344 Check_Token (Tok_Or, AP);
351 procedure T_Private is
353 Check_Token (Tok_Private, SC);
362 Check_Token (Tok_Range, AP);
369 procedure T_Record is
371 Check_Token (Tok_Record, AP);
378 procedure T_Right_Paren is
380 if Token = Tok_Right_Paren then
383 Error_Msg_AP ("missing "")""");
391 procedure T_Semicolon is
394 if Token = Tok_Semicolon then
397 if Token = Tok_Semicolon then
398 Error_Msg_SC ("extra "";"" ignored");
402 elsif Token = Tok_Colon then
403 Error_Msg_SC (""":"" should be "";""");
406 elsif Token = Tok_Comma then
407 Error_Msg_SC (""","" should be "";""");
410 elsif Token = Tok_Dot then
411 Error_Msg_SC ("""."" should be "";""");
414 -- An interesting little kludge here. If the previous token is a
415 -- semicolon, then there is no way that we can legitimately need
416 -- another semicolon. This could only arise in an error situation
417 -- where an error has already been signalled. By simply ignoring
418 -- the request for a semicolon in this case, we avoid some spurious
419 -- missing semicolon messages.
421 elsif Prev_Token = Tok_Semicolon then
424 -- If the current token is | then this is a reasonable
425 -- place to suggest the possibility of a "C" confusion :-)
427 elsif Token = Tok_Vertical_Bar then
428 Error_Msg_SC ("unexpected occurrence of ""'|"", did you mean OR'?");
429 Resync_Past_Semicolon;
431 -- Otherwise we really do have a missing semicolon
434 Error_Msg_AP ("|missing "";""");
446 Check_Token (Tok_Then, AP);
455 Check_Token (Tok_Type, BC);
464 Check_Token (Tok_Use, SC);
473 Check_Token (Tok_When, SC);
482 Check_Token (Tok_With, BC);
489 procedure TF_Arrow is
490 Scan_State : Saved_Scan_State;
493 if Token = Tok_Arrow then
494 Scan; -- skip arrow and we are done
496 elsif Token = Tok_Colon_Equal then
497 T_Arrow; -- Let T_Arrow give the message
500 T_Arrow; -- give missing arrow message
501 Save_Scan_State (Scan_State); -- at start of junk tokens
504 if Prev_Token_Ptr < Current_Line_Start
505 or else Token = Tok_Semicolon
506 or else Token = Tok_EOF
508 Restore_Scan_State (Scan_State); -- to where we were!
512 Scan; -- continue search!
514 if Token = Tok_Arrow then
527 Scan_State : Saved_Scan_State;
530 if Token = Tok_Is then
531 T_Is; -- past IS and we are done
533 -- Allow OF or => or = in place of IS (with error message)
536 or else Token = Tok_Arrow
537 or else Token = Tok_Equal
539 T_Is; -- give missing IS message and skip bad token
542 T_Is; -- give missing IS message
543 Save_Scan_State (Scan_State); -- at start of junk tokens
546 if Prev_Token_Ptr < Current_Line_Start
547 or else Token = Tok_Semicolon
548 or else Token = Tok_EOF
550 Restore_Scan_State (Scan_State); -- to where we were!
554 Scan; -- continue search!
557 or else Token = Tok_Of
558 or else Token = Tok_Arrow
560 Scan; -- past IS or OF or =>
572 Scan_State : Saved_Scan_State;
575 if Token = Tok_Loop then
576 Scan; -- past LOOP and we are done
578 -- Allow DO or THEN in place of LOOP
580 elsif Token = Tok_Then or else Token = Tok_Do then
581 T_Loop; -- give missing LOOP message
584 T_Loop; -- give missing LOOP message
585 Save_Scan_State (Scan_State); -- at start of junk tokens
588 if Prev_Token_Ptr < Current_Line_Start
589 or else Token = Tok_Semicolon
590 or else Token = Tok_EOF
592 Restore_Scan_State (Scan_State); -- to where we were!
596 Scan; -- continue search!
598 if Token = Tok_Loop or else Token = Tok_Then then
599 Scan; -- past loop or then (message already generated)
610 procedure TF_Return is
611 Scan_State : Saved_Scan_State;
614 if Token = Tok_Return then
615 Scan; -- skip RETURN and we are done
618 Error_Msg_SC ("missing RETURN");
619 Save_Scan_State (Scan_State); -- at start of junk tokens
622 if Prev_Token_Ptr < Current_Line_Start
623 or else Token = Tok_Semicolon
624 or else Token = Tok_EOF
626 Restore_Scan_State (Scan_State); -- to where we were!
630 Scan; -- continue search!
632 if Token = Tok_Return then
644 procedure TF_Semicolon is
645 Scan_State : Saved_Scan_State;
648 if Token = Tok_Semicolon then
652 -- An interesting little kludge here. If the previous token is a
653 -- semicolon, then there is no way that we can legitimately need
654 -- another semicolon. This could only arise in an error situation
655 -- where an error has already been signalled. By simply ignoring
656 -- the request for a semicolon in this case, we avoid some spurious
657 -- missing semicolon messages.
659 elsif Prev_Token = Tok_Semicolon then
663 if Token = Tok_Pragma then
666 if Token = Tok_Semicolon then
672 T_Semicolon; -- give missing semicolon message
673 Save_Scan_State (Scan_State); -- at start of junk tokens
676 if Prev_Token_Ptr < Current_Line_Start
677 or else Token = Tok_EOF
679 Restore_Scan_State (Scan_State); -- to where we were
683 Scan; -- continue search
685 if Token = Tok_Semicolon then
689 elsif Token in Token_Class_After_SM then
701 Scan_State : Saved_Scan_State;
704 if Token = Tok_Then then
705 Scan; -- past THEN and we are done
708 T_Then; -- give missing THEN message
709 Save_Scan_State (Scan_State); -- at start of junk tokens
712 if Prev_Token_Ptr < Current_Line_Start
713 or else Token = Tok_Semicolon
714 or else Token = Tok_EOF
716 Restore_Scan_State (Scan_State); -- to where we were
720 Scan; -- continue search!
722 if Token = Tok_Then then
735 Scan_State : Saved_Scan_State;
738 if Token = Tok_Use then
739 Scan; -- past USE and we are done
742 T_Use; -- give USE expected message
743 Save_Scan_State (Scan_State); -- at start of junk tokens
746 if Prev_Token_Ptr < Current_Line_Start
747 or else Token = Tok_Semicolon
748 or else Token = Tok_EOF
750 Restore_Scan_State (Scan_State); -- to where we were
754 Scan; -- continue search!
756 if Token = Tok_Use then
768 procedure Wrong_Token (T : Token_Type; P : Position) is
769 Missing : constant String := "missing ";
770 Image : constant String := Token_Type'Image (T);
771 Tok_Name : constant String := Image (5 .. Image'Length);
772 M : String (1 .. Missing'Length + Tok_Name'Length);
775 -- Set M to Missing & Tok_Name.
777 M (1 .. Missing'Length) := Missing;
778 M (Missing'Length + 1 .. M'Last) := Tok_Name;
780 if Token = Tok_Semicolon then
784 Error_Msg_SP ("extra "";"" ignored");
790 elsif Token = Tok_Comma then
794 Error_Msg_SP ("extra "","" ignored");
803 when SC => Error_Msg_SC (M);
804 when BC => Error_Msg_BC (M);
805 when AP => Error_Msg_AP (M);