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 ------------------------------------------------------------------------------
31 procedure Resync_Init
;
32 -- This routine is called on initiating a resynchronization action
34 procedure Resync_Resume
;
35 -- This routine is called on completing a resynchronization action
41 procedure Resync_Choice
is
45 -- Loop till we get a token that terminates a choice. Note that EOF is
46 -- one such token, so we are sure to get out of this loop eventually!
48 while Token
not in Token_Class_Cterm
loop
59 procedure Resync_Cunit
is
63 while Token
not in Token_Class_Cunit
64 and then Token
/= Tok_EOF
72 -----------------------
73 -- Resync_Expression --
74 -----------------------
76 procedure Resync_Expression
is
84 -- Terminating tokens are those in class Eterm and also RANGE,
85 -- DIGITS or DELTA if not preceded by an apostrophe (if they are
86 -- preceded by an apostrophe, then they are attributes). In addiion,
87 -- at the outer parentheses level only, we also consider a comma,
88 -- right parenthesis or vertical bar to terminate an expression.
90 if Token
in Token_Class_Eterm
92 or else (Token
in Token_Class_Atkwd
93 and then Prev_Token
/= Tok_Apostrophe
)
95 or else (Paren_Count
= 0
98 or else Token
= Tok_Right_Paren
99 or else Token
= Tok_Vertical_Bar
))
101 -- A special check: if we stop on the ELSE of OR ELSE or the
102 -- THEN of AND THEN, keep going, because this is not really an
103 -- expression terminator after all. Also, keep going past WITH
104 -- since this can be part of an extension aggregate
106 if (Token
= Tok_Else
and then Prev_Token
= Tok_Or
)
107 or else (Token
= Tok_Then
and then Prev_Token
= Tok_And
)
108 or else Token
= Tok_With
116 if Token
= Tok_Left_Paren
then
117 Paren_Count
:= Paren_Count
+ 1;
119 elsif Token
= Tok_Right_Paren
then
120 Paren_Count
:= Paren_Count
- 1;
124 Scan
; -- past token to be skipped
128 end Resync_Expression
;
134 procedure Resync_Init
is
136 -- The following check makes sure we do not get stuck in an infinite
137 -- loop resynchonizing and getting nowhere. If we are called to do a
138 -- resynchronize and we are exactly at the same point that we left off
139 -- on the last resynchronize call, then we force at least one token to
140 -- be skipped so that we make progress!
142 if Token_Ptr
= Last_Resync_Point
then
143 Scan
; -- to skip at least one token
146 -- Output extra error message if debug R flag is set
149 Error_Msg_SC
("resynchronizing!");
153 ---------------------------
154 -- Resync_Past_Semicolon --
155 ---------------------------
157 procedure Resync_Past_Semicolon
is
162 -- Done if we are at a semicolon
164 if Token
= Tok_Semicolon
then
165 Scan
; -- past semicolon
168 -- Done if we are at a token which normally appears only after
169 -- a semicolon. One special glitch is that the keyword private is
170 -- in this category only if it does NOT appear after WITH.
172 elsif Token
in Token_Class_After_SM
173 and then (Token
/= Tok_Private
or else Prev_Token
/= Tok_With
)
177 -- Otherwise keep going
184 -- Fall out of loop with resyncrhonization complete
187 end Resync_Past_Semicolon
;
189 ----------------------------------------------
190 -- Resync_Past_Semicolon_Or_To_Loop_Or_Then --
191 ----------------------------------------------
193 procedure Resync_Past_Semicolon_Or_To_Loop_Or_Then
is
198 -- Done if at semicolon
200 if Token
= Tok_Semicolon
then
201 Scan
; -- past the semicolon
204 -- Done if we are at a token which normally appears only after
205 -- a semicolon. One special glitch is that the keyword private is
206 -- in this category only if it does NOT appear after WITH.
208 elsif (Token
in Token_Class_After_SM
209 and then (Token
/= Tok_Private
210 or else Prev_Token
/= Tok_With
))
214 -- Done if we are at THEN or LOOP
216 elsif Token
= Tok_Then
or else Token
= Tok_Loop
then
219 -- Otherwise keep going
226 -- Fall out of loop with resyncrhonization complete
229 end Resync_Past_Semicolon_Or_To_Loop_Or_Then
;
235 procedure Resync_Resume
is
237 -- Save resync point (see special test in Resync_Init)
239 Last_Resync_Point
:= Token_Ptr
;
242 Error_Msg_SC
("resuming here!");
250 procedure Resync_To_When
is
255 -- Done if at semicolon, WHEN or IS
257 if Token
= Tok_Semicolon
258 or else Token
= Tok_When
259 or else Token
= Tok_Is
263 -- Otherwise keep going
270 -- Fall out of loop with resyncrhonization complete
275 ---------------------------
276 -- Resync_Semicolon_List --
277 ---------------------------
279 procedure Resync_Semicolon_List
is
288 or else Token
= Tok_Semicolon
289 or else Token
= Tok_Is
290 or else Token
in Token_Class_After_SM
294 elsif Token
= Tok_Left_Paren
then
295 Paren_Count
:= Paren_Count
+ 1;
297 elsif Token
= Tok_Right_Paren
then
298 if Paren_Count
= 0 then
301 Paren_Count
:= Paren_Count
- 1;
309 end Resync_Semicolon_List
;