1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2024, 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 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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
29 procedure Resync_Init
;
30 -- This routine is called on initiating a resynchronization action
32 procedure Resync_Resume
;
33 -- This routine is called on completing a resynchronization action
39 procedure Resync_Choice
is
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.
46 while Token
not in Token_Class_Cterm
loop
57 procedure Resync_Cunit
is
61 while Token
not in Token_Class_Cunit | Tok_EOF
loop
68 -----------------------
69 -- Resync_Expression --
70 -----------------------
72 procedure Resync_Expression
is
80 -- Terminating tokens are those in class Eterm and also RANGE,
81 -- DIGITS or DELTA if not preceded by an apostrophe (if they are
82 -- preceded by an apostrophe, then they are attributes). In addition,
83 -- at the outer parentheses level only, we also consider a comma,
84 -- right parenthesis or vertical bar to terminate an expression.
86 if Token
in Token_Class_Eterm
88 or else (Token
in Token_Class_Atkwd
89 and then Prev_Token
/= Tok_Apostrophe
)
91 or else (Paren_Count
= 0
93 Token
in Tok_Comma | Tok_Right_Paren | Tok_Vertical_Bar
)
95 -- A special check: if we stop on the ELSE of OR ELSE or the
96 -- THEN of AND THEN, keep going, because this is not really an
97 -- expression terminator after all. Also, keep going past WITH
98 -- since this can be part of an extension aggregate
100 if (Token
= Tok_Else
and then Prev_Token
= Tok_Or
)
101 or else (Token
= Tok_Then
and then Prev_Token
= Tok_And
)
102 or else Token
= Tok_With
110 if Token
= Tok_Left_Paren
then
111 Paren_Count
:= Paren_Count
+ 1;
113 elsif Token
= Tok_Right_Paren
then
114 Paren_Count
:= Paren_Count
- 1;
118 Scan
; -- past token to be skipped
122 end Resync_Expression
;
128 procedure Resync_Init
is
130 -- The following check makes sure we do not get stuck in an infinite
131 -- loop resynchronizing and getting nowhere. If we are called to do a
132 -- resynchronize and we are exactly at the same point that we left off
133 -- on the last resynchronize call, then we force at least one token to
134 -- be skipped so that we make progress.
136 if Token_Ptr
= Last_Resync_Point
then
137 Scan
; -- to skip at least one token
140 -- Output extra error message if debug R flag is set
143 Error_Msg_SC
("resynchronizing!");
147 ----------------------------------
148 -- Resync_Past_Malformed_Aspect --
149 ----------------------------------
151 procedure Resync_Past_Malformed_Aspect
is
156 -- A comma may separate two aspect specifications, but it may also
157 -- delimit multiple arguments of a single aspect.
159 if Token
= Tok_Comma
then
161 Scan_State
: Saved_Scan_State
;
164 Save_Scan_State
(Scan_State
);
167 -- The identifier following the comma is a valid aspect, the
168 -- current malformed aspect has been successfully skipped.
170 if Token
= Tok_Identifier
171 and then Is_Aspect_Id
(Token_Name
)
173 Restore_Scan_State
(Scan_State
);
176 -- The comma is delimiting multiple arguments of an aspect
179 Restore_Scan_State
(Scan_State
);
183 -- An IS signals the last aspect specification when the related
184 -- context is a body.
186 elsif Token
= Tok_Is
then
189 -- A semicolon signals the last aspect specification
191 elsif Token
= Tok_Semicolon
then
194 -- In the case of a mistyped semicolon, any token which follows a
195 -- semicolon signals the last aspect specification.
197 elsif Token
in Token_Class_After_SM
then
206 -- Fall out of loop with resynchronization complete
209 end Resync_Past_Malformed_Aspect
;
211 ---------------------------
212 -- Resync_Past_Semicolon --
213 ---------------------------
215 procedure Resync_Past_Semicolon
is
220 -- Done if we are at a semicolon
222 if Token
= Tok_Semicolon
then
223 Scan
; -- past semicolon
226 -- Done if we are at a token which normally appears only after
227 -- a semicolon. One special glitch is that the keyword private is
228 -- in this category only if it does NOT appear after WITH.
230 elsif Token
in Token_Class_After_SM
231 and then (Token
/= Tok_Private
or else Prev_Token
/= Tok_With
)
235 -- Otherwise keep going
242 -- Fall out of loop with resynchronization complete
245 end Resync_Past_Semicolon
;
247 ----------------------------------------------
248 -- Resync_Past_Semicolon_Or_To_Loop_Or_Then --
249 ----------------------------------------------
251 procedure Resync_Past_Semicolon_Or_To_Loop_Or_Then
is
256 -- Done if at semicolon
258 if Token
= Tok_Semicolon
then
259 Scan
; -- past the semicolon
262 -- Done if we are at a token which normally appears only after
263 -- a semicolon. One special glitch is that the keyword private is
264 -- in this category only if it does NOT appear after WITH.
266 elsif Token
in Token_Class_After_SM
267 and then (Token
/= Tok_Private
or else Prev_Token
/= Tok_With
)
271 -- Done if we are at THEN or LOOP
273 elsif Token
in Tok_Then | Tok_Loop
then
276 -- Otherwise keep going
283 -- Fall out of loop with resynchronization complete
286 end Resync_Past_Semicolon_Or_To_Loop_Or_Then
;
292 procedure Resync_Resume
is
294 -- Save resync point (see special test in Resync_Init)
296 Last_Resync_Point
:= Token_Ptr
;
299 Error_Msg_SC
("resuming here!");
303 ---------------------------
304 -- Resync_Semicolon_List --
305 ---------------------------
307 procedure Resync_Semicolon_List
is
315 if Token
in Tok_EOF | Tok_Semicolon | Tok_Is | Token_Class_After_SM
319 elsif Token
= Tok_Left_Paren
then
320 Paren_Count
:= Paren_Count
+ 1;
322 elsif Token
= Tok_Right_Paren
then
323 if Paren_Count
= 0 then
326 Paren_Count
:= Paren_Count
- 1;
334 end Resync_Semicolon_List
;
336 -------------------------
337 -- Resync_To_Semicolon --
338 -------------------------
340 procedure Resync_To_Semicolon
is
345 -- Done if we are at a semicolon
347 if Token
= Tok_Semicolon
then
350 -- Done if we are at a token which normally appears only after
351 -- a semicolon. One special glitch is that the keyword private is
352 -- in this category only if it does NOT appear after WITH.
354 elsif Token
in Token_Class_After_SM
355 and then (Token
/= Tok_Private
or else Prev_Token
/= Tok_With
)
359 -- Otherwise keep going
366 -- Fall out of loop with resynchronization complete
369 end Resync_To_Semicolon
;
375 procedure Resync_To_When
is
380 -- Done if at semicolon, WHEN or IS
382 if Token
in Tok_Semicolon | Tok_When | Tok_Is
then
385 -- Otherwise keep going
392 -- Fall out of loop with resynchronization complete