1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P A R . S Y N C -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- 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 2, 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 COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- GNAT was originally developed by the GNAT team at New York University. -- 23-- Extensive contributions were provided by Ada Core Technologies Inc. -- 24-- -- 25------------------------------------------------------------------------------ 26 27separate (Par) 28package body Sync is 29 30 procedure Resync_Init; 31 -- This routine is called on initiating a resynchronization action 32 33 procedure Resync_Resume; 34 -- This routine is called on completing a resynchronization action 35 36 ------------------- 37 -- Resync_Choice -- 38 ------------------- 39 40 procedure Resync_Choice is 41 begin 42 Resync_Init; 43 44 -- Loop till we get a token that terminates a choice. Note that EOF is 45 -- one such token, so we are sure to get out of this loop eventually! 46 47 while Token not in Token_Class_Cterm loop 48 Scan; 49 end loop; 50 51 Resync_Resume; 52 end Resync_Choice; 53 54 ------------------ 55 -- Resync_Cunit -- 56 ------------------ 57 58 procedure Resync_Cunit is 59 begin 60 Resync_Init; 61 62 while Token not in Token_Class_Cunit 63 and then Token /= Tok_EOF 64 loop 65 Scan; 66 end loop; 67 68 Resync_Resume; 69 end Resync_Cunit; 70 71 ----------------------- 72 -- Resync_Expression -- 73 ----------------------- 74 75 procedure Resync_Expression is 76 Paren_Count : Int; 77 78 begin 79 Resync_Init; 80 Paren_Count := 0; 81 82 loop 83 -- Terminating tokens are those in class Eterm and also RANGE, 84 -- DIGITS or DELTA if not preceded by an apostrophe (if they are 85 -- preceded by an apostrophe, then they are attributes). In addiion, 86 -- at the outer parentheses level only, we also consider a comma, 87 -- right parenthesis or vertical bar to terminate an expression. 88 89 if Token in Token_Class_Eterm 90 91 or else (Token in Token_Class_Atkwd 92 and then Prev_Token /= Tok_Apostrophe) 93 94 or else (Paren_Count = 0 95 and then 96 (Token = Tok_Comma 97 or else Token = Tok_Right_Paren 98 or else Token = Tok_Vertical_Bar)) 99 then 100 -- A special check: if we stop on the ELSE of OR ELSE or the 101 -- THEN of AND THEN, keep going, because this is not really an 102 -- expression terminator after all. Also, keep going past WITH 103 -- since this can be part of an extension aggregate 104 105 if (Token = Tok_Else and then Prev_Token = Tok_Or) 106 or else (Token = Tok_Then and then Prev_Token = Tok_And) 107 or else Token = Tok_With 108 then 109 null; 110 else 111 exit; 112 end if; 113 end if; 114 115 if Token = Tok_Left_Paren then 116 Paren_Count := Paren_Count + 1; 117 118 elsif Token = Tok_Right_Paren then 119 Paren_Count := Paren_Count - 1; 120 121 end if; 122 123 Scan; -- past token to be skipped 124 end loop; 125 126 Resync_Resume; 127 end Resync_Expression; 128 129 ----------------- 130 -- Resync_Init -- 131 ----------------- 132 133 procedure Resync_Init is 134 begin 135 -- The following check makes sure we do not get stuck in an infinite 136 -- loop resynchonizing and getting nowhere. If we are called to do a 137 -- resynchronize and we are exactly at the same point that we left off 138 -- on the last resynchronize call, then we force at least one token to 139 -- be skipped so that we make progress! 140 141 if Token_Ptr = Last_Resync_Point then 142 Scan; -- to skip at least one token 143 end if; 144 145 -- Output extra error message if debug R flag is set 146 147 if Debug_Flag_R then 148 Error_Msg_SC ("resynchronizing!"); 149 end if; 150 end Resync_Init; 151 152 --------------------------- 153 -- Resync_Past_Semicolon -- 154 --------------------------- 155 156 procedure Resync_Past_Semicolon is 157 begin 158 Resync_Init; 159 160 loop 161 -- Done if we are at a semicolon 162 163 if Token = Tok_Semicolon then 164 Scan; -- past semicolon 165 exit; 166 167 -- Done if we are at a token which normally appears only after 168 -- a semicolon. One special glitch is that the keyword private is 169 -- in this category only if it does NOT appear after WITH. 170 171 elsif Token in Token_Class_After_SM 172 and then (Token /= Tok_Private or else Prev_Token /= Tok_With) 173 then 174 exit; 175 176 -- Otherwise keep going 177 178 else 179 Scan; 180 end if; 181 end loop; 182 183 -- Fall out of loop with resynchronization complete 184 185 Resync_Resume; 186 end Resync_Past_Semicolon; 187 188 ------------------------- 189 -- Resync_To_Semicolon -- 190 ------------------------- 191 192 procedure Resync_To_Semicolon is 193 begin 194 Resync_Init; 195 196 loop 197 -- Done if we are at a semicolon 198 199 if Token = Tok_Semicolon then 200 exit; 201 202 -- Done if we are at a token which normally appears only after 203 -- a semicolon. One special glitch is that the keyword private is 204 -- in this category only if it does NOT appear after WITH. 205 206 elsif Token in Token_Class_After_SM 207 and then (Token /= Tok_Private or else Prev_Token /= Tok_With) 208 then 209 exit; 210 211 -- Otherwise keep going 212 213 else 214 Scan; 215 end if; 216 end loop; 217 218 -- Fall out of loop with resynchronization complete 219 220 Resync_Resume; 221 end Resync_To_Semicolon; 222 223 ---------------------------------------------- 224 -- Resync_Past_Semicolon_Or_To_Loop_Or_Then -- 225 ---------------------------------------------- 226 227 procedure Resync_Past_Semicolon_Or_To_Loop_Or_Then is 228 begin 229 Resync_Init; 230 231 loop 232 -- Done if at semicolon 233 234 if Token = Tok_Semicolon then 235 Scan; -- past the semicolon 236 exit; 237 238 -- Done if we are at a token which normally appears only after 239 -- a semicolon. One special glitch is that the keyword private is 240 -- in this category only if it does NOT appear after WITH. 241 242 elsif Token in Token_Class_After_SM 243 and then (Token /= Tok_Private or else Prev_Token /= Tok_With) 244 then 245 exit; 246 247 -- Done if we are at THEN or LOOP 248 249 elsif Token = Tok_Then or else Token = Tok_Loop then 250 exit; 251 252 -- Otherwise keep going 253 254 else 255 Scan; 256 end if; 257 end loop; 258 259 -- Fall out of loop with resyncrhonization complete 260 261 Resync_Resume; 262 end Resync_Past_Semicolon_Or_To_Loop_Or_Then; 263 264 ------------------- 265 -- Resync_Resume -- 266 ------------------- 267 268 procedure Resync_Resume is 269 begin 270 -- Save resync point (see special test in Resync_Init) 271 272 Last_Resync_Point := Token_Ptr; 273 274 if Debug_Flag_R then 275 Error_Msg_SC ("resuming here!"); 276 end if; 277 end Resync_Resume; 278 279 -------------------- 280 -- Resync_To_When -- 281 -------------------- 282 283 procedure Resync_To_When is 284 begin 285 Resync_Init; 286 287 loop 288 -- Done if at semicolon, WHEN or IS 289 290 if Token = Tok_Semicolon 291 or else Token = Tok_When 292 or else Token = Tok_Is 293 then 294 exit; 295 296 -- Otherwise keep going 297 298 else 299 Scan; 300 end if; 301 end loop; 302 303 -- Fall out of loop with resyncrhonization complete 304 305 Resync_Resume; 306 end Resync_To_When; 307 308 --------------------------- 309 -- Resync_Semicolon_List -- 310 --------------------------- 311 312 procedure Resync_Semicolon_List is 313 Paren_Count : Int; 314 315 begin 316 Resync_Init; 317 Paren_Count := 0; 318 319 loop 320 if Token = Tok_EOF 321 or else Token = Tok_Semicolon 322 or else Token = Tok_Is 323 or else Token in Token_Class_After_SM 324 then 325 exit; 326 327 elsif Token = Tok_Left_Paren then 328 Paren_Count := Paren_Count + 1; 329 330 elsif Token = Tok_Right_Paren then 331 if Paren_Count = 0 then 332 exit; 333 else 334 Paren_Count := Paren_Count - 1; 335 end if; 336 end if; 337 338 Scan; 339 end loop; 340 341 Resync_Resume; 342 end Resync_Semicolon_List; 343 344end Sync; 345