1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
27 ------------------------------------------------------------------------------
32 procedure Resync_Init;
33 -- This routine is called on initiating a resynchronization action
35 procedure Resync_Resume;
36 -- This routine is called on completing a resynchronization action
42 procedure Resync_Choice is
46 -- Loop till we get a token that terminates a choice. Note that EOF is
47 -- one such token, so we are sure to get out of this loop eventually!
49 while Token not in Token_Class_Cterm loop
60 procedure Resync_Cunit is
64 while Token not in Token_Class_Cunit
65 and then Token /= Tok_EOF
73 -----------------------
74 -- Resync_Expression --
75 -----------------------
77 procedure Resync_Expression is
85 -- Terminating tokens are those in class Eterm and also RANGE,
86 -- DIGITS or DELTA if not preceded by an apostrophe (if they are
87 -- preceded by an apostrophe, then they are attributes). In addiion,
88 -- at the outer parentheses level only, we also consider a comma,
89 -- right parenthesis or vertical bar to terminate an expression.
91 if Token in Token_Class_Eterm
93 or else (Token in Token_Class_Atkwd
94 and then Prev_Token /= Tok_Apostrophe)
96 or else (Paren_Count = 0
99 or else Token = Tok_Right_Paren
100 or else Token = Tok_Vertical_Bar))
102 -- A special check: if we stop on the ELSE of OR ELSE or the
103 -- THEN of AND THEN, keep going, because this is not really an
104 -- expression terminator after all. Also, keep going past WITH
105 -- since this can be part of an extension aggregate
107 if (Token = Tok_Else and then Prev_Token = Tok_Or)
108 or else (Token = Tok_Then and then Prev_Token = Tok_And)
109 or else Token = Tok_With
117 if Token = Tok_Left_Paren then
118 Paren_Count := Paren_Count + 1;
120 elsif Token = Tok_Right_Paren then
121 Paren_Count := Paren_Count - 1;
125 Scan; -- past token to be skipped
129 end Resync_Expression;
135 procedure Resync_Init is
137 -- The following check makes sure we do not get stuck in an infinite
138 -- loop resynchonizing and getting nowhere. If we are called to do a
139 -- resynchronize and we are exactly at the same point that we left off
140 -- on the last resynchronize call, then we force at least one token to
141 -- be skipped so that we make progress!
143 if Token_Ptr = Last_Resync_Point then
144 Scan; -- to skip at least one token
147 -- Output extra error message if debug R flag is set
150 Error_Msg_SC ("resynchronizing!");
154 ---------------------------
155 -- Resync_Past_Semicolon --
156 ---------------------------
158 procedure Resync_Past_Semicolon is
163 -- Done if we are at a semicolon
165 if Token = Tok_Semicolon then
166 Scan; -- past semicolon
169 -- Done if we are at a token which normally appears only after
170 -- a semicolon. One special glitch is that the keyword private is
171 -- in this category only if it does NOT appear after WITH.
173 elsif Token in Token_Class_After_SM
174 and then (Token /= Tok_Private or else Prev_Token /= Tok_With)
178 -- Otherwise keep going
185 -- Fall out of loop with resyncrhonization complete
188 end Resync_Past_Semicolon;
190 ----------------------------------------------
191 -- Resync_Past_Semicolon_Or_To_Loop_Or_Then --
192 ----------------------------------------------
194 procedure Resync_Past_Semicolon_Or_To_Loop_Or_Then is
199 -- Done if at semicolon
201 if Token = Tok_Semicolon then
202 Scan; -- past the semicolon
205 -- Done if we are at a token which normally appears only after
206 -- a semicolon. One special glitch is that the keyword private is
207 -- in this category only if it does NOT appear after WITH.
209 elsif (Token in Token_Class_After_SM
210 and then (Token /= Tok_Private
211 or else Prev_Token /= Tok_With))
215 -- Done if we are at THEN or LOOP
217 elsif Token = Tok_Then or else Token = Tok_Loop then
220 -- Otherwise keep going
227 -- Fall out of loop with resyncrhonization complete
230 end Resync_Past_Semicolon_Or_To_Loop_Or_Then;
236 procedure Resync_Resume is
238 -- Save resync point (see special test in Resync_Init)
240 Last_Resync_Point := Token_Ptr;
243 Error_Msg_SC ("resuming here!");
251 procedure Resync_To_When is
256 -- Done if at semicolon, WHEN or IS
258 if Token = Tok_Semicolon
259 or else Token = Tok_When
260 or else Token = Tok_Is
264 -- Otherwise keep going
271 -- Fall out of loop with resyncrhonization complete
276 ---------------------------
277 -- Resync_Semicolon_List --
278 ---------------------------
280 procedure Resync_Semicolon_List is
289 or else Token = Tok_Semicolon
290 or else Token = Tok_Is
291 or else Token in Token_Class_After_SM
295 elsif Token = Tok_Left_Paren then
296 Paren_Count := Paren_Count + 1;
298 elsif Token = Tok_Right_Paren then
299 if Paren_Count = 0 then
302 Paren_Count := Paren_Count - 1;
310 end Resync_Semicolon_List;