1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . S T R I N G S . S U P E R B O U N D E D -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2003-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.Maps; use Ada.Strings.Maps; 33with Ada.Strings.Search; 34 35package body Ada.Strings.Superbounded is 36 37 ------------ 38 -- Concat -- 39 ------------ 40 41 function Concat 42 (Left : Super_String; 43 Right : Super_String) return Super_String 44 is 45 begin 46 return Result : Super_String (Left.Max_Length) do 47 declare 48 Llen : constant Natural := Left.Current_Length; 49 Rlen : constant Natural := Right.Current_Length; 50 Nlen : constant Natural := Llen + Rlen; 51 begin 52 if Nlen > Left.Max_Length then 53 raise Ada.Strings.Length_Error; 54 end if; 55 56 Result.Current_Length := Nlen; 57 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 58 Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen); 59 end; 60 end return; 61 end Concat; 62 63 function Concat 64 (Left : Super_String; 65 Right : String) return Super_String 66 is 67 begin 68 return Result : Super_String (Left.Max_Length) do 69 declare 70 Llen : constant Natural := Left.Current_Length; 71 Nlen : constant Natural := Llen + Right'Length; 72 begin 73 if Nlen > Left.Max_Length then 74 raise Ada.Strings.Length_Error; 75 end if; 76 77 Result.Current_Length := Nlen; 78 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 79 Result.Data (Llen + 1 .. Nlen) := Right; 80 end; 81 end return; 82 end Concat; 83 84 function Concat 85 (Left : String; 86 Right : Super_String) return Super_String 87 is 88 89 begin 90 return Result : Super_String (Right.Max_Length) do 91 declare 92 Llen : constant Natural := Left'Length; 93 Rlen : constant Natural := Right.Current_Length; 94 Nlen : constant Natural := Llen + Rlen; 95 begin 96 if Nlen > Right.Max_Length then 97 raise Ada.Strings.Length_Error; 98 end if; 99 100 Result.Current_Length := Nlen; 101 Result.Data (1 .. Llen) := Left; 102 Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen); 103 end; 104 end return; 105 end Concat; 106 107 function Concat 108 (Left : Super_String; 109 Right : Character) return Super_String 110 is 111 begin 112 return Result : Super_String (Left.Max_Length) do 113 declare 114 Llen : constant Natural := Left.Current_Length; 115 begin 116 if Llen = Left.Max_Length then 117 raise Ada.Strings.Length_Error; 118 end if; 119 120 Result.Current_Length := Llen + 1; 121 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 122 Result.Data (Result.Current_Length) := Right; 123 end; 124 end return; 125 end Concat; 126 127 function Concat 128 (Left : Character; 129 Right : Super_String) return Super_String 130 is 131 begin 132 return Result : Super_String (Right.Max_Length) do 133 declare 134 Rlen : constant Natural := Right.Current_Length; 135 begin 136 if Rlen = Right.Max_Length then 137 raise Ada.Strings.Length_Error; 138 end if; 139 140 Result.Current_Length := Rlen + 1; 141 Result.Data (1) := Left; 142 Result.Data (2 .. Result.Current_Length) := 143 Right.Data (1 .. Rlen); 144 end; 145 end return; 146 end Concat; 147 148 ----------- 149 -- Equal -- 150 ----------- 151 152 function "=" 153 (Left : Super_String; 154 Right : Super_String) return Boolean 155 is 156 begin 157 return Left.Current_Length = Right.Current_Length 158 and then Left.Data (1 .. Left.Current_Length) = 159 Right.Data (1 .. Right.Current_Length); 160 end "="; 161 162 function Equal 163 (Left : Super_String; 164 Right : String) return Boolean 165 is 166 begin 167 return Left.Current_Length = Right'Length 168 and then Left.Data (1 .. Left.Current_Length) = Right; 169 end Equal; 170 171 function Equal 172 (Left : String; 173 Right : Super_String) return Boolean 174 is 175 begin 176 return Left'Length = Right.Current_Length 177 and then Left = Right.Data (1 .. Right.Current_Length); 178 end Equal; 179 180 ------------- 181 -- Greater -- 182 ------------- 183 184 function Greater 185 (Left : Super_String; 186 Right : Super_String) return Boolean 187 is 188 begin 189 return Left.Data (1 .. Left.Current_Length) > 190 Right.Data (1 .. Right.Current_Length); 191 end Greater; 192 193 function Greater 194 (Left : Super_String; 195 Right : String) return Boolean 196 is 197 begin 198 return Left.Data (1 .. Left.Current_Length) > Right; 199 end Greater; 200 201 function Greater 202 (Left : String; 203 Right : Super_String) return Boolean 204 is 205 begin 206 return Left > Right.Data (1 .. Right.Current_Length); 207 end Greater; 208 209 ---------------------- 210 -- Greater_Or_Equal -- 211 ---------------------- 212 213 function Greater_Or_Equal 214 (Left : Super_String; 215 Right : Super_String) return Boolean 216 is 217 begin 218 return Left.Data (1 .. Left.Current_Length) >= 219 Right.Data (1 .. Right.Current_Length); 220 end Greater_Or_Equal; 221 222 function Greater_Or_Equal 223 (Left : Super_String; 224 Right : String) return Boolean 225 is 226 begin 227 return Left.Data (1 .. Left.Current_Length) >= Right; 228 end Greater_Or_Equal; 229 230 function Greater_Or_Equal 231 (Left : String; 232 Right : Super_String) return Boolean 233 is 234 begin 235 return Left >= Right.Data (1 .. Right.Current_Length); 236 end Greater_Or_Equal; 237 238 ---------- 239 -- Less -- 240 ---------- 241 242 function Less 243 (Left : Super_String; 244 Right : Super_String) return Boolean 245 is 246 begin 247 return Left.Data (1 .. Left.Current_Length) < 248 Right.Data (1 .. Right.Current_Length); 249 end Less; 250 251 function Less 252 (Left : Super_String; 253 Right : String) return Boolean 254 is 255 begin 256 return Left.Data (1 .. Left.Current_Length) < Right; 257 end Less; 258 259 function Less 260 (Left : String; 261 Right : Super_String) return Boolean 262 is 263 begin 264 return Left < Right.Data (1 .. Right.Current_Length); 265 end Less; 266 267 ------------------- 268 -- Less_Or_Equal -- 269 ------------------- 270 271 function Less_Or_Equal 272 (Left : Super_String; 273 Right : Super_String) return Boolean 274 is 275 begin 276 return Left.Data (1 .. Left.Current_Length) <= 277 Right.Data (1 .. Right.Current_Length); 278 end Less_Or_Equal; 279 280 function Less_Or_Equal 281 (Left : Super_String; 282 Right : String) return Boolean 283 is 284 begin 285 return Left.Data (1 .. Left.Current_Length) <= Right; 286 end Less_Or_Equal; 287 288 function Less_Or_Equal 289 (Left : String; 290 Right : Super_String) return Boolean 291 is 292 begin 293 return Left <= Right.Data (1 .. Right.Current_Length); 294 end Less_Or_Equal; 295 296 ---------------------- 297 -- Set_Super_String -- 298 ---------------------- 299 300 procedure Set_Super_String 301 (Target : out Super_String; 302 Source : String; 303 Drop : Truncation := Error) 304 is 305 Slen : constant Natural := Source'Length; 306 Max_Length : constant Positive := Target.Max_Length; 307 308 begin 309 if Slen <= Max_Length then 310 Target.Current_Length := Slen; 311 Target.Data (1 .. Slen) := Source; 312 313 else 314 case Drop is 315 when Strings.Right => 316 Target.Current_Length := Max_Length; 317 Target.Data (1 .. Max_Length) := 318 Source (Source'First .. Source'First - 1 + Max_Length); 319 320 when Strings.Left => 321 Target.Current_Length := Max_Length; 322 Target.Data (1 .. Max_Length) := 323 Source (Source'Last - (Max_Length - 1) .. Source'Last); 324 325 when Strings.Error => 326 raise Ada.Strings.Length_Error; 327 end case; 328 end if; 329 end Set_Super_String; 330 331 ------------------ 332 -- Super_Append -- 333 ------------------ 334 335 -- Case of Super_String and Super_String 336 337 function Super_Append 338 (Left : Super_String; 339 Right : Super_String; 340 Drop : Truncation := Error) return Super_String 341 is 342 Max_Length : constant Positive := Left.Max_Length; 343 Result : Super_String (Max_Length); 344 Llen : constant Natural := Left.Current_Length; 345 Rlen : constant Natural := Right.Current_Length; 346 Nlen : constant Natural := Llen + Rlen; 347 348 begin 349 if Nlen <= Max_Length then 350 Result.Current_Length := Nlen; 351 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 352 Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen); 353 354 else 355 Result.Current_Length := Max_Length; 356 357 case Drop is 358 when Strings.Right => 359 if Llen >= Max_Length then -- only case is Llen = Max_Length 360 Result.Data := Left.Data; 361 362 else 363 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 364 Result.Data (Llen + 1 .. Max_Length) := 365 Right.Data (1 .. Max_Length - Llen); 366 end if; 367 368 when Strings.Left => 369 if Rlen >= Max_Length then -- only case is Rlen = Max_Length 370 Result.Data := Right.Data; 371 372 else 373 Result.Data (1 .. Max_Length - Rlen) := 374 Left.Data (Llen - (Max_Length - Rlen - 1) .. Llen); 375 Result.Data (Max_Length - Rlen + 1 .. Max_Length) := 376 Right.Data (1 .. Rlen); 377 end if; 378 379 when Strings.Error => 380 raise Ada.Strings.Length_Error; 381 end case; 382 end if; 383 384 return Result; 385 end Super_Append; 386 387 procedure Super_Append 388 (Source : in out Super_String; 389 New_Item : Super_String; 390 Drop : Truncation := Error) 391 is 392 Max_Length : constant Positive := Source.Max_Length; 393 Llen : constant Natural := Source.Current_Length; 394 Rlen : constant Natural := New_Item.Current_Length; 395 Nlen : constant Natural := Llen + Rlen; 396 397 begin 398 if Nlen <= Max_Length then 399 Source.Current_Length := Nlen; 400 Source.Data (Llen + 1 .. Nlen) := New_Item.Data (1 .. Rlen); 401 402 else 403 Source.Current_Length := Max_Length; 404 405 case Drop is 406 when Strings.Right => 407 if Llen < Max_Length then 408 Source.Data (Llen + 1 .. Max_Length) := 409 New_Item.Data (1 .. Max_Length - Llen); 410 end if; 411 412 when Strings.Left => 413 if Rlen >= Max_Length then -- only case is Rlen = Max_Length 414 Source.Data := New_Item.Data; 415 416 else 417 Source.Data (1 .. Max_Length - Rlen) := 418 Source.Data (Llen - (Max_Length - Rlen - 1) .. Llen); 419 Source.Data (Max_Length - Rlen + 1 .. Max_Length) := 420 New_Item.Data (1 .. Rlen); 421 end if; 422 423 when Strings.Error => 424 raise Ada.Strings.Length_Error; 425 end case; 426 end if; 427 428 end Super_Append; 429 430 -- Case of Super_String and String 431 432 function Super_Append 433 (Left : Super_String; 434 Right : String; 435 Drop : Strings.Truncation := Strings.Error) return Super_String 436 is 437 Max_Length : constant Positive := Left.Max_Length; 438 Result : Super_String (Max_Length); 439 Llen : constant Natural := Left.Current_Length; 440 Rlen : constant Natural := Right'Length; 441 Nlen : constant Natural := Llen + Rlen; 442 443 begin 444 if Nlen <= Max_Length then 445 Result.Current_Length := Nlen; 446 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 447 Result.Data (Llen + 1 .. Nlen) := Right; 448 449 else 450 Result.Current_Length := Max_Length; 451 452 case Drop is 453 when Strings.Right => 454 if Llen >= Max_Length then -- only case is Llen = Max_Length 455 Result.Data := Left.Data; 456 457 else 458 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 459 Result.Data (Llen + 1 .. Max_Length) := 460 Right (Right'First .. Right'First - 1 + 461 Max_Length - Llen); 462 463 end if; 464 465 when Strings.Left => 466 if Rlen >= Max_Length then 467 Result.Data (1 .. Max_Length) := 468 Right (Right'Last - (Max_Length - 1) .. Right'Last); 469 470 else 471 Result.Data (1 .. Max_Length - Rlen) := 472 Left.Data (Llen - (Max_Length - Rlen - 1) .. Llen); 473 Result.Data (Max_Length - Rlen + 1 .. Max_Length) := 474 Right; 475 end if; 476 477 when Strings.Error => 478 raise Ada.Strings.Length_Error; 479 end case; 480 end if; 481 482 return Result; 483 end Super_Append; 484 485 procedure Super_Append 486 (Source : in out Super_String; 487 New_Item : String; 488 Drop : Truncation := Error) 489 is 490 Max_Length : constant Positive := Source.Max_Length; 491 Llen : constant Natural := Source.Current_Length; 492 Rlen : constant Natural := New_Item'Length; 493 Nlen : constant Natural := Llen + Rlen; 494 495 begin 496 if Nlen <= Max_Length then 497 Source.Current_Length := Nlen; 498 Source.Data (Llen + 1 .. Nlen) := New_Item; 499 500 else 501 Source.Current_Length := Max_Length; 502 503 case Drop is 504 when Strings.Right => 505 if Llen < Max_Length then 506 Source.Data (Llen + 1 .. Max_Length) := 507 New_Item (New_Item'First .. 508 New_Item'First - 1 + Max_Length - Llen); 509 end if; 510 511 when Strings.Left => 512 if Rlen >= Max_Length then 513 Source.Data (1 .. Max_Length) := 514 New_Item (New_Item'Last - (Max_Length - 1) .. 515 New_Item'Last); 516 517 else 518 Source.Data (1 .. Max_Length - Rlen) := 519 Source.Data (Llen - (Max_Length - Rlen - 1) .. Llen); 520 Source.Data (Max_Length - Rlen + 1 .. Max_Length) := 521 New_Item; 522 end if; 523 524 when Strings.Error => 525 raise Ada.Strings.Length_Error; 526 end case; 527 end if; 528 529 end Super_Append; 530 531 -- Case of String and Super_String 532 533 function Super_Append 534 (Left : String; 535 Right : Super_String; 536 Drop : Strings.Truncation := Strings.Error) return Super_String 537 is 538 Max_Length : constant Positive := Right.Max_Length; 539 Result : Super_String (Max_Length); 540 Llen : constant Natural := Left'Length; 541 Rlen : constant Natural := Right.Current_Length; 542 Nlen : constant Natural := Llen + Rlen; 543 544 begin 545 if Nlen <= Max_Length then 546 Result.Current_Length := Nlen; 547 Result.Data (1 .. Llen) := Left; 548 Result.Data (Llen + 1 .. Llen + Rlen) := Right.Data (1 .. Rlen); 549 550 else 551 Result.Current_Length := Max_Length; 552 553 case Drop is 554 when Strings.Right => 555 if Llen >= Max_Length then 556 Result.Data (1 .. Max_Length) := 557 Left (Left'First .. Left'First + (Max_Length - 1)); 558 559 else 560 Result.Data (1 .. Llen) := Left; 561 Result.Data (Llen + 1 .. Max_Length) := 562 Right.Data (1 .. Max_Length - Llen); 563 end if; 564 565 when Strings.Left => 566 if Rlen >= Max_Length then 567 Result.Data (1 .. Max_Length) := 568 Right.Data (Rlen - (Max_Length - 1) .. Rlen); 569 570 else 571 Result.Data (1 .. Max_Length - Rlen) := 572 Left (Left'Last - (Max_Length - Rlen - 1) .. Left'Last); 573 Result.Data (Max_Length - Rlen + 1 .. Max_Length) := 574 Right.Data (1 .. Rlen); 575 end if; 576 577 when Strings.Error => 578 raise Ada.Strings.Length_Error; 579 end case; 580 end if; 581 582 return Result; 583 end Super_Append; 584 585 -- Case of Super_String and Character 586 587 function Super_Append 588 (Left : Super_String; 589 Right : Character; 590 Drop : Strings.Truncation := Strings.Error) return Super_String 591 is 592 Max_Length : constant Positive := Left.Max_Length; 593 Result : Super_String (Max_Length); 594 Llen : constant Natural := Left.Current_Length; 595 596 begin 597 if Llen < Max_Length then 598 Result.Current_Length := Llen + 1; 599 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 600 Result.Data (Llen + 1) := Right; 601 return Result; 602 603 else 604 case Drop is 605 when Strings.Right => 606 return Left; 607 608 when Strings.Left => 609 Result.Current_Length := Max_Length; 610 Result.Data (1 .. Max_Length - 1) := 611 Left.Data (2 .. Max_Length); 612 Result.Data (Max_Length) := Right; 613 return Result; 614 615 when Strings.Error => 616 raise Ada.Strings.Length_Error; 617 end case; 618 end if; 619 end Super_Append; 620 621 procedure Super_Append 622 (Source : in out Super_String; 623 New_Item : Character; 624 Drop : Truncation := Error) 625 is 626 Max_Length : constant Positive := Source.Max_Length; 627 Llen : constant Natural := Source.Current_Length; 628 629 begin 630 if Llen < Max_Length then 631 Source.Current_Length := Llen + 1; 632 Source.Data (Llen + 1) := New_Item; 633 634 else 635 Source.Current_Length := Max_Length; 636 637 case Drop is 638 when Strings.Right => 639 null; 640 641 when Strings.Left => 642 Source.Data (1 .. Max_Length - 1) := 643 Source.Data (2 .. Max_Length); 644 Source.Data (Max_Length) := New_Item; 645 646 when Strings.Error => 647 raise Ada.Strings.Length_Error; 648 end case; 649 end if; 650 651 end Super_Append; 652 653 -- Case of Character and Super_String 654 655 function Super_Append 656 (Left : Character; 657 Right : Super_String; 658 Drop : Strings.Truncation := Strings.Error) return Super_String 659 is 660 Max_Length : constant Positive := Right.Max_Length; 661 Result : Super_String (Max_Length); 662 Rlen : constant Natural := Right.Current_Length; 663 664 begin 665 if Rlen < Max_Length then 666 Result.Current_Length := Rlen + 1; 667 Result.Data (1) := Left; 668 Result.Data (2 .. Rlen + 1) := Right.Data (1 .. Rlen); 669 return Result; 670 671 else 672 case Drop is 673 when Strings.Right => 674 Result.Current_Length := Max_Length; 675 Result.Data (1) := Left; 676 Result.Data (2 .. Max_Length) := 677 Right.Data (1 .. Max_Length - 1); 678 return Result; 679 680 when Strings.Left => 681 return Right; 682 683 when Strings.Error => 684 raise Ada.Strings.Length_Error; 685 end case; 686 end if; 687 end Super_Append; 688 689 ----------------- 690 -- Super_Count -- 691 ----------------- 692 693 function Super_Count 694 (Source : Super_String; 695 Pattern : String; 696 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural 697 is 698 begin 699 return 700 Search.Count 701 (Source.Data (1 .. Source.Current_Length), Pattern, Mapping); 702 end Super_Count; 703 704 function Super_Count 705 (Source : Super_String; 706 Pattern : String; 707 Mapping : Maps.Character_Mapping_Function) return Natural 708 is 709 begin 710 return 711 Search.Count 712 (Source.Data (1 .. Source.Current_Length), Pattern, Mapping); 713 end Super_Count; 714 715 function Super_Count 716 (Source : Super_String; 717 Set : Maps.Character_Set) return Natural 718 is 719 begin 720 return Search.Count (Source.Data (1 .. Source.Current_Length), Set); 721 end Super_Count; 722 723 ------------------ 724 -- Super_Delete -- 725 ------------------ 726 727 function Super_Delete 728 (Source : Super_String; 729 From : Positive; 730 Through : Natural) return Super_String 731 is 732 Result : Super_String (Source.Max_Length); 733 Slen : constant Natural := Source.Current_Length; 734 Num_Delete : constant Integer := Through - From + 1; 735 736 begin 737 if Num_Delete <= 0 then 738 return Source; 739 740 elsif From > Slen + 1 then 741 raise Ada.Strings.Index_Error; 742 743 elsif Through >= Slen then 744 Result.Current_Length := From - 1; 745 Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1); 746 return Result; 747 748 else 749 Result.Current_Length := Slen - Num_Delete; 750 Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1); 751 Result.Data (From .. Result.Current_Length) := 752 Source.Data (Through + 1 .. Slen); 753 return Result; 754 end if; 755 end Super_Delete; 756 757 procedure Super_Delete 758 (Source : in out Super_String; 759 From : Positive; 760 Through : Natural) 761 is 762 Slen : constant Natural := Source.Current_Length; 763 Num_Delete : constant Integer := Through - From + 1; 764 765 begin 766 if Num_Delete <= 0 then 767 return; 768 769 elsif From > Slen + 1 then 770 raise Ada.Strings.Index_Error; 771 772 elsif Through >= Slen then 773 Source.Current_Length := From - 1; 774 775 else 776 Source.Current_Length := Slen - Num_Delete; 777 Source.Data (From .. Source.Current_Length) := 778 Source.Data (Through + 1 .. Slen); 779 end if; 780 end Super_Delete; 781 782 ------------------- 783 -- Super_Element -- 784 ------------------- 785 786 function Super_Element 787 (Source : Super_String; 788 Index : Positive) return Character 789 is 790 begin 791 if Index <= Source.Current_Length then 792 return Source.Data (Index); 793 else 794 raise Strings.Index_Error; 795 end if; 796 end Super_Element; 797 798 ---------------------- 799 -- Super_Find_Token -- 800 ---------------------- 801 802 procedure Super_Find_Token 803 (Source : Super_String; 804 Set : Maps.Character_Set; 805 From : Positive; 806 Test : Strings.Membership; 807 First : out Positive; 808 Last : out Natural) 809 is 810 begin 811 Search.Find_Token 812 (Source.Data (From .. Source.Current_Length), Set, Test, First, Last); 813 end Super_Find_Token; 814 815 procedure Super_Find_Token 816 (Source : Super_String; 817 Set : Maps.Character_Set; 818 Test : Strings.Membership; 819 First : out Positive; 820 Last : out Natural) 821 is 822 begin 823 Search.Find_Token 824 (Source.Data (1 .. Source.Current_Length), Set, Test, First, Last); 825 end Super_Find_Token; 826 827 ---------------- 828 -- Super_Head -- 829 ---------------- 830 831 function Super_Head 832 (Source : Super_String; 833 Count : Natural; 834 Pad : Character := Space; 835 Drop : Strings.Truncation := Strings.Error) return Super_String 836 is 837 Max_Length : constant Positive := Source.Max_Length; 838 Result : Super_String (Max_Length); 839 Slen : constant Natural := Source.Current_Length; 840 Npad : constant Integer := Count - Slen; 841 842 begin 843 if Npad <= 0 then 844 Result.Current_Length := Count; 845 Result.Data (1 .. Count) := Source.Data (1 .. Count); 846 847 elsif Count <= Max_Length then 848 Result.Current_Length := Count; 849 Result.Data (1 .. Slen) := Source.Data (1 .. Slen); 850 Result.Data (Slen + 1 .. Count) := (others => Pad); 851 852 else 853 Result.Current_Length := Max_Length; 854 855 case Drop is 856 when Strings.Right => 857 Result.Data (1 .. Slen) := Source.Data (1 .. Slen); 858 Result.Data (Slen + 1 .. Max_Length) := (others => Pad); 859 860 when Strings.Left => 861 if Npad >= Max_Length then 862 Result.Data := (others => Pad); 863 864 else 865 Result.Data (1 .. Max_Length - Npad) := 866 Source.Data (Count - Max_Length + 1 .. Slen); 867 Result.Data (Max_Length - Npad + 1 .. Max_Length) := 868 (others => Pad); 869 end if; 870 871 when Strings.Error => 872 raise Ada.Strings.Length_Error; 873 end case; 874 end if; 875 876 return Result; 877 end Super_Head; 878 879 procedure Super_Head 880 (Source : in out Super_String; 881 Count : Natural; 882 Pad : Character := Space; 883 Drop : Truncation := Error) 884 is 885 Max_Length : constant Positive := Source.Max_Length; 886 Slen : constant Natural := Source.Current_Length; 887 Npad : constant Integer := Count - Slen; 888 Temp : String (1 .. Max_Length); 889 890 begin 891 if Npad <= 0 then 892 Source.Current_Length := Count; 893 894 elsif Count <= Max_Length then 895 Source.Current_Length := Count; 896 Source.Data (Slen + 1 .. Count) := (others => Pad); 897 898 else 899 Source.Current_Length := Max_Length; 900 901 case Drop is 902 when Strings.Right => 903 Source.Data (Slen + 1 .. Max_Length) := (others => Pad); 904 905 when Strings.Left => 906 if Npad > Max_Length then 907 Source.Data := (others => Pad); 908 909 else 910 Temp := Source.Data; 911 Source.Data (1 .. Max_Length - Npad) := 912 Temp (Count - Max_Length + 1 .. Slen); 913 914 for J in Max_Length - Npad + 1 .. Max_Length loop 915 Source.Data (J) := Pad; 916 end loop; 917 end if; 918 919 when Strings.Error => 920 raise Ada.Strings.Length_Error; 921 end case; 922 end if; 923 end Super_Head; 924 925 ----------------- 926 -- Super_Index -- 927 ----------------- 928 929 function Super_Index 930 (Source : Super_String; 931 Pattern : String; 932 Going : Strings.Direction := Strings.Forward; 933 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural 934 is 935 begin 936 return Search.Index 937 (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping); 938 end Super_Index; 939 940 function Super_Index 941 (Source : Super_String; 942 Pattern : String; 943 Going : Direction := Forward; 944 Mapping : Maps.Character_Mapping_Function) return Natural 945 is 946 begin 947 return Search.Index 948 (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping); 949 end Super_Index; 950 951 function Super_Index 952 (Source : Super_String; 953 Set : Maps.Character_Set; 954 Test : Strings.Membership := Strings.Inside; 955 Going : Strings.Direction := Strings.Forward) return Natural 956 is 957 begin 958 return Search.Index 959 (Source.Data (1 .. Source.Current_Length), Set, Test, Going); 960 end Super_Index; 961 962 function Super_Index 963 (Source : Super_String; 964 Pattern : String; 965 From : Positive; 966 Going : Direction := Forward; 967 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural 968 is 969 begin 970 return Search.Index 971 (Source.Data (1 .. Source.Current_Length), 972 Pattern, From, Going, Mapping); 973 end Super_Index; 974 975 function Super_Index 976 (Source : Super_String; 977 Pattern : String; 978 From : Positive; 979 Going : Direction := Forward; 980 Mapping : Maps.Character_Mapping_Function) return Natural 981 is 982 begin 983 return Search.Index 984 (Source.Data (1 .. Source.Current_Length), 985 Pattern, From, Going, Mapping); 986 end Super_Index; 987 988 function Super_Index 989 (Source : Super_String; 990 Set : Maps.Character_Set; 991 From : Positive; 992 Test : Membership := Inside; 993 Going : Direction := Forward) return Natural 994 is 995 begin 996 return Search.Index 997 (Source.Data (1 .. Source.Current_Length), Set, From, Test, Going); 998 end Super_Index; 999 1000 --------------------------- 1001 -- Super_Index_Non_Blank -- 1002 --------------------------- 1003 1004 function Super_Index_Non_Blank 1005 (Source : Super_String; 1006 Going : Strings.Direction := Strings.Forward) return Natural 1007 is 1008 begin 1009 return 1010 Search.Index_Non_Blank 1011 (Source.Data (1 .. Source.Current_Length), Going); 1012 end Super_Index_Non_Blank; 1013 1014 function Super_Index_Non_Blank 1015 (Source : Super_String; 1016 From : Positive; 1017 Going : Direction := Forward) return Natural 1018 is 1019 begin 1020 return 1021 Search.Index_Non_Blank 1022 (Source.Data (1 .. Source.Current_Length), From, Going); 1023 end Super_Index_Non_Blank; 1024 1025 ------------------ 1026 -- Super_Insert -- 1027 ------------------ 1028 1029 function Super_Insert 1030 (Source : Super_String; 1031 Before : Positive; 1032 New_Item : String; 1033 Drop : Strings.Truncation := Strings.Error) return Super_String 1034 is 1035 Max_Length : constant Positive := Source.Max_Length; 1036 Result : Super_String (Max_Length); 1037 Slen : constant Natural := Source.Current_Length; 1038 Nlen : constant Natural := New_Item'Length; 1039 Tlen : constant Natural := Slen + Nlen; 1040 Blen : constant Natural := Before - 1; 1041 Alen : constant Integer := Slen - Blen; 1042 Droplen : constant Integer := Tlen - Max_Length; 1043 1044 -- Tlen is the length of the total string before possible truncation. 1045 -- Blen, Alen are the lengths of the before and after pieces of the 1046 -- source string. 1047 1048 begin 1049 if Alen < 0 then 1050 raise Ada.Strings.Index_Error; 1051 1052 elsif Droplen <= 0 then 1053 Result.Current_Length := Tlen; 1054 Result.Data (1 .. Blen) := Source.Data (1 .. Blen); 1055 Result.Data (Before .. Before + Nlen - 1) := New_Item; 1056 Result.Data (Before + Nlen .. Tlen) := 1057 Source.Data (Before .. Slen); 1058 1059 else 1060 Result.Current_Length := Max_Length; 1061 1062 case Drop is 1063 when Strings.Right => 1064 Result.Data (1 .. Blen) := Source.Data (1 .. Blen); 1065 1066 if Droplen > Alen then 1067 Result.Data (Before .. Max_Length) := 1068 New_Item (New_Item'First 1069 .. New_Item'First + Max_Length - Before); 1070 else 1071 Result.Data (Before .. Before + Nlen - 1) := New_Item; 1072 Result.Data (Before + Nlen .. Max_Length) := 1073 Source.Data (Before .. Slen - Droplen); 1074 end if; 1075 1076 when Strings.Left => 1077 Result.Data (Max_Length - (Alen - 1) .. Max_Length) := 1078 Source.Data (Before .. Slen); 1079 1080 if Droplen >= Blen then 1081 Result.Data (1 .. Max_Length - Alen) := 1082 New_Item (New_Item'Last - (Max_Length - Alen) + 1 1083 .. New_Item'Last); 1084 else 1085 Result.Data 1086 (Blen - Droplen + 1 .. Max_Length - Alen) := 1087 New_Item; 1088 Result.Data (1 .. Blen - Droplen) := 1089 Source.Data (Droplen + 1 .. Blen); 1090 end if; 1091 1092 when Strings.Error => 1093 raise Ada.Strings.Length_Error; 1094 end case; 1095 end if; 1096 1097 return Result; 1098 end Super_Insert; 1099 1100 procedure Super_Insert 1101 (Source : in out Super_String; 1102 Before : Positive; 1103 New_Item : String; 1104 Drop : Strings.Truncation := Strings.Error) 1105 is 1106 begin 1107 -- We do a double copy here because this is one of the situations 1108 -- in which we move data to the right, and at least at the moment, 1109 -- GNAT is not handling such cases correctly ??? 1110 1111 Source := Super_Insert (Source, Before, New_Item, Drop); 1112 end Super_Insert; 1113 1114 ------------------ 1115 -- Super_Length -- 1116 ------------------ 1117 1118 function Super_Length (Source : Super_String) return Natural is 1119 begin 1120 return Source.Current_Length; 1121 end Super_Length; 1122 1123 --------------------- 1124 -- Super_Overwrite -- 1125 --------------------- 1126 1127 function Super_Overwrite 1128 (Source : Super_String; 1129 Position : Positive; 1130 New_Item : String; 1131 Drop : Strings.Truncation := Strings.Error) return Super_String 1132 is 1133 Max_Length : constant Positive := Source.Max_Length; 1134 Result : Super_String (Max_Length); 1135 Endpos : constant Natural := Position + New_Item'Length - 1; 1136 Slen : constant Natural := Source.Current_Length; 1137 Droplen : Natural; 1138 1139 begin 1140 if Position > Slen + 1 then 1141 raise Ada.Strings.Index_Error; 1142 1143 elsif New_Item'Length = 0 then 1144 return Source; 1145 1146 elsif Endpos <= Slen then 1147 Result.Current_Length := Source.Current_Length; 1148 Result.Data (1 .. Slen) := Source.Data (1 .. Slen); 1149 Result.Data (Position .. Endpos) := New_Item; 1150 return Result; 1151 1152 elsif Endpos <= Max_Length then 1153 Result.Current_Length := Endpos; 1154 Result.Data (1 .. Position - 1) := Source.Data (1 .. Position - 1); 1155 Result.Data (Position .. Endpos) := New_Item; 1156 return Result; 1157 1158 else 1159 Result.Current_Length := Max_Length; 1160 Droplen := Endpos - Max_Length; 1161 1162 case Drop is 1163 when Strings.Right => 1164 Result.Data (1 .. Position - 1) := 1165 Source.Data (1 .. Position - 1); 1166 1167 Result.Data (Position .. Max_Length) := 1168 New_Item (New_Item'First .. New_Item'Last - Droplen); 1169 return Result; 1170 1171 when Strings.Left => 1172 if New_Item'Length >= Max_Length then 1173 Result.Data (1 .. Max_Length) := 1174 New_Item (New_Item'Last - Max_Length + 1 .. 1175 New_Item'Last); 1176 return Result; 1177 1178 else 1179 Result.Data (1 .. Max_Length - New_Item'Length) := 1180 Source.Data (Droplen + 1 .. Position - 1); 1181 Result.Data 1182 (Max_Length - New_Item'Length + 1 .. Max_Length) := 1183 New_Item; 1184 return Result; 1185 end if; 1186 1187 when Strings.Error => 1188 raise Ada.Strings.Length_Error; 1189 end case; 1190 end if; 1191 end Super_Overwrite; 1192 1193 procedure Super_Overwrite 1194 (Source : in out Super_String; 1195 Position : Positive; 1196 New_Item : String; 1197 Drop : Strings.Truncation := Strings.Error) 1198 is 1199 Max_Length : constant Positive := Source.Max_Length; 1200 Endpos : constant Positive := Position + New_Item'Length - 1; 1201 Slen : constant Natural := Source.Current_Length; 1202 Droplen : Natural; 1203 1204 begin 1205 if Position > Slen + 1 then 1206 raise Ada.Strings.Index_Error; 1207 1208 elsif Endpos <= Slen then 1209 Source.Data (Position .. Endpos) := New_Item; 1210 1211 elsif Endpos <= Max_Length then 1212 Source.Data (Position .. Endpos) := New_Item; 1213 Source.Current_Length := Endpos; 1214 1215 else 1216 Source.Current_Length := Max_Length; 1217 Droplen := Endpos - Max_Length; 1218 1219 case Drop is 1220 when Strings.Right => 1221 Source.Data (Position .. Max_Length) := 1222 New_Item (New_Item'First .. New_Item'Last - Droplen); 1223 1224 when Strings.Left => 1225 if New_Item'Length > Max_Length then 1226 Source.Data (1 .. Max_Length) := 1227 New_Item (New_Item'Last - Max_Length + 1 .. 1228 New_Item'Last); 1229 1230 else 1231 Source.Data (1 .. Max_Length - New_Item'Length) := 1232 Source.Data (Droplen + 1 .. Position - 1); 1233 1234 Source.Data 1235 (Max_Length - New_Item'Length + 1 .. Max_Length) := 1236 New_Item; 1237 end if; 1238 1239 when Strings.Error => 1240 raise Ada.Strings.Length_Error; 1241 end case; 1242 end if; 1243 end Super_Overwrite; 1244 1245 --------------------------- 1246 -- Super_Replace_Element -- 1247 --------------------------- 1248 1249 procedure Super_Replace_Element 1250 (Source : in out Super_String; 1251 Index : Positive; 1252 By : Character) 1253 is 1254 begin 1255 if Index <= Source.Current_Length then 1256 Source.Data (Index) := By; 1257 else 1258 raise Ada.Strings.Index_Error; 1259 end if; 1260 end Super_Replace_Element; 1261 1262 ------------------------- 1263 -- Super_Replace_Slice -- 1264 ------------------------- 1265 1266 function Super_Replace_Slice 1267 (Source : Super_String; 1268 Low : Positive; 1269 High : Natural; 1270 By : String; 1271 Drop : Strings.Truncation := Strings.Error) return Super_String 1272 is 1273 Max_Length : constant Positive := Source.Max_Length; 1274 Slen : constant Natural := Source.Current_Length; 1275 1276 begin 1277 if Low > Slen + 1 then 1278 raise Strings.Index_Error; 1279 1280 elsif High < Low then 1281 return Super_Insert (Source, Low, By, Drop); 1282 1283 else 1284 declare 1285 Blen : constant Natural := Natural'Max (0, Low - 1); 1286 Alen : constant Natural := Natural'Max (0, Slen - High); 1287 Tlen : constant Natural := Blen + By'Length + Alen; 1288 Droplen : constant Integer := Tlen - Max_Length; 1289 Result : Super_String (Max_Length); 1290 1291 -- Tlen is the total length of the result string before any 1292 -- truncation. Blen and Alen are the lengths of the pieces 1293 -- of the original string that end up in the result string 1294 -- before and after the replaced slice. 1295 1296 begin 1297 if Droplen <= 0 then 1298 Result.Current_Length := Tlen; 1299 Result.Data (1 .. Blen) := Source.Data (1 .. Blen); 1300 Result.Data (Low .. Low + By'Length - 1) := By; 1301 Result.Data (Low + By'Length .. Tlen) := 1302 Source.Data (High + 1 .. Slen); 1303 1304 else 1305 Result.Current_Length := Max_Length; 1306 1307 case Drop is 1308 when Strings.Right => 1309 Result.Data (1 .. Blen) := Source.Data (1 .. Blen); 1310 1311 if Droplen > Alen then 1312 Result.Data (Low .. Max_Length) := 1313 By (By'First .. By'First + Max_Length - Low); 1314 else 1315 Result.Data (Low .. Low + By'Length - 1) := By; 1316 Result.Data (Low + By'Length .. Max_Length) := 1317 Source.Data (High + 1 .. Slen - Droplen); 1318 end if; 1319 1320 when Strings.Left => 1321 Result.Data (Max_Length - (Alen - 1) .. Max_Length) := 1322 Source.Data (High + 1 .. Slen); 1323 1324 if Droplen >= Blen then 1325 Result.Data (1 .. Max_Length - Alen) := 1326 By (By'Last - (Max_Length - Alen) + 1 .. By'Last); 1327 else 1328 Result.Data 1329 (Blen - Droplen + 1 .. Max_Length - Alen) := By; 1330 Result.Data (1 .. Blen - Droplen) := 1331 Source.Data (Droplen + 1 .. Blen); 1332 end if; 1333 1334 when Strings.Error => 1335 raise Ada.Strings.Length_Error; 1336 end case; 1337 end if; 1338 1339 return Result; 1340 end; 1341 end if; 1342 end Super_Replace_Slice; 1343 1344 procedure Super_Replace_Slice 1345 (Source : in out Super_String; 1346 Low : Positive; 1347 High : Natural; 1348 By : String; 1349 Drop : Strings.Truncation := Strings.Error) 1350 is 1351 begin 1352 -- We do a double copy here because this is one of the situations 1353 -- in which we move data to the right, and at least at the moment, 1354 -- GNAT is not handling such cases correctly ??? 1355 1356 Source := Super_Replace_Slice (Source, Low, High, By, Drop); 1357 end Super_Replace_Slice; 1358 1359 --------------------- 1360 -- Super_Replicate -- 1361 --------------------- 1362 1363 function Super_Replicate 1364 (Count : Natural; 1365 Item : Character; 1366 Drop : Truncation := Error; 1367 Max_Length : Positive) return Super_String 1368 is 1369 Result : Super_String (Max_Length); 1370 1371 begin 1372 if Count <= Max_Length then 1373 Result.Current_Length := Count; 1374 1375 elsif Drop = Strings.Error then 1376 raise Ada.Strings.Length_Error; 1377 1378 else 1379 Result.Current_Length := Max_Length; 1380 end if; 1381 1382 Result.Data (1 .. Result.Current_Length) := (others => Item); 1383 return Result; 1384 end Super_Replicate; 1385 1386 function Super_Replicate 1387 (Count : Natural; 1388 Item : String; 1389 Drop : Truncation := Error; 1390 Max_Length : Positive) return Super_String 1391 is 1392 Length : constant Integer := Count * Item'Length; 1393 Result : Super_String (Max_Length); 1394 Indx : Positive; 1395 1396 begin 1397 if Length <= Max_Length then 1398 Result.Current_Length := Length; 1399 1400 if Length > 0 then 1401 Indx := 1; 1402 1403 for J in 1 .. Count loop 1404 Result.Data (Indx .. Indx + Item'Length - 1) := Item; 1405 Indx := Indx + Item'Length; 1406 end loop; 1407 end if; 1408 1409 else 1410 Result.Current_Length := Max_Length; 1411 1412 case Drop is 1413 when Strings.Right => 1414 Indx := 1; 1415 1416 while Indx + Item'Length <= Max_Length + 1 loop 1417 Result.Data (Indx .. Indx + Item'Length - 1) := Item; 1418 Indx := Indx + Item'Length; 1419 end loop; 1420 1421 Result.Data (Indx .. Max_Length) := 1422 Item (Item'First .. Item'First + Max_Length - Indx); 1423 1424 when Strings.Left => 1425 Indx := Max_Length; 1426 1427 while Indx - Item'Length >= 1 loop 1428 Result.Data (Indx - (Item'Length - 1) .. Indx) := Item; 1429 Indx := Indx - Item'Length; 1430 end loop; 1431 1432 Result.Data (1 .. Indx) := 1433 Item (Item'Last - Indx + 1 .. Item'Last); 1434 1435 when Strings.Error => 1436 raise Ada.Strings.Length_Error; 1437 end case; 1438 end if; 1439 1440 return Result; 1441 end Super_Replicate; 1442 1443 function Super_Replicate 1444 (Count : Natural; 1445 Item : Super_String; 1446 Drop : Strings.Truncation := Strings.Error) return Super_String 1447 is 1448 begin 1449 return 1450 Super_Replicate 1451 (Count, 1452 Item.Data (1 .. Item.Current_Length), 1453 Drop, 1454 Item.Max_Length); 1455 end Super_Replicate; 1456 1457 ----------------- 1458 -- Super_Slice -- 1459 ----------------- 1460 1461 function Super_Slice 1462 (Source : Super_String; 1463 Low : Positive; 1464 High : Natural) return String 1465 is 1466 begin 1467 -- Note: test of High > Length is in accordance with AI95-00128 1468 1469 return R : String (Low .. High) do 1470 if Low > Source.Current_Length + 1 1471 or else High > Source.Current_Length 1472 then 1473 raise Index_Error; 1474 end if; 1475 1476 R := Source.Data (Low .. High); 1477 end return; 1478 end Super_Slice; 1479 1480 function Super_Slice 1481 (Source : Super_String; 1482 Low : Positive; 1483 High : Natural) return Super_String 1484 is 1485 begin 1486 return Result : Super_String (Source.Max_Length) do 1487 if Low > Source.Current_Length + 1 1488 or else High > Source.Current_Length 1489 then 1490 raise Index_Error; 1491 end if; 1492 1493 Result.Current_Length := High - Low + 1; 1494 Result.Data (1 .. Result.Current_Length) := Source.Data (Low .. High); 1495 end return; 1496 end Super_Slice; 1497 1498 procedure Super_Slice 1499 (Source : Super_String; 1500 Target : out Super_String; 1501 Low : Positive; 1502 High : Natural) 1503 is 1504 begin 1505 if Low > Source.Current_Length + 1 1506 or else High > Source.Current_Length 1507 then 1508 raise Index_Error; 1509 else 1510 Target.Current_Length := High - Low + 1; 1511 Target.Data (1 .. Target.Current_Length) := Source.Data (Low .. High); 1512 end if; 1513 end Super_Slice; 1514 1515 ---------------- 1516 -- Super_Tail -- 1517 ---------------- 1518 1519 function Super_Tail 1520 (Source : Super_String; 1521 Count : Natural; 1522 Pad : Character := Space; 1523 Drop : Strings.Truncation := Strings.Error) return Super_String 1524 is 1525 Max_Length : constant Positive := Source.Max_Length; 1526 Result : Super_String (Max_Length); 1527 Slen : constant Natural := Source.Current_Length; 1528 Npad : constant Integer := Count - Slen; 1529 1530 begin 1531 if Npad <= 0 then 1532 Result.Current_Length := Count; 1533 Result.Data (1 .. Count) := 1534 Source.Data (Slen - (Count - 1) .. Slen); 1535 1536 elsif Count <= Max_Length then 1537 Result.Current_Length := Count; 1538 Result.Data (1 .. Npad) := (others => Pad); 1539 Result.Data (Npad + 1 .. Count) := Source.Data (1 .. Slen); 1540 1541 else 1542 Result.Current_Length := Max_Length; 1543 1544 case Drop is 1545 when Strings.Right => 1546 if Npad >= Max_Length then 1547 Result.Data := (others => Pad); 1548 1549 else 1550 Result.Data (1 .. Npad) := (others => Pad); 1551 Result.Data (Npad + 1 .. Max_Length) := 1552 Source.Data (1 .. Max_Length - Npad); 1553 end if; 1554 1555 when Strings.Left => 1556 Result.Data (1 .. Max_Length - Slen) := (others => Pad); 1557 Result.Data (Max_Length - Slen + 1 .. Max_Length) := 1558 Source.Data (1 .. Slen); 1559 1560 when Strings.Error => 1561 raise Ada.Strings.Length_Error; 1562 end case; 1563 end if; 1564 1565 return Result; 1566 end Super_Tail; 1567 1568 procedure Super_Tail 1569 (Source : in out Super_String; 1570 Count : Natural; 1571 Pad : Character := Space; 1572 Drop : Truncation := Error) 1573 is 1574 Max_Length : constant Positive := Source.Max_Length; 1575 Slen : constant Natural := Source.Current_Length; 1576 Npad : constant Integer := Count - Slen; 1577 1578 Temp : constant String (1 .. Max_Length) := Source.Data; 1579 1580 begin 1581 if Npad <= 0 then 1582 Source.Current_Length := Count; 1583 Source.Data (1 .. Count) := 1584 Temp (Slen - (Count - 1) .. Slen); 1585 1586 elsif Count <= Max_Length then 1587 Source.Current_Length := Count; 1588 Source.Data (1 .. Npad) := (others => Pad); 1589 Source.Data (Npad + 1 .. Count) := Temp (1 .. Slen); 1590 1591 else 1592 Source.Current_Length := Max_Length; 1593 1594 case Drop is 1595 when Strings.Right => 1596 if Npad >= Max_Length then 1597 Source.Data := (others => Pad); 1598 1599 else 1600 Source.Data (1 .. Npad) := (others => Pad); 1601 Source.Data (Npad + 1 .. Max_Length) := 1602 Temp (1 .. Max_Length - Npad); 1603 end if; 1604 1605 when Strings.Left => 1606 for J in 1 .. Max_Length - Slen loop 1607 Source.Data (J) := Pad; 1608 end loop; 1609 1610 Source.Data (Max_Length - Slen + 1 .. Max_Length) := 1611 Temp (1 .. Slen); 1612 1613 when Strings.Error => 1614 raise Ada.Strings.Length_Error; 1615 end case; 1616 end if; 1617 end Super_Tail; 1618 1619 --------------------- 1620 -- Super_To_String -- 1621 --------------------- 1622 1623 function Super_To_String (Source : Super_String) return String is 1624 begin 1625 return R : String (1 .. Source.Current_Length) do 1626 R := Source.Data (1 .. Source.Current_Length); 1627 end return; 1628 end Super_To_String; 1629 1630 --------------------- 1631 -- Super_Translate -- 1632 --------------------- 1633 1634 function Super_Translate 1635 (Source : Super_String; 1636 Mapping : Maps.Character_Mapping) return Super_String 1637 is 1638 Result : Super_String (Source.Max_Length); 1639 1640 begin 1641 Result.Current_Length := Source.Current_Length; 1642 1643 for J in 1 .. Source.Current_Length loop 1644 Result.Data (J) := Value (Mapping, Source.Data (J)); 1645 end loop; 1646 1647 return Result; 1648 end Super_Translate; 1649 1650 procedure Super_Translate 1651 (Source : in out Super_String; 1652 Mapping : Maps.Character_Mapping) 1653 is 1654 begin 1655 for J in 1 .. Source.Current_Length loop 1656 Source.Data (J) := Value (Mapping, Source.Data (J)); 1657 end loop; 1658 end Super_Translate; 1659 1660 function Super_Translate 1661 (Source : Super_String; 1662 Mapping : Maps.Character_Mapping_Function) return Super_String 1663 is 1664 Result : Super_String (Source.Max_Length); 1665 1666 begin 1667 Result.Current_Length := Source.Current_Length; 1668 1669 for J in 1 .. Source.Current_Length loop 1670 Result.Data (J) := Mapping.all (Source.Data (J)); 1671 end loop; 1672 1673 return Result; 1674 end Super_Translate; 1675 1676 procedure Super_Translate 1677 (Source : in out Super_String; 1678 Mapping : Maps.Character_Mapping_Function) 1679 is 1680 begin 1681 for J in 1 .. Source.Current_Length loop 1682 Source.Data (J) := Mapping.all (Source.Data (J)); 1683 end loop; 1684 end Super_Translate; 1685 1686 ---------------- 1687 -- Super_Trim -- 1688 ---------------- 1689 1690 function Super_Trim 1691 (Source : Super_String; 1692 Side : Trim_End) return Super_String 1693 is 1694 Result : Super_String (Source.Max_Length); 1695 Last : Natural := Source.Current_Length; 1696 First : Positive := 1; 1697 1698 begin 1699 if Side = Left or else Side = Both then 1700 while First <= Last and then Source.Data (First) = ' ' loop 1701 First := First + 1; 1702 end loop; 1703 end if; 1704 1705 if Side = Right or else Side = Both then 1706 while Last >= First and then Source.Data (Last) = ' ' loop 1707 Last := Last - 1; 1708 end loop; 1709 end if; 1710 1711 Result.Current_Length := Last - First + 1; 1712 Result.Data (1 .. Result.Current_Length) := Source.Data (First .. Last); 1713 return Result; 1714 end Super_Trim; 1715 1716 procedure Super_Trim 1717 (Source : in out Super_String; 1718 Side : Trim_End) 1719 is 1720 Max_Length : constant Positive := Source.Max_Length; 1721 Last : Natural := Source.Current_Length; 1722 First : Positive := 1; 1723 Temp : String (1 .. Max_Length); 1724 1725 begin 1726 Temp (1 .. Last) := Source.Data (1 .. Last); 1727 1728 if Side = Left or else Side = Both then 1729 while First <= Last and then Temp (First) = ' ' loop 1730 First := First + 1; 1731 end loop; 1732 end if; 1733 1734 if Side = Right or else Side = Both then 1735 while Last >= First and then Temp (Last) = ' ' loop 1736 Last := Last - 1; 1737 end loop; 1738 end if; 1739 1740 Source.Data := (others => ASCII.NUL); 1741 Source.Current_Length := Last - First + 1; 1742 Source.Data (1 .. Source.Current_Length) := Temp (First .. Last); 1743 end Super_Trim; 1744 1745 function Super_Trim 1746 (Source : Super_String; 1747 Left : Maps.Character_Set; 1748 Right : Maps.Character_Set) return Super_String 1749 is 1750 Result : Super_String (Source.Max_Length); 1751 1752 begin 1753 for First in 1 .. Source.Current_Length loop 1754 if not Is_In (Source.Data (First), Left) then 1755 for Last in reverse First .. Source.Current_Length loop 1756 if not Is_In (Source.Data (Last), Right) then 1757 Result.Current_Length := Last - First + 1; 1758 Result.Data (1 .. Result.Current_Length) := 1759 Source.Data (First .. Last); 1760 return Result; 1761 end if; 1762 end loop; 1763 end if; 1764 end loop; 1765 1766 Result.Current_Length := 0; 1767 return Result; 1768 end Super_Trim; 1769 1770 procedure Super_Trim 1771 (Source : in out Super_String; 1772 Left : Maps.Character_Set; 1773 Right : Maps.Character_Set) 1774 is 1775 begin 1776 for First in 1 .. Source.Current_Length loop 1777 if not Is_In (Source.Data (First), Left) then 1778 for Last in reverse First .. Source.Current_Length loop 1779 if not Is_In (Source.Data (Last), Right) then 1780 if First = 1 then 1781 Source.Current_Length := Last; 1782 return; 1783 else 1784 Source.Current_Length := Last - First + 1; 1785 Source.Data (1 .. Source.Current_Length) := 1786 Source.Data (First .. Last); 1787 1788 for J in Source.Current_Length + 1 .. 1789 Source.Max_Length 1790 loop 1791 Source.Data (J) := ASCII.NUL; 1792 end loop; 1793 1794 return; 1795 end if; 1796 end if; 1797 end loop; 1798 1799 Source.Current_Length := 0; 1800 return; 1801 end if; 1802 end loop; 1803 1804 Source.Current_Length := 0; 1805 end Super_Trim; 1806 1807 ----------- 1808 -- Times -- 1809 ----------- 1810 1811 function Times 1812 (Left : Natural; 1813 Right : Character; 1814 Max_Length : Positive) return Super_String 1815 is 1816 Result : Super_String (Max_Length); 1817 1818 begin 1819 if Left > Max_Length then 1820 raise Ada.Strings.Length_Error; 1821 1822 else 1823 Result.Current_Length := Left; 1824 1825 for J in 1 .. Left loop 1826 Result.Data (J) := Right; 1827 end loop; 1828 end if; 1829 1830 return Result; 1831 end Times; 1832 1833 function Times 1834 (Left : Natural; 1835 Right : String; 1836 Max_Length : Positive) return Super_String 1837 is 1838 Result : Super_String (Max_Length); 1839 Pos : Positive := 1; 1840 Rlen : constant Natural := Right'Length; 1841 Nlen : constant Natural := Left * Rlen; 1842 1843 begin 1844 if Nlen > Max_Length then 1845 raise Ada.Strings.Index_Error; 1846 1847 else 1848 Result.Current_Length := Nlen; 1849 1850 if Nlen > 0 then 1851 for J in 1 .. Left loop 1852 Result.Data (Pos .. Pos + Rlen - 1) := Right; 1853 Pos := Pos + Rlen; 1854 end loop; 1855 end if; 1856 end if; 1857 1858 return Result; 1859 end Times; 1860 1861 function Times 1862 (Left : Natural; 1863 Right : Super_String) return Super_String 1864 is 1865 Result : Super_String (Right.Max_Length); 1866 Pos : Positive := 1; 1867 Rlen : constant Natural := Right.Current_Length; 1868 Nlen : constant Natural := Left * Rlen; 1869 1870 begin 1871 if Nlen > Right.Max_Length then 1872 raise Ada.Strings.Length_Error; 1873 1874 else 1875 Result.Current_Length := Nlen; 1876 1877 if Nlen > 0 then 1878 for J in 1 .. Left loop 1879 Result.Data (Pos .. Pos + Rlen - 1) := 1880 Right.Data (1 .. Rlen); 1881 Pos := Pos + Rlen; 1882 end loop; 1883 end if; 1884 end if; 1885 1886 return Result; 1887 end Times; 1888 1889 --------------------- 1890 -- To_Super_String -- 1891 --------------------- 1892 1893 function To_Super_String 1894 (Source : String; 1895 Max_Length : Natural; 1896 Drop : Truncation := Error) return Super_String 1897 is 1898 Result : Super_String (Max_Length); 1899 Slen : constant Natural := Source'Length; 1900 1901 begin 1902 if Slen <= Max_Length then 1903 Result.Current_Length := Slen; 1904 Result.Data (1 .. Slen) := Source; 1905 1906 else 1907 case Drop is 1908 when Strings.Right => 1909 Result.Current_Length := Max_Length; 1910 Result.Data (1 .. Max_Length) := 1911 Source (Source'First .. Source'First - 1 + Max_Length); 1912 1913 when Strings.Left => 1914 Result.Current_Length := Max_Length; 1915 Result.Data (1 .. Max_Length) := 1916 Source (Source'Last - (Max_Length - 1) .. Source'Last); 1917 1918 when Strings.Error => 1919 raise Ada.Strings.Length_Error; 1920 end case; 1921 end if; 1922 1923 return Result; 1924 end To_Super_String; 1925 1926end Ada.Strings.Superbounded; 1927