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