]> gcc.gnu.org Git - gcc.git/blame - gcc/ada/a-stwise.adb
1aexcept.adb, [...]: Merge header, formatting and other trivial changes from ACT.
[gcc.git] / gcc / ada / a-stwise.adb
CommitLineData
d23b8f57
RK
1------------------------------------------------------------------------------
2-- --
3-- GNAT RUNTIME COMPONENTS --
4-- --
5-- A D A . S T R I N G S . W I D E _ S E A R C H --
6-- --
7-- B o d y --
8-- --
d23b8f57
RK
9-- Copyright (C) 1992,1993,1994 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 2, 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. See the GNU General Public License --
17-- for more details. You should have received a copy of the GNU General --
18-- Public License distributed with GNAT; see file COPYING. If not, write --
19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20-- MA 02111-1307, USA. --
21-- --
22-- As a special exception, if other files instantiate generics from this --
23-- unit, or you link this unit with other files to produce an executable, --
24-- this unit does not by itself cause the resulting executable to be --
25-- covered by the GNU General Public License. This exception does not --
26-- however invalidate any other reasons why the executable file might be --
27-- covered by the GNU Public License. --
28-- --
29-- GNAT was originally developed by the GNAT team at New York University. --
71ff80dc 30-- Extensive contributions were provided by Ada Core Technologies Inc. --
d23b8f57
RK
31-- --
32------------------------------------------------------------------------------
33
34with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
35
36package body Ada.Strings.Wide_Search is
37
38 -----------------------
39 -- Local Subprograms --
40 -----------------------
41
42 function Belongs
43 (Element : Wide_Character;
44 Set : Wide_Maps.Wide_Character_Set;
45 Test : Membership)
46 return Boolean;
47 pragma Inline (Belongs);
48 -- Determines if the given element is in (Test = Inside) or not in
49 -- (Test = Outside) the given character set.
50
51 -------------
52 -- Belongs --
53 -------------
54
55 function Belongs
56 (Element : Wide_Character;
57 Set : Wide_Maps.Wide_Character_Set;
58 Test : Membership)
59 return Boolean is
60
61 begin
62 if Test = Inside then
63 return Is_In (Element, Set);
64 else
65 return not Is_In (Element, Set);
66 end if;
67 end Belongs;
68
69 -----------
70 -- Count --
71 -----------
72
73 function Count
74 (Source : in Wide_String;
75 Pattern : in Wide_String;
76 Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
77 return Natural
78 is
79 N : Natural;
80 J : Natural;
81
82 begin
83 if Pattern = "" then
84 raise Pattern_Error;
85 end if;
86
87 -- Handle the case of non-identity mappings by creating a mapped
88 -- string and making a recursive call using the identity mapping
89 -- on this mapped string.
90
91 if Mapping /= Wide_Maps.Identity then
92 declare
93 Mapped_Source : Wide_String (Source'Range);
94
95 begin
96 for J in Source'Range loop
97 Mapped_Source (J) := Value (Mapping, Source (J));
98 end loop;
99
100 return Count (Mapped_Source, Pattern);
101 end;
102 end if;
103
104 N := 0;
105 J := Source'First;
106
107 while J <= Source'Last - (Pattern'Length - 1) loop
108 if Source (J .. J + (Pattern'Length - 1)) = Pattern then
109 N := N + 1;
110 J := J + Pattern'Length;
111 else
112 J := J + 1;
113 end if;
114 end loop;
115
116 return N;
117 end Count;
118
119 function Count
120 (Source : in Wide_String;
121 Pattern : in Wide_String;
122 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
123 return Natural
124 is
125 Mapped_Source : Wide_String (Source'Range);
126
127 begin
128 for J in Source'Range loop
129 Mapped_Source (J) := Mapping (Source (J));
130 end loop;
131
132 return Count (Mapped_Source, Pattern);
133 end Count;
134
135 function Count (Source : in Wide_String;
136 Set : in Wide_Maps.Wide_Character_Set)
137 return Natural
138 is
139 N : Natural := 0;
140
141 begin
142 for J in Source'Range loop
143 if Is_In (Source (J), Set) then
144 N := N + 1;
145 end if;
146 end loop;
147
148 return N;
149 end Count;
150
151 ----------------
152 -- Find_Token --
153 ----------------
154
155 procedure Find_Token
156 (Source : in Wide_String;
157 Set : in Wide_Maps.Wide_Character_Set;
158 Test : in Membership;
159 First : out Positive;
160 Last : out Natural)
161 is
162 begin
163 for J in Source'Range loop
164 if Belongs (Source (J), Set, Test) then
165 First := J;
166
167 for K in J + 1 .. Source'Last loop
168 if not Belongs (Source (K), Set, Test) then
169 Last := K - 1;
170 return;
171 end if;
172 end loop;
173
174 -- Here if J indexes 1st char of token, and all chars
175 -- after J are in the token
176
177 Last := Source'Last;
178 return;
179 end if;
180 end loop;
181
182 -- Here if no token found
183
184 First := Source'First;
185 Last := 0;
186 end Find_Token;
187
188 -----------
189 -- Index --
190 -----------
191
192 function Index
193 (Source : in Wide_String;
194 Pattern : in Wide_String;
195 Going : in Direction := Forward;
196 Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
197 return Natural
198 is
199 begin
200 if Pattern = "" then
201 raise Pattern_Error;
202 end if;
203
204 -- Handle the case of non-identity mappings by creating a mapped
205 -- string and making a recursive call using the identity mapping
206 -- on this mapped string.
207
208 if Mapping /= Identity then
209 declare
210 Mapped_Source : Wide_String (Source'Range);
211
212 begin
213 for J in Source'Range loop
214 Mapped_Source (J) := Value (Mapping, Source (J));
215 end loop;
216
217 return Index (Mapped_Source, Pattern, Going);
218 end;
219 end if;
220
221 if Going = Forward then
222 for J in Source'First .. Source'Last - Pattern'Length + 1 loop
223 if Pattern = Source (J .. J + Pattern'Length - 1) then
224 return J;
225 end if;
226 end loop;
227
228 else -- Going = Backward
229 for J in reverse Source'First .. Source'Last - Pattern'Length + 1 loop
230 if Pattern = Source (J .. J + Pattern'Length - 1) then
231 return J;
232 end if;
233 end loop;
234 end if;
235
236 -- Fall through if no match found. Note that the loops are skipped
237 -- completely in the case of the pattern being longer than the source.
238
239 return 0;
240 end Index;
241
242 -----------
243 -- Index --
244 -----------
245
246 function Index
247 (Source : in Wide_String;
248 Pattern : in Wide_String;
249 Going : in Direction := Forward;
250 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
251 return Natural
252 is
253 Mapped_Source : Wide_String (Source'Range);
254
255 begin
256 for J in Source'Range loop
257 Mapped_Source (J) := Mapping (Source (J));
258 end loop;
259
260 return Index (Mapped_Source, Pattern, Going);
261 end Index;
262
263 function Index
264 (Source : in Wide_String;
265 Set : in Wide_Maps.Wide_Character_Set;
266 Test : in Membership := Inside;
267 Going : in Direction := Forward)
268 return Natural
269 is
270 begin
271 if Going = Forward then
272 for J in Source'Range loop
273 if Belongs (Source (J), Set, Test) then
274 return J;
275 end if;
276 end loop;
277
278 else -- Going = Backward
279 for J in reverse Source'Range loop
280 if Belongs (Source (J), Set, Test) then
281 return J;
282 end if;
283 end loop;
284 end if;
285
286 -- Fall through if no match
287
288 return 0;
289 end Index;
290
291 ---------------------
292 -- Index_Non_Blank --
293 ---------------------
294
295 function Index_Non_Blank
296 (Source : in Wide_String;
297 Going : in Direction := Forward)
298 return Natural
299 is
300 begin
301 if Going = Forward then
302 for J in Source'Range loop
303 if Source (J) /= Wide_Space then
304 return J;
305 end if;
306 end loop;
307
308 else -- Going = Backward
309 for J in reverse Source'Range loop
310 if Source (J) /= Wide_Space then
311 return J;
312 end if;
313 end loop;
314 end if;
315
316 -- Fall through if no match
317
318 return 0;
319
320 end Index_Non_Blank;
321
322end Ada.Strings.Wide_Search;
This page took 0.372819 seconds and 5 git commands to generate.