File : par-sync.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P A R . S Y N C --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
10 -- --
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 3, 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
25
26 separate (Par)
27 package body Sync is
28
29 procedure Resync_Init;
30 -- This routine is called on initiating a resynchronization action
31
32 procedure Resync_Resume;
33 -- This routine is called on completing a resynchronization action
34
35 -------------------
36 -- Resync_Choice --
37 -------------------
38
39 procedure Resync_Choice is
40 begin
41 Resync_Init;
42
43 -- Loop till we get a token that terminates a choice. Note that EOF is
44 -- one such token, so we are sure to get out of this loop eventually.
45
46 while Token not in Token_Class_Cterm loop
47 Scan;
48 end loop;
49
50 Resync_Resume;
51 end Resync_Choice;
52
53 ------------------
54 -- Resync_Cunit --
55 ------------------
56
57 procedure Resync_Cunit is
58 begin
59 Resync_Init;
60
61 while Token not in Token_Class_Cunit
62 and then Token /= Tok_EOF
63 loop
64 Scan;
65 end loop;
66
67 Resync_Resume;
68 end Resync_Cunit;
69
70 -----------------------
71 -- Resync_Expression --
72 -----------------------
73
74 procedure Resync_Expression is
75 Paren_Count : Int;
76
77 begin
78 Resync_Init;
79 Paren_Count := 0;
80
81 loop
82 -- Terminating tokens are those in class Eterm and also RANGE,
83 -- DIGITS or DELTA if not preceded by an apostrophe (if they are
84 -- preceded by an apostrophe, then they are attributes). In addition,
85 -- at the outer parentheses level only, we also consider a comma,
86 -- right parenthesis or vertical bar to terminate an expression.
87
88 if Token in Token_Class_Eterm
89
90 or else (Token in Token_Class_Atkwd
91 and then Prev_Token /= Tok_Apostrophe)
92
93 or else (Paren_Count = 0
94 and then
95 (Token = Tok_Comma
96 or else Token = Tok_Right_Paren
97 or else Token = Tok_Vertical_Bar))
98 then
99 -- A special check: if we stop on the ELSE of OR ELSE or the
100 -- THEN of AND THEN, keep going, because this is not really an
101 -- expression terminator after all. Also, keep going past WITH
102 -- since this can be part of an extension aggregate
103
104 if (Token = Tok_Else and then Prev_Token = Tok_Or)
105 or else (Token = Tok_Then and then Prev_Token = Tok_And)
106 or else Token = Tok_With
107 then
108 null;
109 else
110 exit;
111 end if;
112 end if;
113
114 if Token = Tok_Left_Paren then
115 Paren_Count := Paren_Count + 1;
116
117 elsif Token = Tok_Right_Paren then
118 Paren_Count := Paren_Count - 1;
119
120 end if;
121
122 Scan; -- past token to be skipped
123 end loop;
124
125 Resync_Resume;
126 end Resync_Expression;
127
128 -----------------
129 -- Resync_Init --
130 -----------------
131
132 procedure Resync_Init is
133 begin
134 -- The following check makes sure we do not get stuck in an infinite
135 -- loop resynchronizing and getting nowhere. If we are called to do a
136 -- resynchronize and we are exactly at the same point that we left off
137 -- on the last resynchronize call, then we force at least one token to
138 -- be skipped so that we make progress.
139
140 if Token_Ptr = Last_Resync_Point then
141 Scan; -- to skip at least one token
142 end if;
143
144 -- Output extra error message if debug R flag is set
145
146 if Debug_Flag_R then
147 Error_Msg_SC ("resynchronizing!");
148 end if;
149 end Resync_Init;
150
151 ----------------------------------
152 -- Resync_Past_Malformed_Aspect --
153 ----------------------------------
154
155 procedure Resync_Past_Malformed_Aspect is
156 begin
157 Resync_Init;
158
159 loop
160 -- A comma may separate two aspect specifications, but it may also
161 -- delimit multiple arguments of a single aspect.
162
163 if Token = Tok_Comma then
164 declare
165 Scan_State : Saved_Scan_State;
166
167 begin
168 Save_Scan_State (Scan_State);
169 Scan; -- past comma
170
171 -- The identifier following the comma is a valid aspect, the
172 -- current malformed aspect has been successfully skipped.
173
174 if Token = Tok_Identifier
175 and then Get_Aspect_Id (Token_Name) /= No_Aspect
176 then
177 Restore_Scan_State (Scan_State);
178 exit;
179
180 -- The comma is delimiting multiple arguments of an aspect
181
182 else
183 Restore_Scan_State (Scan_State);
184 end if;
185 end;
186
187 -- An IS signals the last aspect specification when the related
188 -- context is a body.
189
190 elsif Token = Tok_Is then
191 exit;
192
193 -- A semicolon signals the last aspect specification
194
195 elsif Token = Tok_Semicolon then
196 exit;
197
198 -- In the case of a mistyped semicolon, any token which follows a
199 -- semicolon signals the last aspect specification.
200
201 elsif Token in Token_Class_After_SM then
202 exit;
203 end if;
204
205 -- Keep on resyncing
206
207 Scan;
208 end loop;
209
210 -- Fall out of loop with resynchronization complete
211
212 Resync_Resume;
213 end Resync_Past_Malformed_Aspect;
214
215 ---------------------------
216 -- Resync_Past_Semicolon --
217 ---------------------------
218
219 procedure Resync_Past_Semicolon is
220 begin
221 Resync_Init;
222
223 loop
224 -- Done if we are at a semicolon
225
226 if Token = Tok_Semicolon then
227 Scan; -- past semicolon
228 exit;
229
230 -- Done if we are at a token which normally appears only after
231 -- a semicolon. One special glitch is that the keyword private is
232 -- in this category only if it does NOT appear after WITH.
233
234 elsif Token in Token_Class_After_SM
235 and then (Token /= Tok_Private or else Prev_Token /= Tok_With)
236 then
237 exit;
238
239 -- Otherwise keep going
240
241 else
242 Scan;
243 end if;
244 end loop;
245
246 -- Fall out of loop with resynchronization complete
247
248 Resync_Resume;
249 end Resync_Past_Semicolon;
250
251 ----------------------------------------------
252 -- Resync_Past_Semicolon_Or_To_Loop_Or_Then --
253 ----------------------------------------------
254
255 procedure Resync_Past_Semicolon_Or_To_Loop_Or_Then is
256 begin
257 Resync_Init;
258
259 loop
260 -- Done if at semicolon
261
262 if Token = Tok_Semicolon then
263 Scan; -- past the semicolon
264 exit;
265
266 -- Done if we are at a token which normally appears only after
267 -- a semicolon. One special glitch is that the keyword private is
268 -- in this category only if it does NOT appear after WITH.
269
270 elsif Token in Token_Class_After_SM
271 and then (Token /= Tok_Private or else Prev_Token /= Tok_With)
272 then
273 exit;
274
275 -- Done if we are at THEN or LOOP
276
277 elsif Token = Tok_Then or else Token = Tok_Loop then
278 exit;
279
280 -- Otherwise keep going
281
282 else
283 Scan;
284 end if;
285 end loop;
286
287 -- Fall out of loop with resynchronization complete
288
289 Resync_Resume;
290 end Resync_Past_Semicolon_Or_To_Loop_Or_Then;
291
292 -------------------
293 -- Resync_Resume --
294 -------------------
295
296 procedure Resync_Resume is
297 begin
298 -- Save resync point (see special test in Resync_Init)
299
300 Last_Resync_Point := Token_Ptr;
301
302 if Debug_Flag_R then
303 Error_Msg_SC ("resuming here!");
304 end if;
305 end Resync_Resume;
306
307 ---------------------------
308 -- Resync_Semicolon_List --
309 ---------------------------
310
311 procedure Resync_Semicolon_List is
312 Paren_Count : Int;
313
314 begin
315 Resync_Init;
316 Paren_Count := 0;
317
318 loop
319 if Token = Tok_EOF
320 or else Token = Tok_Semicolon
321 or else Token = Tok_Is
322 or else Token in Token_Class_After_SM
323 then
324 exit;
325
326 elsif Token = Tok_Left_Paren then
327 Paren_Count := Paren_Count + 1;
328
329 elsif Token = Tok_Right_Paren then
330 if Paren_Count = 0 then
331 exit;
332 else
333 Paren_Count := Paren_Count - 1;
334 end if;
335 end if;
336
337 Scan;
338 end loop;
339
340 Resync_Resume;
341 end Resync_Semicolon_List;
342
343 -------------------------
344 -- Resync_To_Semicolon --
345 -------------------------
346
347 procedure Resync_To_Semicolon is
348 begin
349 Resync_Init;
350
351 loop
352 -- Done if we are at a semicolon
353
354 if Token = Tok_Semicolon then
355 exit;
356
357 -- Done if we are at a token which normally appears only after
358 -- a semicolon. One special glitch is that the keyword private is
359 -- in this category only if it does NOT appear after WITH.
360
361 elsif Token in Token_Class_After_SM
362 and then (Token /= Tok_Private or else Prev_Token /= Tok_With)
363 then
364 exit;
365
366 -- Otherwise keep going
367
368 else
369 Scan;
370 end if;
371 end loop;
372
373 -- Fall out of loop with resynchronization complete
374
375 Resync_Resume;
376 end Resync_To_Semicolon;
377
378 --------------------
379 -- Resync_To_When --
380 --------------------
381
382 procedure Resync_To_When is
383 begin
384 Resync_Init;
385
386 loop
387 -- Done if at semicolon, WHEN or IS
388
389 if Token = Tok_Semicolon
390 or else Token = Tok_When
391 or else Token = Tok_Is
392 then
393 exit;
394
395 -- Otherwise keep going
396
397 else
398 Scan;
399 end if;
400 end loop;
401
402 -- Fall out of loop with resynchronization complete
403
404 Resync_Resume;
405 end Resync_To_When;
406
407 end Sync;