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-2019, 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 -- Note: in this case, superflat bounds are not a problem, we just 1477 -- get the null string in accordance with normal Ada slice rules. 1478 1479 R := Source.Data (Low .. High); 1480 end return; 1481 end Super_Slice; 1482 1483 function Super_Slice 1484 (Source : Super_String; 1485 Low : Positive; 1486 High : Natural) return Super_String 1487 is 1488 begin 1489 return Result : Super_String (Source.Max_Length) do 1490 if Low > Source.Current_Length + 1 1491 or else High > Source.Current_Length 1492 then 1493 raise Index_Error; 1494 end if; 1495 1496 -- Note: the Max operation here deals with the superflat case 1497 1498 Result.Current_Length := Integer'Max (0, High - Low + 1); 1499 Result.Data (1 .. Result.Current_Length) := Source.Data (Low .. High); 1500 end return; 1501 end Super_Slice; 1502 1503 procedure Super_Slice 1504 (Source : Super_String; 1505 Target : out Super_String; 1506 Low : Positive; 1507 High : Natural) 1508 is 1509 begin 1510 if Low > Source.Current_Length + 1 1511 or else High > Source.Current_Length 1512 then 1513 raise Index_Error; 1514 end if; 1515 1516 -- Note: the Max operation here deals with the superflat case 1517 1518 Target.Current_Length := Integer'Max (0, High - Low + 1); 1519 Target.Data (1 .. Target.Current_Length) := Source.Data (Low .. High); 1520 end Super_Slice; 1521 1522 ---------------- 1523 -- Super_Tail -- 1524 ---------------- 1525 1526 function Super_Tail 1527 (Source : Super_String; 1528 Count : Natural; 1529 Pad : Character := Space; 1530 Drop : Strings.Truncation := Strings.Error) return Super_String 1531 is 1532 Max_Length : constant Positive := Source.Max_Length; 1533 Result : Super_String (Max_Length); 1534 Slen : constant Natural := Source.Current_Length; 1535 Npad : constant Integer := Count - Slen; 1536 1537 begin 1538 if Npad <= 0 then 1539 Result.Current_Length := Count; 1540 Result.Data (1 .. Count) := 1541 Source.Data (Slen - (Count - 1) .. Slen); 1542 1543 elsif Count <= Max_Length then 1544 Result.Current_Length := Count; 1545 Result.Data (1 .. Npad) := (others => Pad); 1546 Result.Data (Npad + 1 .. Count) := Source.Data (1 .. Slen); 1547 1548 else 1549 Result.Current_Length := Max_Length; 1550 1551 case Drop is 1552 when Strings.Right => 1553 if Npad >= Max_Length then 1554 Result.Data := (others => Pad); 1555 1556 else 1557 Result.Data (1 .. Npad) := (others => Pad); 1558 Result.Data (Npad + 1 .. Max_Length) := 1559 Source.Data (1 .. Max_Length - Npad); 1560 end if; 1561 1562 when Strings.Left => 1563 Result.Data (1 .. Max_Length - Slen) := (others => Pad); 1564 Result.Data (Max_Length - Slen + 1 .. Max_Length) := 1565 Source.Data (1 .. Slen); 1566 1567 when Strings.Error => 1568 raise Ada.Strings.Length_Error; 1569 end case; 1570 end if; 1571 1572 return Result; 1573 end Super_Tail; 1574 1575 procedure Super_Tail 1576 (Source : in out Super_String; 1577 Count : Natural; 1578 Pad : Character := Space; 1579 Drop : Truncation := Error) 1580 is 1581 Max_Length : constant Positive := Source.Max_Length; 1582 Slen : constant Natural := Source.Current_Length; 1583 Npad : constant Integer := Count - Slen; 1584 1585 Temp : constant String (1 .. Max_Length) := Source.Data; 1586 1587 begin 1588 if Npad <= 0 then 1589 Source.Current_Length := Count; 1590 Source.Data (1 .. Count) := 1591 Temp (Slen - (Count - 1) .. Slen); 1592 1593 elsif Count <= Max_Length then 1594 Source.Current_Length := Count; 1595 Source.Data (1 .. Npad) := (others => Pad); 1596 Source.Data (Npad + 1 .. Count) := Temp (1 .. Slen); 1597 1598 else 1599 Source.Current_Length := Max_Length; 1600 1601 case Drop is 1602 when Strings.Right => 1603 if Npad >= Max_Length then 1604 Source.Data := (others => Pad); 1605 1606 else 1607 Source.Data (1 .. Npad) := (others => Pad); 1608 Source.Data (Npad + 1 .. Max_Length) := 1609 Temp (1 .. Max_Length - Npad); 1610 end if; 1611 1612 when Strings.Left => 1613 for J in 1 .. Max_Length - Slen loop 1614 Source.Data (J) := Pad; 1615 end loop; 1616 1617 Source.Data (Max_Length - Slen + 1 .. Max_Length) := 1618 Temp (1 .. Slen); 1619 1620 when Strings.Error => 1621 raise Ada.Strings.Length_Error; 1622 end case; 1623 end if; 1624 end Super_Tail; 1625 1626 --------------------- 1627 -- Super_To_String -- 1628 --------------------- 1629 1630 function Super_To_String (Source : Super_String) return String is 1631 begin 1632 return R : String (1 .. Source.Current_Length) do 1633 R := Source.Data (1 .. Source.Current_Length); 1634 end return; 1635 end Super_To_String; 1636 1637 --------------------- 1638 -- Super_Translate -- 1639 --------------------- 1640 1641 function Super_Translate 1642 (Source : Super_String; 1643 Mapping : Maps.Character_Mapping) return Super_String 1644 is 1645 Result : Super_String (Source.Max_Length); 1646 1647 begin 1648 Result.Current_Length := Source.Current_Length; 1649 1650 for J in 1 .. Source.Current_Length loop 1651 Result.Data (J) := Value (Mapping, Source.Data (J)); 1652 end loop; 1653 1654 return Result; 1655 end Super_Translate; 1656 1657 procedure Super_Translate 1658 (Source : in out Super_String; 1659 Mapping : Maps.Character_Mapping) 1660 is 1661 begin 1662 for J in 1 .. Source.Current_Length loop 1663 Source.Data (J) := Value (Mapping, Source.Data (J)); 1664 end loop; 1665 end Super_Translate; 1666 1667 function Super_Translate 1668 (Source : Super_String; 1669 Mapping : Maps.Character_Mapping_Function) return Super_String 1670 is 1671 Result : Super_String (Source.Max_Length); 1672 1673 begin 1674 Result.Current_Length := Source.Current_Length; 1675 1676 for J in 1 .. Source.Current_Length loop 1677 Result.Data (J) := Mapping.all (Source.Data (J)); 1678 end loop; 1679 1680 return Result; 1681 end Super_Translate; 1682 1683 procedure Super_Translate 1684 (Source : in out Super_String; 1685 Mapping : Maps.Character_Mapping_Function) 1686 is 1687 begin 1688 for J in 1 .. Source.Current_Length loop 1689 Source.Data (J) := Mapping.all (Source.Data (J)); 1690 end loop; 1691 end Super_Translate; 1692 1693 ---------------- 1694 -- Super_Trim -- 1695 ---------------- 1696 1697 function Super_Trim 1698 (Source : Super_String; 1699 Side : Trim_End) return Super_String 1700 is 1701 Result : Super_String (Source.Max_Length); 1702 Last : Natural := Source.Current_Length; 1703 First : Positive := 1; 1704 1705 begin 1706 if Side = Left or else Side = Both then 1707 while First <= Last and then Source.Data (First) = ' ' loop 1708 First := First + 1; 1709 end loop; 1710 end if; 1711 1712 if Side = Right or else Side = Both then 1713 while Last >= First and then Source.Data (Last) = ' ' loop 1714 Last := Last - 1; 1715 end loop; 1716 end if; 1717 1718 Result.Current_Length := Last - First + 1; 1719 Result.Data (1 .. Result.Current_Length) := Source.Data (First .. Last); 1720 return Result; 1721 end Super_Trim; 1722 1723 procedure Super_Trim 1724 (Source : in out Super_String; 1725 Side : Trim_End) 1726 is 1727 Max_Length : constant Positive := Source.Max_Length; 1728 Last : Natural := Source.Current_Length; 1729 First : Positive := 1; 1730 Temp : String (1 .. Max_Length); 1731 1732 begin 1733 Temp (1 .. Last) := Source.Data (1 .. Last); 1734 1735 if Side = Left or else Side = Both then 1736 while First <= Last and then Temp (First) = ' ' loop 1737 First := First + 1; 1738 end loop; 1739 end if; 1740 1741 if Side = Right or else Side = Both then 1742 while Last >= First and then Temp (Last) = ' ' loop 1743 Last := Last - 1; 1744 end loop; 1745 end if; 1746 1747 Source.Current_Length := Last - First + 1; 1748 Source.Data (1 .. Source.Current_Length) := Temp (First .. Last); 1749 end Super_Trim; 1750 1751 function Super_Trim 1752 (Source : Super_String; 1753 Left : Maps.Character_Set; 1754 Right : Maps.Character_Set) return Super_String 1755 is 1756 Result : Super_String (Source.Max_Length); 1757 1758 begin 1759 for First in 1 .. Source.Current_Length loop 1760 if not Is_In (Source.Data (First), Left) then 1761 for Last in reverse First .. Source.Current_Length loop 1762 if not Is_In (Source.Data (Last), Right) then 1763 Result.Current_Length := Last - First + 1; 1764 Result.Data (1 .. Result.Current_Length) := 1765 Source.Data (First .. Last); 1766 return Result; 1767 end if; 1768 end loop; 1769 end if; 1770 end loop; 1771 1772 Result.Current_Length := 0; 1773 return Result; 1774 end Super_Trim; 1775 1776 procedure Super_Trim 1777 (Source : in out Super_String; 1778 Left : Maps.Character_Set; 1779 Right : Maps.Character_Set) 1780 is 1781 begin 1782 for First in 1 .. Source.Current_Length loop 1783 if not Is_In (Source.Data (First), Left) then 1784 for Last in reverse First .. Source.Current_Length loop 1785 if not Is_In (Source.Data (Last), Right) then 1786 if First = 1 then 1787 Source.Current_Length := Last; 1788 return; 1789 else 1790 Source.Current_Length := Last - First + 1; 1791 Source.Data (1 .. Source.Current_Length) := 1792 Source.Data (First .. Last); 1793 return; 1794 end if; 1795 end if; 1796 end loop; 1797 1798 Source.Current_Length := 0; 1799 return; 1800 end if; 1801 end loop; 1802 1803 Source.Current_Length := 0; 1804 end Super_Trim; 1805 1806 ----------- 1807 -- Times -- 1808 ----------- 1809 1810 function Times 1811 (Left : Natural; 1812 Right : Character; 1813 Max_Length : Positive) return Super_String 1814 is 1815 Result : Super_String (Max_Length); 1816 1817 begin 1818 if Left > Max_Length then 1819 raise Ada.Strings.Length_Error; 1820 1821 else 1822 Result.Current_Length := Left; 1823 1824 for J in 1 .. Left loop 1825 Result.Data (J) := Right; 1826 end loop; 1827 end if; 1828 1829 return Result; 1830 end Times; 1831 1832 function Times 1833 (Left : Natural; 1834 Right : String; 1835 Max_Length : Positive) return Super_String 1836 is 1837 Result : Super_String (Max_Length); 1838 Pos : Positive := 1; 1839 Rlen : constant Natural := Right'Length; 1840 Nlen : constant Natural := Left * Rlen; 1841 1842 begin 1843 if Nlen > Max_Length then 1844 raise Ada.Strings.Length_Error; 1845 1846 else 1847 Result.Current_Length := Nlen; 1848 1849 if Nlen > 0 then 1850 for J in 1 .. Left loop 1851 Result.Data (Pos .. Pos + Rlen - 1) := Right; 1852 Pos := Pos + Rlen; 1853 end loop; 1854 end if; 1855 end if; 1856 1857 return Result; 1858 end Times; 1859 1860 function Times 1861 (Left : Natural; 1862 Right : Super_String) return Super_String 1863 is 1864 Result : Super_String (Right.Max_Length); 1865 Pos : Positive := 1; 1866 Rlen : constant Natural := Right.Current_Length; 1867 Nlen : constant Natural := Left * Rlen; 1868 1869 begin 1870 if Nlen > Right.Max_Length then 1871 raise Ada.Strings.Length_Error; 1872 1873 else 1874 Result.Current_Length := Nlen; 1875 1876 if Nlen > 0 then 1877 for J in 1 .. Left loop 1878 Result.Data (Pos .. Pos + Rlen - 1) := 1879 Right.Data (1 .. Rlen); 1880 Pos := Pos + Rlen; 1881 end loop; 1882 end if; 1883 end if; 1884 1885 return Result; 1886 end Times; 1887 1888 --------------------- 1889 -- To_Super_String -- 1890 --------------------- 1891 1892 function To_Super_String 1893 (Source : String; 1894 Max_Length : Natural; 1895 Drop : Truncation := Error) return Super_String 1896 is 1897 Result : Super_String (Max_Length); 1898 Slen : constant Natural := Source'Length; 1899 1900 begin 1901 if Slen <= Max_Length then 1902 Result.Current_Length := Slen; 1903 Result.Data (1 .. Slen) := Source; 1904 1905 else 1906 case Drop is 1907 when Strings.Right => 1908 Result.Current_Length := Max_Length; 1909 Result.Data (1 .. Max_Length) := 1910 Source (Source'First .. Source'First - 1 + Max_Length); 1911 1912 when Strings.Left => 1913 Result.Current_Length := Max_Length; 1914 Result.Data (1 .. Max_Length) := 1915 Source (Source'Last - (Max_Length - 1) .. Source'Last); 1916 1917 when Strings.Error => 1918 raise Ada.Strings.Length_Error; 1919 end case; 1920 end if; 1921 1922 return Result; 1923 end To_Super_String; 1924 1925end Ada.Strings.Superbounded; 1926