URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-stwise.adb] - Blame information for rev 729

Go to most recent revision | Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT RUN-TIME COMPONENTS                         --
--                                                                          --
--              A D A . S T R I N G S . W I D E _ S E A R C H               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
with System;                use System;
 
package body Ada.Strings.Wide_Search is
 
   -----------------------
   -- Local Subprograms --
   -----------------------
 
   function Belongs
     (Element : Wide_Character;
      Set     : Wide_Maps.Wide_Character_Set;
      Test    : Membership) return Boolean;
   pragma Inline (Belongs);
   --  Determines if the given element is in (Test = Inside) or not in
   --  (Test = Outside) the given character set.
 
   -------------
   -- Belongs --
   -------------
 
   function Belongs
     (Element : Wide_Character;
      Set     : Wide_Maps.Wide_Character_Set;
      Test    : Membership) return Boolean
   is
   begin
      if Test = Inside then
         return Is_In (Element, Set);
      else
         return not Is_In (Element, Set);
      end if;
   end Belongs;
 
   -----------
   -- Count --
   -----------
 
   function Count
     (Source  : Wide_String;
      Pattern : Wide_String;
      Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
      return Natural
   is
      PL1 : constant Integer := Pattern'Length - 1;
      Num : Natural;
      Ind : Natural;
      Cur : Natural;
 
   begin
      if Pattern = "" then
         raise Pattern_Error;
      end if;
 
      Num := 0;
      Ind := Source'First;
 
      --  Unmapped case
 
      if Mapping'Address = Wide_Maps.Identity'Address then
         while Ind <= Source'Last - PL1 loop
            if Pattern = Source (Ind .. Ind + PL1) then
               Num := Num + 1;
               Ind := Ind + Pattern'Length;
            else
               Ind := Ind + 1;
            end if;
         end loop;
 
      --  Mapped case
 
      else
         while Ind <= Source'Last - PL1 loop
            Cur := Ind;
            for K in Pattern'Range loop
               if Pattern (K) /= Value (Mapping, Source (Cur)) then
                  Ind := Ind + 1;
                  goto Cont;
               else
                  Cur := Cur + 1;
               end if;
            end loop;
 
            Num := Num + 1;
            Ind := Ind + Pattern'Length;
 
         <<Cont>>
            null;
         end loop;
      end if;
 
      --  Return result
 
      return Num;
   end Count;
 
   function Count
     (Source  : Wide_String;
      Pattern : Wide_String;
      Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
   is
      PL1 : constant Integer := Pattern'Length - 1;
      Num : Natural;
      Ind : Natural;
      Cur : Natural;
 
   begin
      if Pattern = "" then
         raise Pattern_Error;
      end if;
 
      --  Check for null pointer in case checks are off
 
      if Mapping = null then
         raise Constraint_Error;
      end if;
 
      Num := 0;
      Ind := Source'First;
      while Ind <= Source'Last - PL1 loop
         Cur := Ind;
         for K in Pattern'Range loop
            if Pattern (K) /= Mapping (Source (Cur)) then
               Ind := Ind + 1;
               goto Cont;
            else
               Cur := Cur + 1;
            end if;
         end loop;
 
         Num := Num + 1;
         Ind := Ind + Pattern'Length;
 
      <<Cont>>
         null;
      end loop;
 
      return Num;
   end Count;
 
   function Count
     (Source : Wide_String;
      Set    : Wide_Maps.Wide_Character_Set) return Natural
   is
      N : Natural := 0;
 
   begin
      for J in Source'Range loop
         if Is_In (Source (J), Set) then
            N := N + 1;
         end if;
      end loop;
 
      return N;
   end Count;
 
   ----------------
   -- Find_Token --
   ----------------
 
   procedure Find_Token
     (Source : Wide_String;
      Set    : Wide_Maps.Wide_Character_Set;
      From   : Positive;
      Test   : Membership;
      First  : out Positive;
      Last   : out Natural)
   is
   begin
      for J in From .. Source'Last loop
         if Belongs (Source (J), Set, Test) then
            First := J;
 
            for K in J + 1 .. Source'Last loop
               if not Belongs (Source (K), Set, Test) then
                  Last := K - 1;
                  return;
               end if;
            end loop;
 
            --  Here if J indexes first char of token, and all chars after J
            --  are in the token.
 
            Last := Source'Last;
            return;
         end if;
      end loop;
 
      --  Here if no token found
 
      First := From;
      Last  := 0;
   end Find_Token;
 
   procedure Find_Token
     (Source : Wide_String;
      Set    : Wide_Maps.Wide_Character_Set;
      Test   : Membership;
      First  : out Positive;
      Last   : out Natural)
   is
   begin
      for J in Source'Range loop
         if Belongs (Source (J), Set, Test) then
            First := J;
 
            for K in J + 1 .. Source'Last loop
               if not Belongs (Source (K), Set, Test) then
                  Last := K - 1;
                  return;
               end if;
            end loop;
 
            --  Here if J indexes first char of token, and all chars after J
            --  are in the token.
 
            Last := Source'Last;
            return;
         end if;
      end loop;
 
      --  Here if no token found
 
      First := Source'First;
      Last  := 0;
   end Find_Token;
 
   -----------
   -- Index --
   -----------
 
   function Index
     (Source  : Wide_String;
      Pattern : Wide_String;
      Going   : Direction := Forward;
      Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
      return Natural
   is
      PL1 : constant Integer := Pattern'Length - 1;
      Cur : Natural;
 
      Ind : Integer;
      --  Index for start of match check. This can be negative if the pattern
      --  length is greater than the string length, which is why this variable
      --  is Integer instead of Natural. In this case, the search loops do not
      --  execute at all, so this Ind value is never used.
 
   begin
      if Pattern = "" then
         raise Pattern_Error;
      end if;
 
      --  Forwards case
 
      if Going = Forward then
         Ind := Source'First;
 
         --  Unmapped forward case
 
         if Mapping'Address = Wide_Maps.Identity'Address then
            for J in 1 .. Source'Length - PL1 loop
               if Pattern = Source (Ind .. Ind + PL1) then
                  return Ind;
               else
                  Ind := Ind + 1;
               end if;
            end loop;
 
         --  Mapped forward case
 
         else
            for J in 1 .. Source'Length - PL1 loop
               Cur := Ind;
 
               for K in Pattern'Range loop
                  if Pattern (K) /= Value (Mapping, Source (Cur)) then
                     goto Cont1;
                  else
                     Cur := Cur + 1;
                  end if;
               end loop;
 
               return Ind;
 
            <<Cont1>>
               Ind := Ind + 1;
            end loop;
         end if;
 
      --  Backwards case
 
      else
         --  Unmapped backward case
 
         Ind := Source'Last - PL1;
 
         if Mapping'Address = Wide_Maps.Identity'Address then
            for J in reverse 1 .. Source'Length - PL1 loop
               if Pattern = Source (Ind .. Ind + PL1) then
                  return Ind;
               else
                  Ind := Ind - 1;
               end if;
            end loop;
 
         --  Mapped backward case
 
         else
            for J in reverse 1 .. Source'Length - PL1 loop
               Cur := Ind;
 
               for K in Pattern'Range loop
                  if Pattern (K) /= Value (Mapping, Source (Cur)) then
                     goto Cont2;
                  else
                     Cur := Cur + 1;
                  end if;
               end loop;
 
               return Ind;
 
            <<Cont2>>
               Ind := Ind - 1;
            end loop;
         end if;
      end if;
 
      --  Fall through if no match found. Note that the loops are skipped
      --  completely in the case of the pattern being longer than the source.
 
      return 0;
   end Index;
 
   function Index
     (Source  : Wide_String;
      Pattern : Wide_String;
      Going   : Direction := Forward;
      Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
   is
      PL1 : constant Integer := Pattern'Length - 1;
      Ind : Natural;
      Cur : Natural;
 
   begin
      if Pattern = "" then
         raise Pattern_Error;
      end if;
 
      --  Check for null pointer in case checks are off
 
      if Mapping = null then
         raise Constraint_Error;
      end if;
 
      --  If Pattern longer than Source it can't be found
 
      if Pattern'Length > Source'Length then
         return 0;
      end if;
 
      --  Forwards case
 
      if Going = Forward then
         Ind := Source'First;
         for J in 1 .. Source'Length - PL1 loop
            Cur := Ind;
 
            for K in Pattern'Range loop
               if Pattern (K) /= Mapping.all (Source (Cur)) then
                  goto Cont1;
               else
                  Cur := Cur + 1;
               end if;
            end loop;
 
            return Ind;
 
         <<Cont1>>
            Ind := Ind + 1;
         end loop;
 
      --  Backwards case
 
      else
         Ind := Source'Last - PL1;
         for J in reverse 1 .. Source'Length - PL1 loop
            Cur := Ind;
 
            for K in Pattern'Range loop
               if Pattern (K) /= Mapping.all (Source (Cur)) then
                  goto Cont2;
               else
                  Cur := Cur + 1;
               end if;
            end loop;
 
            return Ind;
 
         <<Cont2>>
            Ind := Ind - 1;
         end loop;
      end if;
 
      --  Fall through if no match found. Note that the loops are skipped
      --  completely in the case of the pattern being longer than the source.
 
      return 0;
   end Index;
 
   function Index
     (Source : Wide_String;
      Set    : Wide_Maps.Wide_Character_Set;
      Test   : Membership := Inside;
      Going  : Direction  := Forward) return Natural
   is
   begin
      --  Forwards case
 
      if Going = Forward then
         for J in Source'Range loop
            if Belongs (Source (J), Set, Test) then
               return J;
            end if;
         end loop;
 
      --  Backwards case
 
      else
         for J in reverse Source'Range loop
            if Belongs (Source (J), Set, Test) then
               return J;
            end if;
         end loop;
      end if;
 
      --  Fall through if no match
 
      return 0;
   end Index;
 
   function Index
     (Source  : Wide_String;
      Pattern : Wide_String;
      From    : Positive;
      Going   : Direction := Forward;
      Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
      return Natural
   is
   begin
      if Going = Forward then
         if From < Source'First then
            raise Index_Error;
         end if;
 
         return
           Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
 
      else
         if From > Source'Last then
            raise Index_Error;
         end if;
 
         return
           Index (Source (Source'First .. From), Pattern, Backward, Mapping);
      end if;
   end Index;
 
   function Index
     (Source  : Wide_String;
      Pattern : Wide_String;
      From    : Positive;
      Going   : Direction := Forward;
      Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
   is
   begin
      if Going = Forward then
         if From < Source'First then
            raise Index_Error;
         end if;
 
         return Index
           (Source (From .. Source'Last), Pattern, Forward, Mapping);
 
      else
         if From > Source'Last then
            raise Index_Error;
         end if;
 
         return Index
           (Source (Source'First .. From), Pattern, Backward, Mapping);
      end if;
   end Index;
 
   function Index
     (Source  : Wide_String;
      Set     : Wide_Maps.Wide_Character_Set;
      From    : Positive;
      Test    : Membership := Inside;
      Going   : Direction := Forward) return Natural
   is
   begin
      if Going = Forward then
         if From < Source'First then
            raise Index_Error;
         end if;
 
         return
           Index (Source (From .. Source'Last), Set, Test, Forward);
 
      else
         if From > Source'Last then
            raise Index_Error;
         end if;
 
         return
           Index (Source (Source'First .. From), Set, Test, Backward);
      end if;
   end Index;
 
   ---------------------
   -- Index_Non_Blank --
   ---------------------
 
   function Index_Non_Blank
     (Source : Wide_String;
      Going  : Direction := Forward) return Natural
   is
   begin
      if Going = Forward then
         for J in Source'Range loop
            if Source (J) /= Wide_Space then
               return J;
            end if;
         end loop;
 
      else -- Going = Backward
         for J in reverse Source'Range loop
            if Source (J) /= Wide_Space then
               return J;
            end if;
         end loop;
      end if;
 
      --  Fall through if no match
 
      return 0;
   end Index_Non_Blank;
 
   function Index_Non_Blank
     (Source : Wide_String;
      From   : Positive;
      Going  : Direction := Forward) return Natural
   is
   begin
      if Going = Forward then
         if From < Source'First then
            raise Index_Error;
         end if;
 
         return
           Index_Non_Blank (Source (From .. Source'Last), Forward);
 
      else
         if From > Source'Last then
            raise Index_Error;
         end if;
 
         return
           Index_Non_Blank (Source (Source'First .. From), Backward);
      end if;
   end Index_Non_Blank;
 
end Ada.Strings.Wide_Search;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-stwise.adb] - Blame information for rev 729

Line No.	Rev	Author	Line
1	706	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT RUN-TIME 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			`-- --`
9			`-- Copyright (C) 1992-2010, 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
32			`with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;`
33			`with System; use System;`
34
35			`package body Ada.Strings.Wide_Search is`
36
37			`-----------------------`
38			`-- Local Subprograms --`
39			`-----------------------`
40
41			`function Belongs`
42			`(Element : Wide_Character;`
43			`Set : Wide_Maps.Wide_Character_Set;`
44			`Test : Membership) return Boolean;`
45			`pragma Inline (Belongs);`
46			`-- Determines if the given element is in (Test = Inside) or not in`
47			`-- (Test = Outside) the given character set.`
48
49			`-------------`
50			`-- Belongs --`
51			`-------------`
52
53			`function Belongs`
54			`(Element : Wide_Character;`
55			`Set : Wide_Maps.Wide_Character_Set;`
56			`Test : Membership) return Boolean`
57			`is`
58			`begin`
59			`if Test = Inside then`
60			`return Is_In (Element, Set);`
61			`else`
62			`return not Is_In (Element, Set);`
63			`end if;`
64			`end Belongs;`
65
66			`-----------`
67			`-- Count --`
68			`-----------`
69
70			`function Count`
71			`(Source : Wide_String;`
72			`Pattern : Wide_String;`
73			`Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)`
74			`return Natural`
75			`is`
76			`PL1 : constant Integer := Pattern'Length - 1;`
77			`Num : Natural;`
78			`Ind : Natural;`
79			`Cur : Natural;`
80
81			`begin`
82			`if Pattern = "" then`
83			`raise Pattern_Error;`
84			`end if;`
85
86			`Num := 0;`
87			`Ind := Source'First;`
88
89			`-- Unmapped case`
90
91			`if Mapping'Address = Wide_Maps.Identity'Address then`
92			`while Ind <= Source'Last - PL1 loop`
93			`if Pattern = Source (Ind .. Ind + PL1) then`
94			`Num := Num + 1;`
95			`Ind := Ind + Pattern'Length;`
96			`else`
97			`Ind := Ind + 1;`
98			`end if;`
99			`end loop;`
100
101			`-- Mapped case`
102
103			`else`
104			`while Ind <= Source'Last - PL1 loop`
105			`Cur := Ind;`
106			`for K in Pattern'Range loop`
107			`if Pattern (K) /= Value (Mapping, Source (Cur)) then`
108			`Ind := Ind + 1;`
109			`goto Cont;`
110			`else`
111			`Cur := Cur + 1;`
112			`end if;`
113			`end loop;`
114
115			`Num := Num + 1;`
116			`Ind := Ind + Pattern'Length;`
117
118			`<<Cont>>`
119			`null;`
120			`end loop;`
121			`end if;`
122
123			`-- Return result`
124
125			`return Num;`
126			`end Count;`
127
128			`function Count`
129			`(Source : Wide_String;`
130			`Pattern : Wide_String;`
131			`Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural`
132			`is`
133			`PL1 : constant Integer := Pattern'Length - 1;`
134			`Num : Natural;`
135			`Ind : Natural;`
136			`Cur : Natural;`
137
138			`begin`
139			`if Pattern = "" then`
140			`raise Pattern_Error;`
141			`end if;`
142
143			`-- Check for null pointer in case checks are off`
144
145			`if Mapping = null then`
146			`raise Constraint_Error;`
147			`end if;`
148
149			`Num := 0;`
150			`Ind := Source'First;`
151			`while Ind <= Source'Last - PL1 loop`
152			`Cur := Ind;`
153			`for K in Pattern'Range loop`
154			`if Pattern (K) /= Mapping (Source (Cur)) then`
155			`Ind := Ind + 1;`
156			`goto Cont;`
157			`else`
158			`Cur := Cur + 1;`
159			`end if;`
160			`end loop;`
161
162			`Num := Num + 1;`
163			`Ind := Ind + Pattern'Length;`
164
165			`<<Cont>>`
166			`null;`
167			`end loop;`
168
169			`return Num;`
170			`end Count;`
171
172			`function Count`
173			`(Source : Wide_String;`
174			`Set : Wide_Maps.Wide_Character_Set) return Natural`
175			`is`
176			`N : Natural := 0;`
177
178			`begin`
179			`for J in Source'Range loop`
180			`if Is_In (Source (J), Set) then`
181			`N := N + 1;`
182			`end if;`
183			`end loop;`
184
185			`return N;`
186			`end Count;`
187
188			`----------------`
189			`-- Find_Token --`
190			`----------------`
191
192			`procedure Find_Token`
193			`(Source : Wide_String;`
194			`Set : Wide_Maps.Wide_Character_Set;`
195			`From : Positive;`
196			`Test : Membership;`
197			`First : out Positive;`
198			`Last : out Natural)`
199			`is`
200			`begin`
201			`for J in From .. Source'Last loop`
202			`if Belongs (Source (J), Set, Test) then`
203			`First := J;`
204
205			`for K in J + 1 .. Source'Last loop`
206			`if not Belongs (Source (K), Set, Test) then`
207			`Last := K - 1;`
208			`return;`
209			`end if;`
210			`end loop;`
211
212			`-- Here if J indexes first char of token, and all chars after J`
213			`-- are in the token.`
214
215			`Last := Source'Last;`
216			`return;`
217			`end if;`
218			`end loop;`
219
220			`-- Here if no token found`
221
222			`First := From;`
223			`Last := 0;`
224			`end Find_Token;`
225
226			`procedure Find_Token`
227			`(Source : Wide_String;`
228			`Set : Wide_Maps.Wide_Character_Set;`
229			`Test : Membership;`
230			`First : out Positive;`
231			`Last : out Natural)`
232			`is`
233			`begin`
234			`for J in Source'Range loop`
235			`if Belongs (Source (J), Set, Test) then`
236			`First := J;`
237
238			`for K in J + 1 .. Source'Last loop`
239			`if not Belongs (Source (K), Set, Test) then`
240			`Last := K - 1;`
241			`return;`
242			`end if;`
243			`end loop;`
244
245			`-- Here if J indexes first char of token, and all chars after J`
246			`-- are in the token.`
247
248			`Last := Source'Last;`
249			`return;`
250			`end if;`
251			`end loop;`
252
253			`-- Here if no token found`
254
255			`First := Source'First;`
256			`Last := 0;`
257			`end Find_Token;`
258
259			`-----------`
260			`-- Index --`
261			`-----------`
262
263			`function Index`
264			`(Source : Wide_String;`
265			`Pattern : Wide_String;`
266			`Going : Direction := Forward;`
267			`Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)`
268			`return Natural`
269			`is`
270			`PL1 : constant Integer := Pattern'Length - 1;`
271			`Cur : Natural;`
272
273			`Ind : Integer;`
274			`-- Index for start of match check. This can be negative if the pattern`
275			`-- length is greater than the string length, which is why this variable`
276			`-- is Integer instead of Natural. In this case, the search loops do not`
277			`-- execute at all, so this Ind value is never used.`
278
279			`begin`
280			`if Pattern = "" then`
281			`raise Pattern_Error;`
282			`end if;`
283
284			`-- Forwards case`
285
286			`if Going = Forward then`
287			`Ind := Source'First;`
288
289			`-- Unmapped forward case`
290
291			`if Mapping'Address = Wide_Maps.Identity'Address then`
292			`for J in 1 .. Source'Length - PL1 loop`
293			`if Pattern = Source (Ind .. Ind + PL1) then`
294			`return Ind;`
295			`else`
296			`Ind := Ind + 1;`
297			`end if;`
298			`end loop;`
299
300			`-- Mapped forward case`
301
302			`else`
303			`for J in 1 .. Source'Length - PL1 loop`
304			`Cur := Ind;`
305
306			`for K in Pattern'Range loop`
307			`if Pattern (K) /= Value (Mapping, Source (Cur)) then`
308			`goto Cont1;`
309			`else`
310			`Cur := Cur + 1;`
311			`end if;`
312			`end loop;`
313
314			`return Ind;`
315
316			`<<Cont1>>`
317			`Ind := Ind + 1;`
318			`end loop;`
319			`end if;`
320
321			`-- Backwards case`
322
323			`else`
324			`-- Unmapped backward case`
325
326			`Ind := Source'Last - PL1;`
327
328			`if Mapping'Address = Wide_Maps.Identity'Address then`
329			`for J in reverse 1 .. Source'Length - PL1 loop`
330			`if Pattern = Source (Ind .. Ind + PL1) then`
331			`return Ind;`
332			`else`
333			`Ind := Ind - 1;`
334			`end if;`
335			`end loop;`
336
337			`-- Mapped backward case`
338
339			`else`
340			`for J in reverse 1 .. Source'Length - PL1 loop`
341			`Cur := Ind;`
342
343			`for K in Pattern'Range loop`
344			`if Pattern (K) /= Value (Mapping, Source (Cur)) then`
345			`goto Cont2;`
346			`else`
347			`Cur := Cur + 1;`
348			`end if;`
349			`end loop;`
350
351			`return Ind;`
352
353			`<<Cont2>>`
354			`Ind := Ind - 1;`
355			`end loop;`
356			`end if;`
357			`end if;`
358
359			`-- Fall through if no match found. Note that the loops are skipped`
360			`-- completely in the case of the pattern being longer than the source.`
361
362			`return 0;`
363			`end Index;`
364
365			`function Index`
366			`(Source : Wide_String;`
367			`Pattern : Wide_String;`
368			`Going : Direction := Forward;`
369			`Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural`
370			`is`
371			`PL1 : constant Integer := Pattern'Length - 1;`
372			`Ind : Natural;`
373			`Cur : Natural;`
374
375			`begin`
376			`if Pattern = "" then`
377			`raise Pattern_Error;`
378			`end if;`
379
380			`-- Check for null pointer in case checks are off`
381
382			`if Mapping = null then`
383			`raise Constraint_Error;`
384			`end if;`
385
386			`-- If Pattern longer than Source it can't be found`
387
388			`if Pattern'Length > Source'Length then`
389			`return 0;`
390			`end if;`
391
392			`-- Forwards case`
393
394			`if Going = Forward then`
395			`Ind := Source'First;`
396			`for J in 1 .. Source'Length - PL1 loop`
397			`Cur := Ind;`
398
399			`for K in Pattern'Range loop`
400			`if Pattern (K) /= Mapping.all (Source (Cur)) then`
401			`goto Cont1;`
402			`else`
403			`Cur := Cur + 1;`
404			`end if;`
405			`end loop;`
406
407			`return Ind;`
408
409			`<<Cont1>>`
410			`Ind := Ind + 1;`
411			`end loop;`
412
413			`-- Backwards case`
414
415			`else`
416			`Ind := Source'Last - PL1;`
417			`for J in reverse 1 .. Source'Length - PL1 loop`
418			`Cur := Ind;`
419
420			`for K in Pattern'Range loop`
421			`if Pattern (K) /= Mapping.all (Source (Cur)) then`
422			`goto Cont2;`
423			`else`
424			`Cur := Cur + 1;`
425			`end if;`
426			`end loop;`
427
428			`return Ind;`
429
430			`<<Cont2>>`
431			`Ind := Ind - 1;`
432			`end loop;`
433			`end if;`
434
435			`-- Fall through if no match found. Note that the loops are skipped`
436			`-- completely in the case of the pattern being longer than the source.`
437
438			`return 0;`
439			`end Index;`
440
441			`function Index`
442			`(Source : Wide_String;`
443			`Set : Wide_Maps.Wide_Character_Set;`
444			`Test : Membership := Inside;`
445			`Going : Direction := Forward) return Natural`
446			`is`
447			`begin`
448			`-- Forwards case`
449
450			`if Going = Forward then`
451			`for J in Source'Range loop`
452			`if Belongs (Source (J), Set, Test) then`
453			`return J;`
454			`end if;`
455			`end loop;`
456
457			`-- Backwards case`
458
459			`else`
460			`for J in reverse Source'Range loop`
461			`if Belongs (Source (J), Set, Test) then`
462			`return J;`
463			`end if;`
464			`end loop;`
465			`end if;`
466
467			`-- Fall through if no match`
468
469			`return 0;`
470			`end Index;`
471
472			`function Index`
473			`(Source : Wide_String;`
474			`Pattern : Wide_String;`
475			`From : Positive;`
476			`Going : Direction := Forward;`
477			`Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)`
478			`return Natural`
479			`is`
480			`begin`
481			`if Going = Forward then`
482			`if From < Source'First then`
483			`raise Index_Error;`
484			`end if;`
485
486			`return`
487			`Index (Source (From .. Source'Last), Pattern, Forward, Mapping);`
488
489			`else`
490			`if From > Source'Last then`
491			`raise Index_Error;`
492			`end if;`
493
494			`return`
495			`Index (Source (Source'First .. From), Pattern, Backward, Mapping);`
496			`end if;`
497			`end Index;`
498
499			`function Index`
500			`(Source : Wide_String;`
501			`Pattern : Wide_String;`
502			`From : Positive;`
503			`Going : Direction := Forward;`
504			`Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural`
505			`is`
506			`begin`
507			`if Going = Forward then`
508			`if From < Source'First then`
509			`raise Index_Error;`
510			`end if;`
511
512			`return Index`
513			`(Source (From .. Source'Last), Pattern, Forward, Mapping);`
514
515			`else`
516			`if From > Source'Last then`
517			`raise Index_Error;`
518			`end if;`
519
520			`return Index`
521			`(Source (Source'First .. From), Pattern, Backward, Mapping);`
522			`end if;`
523			`end Index;`
524
525			`function Index`
526			`(Source : Wide_String;`
527			`Set : Wide_Maps.Wide_Character_Set;`
528			`From : Positive;`
529			`Test : Membership := Inside;`
530			`Going : Direction := Forward) return Natural`
531			`is`
532			`begin`
533			`if Going = Forward then`
534			`if From < Source'First then`
535			`raise Index_Error;`
536			`end if;`
537
538			`return`
539			`Index (Source (From .. Source'Last), Set, Test, Forward);`
540
541			`else`
542			`if From > Source'Last then`
543			`raise Index_Error;`
544			`end if;`
545
546			`return`
547			`Index (Source (Source'First .. From), Set, Test, Backward);`
548			`end if;`
549			`end Index;`
550
551			`---------------------`
552			`-- Index_Non_Blank --`
553			`---------------------`
554
555			`function Index_Non_Blank`
556			`(Source : Wide_String;`
557			`Going : Direction := Forward) return Natural`
558			`is`
559			`begin`
560			`if Going = Forward then`
561			`for J in Source'Range loop`
562			`if Source (J) /= Wide_Space then`
563			`return J;`
564			`end if;`
565			`end loop;`
566
567			`else -- Going = Backward`
568			`for J in reverse Source'Range loop`
569			`if Source (J) /= Wide_Space then`
570			`return J;`
571			`end if;`
572			`end loop;`
573			`end if;`
574
575			`-- Fall through if no match`
576
577			`return 0;`
578			`end Index_Non_Blank;`
579
580			`function Index_Non_Blank`
581			`(Source : Wide_String;`
582			`From : Positive;`
583			`Going : Direction := Forward) return Natural`
584			`is`
585			`begin`
586			`if Going = Forward then`
587			`if From < Source'First then`
588			`raise Index_Error;`
589			`end if;`
590
591			`return`
592			`Index_Non_Blank (Source (From .. Source'Last), Forward);`
593
594			`else`
595			`if From > Source'Last then`
596			`raise Index_Error;`
597			`end if;`
598
599			`return`
600			`Index_Non_Blank (Source (Source'First .. From), Backward);`
601			`end if;`
602			`end Index_Non_Blank;`
603
604			`end Ada.Strings.Wide_Search;`