1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, 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
62 and then Token
/= Tok_EOF
70 -----------------------
71 -- Resync_Expression --
72 -----------------------
74 procedure Resync_Expression
is
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.
88 if Token
in Token_Class_Eterm
90 or else (Token
in Token_Class_Atkwd
91 and then Prev_Token
/= Tok_Apostrophe
)
93 or else (Paren_Count
= 0
96 or else Token
= Tok_Right_Paren
97 or else Token
= Tok_Vertical_Bar
))
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
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
114 if Token
= Tok_Left_Paren
then
115 Paren_Count
:= Paren_Count
+ 1;
117 elsif Token
= Tok_Right_Paren
then
118 Paren_Count
:= Paren_Count
- 1;
122 Scan
; -- past token to be skipped
126 end Resync_Expression
;
132 procedure Resync_Init
is
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!
140 if Token_Ptr
= Last_Resync_Point
then
141 Scan
; -- to skip at least one token
144 -- Output extra error message if debug R flag is set
147 Error_Msg_SC
("resynchronizing!");
151 ---------------------------
152 -- Resync_Past_Semicolon --
153 ---------------------------
155 procedure Resync_Past_Semicolon
is
160 -- Done if we are at a semicolon
162 if Token
= Tok_Semicolon
then
163 Scan
; -- past semicolon
166 -- Done if we are at a token which normally appears only after
167 -- a semicolon. One special glitch is that the keyword private is
168 -- in this category only if it does NOT appear after WITH.
170 elsif Token
in Token_Class_After_SM
171 and then (Token
/= Tok_Private
or else Prev_Token
/= Tok_With
)
175 -- Otherwise keep going
182 -- Fall out of loop with resynchronization complete
185 end Resync_Past_Semicolon
;
187 -------------------------
188 -- Resync_To_Semicolon --
189 -------------------------
191 procedure Resync_To_Semicolon
is
196 -- Done if we are at a semicolon
198 if Token
= Tok_Semicolon
then
201 -- Done if we are at a token which normally appears only after
202 -- a semicolon. One special glitch is that the keyword private is
203 -- in this category only if it does NOT appear after WITH.
205 elsif Token
in Token_Class_After_SM
206 and then (Token
/= Tok_Private
or else Prev_Token
/= Tok_With
)
210 -- Otherwise keep going
217 -- Fall out of loop with resynchronization complete
220 end Resync_To_Semicolon
;
222 ----------------------------------------------
223 -- Resync_Past_Semicolon_Or_To_Loop_Or_Then --
224 ----------------------------------------------
226 procedure Resync_Past_Semicolon_Or_To_Loop_Or_Then
is
231 -- Done if at semicolon
233 if Token
= Tok_Semicolon
then
234 Scan
; -- past the semicolon
237 -- Done if we are at a token which normally appears only after
238 -- a semicolon. One special glitch is that the keyword private is
239 -- in this category only if it does NOT appear after WITH.
241 elsif Token
in Token_Class_After_SM
242 and then (Token
/= Tok_Private
or else Prev_Token
/= Tok_With
)
246 -- Done if we are at THEN or LOOP
248 elsif Token
= Tok_Then
or else Token
= Tok_Loop
then
251 -- Otherwise keep going
258 -- Fall out of loop with resynchronization complete
261 end Resync_Past_Semicolon_Or_To_Loop_Or_Then
;
267 procedure Resync_Resume
is
269 -- Save resync point (see special test in Resync_Init)
271 Last_Resync_Point
:= Token_Ptr
;
274 Error_Msg_SC
("resuming here!");
282 procedure Resync_To_When
is
287 -- Done if at semicolon, WHEN or IS
289 if Token
= Tok_Semicolon
290 or else Token
= Tok_When
291 or else Token
= Tok_Is
295 -- Otherwise keep going
302 -- Fall out of loop with resynchronization complete
307 ---------------------------
308 -- Resync_Semicolon_List --
309 ---------------------------
311 procedure Resync_Semicolon_List
is
320 or else Token
= Tok_Semicolon
321 or else Token
= Tok_Is
322 or else Token
in Token_Class_After_SM
326 elsif Token
= Tok_Left_Paren
then
327 Paren_Count
:= Paren_Count
+ 1;
329 elsif Token
= Tok_Right_Paren
then
330 if Paren_Count
= 0 then
333 Paren_Count
:= Paren_Count
- 1;
341 end Resync_Semicolon_List
;