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-2008, 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_Semicolon -- 153 --------------------------- 154 155 procedure Resync_Past_Semicolon is 156 begin 157 Resync_Init; 158 159 loop 160 -- Done if we are at a semicolon 161 162 if Token = Tok_Semicolon then 163 Scan; -- past semicolon 164 exit; 165 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. 169 170 elsif Token in Token_Class_After_SM 171 and then (Token /= Tok_Private or else Prev_Token /= Tok_With) 172 then 173 exit; 174 175 -- Otherwise keep going 176 177 else 178 Scan; 179 end if; 180 end loop; 181 182 -- Fall out of loop with resynchronization complete 183 184 Resync_Resume; 185 end Resync_Past_Semicolon; 186 187 ------------------------- 188 -- Resync_To_Semicolon -- 189 ------------------------- 190 191 procedure Resync_To_Semicolon is 192 begin 193 Resync_Init; 194 195 loop 196 -- Done if we are at a semicolon 197 198 if Token = Tok_Semicolon then 199 exit; 200 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. 204 205 elsif Token in Token_Class_After_SM 206 and then (Token /= Tok_Private or else Prev_Token /= Tok_With) 207 then 208 exit; 209 210 -- Otherwise keep going 211 212 else 213 Scan; 214 end if; 215 end loop; 216 217 -- Fall out of loop with resynchronization complete 218 219 Resync_Resume; 220 end Resync_To_Semicolon; 221 222 ---------------------------------------------- 223 -- Resync_Past_Semicolon_Or_To_Loop_Or_Then -- 224 ---------------------------------------------- 225 226 procedure Resync_Past_Semicolon_Or_To_Loop_Or_Then is 227 begin 228 Resync_Init; 229 230 loop 231 -- Done if at semicolon 232 233 if Token = Tok_Semicolon then 234 Scan; -- past the semicolon 235 exit; 236 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. 240 241 elsif Token in Token_Class_After_SM 242 and then (Token /= Tok_Private or else Prev_Token /= Tok_With) 243 then 244 exit; 245 246 -- Done if we are at THEN or LOOP 247 248 elsif Token = Tok_Then or else Token = Tok_Loop then 249 exit; 250 251 -- Otherwise keep going 252 253 else 254 Scan; 255 end if; 256 end loop; 257 258 -- Fall out of loop with resynchronization complete 259 260 Resync_Resume; 261 end Resync_Past_Semicolon_Or_To_Loop_Or_Then; 262 263 ------------------- 264 -- Resync_Resume -- 265 ------------------- 266 267 procedure Resync_Resume is 268 begin 269 -- Save resync point (see special test in Resync_Init) 270 271 Last_Resync_Point := Token_Ptr; 272 273 if Debug_Flag_R then 274 Error_Msg_SC ("resuming here!"); 275 end if; 276 end Resync_Resume; 277 278 -------------------- 279 -- Resync_To_When -- 280 -------------------- 281 282 procedure Resync_To_When is 283 begin 284 Resync_Init; 285 286 loop 287 -- Done if at semicolon, WHEN or IS 288 289 if Token = Tok_Semicolon 290 or else Token = Tok_When 291 or else Token = Tok_Is 292 then 293 exit; 294 295 -- Otherwise keep going 296 297 else 298 Scan; 299 end if; 300 end loop; 301 302 -- Fall out of loop with resynchronization complete 303 304 Resync_Resume; 305 end Resync_To_When; 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 343end Sync; 344