1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212 | with
lace.Strings.fixed,
ada.Characters.handling,
ada.Strings.Hash;
package body lace.Text
is
---------------
-- Construction
--
function to_Text (From : in String;
Trim : in Boolean := False) return Item
is
begin
return to_Text (From,
Capacity => From'Length,
Trim => Trim);
end to_Text;
function to_Text (From : in String;
Capacity : in Natural;
Trim : in Boolean := False) return Item
is
the_String : constant String := (if Trim then lace.Strings.fixed.Trim (From, ada.Strings.Both)
else From);
Self : Item (Capacity);
begin
Self.Length := the_String'Length;
Self.Data (1 .. Self.Length) := the_String;
return Self;
end to_Text;
function "+" (From : in String) return Item
is
begin
return to_Text (From);
end "+";
-------------
-- Attributes
--
procedure String_is (Self : in out Item;
Now : in String)
is
begin
Self.Data (1 .. Now'Length) := Now;
Self.Length := Now'Length;
end String_is;
function to_String (Self : in Item) return String
is
begin
return Self.Data (1 .. Self.Length);
end to_String;
function is_Empty (Self : in Item) return Boolean
is
begin
return Self.Length = 0;
end is_Empty;
function Length (Self : in Item) return Natural
is
begin
return Self.Length;
end Length;
function Image (Self : in Item) return String
is
begin
return
"(Capacity =>" & Self.Capacity'Image & "," &
" Length =>" & Self.Length 'Image & "," &
" Data => '" & to_String (Self) & "')";
end Image;
function Hashed (Self : in Item) return ada.Containers.Hash_type
is
begin
return ada.strings.Hash (Self.Data (1 .. Self.Length));
end Hashed;
overriding
function "=" (Left, Right : in Item) return Boolean
is
begin
if Left.Length /= Right.Length
then
return False;
end if;
return to_String (Left) = to_String (Right);
end "=";
function to_Lowercase (Self : in Item) return Item
is
use ada.Characters.handling;
Result : Item := Self;
begin
for i in 1 .. Self.Length
loop
Result.Data (i) := to_Lower (Self.Data (i));
end loop;
return Result;
end to_Lowercase;
function mono_Spaced (Self : in Item) return Item
is
Result : Item (Self.Capacity);
Prior : Character := 'a';
Length : Natural := 0;
begin
for i in 1 .. Self.Length
loop
if Self.Data (i) = ' '
and Prior = ' '
then
null;
else
Length := Length + 1;
Result.Data (Length) := Self.Data (i);
Prior := Self.Data (i);
end if;
end loop;
Result.Length := Length;
return Result;
end mono_Spaced;
----------
-- Streams
--
function Item_input (Stream : access ada.Streams.root_Stream_type'Class) return Item
is
Capacity : Positive;
Length : Natural;
begin
Positive'read (Stream, Capacity);
Natural 'read (Stream, Length);
declare
Data : String (1 .. Capacity);
begin
String'read (Stream, Data (1 .. Length));
return (Capacity => Capacity,
Data => Data,
Length => Length);
end;
end Item_input;
procedure Item_output (Stream : access ada.Streams.root_Stream_type'Class;
the_Item : in Item)
is
begin
Positive'write (Stream, the_Item.Capacity);
Natural 'write (Stream, the_Item.Length);
String 'write (Stream, the_Item.Data (1 .. the_Item.Length));
end Item_output;
procedure Write (Stream : access ada.Streams.root_Stream_type'Class;
Self : in Item)
is
begin
Natural'write (Stream, Self.Length);
String 'write (Stream, Self.Data (1 .. Self.Length));
end Write;
procedure Read (Stream : access ada.Streams.root_Stream_type'Class;
Self : out Item)
is
begin
Natural'read (Stream, Self.Length);
String 'read (Stream, Self.Data (1 .. Self.Length));
end Read;
end lace.Text;
|