|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- P A R . S Y N C --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
|
|
111
|
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;
|
