1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . S T R I N G S . 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 32-- Note: This code is derived from the ADAR.CSH public domain Ada 83 33-- versions of the Appendix C string handling packages (code extracted 34-- from Ada.Strings.Fixed). A significant change is that we optimize the 35-- case of identity mappings for Count and Index, and also Index_Non_Blank 36-- is specialized (rather than using the general Index routine). 37 38with Ada.Strings.Maps; use Ada.Strings.Maps; 39with System; use System; 40 41package body Ada.Strings.Search is 42 43 ----------------------- 44 -- Local Subprograms -- 45 ----------------------- 46 47 function Belongs 48 (Element : Character; 49 Set : Maps.Character_Set; 50 Test : Membership) return Boolean; 51 pragma Inline (Belongs); 52 -- Determines if the given element is in (Test = Inside) or not in 53 -- (Test = Outside) the given character set. 54 55 ------------- 56 -- Belongs -- 57 ------------- 58 59 function Belongs 60 (Element : Character; 61 Set : Maps.Character_Set; 62 Test : Membership) return Boolean 63 is 64 begin 65 if Test = Inside then 66 return Is_In (Element, Set); 67 else 68 return not Is_In (Element, Set); 69 end if; 70 end Belongs; 71 72 ----------- 73 -- Count -- 74 ----------- 75 76 function Count 77 (Source : String; 78 Pattern : String; 79 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural 80 is 81 PL1 : constant Integer := Pattern'Length - 1; 82 Num : Natural; 83 Ind : Natural; 84 Cur : Natural; 85 86 begin 87 if Pattern = "" then 88 raise Pattern_Error; 89 end if; 90 91 Num := 0; 92 Ind := Source'First; 93 94 -- Unmapped case 95 96 if Mapping'Address = Maps.Identity'Address then 97 while Ind <= Source'Last - PL1 loop 98 if Pattern = Source (Ind .. Ind + PL1) then 99 Num := Num + 1; 100 Ind := Ind + Pattern'Length; 101 else 102 Ind := Ind + 1; 103 end if; 104 end loop; 105 106 -- Mapped case 107 108 else 109 while Ind <= Source'Last - PL1 loop 110 Cur := Ind; 111 for K in Pattern'Range loop 112 if Pattern (K) /= Value (Mapping, Source (Cur)) then 113 Ind := Ind + 1; 114 goto Cont; 115 else 116 Cur := Cur + 1; 117 end if; 118 end loop; 119 120 Num := Num + 1; 121 Ind := Ind + Pattern'Length; 122 123 <<Cont>> 124 null; 125 end loop; 126 end if; 127 128 -- Return result 129 130 return Num; 131 end Count; 132 133 function Count 134 (Source : String; 135 Pattern : String; 136 Mapping : Maps.Character_Mapping_Function) return Natural 137 is 138 PL1 : constant Integer := Pattern'Length - 1; 139 Num : Natural; 140 Ind : Natural; 141 Cur : Natural; 142 143 begin 144 if Pattern = "" then 145 raise Pattern_Error; 146 end if; 147 148 -- Check for null pointer in case checks are off 149 150 if Mapping = null then 151 raise Constraint_Error; 152 end if; 153 154 Num := 0; 155 Ind := Source'First; 156 while Ind <= Source'Last - PL1 loop 157 Cur := Ind; 158 for K in Pattern'Range loop 159 if Pattern (K) /= Mapping (Source (Cur)) then 160 Ind := Ind + 1; 161 goto Cont; 162 else 163 Cur := Cur + 1; 164 end if; 165 end loop; 166 167 Num := Num + 1; 168 Ind := Ind + Pattern'Length; 169 170 <<Cont>> 171 null; 172 end loop; 173 174 return Num; 175 end Count; 176 177 function Count 178 (Source : String; 179 Set : Maps.Character_Set) return Natural 180 is 181 N : Natural := 0; 182 183 begin 184 for J in Source'Range loop 185 if Is_In (Source (J), Set) then 186 N := N + 1; 187 end if; 188 end loop; 189 190 return N; 191 end Count; 192 193 ---------------- 194 -- Find_Token -- 195 ---------------- 196 197 procedure Find_Token 198 (Source : String; 199 Set : Maps.Character_Set; 200 From : Positive; 201 Test : Membership; 202 First : out Positive; 203 Last : out Natural) 204 is 205 begin 206 for J in From .. Source'Last loop 207 if Belongs (Source (J), Set, Test) then 208 First := J; 209 210 for K in J + 1 .. Source'Last loop 211 if not Belongs (Source (K), Set, Test) then 212 Last := K - 1; 213 return; 214 end if; 215 end loop; 216 217 -- Here if J indexes first char of token, and all chars after J 218 -- are in the token. 219 220 Last := Source'Last; 221 return; 222 end if; 223 end loop; 224 225 -- Here if no token found 226 227 First := From; 228 Last := 0; 229 end Find_Token; 230 231 procedure Find_Token 232 (Source : String; 233 Set : Maps.Character_Set; 234 Test : Membership; 235 First : out Positive; 236 Last : out Natural) 237 is 238 begin 239 for J in Source'Range loop 240 if Belongs (Source (J), Set, Test) then 241 First := J; 242 243 for K in J + 1 .. Source'Last loop 244 if not Belongs (Source (K), Set, Test) then 245 Last := K - 1; 246 return; 247 end if; 248 end loop; 249 250 -- Here if J indexes first char of token, and all chars after J 251 -- are in the token. 252 253 Last := Source'Last; 254 return; 255 end if; 256 end loop; 257 258 -- Here if no token found 259 260 First := Source'First; 261 Last := 0; 262 end Find_Token; 263 264 ----------- 265 -- Index -- 266 ----------- 267 268 function Index 269 (Source : String; 270 Pattern : String; 271 Going : Direction := Forward; 272 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural 273 is 274 PL1 : constant Integer := Pattern'Length - 1; 275 Cur : Natural; 276 277 Ind : Integer; 278 -- Index for start of match check. This can be negative if the pattern 279 -- length is greater than the string length, which is why this variable 280 -- is Integer instead of Natural. In this case, the search loops do not 281 -- execute at all, so this Ind value is never used. 282 283 begin 284 if Pattern = "" then 285 raise Pattern_Error; 286 end if; 287 288 -- Forwards case 289 290 if Going = Forward then 291 Ind := Source'First; 292 293 -- Unmapped forward case 294 295 if Mapping'Address = Maps.Identity'Address then 296 for J in 1 .. Source'Length - PL1 loop 297 if Pattern = Source (Ind .. Ind + PL1) then 298 return Ind; 299 else 300 Ind := Ind + 1; 301 end if; 302 end loop; 303 304 -- Mapped forward case 305 306 else 307 for J in 1 .. Source'Length - PL1 loop 308 Cur := Ind; 309 310 for K in Pattern'Range loop 311 if Pattern (K) /= Value (Mapping, Source (Cur)) then 312 goto Cont1; 313 else 314 Cur := Cur + 1; 315 end if; 316 end loop; 317 318 return Ind; 319 320 <<Cont1>> 321 Ind := Ind + 1; 322 end loop; 323 end if; 324 325 -- Backwards case 326 327 else 328 -- Unmapped backward case 329 330 Ind := Source'Last - PL1; 331 332 if Mapping'Address = Maps.Identity'Address then 333 for J in reverse 1 .. Source'Length - PL1 loop 334 if Pattern = Source (Ind .. Ind + PL1) then 335 return Ind; 336 else 337 Ind := Ind - 1; 338 end if; 339 end loop; 340 341 -- Mapped backward case 342 343 else 344 for J in reverse 1 .. Source'Length - PL1 loop 345 Cur := Ind; 346 347 for K in Pattern'Range loop 348 if Pattern (K) /= Value (Mapping, Source (Cur)) then 349 goto Cont2; 350 else 351 Cur := Cur + 1; 352 end if; 353 end loop; 354 355 return Ind; 356 357 <<Cont2>> 358 Ind := Ind - 1; 359 end loop; 360 end if; 361 end if; 362 363 -- Fall through if no match found. Note that the loops are skipped 364 -- completely in the case of the pattern being longer than the source. 365 366 return 0; 367 end Index; 368 369 function Index 370 (Source : String; 371 Pattern : String; 372 Going : Direction := Forward; 373 Mapping : Maps.Character_Mapping_Function) return Natural 374 is 375 PL1 : constant Integer := Pattern'Length - 1; 376 Ind : Natural; 377 Cur : Natural; 378 379 begin 380 if Pattern = "" then 381 raise Pattern_Error; 382 end if; 383 384 -- Check for null pointer in case checks are off 385 386 if Mapping = null then 387 raise Constraint_Error; 388 end if; 389 390 -- If Pattern longer than Source it can't be found 391 392 if Pattern'Length > Source'Length then 393 return 0; 394 end if; 395 396 -- Forwards case 397 398 if Going = Forward then 399 Ind := Source'First; 400 for J in 1 .. Source'Length - PL1 loop 401 Cur := Ind; 402 403 for K in Pattern'Range loop 404 if Pattern (K) /= Mapping.all (Source (Cur)) then 405 goto Cont1; 406 else 407 Cur := Cur + 1; 408 end if; 409 end loop; 410 411 return Ind; 412 413 <<Cont1>> 414 Ind := Ind + 1; 415 end loop; 416 417 -- Backwards case 418 419 else 420 Ind := Source'Last - PL1; 421 for J in reverse 1 .. Source'Length - PL1 loop 422 Cur := Ind; 423 424 for K in Pattern'Range loop 425 if Pattern (K) /= Mapping.all (Source (Cur)) then 426 goto Cont2; 427 else 428 Cur := Cur + 1; 429 end if; 430 end loop; 431 432 return Ind; 433 434 <<Cont2>> 435 Ind := Ind - 1; 436 end loop; 437 end if; 438 439 -- Fall through if no match found. Note that the loops are skipped 440 -- completely in the case of the pattern being longer than the source. 441 442 return 0; 443 end Index; 444 445 function Index 446 (Source : String; 447 Set : Maps.Character_Set; 448 Test : Membership := Inside; 449 Going : Direction := Forward) return Natural 450 is 451 begin 452 -- Forwards case 453 454 if Going = Forward then 455 for J in Source'Range loop 456 if Belongs (Source (J), Set, Test) then 457 return J; 458 end if; 459 end loop; 460 461 -- Backwards case 462 463 else 464 for J in reverse Source'Range loop 465 if Belongs (Source (J), Set, Test) then 466 return J; 467 end if; 468 end loop; 469 end if; 470 471 -- Fall through if no match 472 473 return 0; 474 end Index; 475 476 function Index 477 (Source : String; 478 Pattern : String; 479 From : Positive; 480 Going : Direction := Forward; 481 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural 482 is 483 begin 484 if Going = Forward then 485 if From < Source'First then 486 raise Index_Error; 487 end if; 488 489 return 490 Index (Source (From .. Source'Last), Pattern, Forward, Mapping); 491 492 else 493 if From > Source'Last then 494 raise Index_Error; 495 end if; 496 497 return 498 Index (Source (Source'First .. From), Pattern, Backward, Mapping); 499 end if; 500 end Index; 501 502 function Index 503 (Source : String; 504 Pattern : String; 505 From : Positive; 506 Going : Direction := Forward; 507 Mapping : Maps.Character_Mapping_Function) 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 : String; 530 Set : Maps.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 : 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) /= ' ' 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) /= ' ' 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 : 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.Search; 608