1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . S T R I N G S . W I D E _ S E A R C H -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2010, 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. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps; 33with System; use System; 34 35package body Ada.Strings.Wide_Search is 36 37 ----------------------- 38 -- Local Subprograms -- 39 ----------------------- 40 41 function Belongs 42 (Element : Wide_Character; 43 Set : Wide_Maps.Wide_Character_Set; 44 Test : Membership) return Boolean; 45 pragma Inline (Belongs); 46 -- Determines if the given element is in (Test = Inside) or not in 47 -- (Test = Outside) the given character set. 48 49 ------------- 50 -- Belongs -- 51 ------------- 52 53 function Belongs 54 (Element : Wide_Character; 55 Set : Wide_Maps.Wide_Character_Set; 56 Test : Membership) return Boolean 57 is 58 begin 59 if Test = Inside then 60 return Is_In (Element, Set); 61 else 62 return not Is_In (Element, Set); 63 end if; 64 end Belongs; 65 66 ----------- 67 -- Count -- 68 ----------- 69 70 function Count 71 (Source : Wide_String; 72 Pattern : Wide_String; 73 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) 74 return Natural 75 is 76 PL1 : constant Integer := Pattern'Length - 1; 77 Num : Natural; 78 Ind : Natural; 79 Cur : Natural; 80 81 begin 82 if Pattern = "" then 83 raise Pattern_Error; 84 end if; 85 86 Num := 0; 87 Ind := Source'First; 88 89 -- Unmapped case 90 91 if Mapping'Address = Wide_Maps.Identity'Address then 92 while Ind <= Source'Last - PL1 loop 93 if Pattern = Source (Ind .. Ind + PL1) then 94 Num := Num + 1; 95 Ind := Ind + Pattern'Length; 96 else 97 Ind := Ind + 1; 98 end if; 99 end loop; 100 101 -- Mapped case 102 103 else 104 while Ind <= Source'Last - PL1 loop 105 Cur := Ind; 106 for K in Pattern'Range loop 107 if Pattern (K) /= Value (Mapping, Source (Cur)) then 108 Ind := Ind + 1; 109 goto Cont; 110 else 111 Cur := Cur + 1; 112 end if; 113 end loop; 114 115 Num := Num + 1; 116 Ind := Ind + Pattern'Length; 117 118 <<Cont>> 119 null; 120 end loop; 121 end if; 122 123 -- Return result 124 125 return Num; 126 end Count; 127 128 function Count 129 (Source : Wide_String; 130 Pattern : Wide_String; 131 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural 132 is 133 PL1 : constant Integer := Pattern'Length - 1; 134 Num : Natural; 135 Ind : Natural; 136 Cur : Natural; 137 138 begin 139 if Pattern = "" then 140 raise Pattern_Error; 141 end if; 142 143 -- Check for null pointer in case checks are off 144 145 if Mapping = null then 146 raise Constraint_Error; 147 end if; 148 149 Num := 0; 150 Ind := Source'First; 151 while Ind <= Source'Last - PL1 loop 152 Cur := Ind; 153 for K in Pattern'Range loop 154 if Pattern (K) /= Mapping (Source (Cur)) then 155 Ind := Ind + 1; 156 goto Cont; 157 else 158 Cur := Cur + 1; 159 end if; 160 end loop; 161 162 Num := Num + 1; 163 Ind := Ind + Pattern'Length; 164 165 <<Cont>> 166 null; 167 end loop; 168 169 return Num; 170 end Count; 171 172 function Count 173 (Source : Wide_String; 174 Set : Wide_Maps.Wide_Character_Set) return Natural 175 is 176 N : Natural := 0; 177 178 begin 179 for J in Source'Range loop 180 if Is_In (Source (J), Set) then 181 N := N + 1; 182 end if; 183 end loop; 184 185 return N; 186 end Count; 187 188 ---------------- 189 -- Find_Token -- 190 ---------------- 191 192 procedure Find_Token 193 (Source : Wide_String; 194 Set : Wide_Maps.Wide_Character_Set; 195 From : Positive; 196 Test : Membership; 197 First : out Positive; 198 Last : out Natural) 199 is 200 begin 201 for J in From .. Source'Last loop 202 if Belongs (Source (J), Set, Test) then 203 First := J; 204 205 for K in J + 1 .. Source'Last loop 206 if not Belongs (Source (K), Set, Test) then 207 Last := K - 1; 208 return; 209 end if; 210 end loop; 211 212 -- Here if J indexes first char of token, and all chars after J 213 -- are in the token. 214 215 Last := Source'Last; 216 return; 217 end if; 218 end loop; 219 220 -- Here if no token found 221 222 First := From; 223 Last := 0; 224 end Find_Token; 225 226 procedure Find_Token 227 (Source : Wide_String; 228 Set : Wide_Maps.Wide_Character_Set; 229 Test : Membership; 230 First : out Positive; 231 Last : out Natural) 232 is 233 begin 234 for J in Source'Range loop 235 if Belongs (Source (J), Set, Test) then 236 First := J; 237 238 for K in J + 1 .. Source'Last loop 239 if not Belongs (Source (K), Set, Test) then 240 Last := K - 1; 241 return; 242 end if; 243 end loop; 244 245 -- Here if J indexes first char of token, and all chars after J 246 -- are in the token. 247 248 Last := Source'Last; 249 return; 250 end if; 251 end loop; 252 253 -- Here if no token found 254 255 First := Source'First; 256 Last := 0; 257 end Find_Token; 258 259 ----------- 260 -- Index -- 261 ----------- 262 263 function Index 264 (Source : Wide_String; 265 Pattern : Wide_String; 266 Going : Direction := Forward; 267 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) 268 return Natural 269 is 270 PL1 : constant Integer := Pattern'Length - 1; 271 Cur : Natural; 272 273 Ind : Integer; 274 -- Index for start of match check. This can be negative if the pattern 275 -- length is greater than the string length, which is why this variable 276 -- is Integer instead of Natural. In this case, the search loops do not 277 -- execute at all, so this Ind value is never used. 278 279 begin 280 if Pattern = "" then 281 raise Pattern_Error; 282 end if; 283 284 -- Forwards case 285 286 if Going = Forward then 287 Ind := Source'First; 288 289 -- Unmapped forward case 290 291 if Mapping'Address = Wide_Maps.Identity'Address then 292 for J in 1 .. Source'Length - PL1 loop 293 if Pattern = Source (Ind .. Ind + PL1) then 294 return Ind; 295 else 296 Ind := Ind + 1; 297 end if; 298 end loop; 299 300 -- Mapped forward case 301 302 else 303 for J in 1 .. Source'Length - PL1 loop 304 Cur := Ind; 305 306 for K in Pattern'Range loop 307 if Pattern (K) /= Value (Mapping, Source (Cur)) then 308 goto Cont1; 309 else 310 Cur := Cur + 1; 311 end if; 312 end loop; 313 314 return Ind; 315 316 <<Cont1>> 317 Ind := Ind + 1; 318 end loop; 319 end if; 320 321 -- Backwards case 322 323 else 324 -- Unmapped backward case 325 326 Ind := Source'Last - PL1; 327 328 if Mapping'Address = Wide_Maps.Identity'Address then 329 for J in reverse 1 .. Source'Length - PL1 loop 330 if Pattern = Source (Ind .. Ind + PL1) then 331 return Ind; 332 else 333 Ind := Ind - 1; 334 end if; 335 end loop; 336 337 -- Mapped backward case 338 339 else 340 for J in reverse 1 .. Source'Length - PL1 loop 341 Cur := Ind; 342 343 for K in Pattern'Range loop 344 if Pattern (K) /= Value (Mapping, Source (Cur)) then 345 goto Cont2; 346 else 347 Cur := Cur + 1; 348 end if; 349 end loop; 350 351 return Ind; 352 353 <<Cont2>> 354 Ind := Ind - 1; 355 end loop; 356 end if; 357 end if; 358 359 -- Fall through if no match found. Note that the loops are skipped 360 -- completely in the case of the pattern being longer than the source. 361 362 return 0; 363 end Index; 364 365 function Index 366 (Source : Wide_String; 367 Pattern : Wide_String; 368 Going : Direction := Forward; 369 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural 370 is 371 PL1 : constant Integer := Pattern'Length - 1; 372 Ind : Natural; 373 Cur : Natural; 374 375 begin 376 if Pattern = "" then 377 raise Pattern_Error; 378 end if; 379 380 -- Check for null pointer in case checks are off 381 382 if Mapping = null then 383 raise Constraint_Error; 384 end if; 385 386 -- If Pattern longer than Source it can't be found 387 388 if Pattern'Length > Source'Length then 389 return 0; 390 end if; 391 392 -- Forwards case 393 394 if Going = Forward then 395 Ind := Source'First; 396 for J in 1 .. Source'Length - PL1 loop 397 Cur := Ind; 398 399 for K in Pattern'Range loop 400 if Pattern (K) /= Mapping.all (Source (Cur)) then 401 goto Cont1; 402 else 403 Cur := Cur + 1; 404 end if; 405 end loop; 406 407 return Ind; 408 409 <<Cont1>> 410 Ind := Ind + 1; 411 end loop; 412 413 -- Backwards case 414 415 else 416 Ind := Source'Last - PL1; 417 for J in reverse 1 .. Source'Length - PL1 loop 418 Cur := Ind; 419 420 for K in Pattern'Range loop 421 if Pattern (K) /= Mapping.all (Source (Cur)) then 422 goto Cont2; 423 else 424 Cur := Cur + 1; 425 end if; 426 end loop; 427 428 return Ind; 429 430 <<Cont2>> 431 Ind := Ind - 1; 432 end loop; 433 end if; 434 435 -- Fall through if no match found. Note that the loops are skipped 436 -- completely in the case of the pattern being longer than the source. 437 438 return 0; 439 end Index; 440 441 function Index 442 (Source : Wide_String; 443 Set : Wide_Maps.Wide_Character_Set; 444 Test : Membership := Inside; 445 Going : Direction := Forward) return Natural 446 is 447 begin 448 -- Forwards case 449 450 if Going = Forward then 451 for J in Source'Range loop 452 if Belongs (Source (J), Set, Test) then 453 return J; 454 end if; 455 end loop; 456 457 -- Backwards case 458 459 else 460 for J in reverse Source'Range loop 461 if Belongs (Source (J), Set, Test) then 462 return J; 463 end if; 464 end loop; 465 end if; 466 467 -- Fall through if no match 468 469 return 0; 470 end Index; 471 472 function Index 473 (Source : Wide_String; 474 Pattern : Wide_String; 475 From : Positive; 476 Going : Direction := Forward; 477 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) 478 return Natural 479 is 480 begin 481 if Going = Forward then 482 if From < Source'First then 483 raise Index_Error; 484 end if; 485 486 return 487 Index (Source (From .. Source'Last), Pattern, Forward, Mapping); 488 489 else 490 if From > Source'Last then 491 raise Index_Error; 492 end if; 493 494 return 495 Index (Source (Source'First .. From), Pattern, Backward, Mapping); 496 end if; 497 end Index; 498 499 function Index 500 (Source : Wide_String; 501 Pattern : Wide_String; 502 From : Positive; 503 Going : Direction := Forward; 504 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural 505 is 506 begin 507 if Going = Forward then 508 if From < Source'First then 509 raise Index_Error; 510 end if; 511 512 return Index 513 (Source (From .. Source'Last), Pattern, Forward, Mapping); 514 515 else 516 if From > Source'Last then 517 raise Index_Error; 518 end if; 519 520 return Index 521 (Source (Source'First .. From), Pattern, Backward, Mapping); 522 end if; 523 end Index; 524 525 function Index 526 (Source : Wide_String; 527 Set : Wide_Maps.Wide_Character_Set; 528 From : Positive; 529 Test : Membership := Inside; 530 Going : Direction := Forward) return Natural 531 is 532 begin 533 if Going = Forward then 534 if From < Source'First then 535 raise Index_Error; 536 end if; 537 538 return 539 Index (Source (From .. Source'Last), Set, Test, Forward); 540 541 else 542 if From > Source'Last then 543 raise Index_Error; 544 end if; 545 546 return 547 Index (Source (Source'First .. From), Set, Test, Backward); 548 end if; 549 end Index; 550 551 --------------------- 552 -- Index_Non_Blank -- 553 --------------------- 554 555 function Index_Non_Blank 556 (Source : Wide_String; 557 Going : Direction := Forward) return Natural 558 is 559 begin 560 if Going = Forward then 561 for J in Source'Range loop 562 if Source (J) /= Wide_Space then 563 return J; 564 end if; 565 end loop; 566 567 else -- Going = Backward 568 for J in reverse Source'Range loop 569 if Source (J) /= Wide_Space then 570 return J; 571 end if; 572 end loop; 573 end if; 574 575 -- Fall through if no match 576 577 return 0; 578 end Index_Non_Blank; 579 580 function Index_Non_Blank 581 (Source : Wide_String; 582 From : Positive; 583 Going : Direction := Forward) return Natural 584 is 585 begin 586 if Going = Forward then 587 if From < Source'First then 588 raise Index_Error; 589 end if; 590 591 return 592 Index_Non_Blank (Source (From .. Source'Last), Forward); 593 594 else 595 if From > Source'Last then 596 raise Index_Error; 597 end if; 598 599 return 600 Index_Non_Blank (Source (Source'First .. From), Backward); 601 end if; 602 end Index_Non_Blank; 603 604end Ada.Strings.Wide_Search; 605