]>
Commit | Line | Data |
---|---|---|
19235870 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- P A R . S Y N C -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- |
19235870 RK |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
19235870 RK |
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 -- | |
b5c84c3c RD |
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. -- | |
19235870 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
19235870 RK |
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 | |
a90bd866 | 44 | -- one such token, so we are sure to get out of this loop eventually. |
19235870 RK |
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 | |
dec55d76 | 84 | -- preceded by an apostrophe, then they are attributes). In addition, |
19235870 RK |
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 | |
dec55d76 | 135 | -- loop resynchronizing and getting nowhere. If we are called to do a |
19235870 RK |
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 | |
a90bd866 | 138 | -- be skipped so that we make progress. |
19235870 RK |
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 | ||
adb252d8 AC |
151 | ---------------------------------- |
152 | -- Resync_Past_Malformed_Aspect -- | |
153 | ---------------------------------- | |
19235870 | 154 | |
adb252d8 | 155 | procedure Resync_Past_Malformed_Aspect is |
19235870 RK |
156 | begin |
157 | Resync_Init; | |
158 | ||
159 | loop | |
adb252d8 AC |
160 | -- A comma may separate two aspect specifications, but it may also |
161 | -- delimit multiple arguments of a single aspect. | |
19235870 | 162 | |
adb252d8 AC |
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 | |
19235870 RK |
191 | exit; |
192 | ||
adb252d8 | 193 | -- A semicolon signals the last aspect specification |
19235870 | 194 | |
adb252d8 | 195 | elsif Token = Tok_Semicolon then |
19235870 RK |
196 | exit; |
197 | ||
adb252d8 AC |
198 | -- In the case of a mistyped semicolon, any token which follows a |
199 | -- semicolon signals the last aspect specification. | |
19235870 | 200 | |
adb252d8 AC |
201 | elsif Token in Token_Class_After_SM then |
202 | exit; | |
19235870 | 203 | end if; |
adb252d8 AC |
204 | |
205 | -- Keep on resyncing | |
206 | ||
207 | Scan; | |
19235870 RK |
208 | end loop; |
209 | ||
fbf5a39b | 210 | -- Fall out of loop with resynchronization complete |
19235870 RK |
211 | |
212 | Resync_Resume; | |
adb252d8 | 213 | end Resync_Past_Malformed_Aspect; |
19235870 | 214 | |
adb252d8 AC |
215 | --------------------------- |
216 | -- Resync_Past_Semicolon -- | |
217 | --------------------------- | |
fbf5a39b | 218 | |
adb252d8 | 219 | procedure Resync_Past_Semicolon is |
fbf5a39b AC |
220 | begin |
221 | Resync_Init; | |
222 | ||
223 | loop | |
224 | -- Done if we are at a semicolon | |
225 | ||
226 | if Token = Tok_Semicolon then | |
adb252d8 | 227 | Scan; -- past semicolon |
fbf5a39b AC |
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; | |
adb252d8 | 249 | end Resync_Past_Semicolon; |
fbf5a39b | 250 | |
19235870 RK |
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 | ||
fbf5a39b AC |
270 | elsif Token in Token_Class_After_SM |
271 | and then (Token /= Tok_Private or else Prev_Token /= Tok_With) | |
19235870 RK |
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 | ||
dec55d76 | 287 | -- Fall out of loop with resynchronization complete |
19235870 RK |
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 | ||
19235870 RK |
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 | ||
adb252d8 AC |
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 | ||
19235870 | 407 | end Sync; |