The Ada Program: bounded_strings.adb

  1 -- bounded_strings.adb: generic package implementing bounded-length strings
  2 
  3 package body Bounded_Strings is
  4 
  5    function Length (Source : in Bounded_String) return Natural is
  6    begin
  7       return Source.Length;
  8    end Length;
  9 
 10    function Element (Source : in Bounded_String;
 11                      Index  : in Positive) return Character is
 12    begin
 13       return Source.Data(Index);
 14    end Element;
 15 
 16    ------------------------------------------------------------------------------
 17    -- Relational operators
 18    ------------------------------------------------------------------------------
 19    function "<" (Left, Right: Bounded_String) return Boolean is
 20    begin
 21       return  Left.Data(1..Left.Length) < Right.Data(1..Right.Length);
 22    end "<";
 23 
 24    function "<=" (Left, Right: Bounded_String) return Boolean is
 25    begin
 26       return  Left.Data(1..Left.Length) <= Right.Data(1..Right.Length);
 27    end "<=";
 28 
 29    function ">" (Left, Right: Bounded_String) return Boolean is
 30    begin
 31       return  Left.Data(1..Left.Length) > Right.Data(1..Right.Length);
 32    end ">";
 33 
 34    function ">=" (Left, Right: Bounded_String) return Boolean is
 35    begin
 36       return  Left.Data(1..Left.Length) >= Right.Data(1..Right.Length);
 37    end ">=";
 38 
 39    function Equal (Left, Right: Bounded_String) return Boolean is
 40    begin
 41       return  Left.Data(1..Left.Length) = Right.Data(1..Right.Length);
 42    end Equal;
 43 
 44 
 45    ------------------------------------------------------------------------------
 46    -- Concatenation operators
 47    ------------------------------------------------------------------------------
 48    function "&" (Left, Right: Bounded_String) return Bounded_String is
 49       Result : Bounded_String;
 50    begin
 51       Result.Length := Left.Length + Right.Length;
 52       Result.Data(1..Left.Length)               := Left.Data(1..Left.Length);
 53       Result.Data(Left.Length+1..Result.Length) := Right.Data(1..Right.Length);
 54       return Result;
 55    end "&";
 56 
 57    function "&" (Left : Bounded_String; Right: Character) return Bounded_String is
 58       Result : Bounded_String;
 59    begin
 60       Result.Length := Left.Length + 1;
 61       Result.Data(1..Left.Length) := Left.Data(1..Left.Length);
 62       Result.Data(Result.Length)  := Right;
 63       return Result;
 64    end "&";
 65 
 66    function "&" (Left : Character; Right: Bounded_String) return Bounded_String is
 67       Result : Bounded_String;
 68    begin
 69       Result.Length  := Right.Length + 1;
 70       Result.Data(1) := Left;
 71       Result.Data(2..Result.Length) := Right.Data(1..Right.Length);
 72       return Result;
 73    end "&";
 74 
 75    function "&" (Left : Bounded_String; Right: String) return Bounded_String is
 76       Result : Bounded_String;
 77    begin
 78       Result.Length := Left.Length + Right'Length;
 79       Result.Data(1..Left.Length)               := Left.Data(1..Left.Length);
 80       Result.Data(Left.Length+1..Result.Length) := Right;
 81       return Result;
 82    end "&";
 83 
 84    function "&" (Left : String; Right: Bounded_String) return Bounded_String is
 85       Result : Bounded_String;
 86    begin
 87       Result.Length := Left'Length + Right.Length;
 88       Result.Data(1..Left'Length)               := Left;
 89       Result.Data(Left'Length+1..Result.Length) := Right.Data(1..Right.Length);
 90       return Result;
 91    end "&";
 92 
 93 
 94    ------------------------------------------------------------------------------
 95    function Slice (Source : Bounded_String;
 96                    Low    : Positive;
 97                    High   : Natural) return Bounded_String is
 98       Result : Bounded_String;
 99    begin
100       if High < Low then                -- Null string?
101          Result.Length := 0;
102       elsif High <= Source.Length then  -- Normal case?
103          Result.Length := High - Low + 1;
104          Result.Data(1..Result.Length) := Source.Data(Low..High);
105       else                              -- Range out of bounds.
106          raise CONSTRAINT_ERROR;
107       end if;
108       return Result;
109    end Slice;
110 
111    ------------------------------------------------------------------------------
112    function Index (Source, Pattern :  Bounded_String) return Natural is
113       First : Positive;      -- Pattern is compared to
114       Last  : Positive;      -- Source (First..Last)
115    begin  -- Search
116       First := 1;            -- Begin search at the first position of Source
117       Last  := Pattern.Length;
118       Search_Loop:  -- Each iteration, the pattern is compared to one slice
119       loop          -- of the source
120          -- Exit when there are fewer characters remaining in Source to check
121          -- than there are in the Pattern   or   when match is found
122          exit when  Last > Source.Length  or else
123                     Source.Data(First..Last) = Pattern.Data(1..Pattern.Length);
124          First := First + 1;
125          Last  := Last  + 1;
126       end loop Search_Loop;
127       if Last <= Source.Length then   -- Did we find the pattern?
128          return First;
129       else
130          return 0;
131       end if;
132    end Index;
133 
134 
135    ------------------------------------------------------------------------------
136    function To_String (Source : in Bounded_String) return String is
137    begin
138       return Source.Data(1..Source.Length);   -- return the slice
139    end To_String;
140 
141    ------------------------------------------------------------------------------
142    function To_Bounded_String (Source : in String) return Bounded_String is
143       Result : Bounded_String;
144    begin
145       Result.Length := Source'Last - Source'First + 1;
146       Result.Data(1..Result.Length) := Source;
147       return Result;
148    end To_Bounded_String;
149 
150 
151    ------------------------------------------------------------------------------
152    -- Input and Output Operations
153    ------------------------------------------------------------------------------
154    procedure Get_Line (File : in  Text_IO.File_Type := Text_IO.Current_Input;
155                        Item : out Bounded_String) is
156    begin
157       Text_IO.Get_Line (File => File, Item => Item.Data, Last => Item.Length);
158    end Get_Line;
159 
160    ------------------------------------------------------------------------------
161    procedure Put (File : in Text_IO.File_Type := Text_IO.Current_Output;
162                   Item : in Bounded_String) is
163    begin
164       Text_IO.Put (File => File, Item => Item.Data (1..Item.Length));
165    end Put;
166 
167 end Bounded_Strings;