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-2019, 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 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. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26separate (Par) 27package 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 44 -- one such token, so we are sure to get out of this loop eventually. 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 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. 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 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. 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 151 ---------------------------------- 152 -- Resync_Past_Malformed_Aspect -- 153 ---------------------------------- 154 155 procedure Resync_Past_Malformed_Aspect is 156 begin 157 Resync_Init; 158 159 loop 160 -- A comma may separate two aspect specifications, but it may also 161 -- delimit multiple arguments of a single aspect. 162 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 191 exit; 192 193 -- A semicolon signals the last aspect specification 194 195 elsif Token = Tok_Semicolon then 196 exit; 197 198 -- In the case of a mistyped semicolon, any token which follows a 199 -- semicolon signals the last aspect specification. 200 201 elsif Token in Token_Class_After_SM then 202 exit; 203 end if; 204 205 -- Keep on resyncing 206 207 Scan; 208 end loop; 209 210 -- Fall out of loop with resynchronization complete 211 212 Resync_Resume; 213 end Resync_Past_Malformed_Aspect; 214 215 --------------------------- 216 -- Resync_Past_Semicolon -- 217 --------------------------- 218 219 procedure Resync_Past_Semicolon is 220 begin 221 Resync_Init; 222 223 loop 224 -- Done if we are at a semicolon 225 226 if Token = Tok_Semicolon then 227 Scan; -- past semicolon 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; 249 end Resync_Past_Semicolon; 250 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 270 elsif Token in Token_Class_After_SM 271 and then (Token /= Tok_Private or else Prev_Token /= Tok_With) 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 287 -- Fall out of loop with resynchronization complete 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 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 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 407end Sync; 408