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-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_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 -- RM 2005 A.4.3 (68/1) specifies that an exception must be raised if 256 -- Source'First is not positive and is assigned to First. Formulation 257 -- is slightly different in RM 2012, but the intent seems similar, so 258 -- we check explicitly for that condition. 259 260 if Source'First not in Positive then 261 raise Constraint_Error; 262 263 else 264 First := Source'First; 265 Last := 0; 266 end if; 267 end Find_Token; 268 269 ----------- 270 -- Index -- 271 ----------- 272 273 function Index 274 (Source : Wide_String; 275 Pattern : Wide_String; 276 Going : Direction := Forward; 277 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) 278 return Natural 279 is 280 PL1 : constant Integer := Pattern'Length - 1; 281 Cur : Natural; 282 283 Ind : Integer; 284 -- Index for start of match check. This can be negative if the pattern 285 -- length is greater than the string length, which is why this variable 286 -- is Integer instead of Natural. In this case, the search loops do not 287 -- execute at all, so this Ind value is never used. 288 289 begin 290 if Pattern = "" then 291 raise Pattern_Error; 292 end if; 293 294 -- Forwards case 295 296 if Going = Forward then 297 Ind := Source'First; 298 299 -- Unmapped forward case 300 301 if Mapping'Address = Wide_Maps.Identity'Address then 302 for J in 1 .. Source'Length - PL1 loop 303 if Pattern = Source (Ind .. Ind + PL1) then 304 return Ind; 305 else 306 Ind := Ind + 1; 307 end if; 308 end loop; 309 310 -- Mapped forward case 311 312 else 313 for J in 1 .. Source'Length - PL1 loop 314 Cur := Ind; 315 316 for K in Pattern'Range loop 317 if Pattern (K) /= Value (Mapping, Source (Cur)) then 318 goto Cont1; 319 else 320 Cur := Cur + 1; 321 end if; 322 end loop; 323 324 return Ind; 325 326 <<Cont1>> 327 Ind := Ind + 1; 328 end loop; 329 end if; 330 331 -- Backwards case 332 333 else 334 -- Unmapped backward case 335 336 Ind := Source'Last - PL1; 337 338 if Mapping'Address = Wide_Maps.Identity'Address then 339 for J in reverse 1 .. Source'Length - PL1 loop 340 if Pattern = Source (Ind .. Ind + PL1) then 341 return Ind; 342 else 343 Ind := Ind - 1; 344 end if; 345 end loop; 346 347 -- Mapped backward case 348 349 else 350 for J in reverse 1 .. Source'Length - PL1 loop 351 Cur := Ind; 352 353 for K in Pattern'Range loop 354 if Pattern (K) /= Value (Mapping, Source (Cur)) then 355 goto Cont2; 356 else 357 Cur := Cur + 1; 358 end if; 359 end loop; 360 361 return Ind; 362 363 <<Cont2>> 364 Ind := Ind - 1; 365 end loop; 366 end if; 367 end if; 368 369 -- Fall through if no match found. Note that the loops are skipped 370 -- completely in the case of the pattern being longer than the source. 371 372 return 0; 373 end Index; 374 375 function Index 376 (Source : Wide_String; 377 Pattern : Wide_String; 378 Going : Direction := Forward; 379 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural 380 is 381 PL1 : constant Integer := Pattern'Length - 1; 382 Ind : Natural; 383 Cur : Natural; 384 385 begin 386 if Pattern = "" then 387 raise Pattern_Error; 388 end if; 389 390 -- Check for null pointer in case checks are off 391 392 if Mapping = null then 393 raise Constraint_Error; 394 end if; 395 396 -- If Pattern longer than Source it can't be found 397 398 if Pattern'Length > Source'Length then 399 return 0; 400 end if; 401 402 -- Forwards case 403 404 if Going = Forward then 405 Ind := Source'First; 406 for J in 1 .. Source'Length - PL1 loop 407 Cur := Ind; 408 409 for K in Pattern'Range loop 410 if Pattern (K) /= Mapping.all (Source (Cur)) then 411 goto Cont1; 412 else 413 Cur := Cur + 1; 414 end if; 415 end loop; 416 417 return Ind; 418 419 <<Cont1>> 420 Ind := Ind + 1; 421 end loop; 422 423 -- Backwards case 424 425 else 426 Ind := Source'Last - PL1; 427 for J in reverse 1 .. Source'Length - PL1 loop 428 Cur := Ind; 429 430 for K in Pattern'Range loop 431 if Pattern (K) /= Mapping.all (Source (Cur)) then 432 goto Cont2; 433 else 434 Cur := Cur + 1; 435 end if; 436 end loop; 437 438 return Ind; 439 440 <<Cont2>> 441 Ind := Ind - 1; 442 end loop; 443 end if; 444 445 -- Fall through if no match found. Note that the loops are skipped 446 -- completely in the case of the pattern being longer than the source. 447 448 return 0; 449 end Index; 450 451 function Index 452 (Source : Wide_String; 453 Set : Wide_Maps.Wide_Character_Set; 454 Test : Membership := Inside; 455 Going : Direction := Forward) return Natural 456 is 457 begin 458 -- Forwards case 459 460 if Going = Forward then 461 for J in Source'Range loop 462 if Belongs (Source (J), Set, Test) then 463 return J; 464 end if; 465 end loop; 466 467 -- Backwards case 468 469 else 470 for J in reverse Source'Range loop 471 if Belongs (Source (J), Set, Test) then 472 return J; 473 end if; 474 end loop; 475 end if; 476 477 -- Fall through if no match 478 479 return 0; 480 end Index; 481 482 function Index 483 (Source : Wide_String; 484 Pattern : Wide_String; 485 From : Positive; 486 Going : Direction := Forward; 487 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) 488 return Natural 489 is 490 begin 491 if Going = Forward then 492 if From < Source'First then 493 raise Index_Error; 494 end if; 495 496 return 497 Index (Source (From .. Source'Last), Pattern, Forward, Mapping); 498 499 else 500 if From > Source'Last then 501 raise Index_Error; 502 end if; 503 504 return 505 Index (Source (Source'First .. From), Pattern, Backward, Mapping); 506 end if; 507 end Index; 508 509 function Index 510 (Source : Wide_String; 511 Pattern : Wide_String; 512 From : Positive; 513 Going : Direction := Forward; 514 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural 515 is 516 begin 517 if Going = Forward then 518 if From < Source'First then 519 raise Index_Error; 520 end if; 521 522 return Index 523 (Source (From .. Source'Last), Pattern, Forward, Mapping); 524 525 else 526 if From > Source'Last then 527 raise Index_Error; 528 end if; 529 530 return Index 531 (Source (Source'First .. From), Pattern, Backward, Mapping); 532 end if; 533 end Index; 534 535 function Index 536 (Source : Wide_String; 537 Set : Wide_Maps.Wide_Character_Set; 538 From : Positive; 539 Test : Membership := Inside; 540 Going : Direction := Forward) return Natural 541 is 542 begin 543 if Going = Forward then 544 if From < Source'First then 545 raise Index_Error; 546 end if; 547 548 return 549 Index (Source (From .. Source'Last), Set, Test, Forward); 550 551 else 552 if From > Source'Last then 553 raise Index_Error; 554 end if; 555 556 return 557 Index (Source (Source'First .. From), Set, Test, Backward); 558 end if; 559 end Index; 560 561 --------------------- 562 -- Index_Non_Blank -- 563 --------------------- 564 565 function Index_Non_Blank 566 (Source : Wide_String; 567 Going : Direction := Forward) return Natural 568 is 569 begin 570 if Going = Forward then 571 for J in Source'Range loop 572 if Source (J) /= Wide_Space then 573 return J; 574 end if; 575 end loop; 576 577 else -- Going = Backward 578 for J in reverse Source'Range loop 579 if Source (J) /= Wide_Space then 580 return J; 581 end if; 582 end loop; 583 end if; 584 585 -- Fall through if no match 586 587 return 0; 588 end Index_Non_Blank; 589 590 function Index_Non_Blank 591 (Source : Wide_String; 592 From : Positive; 593 Going : Direction := Forward) return Natural 594 is 595 begin 596 if Going = Forward then 597 if From < Source'First then 598 raise Index_Error; 599 end if; 600 601 return 602 Index_Non_Blank (Source (From .. Source'Last), Forward); 603 604 else 605 if From > Source'Last then 606 raise Index_Error; 607 end if; 608 609 return 610 Index_Non_Blank (Source (Source'First .. From), Backward); 611 end if; 612 end Index_Non_Blank; 613 614end Ada.Strings.Wide_Search; 615