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 ------------------------------------------------------------------------------
30 procedure Resync_Init;
31 -- This routine is called on initiating a resynchronization action
33 procedure Resync_Resume;
34 -- This routine is called on completing a resynchronization action
40 procedure Resync_Choice is
44 -- Loop till we get a token that terminates a choice. Note that EOF is
45 -- one such token, so we are sure to get out of this loop eventually!
47 while Token not in Token_Class_Cterm loop
58 procedure Resync_Cunit is
62 while Token not in Token_Class_Cunit
63 and then Token /= Tok_EOF
71 -----------------------
72 -- Resync_Expression --
73 -----------------------
75 procedure Resync_Expression is
83 -- Terminating tokens are those in class Eterm and also RANGE,
84 -- DIGITS or DELTA if not preceded by an apostrophe (if they are
85 -- preceded by an apostrophe, then they are attributes). In addiion,
86 -- at the outer parentheses level only, we also consider a comma,
87 -- right parenthesis or vertical bar to terminate an expression.
89 if Token in Token_Class_Eterm
91 or else (Token in Token_Class_Atkwd
92 and then Prev_Token /= Tok_Apostrophe)
94 or else (Paren_Count = 0
97 or else Token = Tok_Right_Paren
98 or else Token = Tok_Vertical_Bar))
100 -- A special check: if we stop on the ELSE of OR ELSE or the
101 -- THEN of AND THEN, keep going, because this is not really an
102 -- expression terminator after all. Also, keep going past WITH
103 -- since this can be part of an extension aggregate
105 if (Token = Tok_Else and then Prev_Token = Tok_Or)
106 or else (Token = Tok_Then and then Prev_Token = Tok_And)
107 or else Token = Tok_With
115 if Token = Tok_Left_Paren then
116 Paren_Count := Paren_Count + 1;
118 elsif Token = Tok_Right_Paren then
119 Paren_Count := Paren_Count - 1;
123 Scan; -- past token to be skipped
127 end Resync_Expression;
133 procedure Resync_Init is
135 -- The following check makes sure we do not get stuck in an infinite
136 -- loop resynchonizing and getting nowhere. If we are called to do a
137 -- resynchronize and we are exactly at the same point that we left off
138 -- on the last resynchronize call, then we force at least one token to
139 -- be skipped so that we make progress!
141 if Token_Ptr = Last_Resync_Point then
142 Scan; -- to skip at least one token
145 -- Output extra error message if debug R flag is set
148 Error_Msg_SC ("resynchronizing!");
152 ---------------------------
153 -- Resync_Past_Semicolon --
154 ---------------------------
156 procedure Resync_Past_Semicolon is
161 -- Done if we are at a semicolon
163 if Token = Tok_Semicolon then
164 Scan; -- past semicolon
167 -- Done if we are at a token which normally appears only after
168 -- a semicolon. One special glitch is that the keyword private is
169 -- in this category only if it does NOT appear after WITH.
171 elsif Token in Token_Class_After_SM
172 and then (Token /= Tok_Private or else Prev_Token /= Tok_With)
176 -- Otherwise keep going
183 -- Fall out of loop with resynchronization complete
186 end Resync_Past_Semicolon;
188 -------------------------
189 -- Resync_To_Semicolon --
190 -------------------------
192 procedure Resync_To_Semicolon is
197 -- Done if we are at a semicolon
199 if Token = Tok_Semicolon then
202 -- Done if we are at a token which normally appears only after
203 -- a semicolon. One special glitch is that the keyword private is
204 -- in this category only if it does NOT appear after WITH.
206 elsif Token in Token_Class_After_SM
207 and then (Token /= Tok_Private or else Prev_Token /= Tok_With)
211 -- Otherwise keep going
218 -- Fall out of loop with resynchronization complete
221 end Resync_To_Semicolon;
223 ----------------------------------------------
224 -- Resync_Past_Semicolon_Or_To_Loop_Or_Then --
225 ----------------------------------------------
227 procedure Resync_Past_Semicolon_Or_To_Loop_Or_Then is
232 -- Done if at semicolon
234 if Token = Tok_Semicolon then
235 Scan; -- past the semicolon
238 -- Done if we are at a token which normally appears only after
239 -- a semicolon. One special glitch is that the keyword private is
240 -- in this category only if it does NOT appear after WITH.
242 elsif Token in Token_Class_After_SM
243 and then (Token /= Tok_Private or else Prev_Token /= Tok_With)
247 -- Done if we are at THEN or LOOP
249 elsif Token = Tok_Then or else Token = Tok_Loop then
252 -- Otherwise keep going
259 -- Fall out of loop with resyncrhonization complete
262 end Resync_Past_Semicolon_Or_To_Loop_Or_Then;
268 procedure Resync_Resume is
270 -- Save resync point (see special test in Resync_Init)
272 Last_Resync_Point := Token_Ptr;
275 Error_Msg_SC ("resuming here!");
283 procedure Resync_To_When is
288 -- Done if at semicolon, WHEN or IS
290 if Token = Tok_Semicolon
291 or else Token = Tok_When
292 or else Token = Tok_Is
296 -- Otherwise keep going
303 -- Fall out of loop with resyncrhonization complete
308 ---------------------------
309 -- Resync_Semicolon_List --
310 ---------------------------
312 procedure Resync_Semicolon_List is
321 or else Token = Tok_Semicolon
322 or else Token = Tok_Is
323 or else Token in Token_Class_After_SM
327 elsif Token = Tok_Left_Paren then
328 Paren_Count := Paren_Count + 1;
330 elsif Token = Tok_Right_Paren then
331 if Paren_Count = 0 then
334 Paren_Count := Paren_Count - 1;
342 end Resync_Semicolon_List;