1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2003 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");
404 elsif Token = Tok_Colon then
405 Error_Msg_SC (""":"" should be "";""");
409 elsif Token = Tok_Comma then
410 Error_Msg_SC (""","" should be "";""");
414 elsif Token = Tok_Dot then
415 Error_Msg_SC ("""."" should be "";""");
419 -- An interesting little kludge here. If the previous token is a
420 -- semicolon, then there is no way that we can legitimately need
421 -- another semicolon. This could only arise in an error situation
422 -- where an error has already been signalled. By simply ignoring
423 -- the request for a semicolon in this case, we avoid some spurious
424 -- missing semicolon messages.
426 elsif Prev_Token = Tok_Semicolon then
429 -- If the current token is | then this is a reasonable
430 -- place to suggest the possibility of a "C" confusion :-)
432 elsif Token = Tok_Vertical_Bar then
433 Error_Msg_SC ("unexpected occurrence of ""'|"", did you mean OR'?");
434 Resync_Past_Semicolon;
437 -- Deal with pragma. If pragma is not at start of line, it is
438 -- considered misplaced otherwise we treat it as a normal
439 -- missing semicolong case.
441 elsif Token = Tok_Pragma
442 and then not Token_Is_At_Start_Of_Line
446 if Token = Tok_Semicolon then
452 -- If none of those tests return, we really have a missing semicolon
454 Error_Msg_AP ("|missing "";""");
464 Check_Token (Tok_Then, AP);
473 Check_Token (Tok_Type, BC);
482 Check_Token (Tok_Use, SC);
491 Check_Token (Tok_When, SC);
500 Check_Token (Tok_With, BC);
507 procedure TF_Arrow is
508 Scan_State : Saved_Scan_State;
511 if Token = Tok_Arrow then
512 Scan; -- skip arrow and we are done
514 elsif Token = Tok_Colon_Equal then
515 T_Arrow; -- Let T_Arrow give the message
518 T_Arrow; -- give missing arrow message
519 Save_Scan_State (Scan_State); -- at start of junk tokens
522 if Prev_Token_Ptr < Current_Line_Start
523 or else Token = Tok_Semicolon
524 or else Token = Tok_EOF
526 Restore_Scan_State (Scan_State); -- to where we were!
530 Scan; -- continue search!
532 if Token = Tok_Arrow then
545 Scan_State : Saved_Scan_State;
548 if Token = Tok_Is then
549 T_Is; -- past IS and we are done
551 -- Allow OF or => or = in place of IS (with error message)
554 or else Token = Tok_Arrow
555 or else Token = Tok_Equal
557 T_Is; -- give missing IS message and skip bad token
560 T_Is; -- give missing IS message
561 Save_Scan_State (Scan_State); -- at start of junk tokens
564 if Prev_Token_Ptr < Current_Line_Start
565 or else Token = Tok_Semicolon
566 or else Token = Tok_EOF
568 Restore_Scan_State (Scan_State); -- to where we were!
572 Scan; -- continue search!
575 or else Token = Tok_Of
576 or else Token = Tok_Arrow
578 Scan; -- past IS or OF or =>
590 Scan_State : Saved_Scan_State;
593 if Token = Tok_Loop then
594 Scan; -- past LOOP and we are done
596 -- Allow DO or THEN in place of LOOP
598 elsif Token = Tok_Then or else Token = Tok_Do then
599 T_Loop; -- give missing LOOP message
602 T_Loop; -- give missing LOOP message
603 Save_Scan_State (Scan_State); -- at start of junk tokens
606 if Prev_Token_Ptr < Current_Line_Start
607 or else Token = Tok_Semicolon
608 or else Token = Tok_EOF
610 Restore_Scan_State (Scan_State); -- to where we were!
614 Scan; -- continue search!
616 if Token = Tok_Loop or else Token = Tok_Then then
617 Scan; -- past loop or then (message already generated)
628 procedure TF_Return is
629 Scan_State : Saved_Scan_State;
632 if Token = Tok_Return then
633 Scan; -- skip RETURN and we are done
636 Error_Msg_SC ("missing RETURN");
637 Save_Scan_State (Scan_State); -- at start of junk tokens
640 if Prev_Token_Ptr < Current_Line_Start
641 or else Token = Tok_Semicolon
642 or else Token = Tok_EOF
644 Restore_Scan_State (Scan_State); -- to where we were!
648 Scan; -- continue search!
650 if Token = Tok_Return then
662 procedure TF_Semicolon is
663 Scan_State : Saved_Scan_State;
666 if Token = Tok_Semicolon then
670 -- An interesting little kludge here. If the previous token is a
671 -- semicolon, then there is no way that we can legitimately need
672 -- another semicolon. This could only arise in an error situation
673 -- where an error has already been signalled. By simply ignoring
674 -- the request for a semicolon in this case, we avoid some spurious
675 -- missing semicolon messages.
677 elsif Prev_Token = Tok_Semicolon then
681 -- Deal with pragma. If pragma is not at start of line, it is
682 -- considered misplaced otherwise we treat it as a normal
683 -- missing semicolong case.
685 if Token = Tok_Pragma
686 and then not Token_Is_At_Start_Of_Line
690 if Token = Tok_Semicolon then
696 -- Here we definitely have a missing semicolon, so give message
700 -- Scan out junk on rest of line
702 Save_Scan_State (Scan_State); -- at start of junk tokens
705 if Prev_Token_Ptr < Current_Line_Start
706 or else Token = Tok_EOF
708 Restore_Scan_State (Scan_State); -- to where we were
712 Scan; -- continue search
714 if Token = Tok_Semicolon then
718 elsif Token in Token_Class_After_SM then
730 Scan_State : Saved_Scan_State;
733 if Token = Tok_Then then
734 Scan; -- past THEN and we are done
737 T_Then; -- give missing THEN message
738 Save_Scan_State (Scan_State); -- at start of junk tokens
741 if Prev_Token_Ptr < Current_Line_Start
742 or else Token = Tok_Semicolon
743 or else Token = Tok_EOF
745 Restore_Scan_State (Scan_State); -- to where we were
749 Scan; -- continue search!
751 if Token = Tok_Then then
764 Scan_State : Saved_Scan_State;
767 if Token = Tok_Use then
768 Scan; -- past USE and we are done
771 T_Use; -- give USE expected message
772 Save_Scan_State (Scan_State); -- at start of junk tokens
775 if Prev_Token_Ptr < Current_Line_Start
776 or else Token = Tok_Semicolon
777 or else Token = Tok_EOF
779 Restore_Scan_State (Scan_State); -- to where we were
783 Scan; -- continue search!
785 if Token = Tok_Use then
797 procedure Wrong_Token (T : Token_Type; P : Position) is
798 Missing : constant String := "missing ";
799 Image : constant String := Token_Type'Image (T);
800 Tok_Name : constant String := Image (5 .. Image'Length);
801 M : String (1 .. Missing'Length + Tok_Name'Length);
804 -- Set M to Missing & Tok_Name.
806 M (1 .. Missing'Length) := Missing;
807 M (Missing'Length + 1 .. M'Last) := Tok_Name;
809 if Token = Tok_Semicolon then
813 Error_Msg_SP ("extra "";"" ignored");
819 elsif Token = Tok_Comma then
823 Error_Msg_SP ("extra "","" ignored");
832 when SC => Error_Msg_SC (M);
833 when BC => Error_Msg_BC (M);
834 when AP => Error_Msg_AP (M);