1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . S T R I N G S . W I D E _ W I D E _ S E A R C H -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2015, 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_Wide_Maps; use Ada.Strings.Wide_Wide_Maps; 33with System; use System; 34 35package body Ada.Strings.Wide_Wide_Search is 36 37 ----------------------- 38 -- Local Subprograms -- 39 ----------------------- 40 41 function Belongs 42 (Element : Wide_Wide_Character; 43 Set : Wide_Wide_Maps.Wide_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_Wide_Character; 55 Set : Wide_Wide_Maps.Wide_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_Wide_String; 72 Pattern : Wide_Wide_String; 73 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := 74 Wide_Wide_Maps.Identity) 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_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_Wide_String; 130 Pattern : Wide_Wide_String; 131 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 132 return Natural 133 is 134 PL1 : constant Integer := Pattern'Length - 1; 135 Num : Natural; 136 Ind : Natural; 137 Cur : Natural; 138 139 begin 140 if Pattern = "" then 141 raise Pattern_Error; 142 end if; 143 144 -- Check for null pointer in case checks are off 145 146 if Mapping = null then 147 raise Constraint_Error; 148 end if; 149 150 Num := 0; 151 Ind := Source'First; 152 while Ind <= Source'Last - PL1 loop 153 Cur := Ind; 154 for K in Pattern'Range loop 155 if Pattern (K) /= Mapping (Source (Cur)) then 156 Ind := Ind + 1; 157 goto Cont; 158 else 159 Cur := Cur + 1; 160 end if; 161 end loop; 162 163 Num := Num + 1; 164 Ind := Ind + Pattern'Length; 165 166 <<Cont>> 167 null; 168 end loop; 169 170 return Num; 171 end Count; 172 173 function Count 174 (Source : Wide_Wide_String; 175 Set : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural 176 is 177 N : Natural := 0; 178 179 begin 180 for J in Source'Range loop 181 if Is_In (Source (J), Set) then 182 N := N + 1; 183 end if; 184 end loop; 185 186 return N; 187 end Count; 188 189 ---------------- 190 -- Find_Token -- 191 ---------------- 192 193 procedure Find_Token 194 (Source : Wide_Wide_String; 195 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 196 From : Positive; 197 Test : Membership; 198 First : out Positive; 199 Last : out Natural) 200 is 201 begin 202 for J in From .. Source'Last loop 203 if Belongs (Source (J), Set, Test) then 204 First := J; 205 206 for K in J + 1 .. Source'Last loop 207 if not Belongs (Source (K), Set, Test) then 208 Last := K - 1; 209 return; 210 end if; 211 end loop; 212 213 -- Here if J indexes first char of token, and all chars after J 214 -- are in the token. 215 216 Last := Source'Last; 217 return; 218 end if; 219 end loop; 220 221 -- Here if no token found 222 223 First := From; 224 Last := 0; 225 end Find_Token; 226 227 procedure Find_Token 228 (Source : Wide_Wide_String; 229 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 230 Test : Membership; 231 First : out Positive; 232 Last : out Natural) 233 is 234 begin 235 for J in Source'Range loop 236 if Belongs (Source (J), Set, Test) then 237 First := J; 238 239 for K in J + 1 .. Source'Last loop 240 if not Belongs (Source (K), Set, Test) then 241 Last := K - 1; 242 return; 243 end if; 244 end loop; 245 246 -- Here if J indexes first char of token, and all chars after J 247 -- are in the token. 248 249 Last := Source'Last; 250 return; 251 end if; 252 end loop; 253 254 -- Here if no token found 255 256 -- RM 2005 A.4.3 (68/1) specifies that an exception must be raised if 257 -- Source'First is not positive and is assigned to First. Formulation 258 -- is slightly different in RM 2012, but the intent seems similar, so 259 -- we check explicitly for that condition. 260 261 if Source'First not in Positive then 262 raise Constraint_Error; 263 264 else 265 First := Source'First; 266 Last := 0; 267 end if; 268 end Find_Token; 269 270 ----------- 271 -- Index -- 272 ----------- 273 274 function Index 275 (Source : Wide_Wide_String; 276 Pattern : Wide_Wide_String; 277 Going : Direction := Forward; 278 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := 279 Wide_Wide_Maps.Identity) return Natural 280 is 281 PL1 : constant Integer := Pattern'Length - 1; 282 Cur : Natural; 283 284 Ind : Integer; 285 -- Index for start of match check. This can be negative if the pattern 286 -- length is greater than the string length, which is why this variable 287 -- is Integer instead of Natural. In this case, the search loops do not 288 -- execute at all, so this Ind value is never used. 289 290 begin 291 if Pattern = "" then 292 raise Pattern_Error; 293 end if; 294 295 -- Forwards case 296 297 if Going = Forward then 298 Ind := Source'First; 299 300 -- Unmapped forward case 301 302 if Mapping'Address = Wide_Wide_Maps.Identity'Address then 303 for J in 1 .. Source'Length - PL1 loop 304 if Pattern = Source (Ind .. Ind + PL1) then 305 return Ind; 306 else 307 Ind := Ind + 1; 308 end if; 309 end loop; 310 311 -- Mapped forward case 312 313 else 314 for J in 1 .. Source'Length - PL1 loop 315 Cur := Ind; 316 317 for K in Pattern'Range loop 318 if Pattern (K) /= Value (Mapping, Source (Cur)) then 319 goto Cont1; 320 else 321 Cur := Cur + 1; 322 end if; 323 end loop; 324 325 return Ind; 326 327 <<Cont1>> 328 Ind := Ind + 1; 329 end loop; 330 end if; 331 332 -- Backwards case 333 334 else 335 -- Unmapped backward case 336 337 Ind := Source'Last - PL1; 338 339 if Mapping'Address = Wide_Wide_Maps.Identity'Address then 340 for J in reverse 1 .. Source'Length - PL1 loop 341 if Pattern = Source (Ind .. Ind + PL1) then 342 return Ind; 343 else 344 Ind := Ind - 1; 345 end if; 346 end loop; 347 348 -- Mapped backward case 349 350 else 351 for J in reverse 1 .. Source'Length - PL1 loop 352 Cur := Ind; 353 354 for K in Pattern'Range loop 355 if Pattern (K) /= Value (Mapping, Source (Cur)) then 356 goto Cont2; 357 else 358 Cur := Cur + 1; 359 end if; 360 end loop; 361 362 return Ind; 363 364 <<Cont2>> 365 Ind := Ind - 1; 366 end loop; 367 end if; 368 end if; 369 370 -- Fall through if no match found. Note that the loops are skipped 371 -- completely in the case of the pattern being longer than the source. 372 373 return 0; 374 end Index; 375 376 function Index 377 (Source : Wide_Wide_String; 378 Pattern : Wide_Wide_String; 379 Going : Direction := Forward; 380 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 381 return Natural 382 is 383 PL1 : constant Integer := Pattern'Length - 1; 384 Ind : Natural; 385 Cur : Natural; 386 387 begin 388 if Pattern = "" then 389 raise Pattern_Error; 390 end if; 391 392 -- Check for null pointer in case checks are off 393 394 if Mapping = null then 395 raise Constraint_Error; 396 end if; 397 398 -- If Pattern longer than Source it can't be found 399 400 if Pattern'Length > Source'Length then 401 return 0; 402 end if; 403 404 -- Forwards case 405 406 if Going = Forward then 407 Ind := Source'First; 408 for J in 1 .. Source'Length - PL1 loop 409 Cur := Ind; 410 411 for K in Pattern'Range loop 412 if Pattern (K) /= Mapping.all (Source (Cur)) then 413 goto Cont1; 414 else 415 Cur := Cur + 1; 416 end if; 417 end loop; 418 419 return Ind; 420 421 <<Cont1>> 422 Ind := Ind + 1; 423 end loop; 424 425 -- Backwards case 426 427 else 428 Ind := Source'Last - PL1; 429 for J in reverse 1 .. Source'Length - PL1 loop 430 Cur := Ind; 431 432 for K in Pattern'Range loop 433 if Pattern (K) /= Mapping.all (Source (Cur)) then 434 goto Cont2; 435 else 436 Cur := Cur + 1; 437 end if; 438 end loop; 439 440 return Ind; 441 442 <<Cont2>> 443 Ind := Ind - 1; 444 end loop; 445 end if; 446 447 -- Fall through if no match found. Note that the loops are skipped 448 -- completely in the case of the pattern being longer than the source. 449 450 return 0; 451 end Index; 452 453 function Index 454 (Source : Wide_Wide_String; 455 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 456 Test : Membership := Inside; 457 Going : Direction := Forward) return Natural 458 is 459 begin 460 -- Forwards case 461 462 if Going = Forward then 463 for J in Source'Range loop 464 if Belongs (Source (J), Set, Test) then 465 return J; 466 end if; 467 end loop; 468 469 -- Backwards case 470 471 else 472 for J in reverse Source'Range loop 473 if Belongs (Source (J), Set, Test) then 474 return J; 475 end if; 476 end loop; 477 end if; 478 479 -- Fall through if no match 480 481 return 0; 482 end Index; 483 484 function Index 485 (Source : Wide_Wide_String; 486 Pattern : Wide_Wide_String; 487 From : Positive; 488 Going : Direction := Forward; 489 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := 490 Wide_Wide_Maps.Identity) return Natural 491 is 492 begin 493 if Going = Forward then 494 if From < Source'First then 495 raise Index_Error; 496 end if; 497 498 return 499 Index (Source (From .. Source'Last), Pattern, Forward, Mapping); 500 501 else 502 if From > Source'Last then 503 raise Index_Error; 504 end if; 505 506 return 507 Index (Source (Source'First .. From), Pattern, Backward, Mapping); 508 end if; 509 end Index; 510 511 function Index 512 (Source : Wide_Wide_String; 513 Pattern : Wide_Wide_String; 514 From : Positive; 515 Going : Direction := Forward; 516 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 517 return Natural 518 is 519 begin 520 if Going = Forward then 521 if From < Source'First then 522 raise Index_Error; 523 end if; 524 525 return Index 526 (Source (From .. Source'Last), Pattern, Forward, Mapping); 527 528 else 529 if From > Source'Last then 530 raise Index_Error; 531 end if; 532 533 return Index 534 (Source (Source'First .. From), Pattern, Backward, Mapping); 535 end if; 536 end Index; 537 538 function Index 539 (Source : Wide_Wide_String; 540 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 541 From : Positive; 542 Test : Membership := Inside; 543 Going : Direction := Forward) return Natural 544 is 545 begin 546 if Going = Forward then 547 if From < Source'First then 548 raise Index_Error; 549 end if; 550 551 return 552 Index (Source (From .. Source'Last), Set, Test, Forward); 553 554 else 555 if From > Source'Last then 556 raise Index_Error; 557 end if; 558 559 return 560 Index (Source (Source'First .. From), Set, Test, Backward); 561 end if; 562 end Index; 563 564 --------------------- 565 -- Index_Non_Blank -- 566 --------------------- 567 568 function Index_Non_Blank 569 (Source : Wide_Wide_String; 570 Going : Direction := Forward) return Natural 571 is 572 begin 573 if Going = Forward then 574 for J in Source'Range loop 575 if Source (J) /= Wide_Wide_Space then 576 return J; 577 end if; 578 end loop; 579 580 else -- Going = Backward 581 for J in reverse Source'Range loop 582 if Source (J) /= Wide_Wide_Space then 583 return J; 584 end if; 585 end loop; 586 end if; 587 588 -- Fall through if no match 589 590 return 0; 591 end Index_Non_Blank; 592 593 function Index_Non_Blank 594 (Source : Wide_Wide_String; 595 From : Positive; 596 Going : Direction := Forward) return Natural 597 is 598 begin 599 if Going = Forward then 600 if From < Source'First then 601 raise Index_Error; 602 end if; 603 604 return 605 Index_Non_Blank (Source (From .. Source'Last), Forward); 606 607 else 608 if From > Source'Last then 609 raise Index_Error; 610 end if; 611 612 return 613 Index_Non_Blank (Source (Source'First .. From), Backward); 614 end if; 615 end Index_Non_Blank; 616 617end Ada.Strings.Wide_Wide_Search; 618