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