URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [a-stwise.adb] - Blame information for rev 284

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-2009, 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;
      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_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [a-stwise.adb] - Blame information for rev 284

Line No.	Rev	Author	Line
1	281	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-2009, 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			`Test : Membership;`
196			`First : out Positive;`
197			`Last : out Natural)`
198			`is`
199			`begin`
200			`for J in Source'Range loop`
201			`if Belongs (Source (J), Set, Test) then`
202			`First := J;`
203
204			`for K in J + 1 .. Source'Last loop`
205			`if not Belongs (Source (K), Set, Test) then`
206			`Last := K - 1;`
207			`return;`
208			`end if;`
209			`end loop;`
210
211			`-- Here if J indexes first char of token, and all chars after J`
212			`-- are in the token.`
213
214			`Last := Source'Last;`
215			`return;`
216			`end if;`
217			`end loop;`
218
219			`-- Here if no token found`
220
221			`First := Source'First;`
222			`Last := 0;`
223			`end Find_Token;`
224
225			`-----------`
226			`-- Index --`
227			`-----------`
228
229			`function Index`
230			`(Source : Wide_String;`
231			`Pattern : Wide_String;`
232			`Going : Direction := Forward;`
233			`Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)`
234			`return Natural`
235			`is`
236			`PL1 : constant Integer := Pattern'Length - 1;`
237			`Cur : Natural;`
238
239			`Ind : Integer;`
240			`-- Index for start of match check. This can be negative if the pattern`
241			`-- length is greater than the string length, which is why this variable`
242			`-- is Integer instead of Natural. In this case, the search loops do not`
243			`-- execute at all, so this Ind value is never used.`
244
245			`begin`
246			`if Pattern = "" then`
247			`raise Pattern_Error;`
248			`end if;`
249
250			`-- Forwards case`
251
252			`if Going = Forward then`
253			`Ind := Source'First;`
254
255			`-- Unmapped forward case`
256
257			`if Mapping'Address = Wide_Maps.Identity'Address then`
258			`for J in 1 .. Source'Length - PL1 loop`
259			`if Pattern = Source (Ind .. Ind + PL1) then`
260			`return Ind;`
261			`else`
262			`Ind := Ind + 1;`
263			`end if;`
264			`end loop;`
265
266			`-- Mapped forward case`
267
268			`else`
269			`for J in 1 .. Source'Length - PL1 loop`
270			`Cur := Ind;`
271
272			`for K in Pattern'Range loop`
273			`if Pattern (K) /= Value (Mapping, Source (Cur)) then`
274			`goto Cont1;`
275			`else`
276			`Cur := Cur + 1;`
277			`end if;`
278			`end loop;`
279
280			`return Ind;`
281
282			`<<Cont1>>`
283			`Ind := Ind + 1;`
284			`end loop;`
285			`end if;`
286
287			`-- Backwards case`
288
289			`else`
290			`-- Unmapped backward case`
291
292			`Ind := Source'Last - PL1;`
293
294			`if Mapping'Address = Wide_Maps.Identity'Address then`
295			`for J in reverse 1 .. Source'Length - PL1 loop`
296			`if Pattern = Source (Ind .. Ind + PL1) then`
297			`return Ind;`
298			`else`
299			`Ind := Ind - 1;`
300			`end if;`
301			`end loop;`
302
303			`-- Mapped backward case`
304
305			`else`
306			`for J in reverse 1 .. Source'Length - PL1 loop`
307			`Cur := Ind;`
308
309			`for K in Pattern'Range loop`
310			`if Pattern (K) /= Value (Mapping, Source (Cur)) then`
311			`goto Cont2;`
312			`else`
313			`Cur := Cur + 1;`
314			`end if;`
315			`end loop;`
316
317			`return Ind;`
318
319			`<<Cont2>>`
320			`Ind := Ind - 1;`
321			`end loop;`
322			`end if;`
323			`end if;`
324
325			`-- Fall through if no match found. Note that the loops are skipped`
326			`-- completely in the case of the pattern being longer than the source.`
327
328			`return 0;`
329			`end Index;`
330
331			`function Index`
332			`(Source : Wide_String;`
333			`Pattern : Wide_String;`
334			`Going : Direction := Forward;`
335			`Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural`
336			`is`
337			`PL1 : constant Integer := Pattern'Length - 1;`
338			`Ind : Natural;`
339			`Cur : Natural;`
340
341			`begin`
342			`if Pattern = "" then`
343			`raise Pattern_Error;`
344			`end if;`
345
346			`-- Check for null pointer in case checks are off`
347
348			`if Mapping = null then`
349			`raise Constraint_Error;`
350			`end if;`
351
352			`-- If Pattern longer than Source it can't be found`
353
354			`if Pattern'Length > Source'Length then`
355			`return 0;`
356			`end if;`
357
358			`-- Forwards case`
359
360			`if Going = Forward then`
361			`Ind := Source'First;`
362			`for J in 1 .. Source'Length - PL1 loop`
363			`Cur := Ind;`
364
365			`for K in Pattern'Range loop`
366			`if Pattern (K) /= Mapping.all (Source (Cur)) then`
367			`goto Cont1;`
368			`else`
369			`Cur := Cur + 1;`
370			`end if;`
371			`end loop;`
372
373			`return Ind;`
374
375			`<<Cont1>>`
376			`Ind := Ind + 1;`
377			`end loop;`
378
379			`-- Backwards case`
380
381			`else`
382			`Ind := Source'Last - PL1;`
383			`for J in reverse 1 .. Source'Length - PL1 loop`
384			`Cur := Ind;`
385
386			`for K in Pattern'Range loop`
387			`if Pattern (K) /= Mapping.all (Source (Cur)) then`
388			`goto Cont2;`
389			`else`
390			`Cur := Cur + 1;`
391			`end if;`
392			`end loop;`
393
394			`return Ind;`
395
396			`<<Cont2>>`
397			`Ind := Ind - 1;`
398			`end loop;`
399			`end if;`
400
401			`-- Fall through if no match found. Note that the loops are skipped`
402			`-- completely in the case of the pattern being longer than the source.`
403
404			`return 0;`
405			`end Index;`
406
407			`function Index`
408			`(Source : Wide_String;`
409			`Set : Wide_Maps.Wide_Character_Set;`
410			`Test : Membership := Inside;`
411			`Going : Direction := Forward) return Natural`
412			`is`
413			`begin`
414			`-- Forwards case`
415
416			`if Going = Forward then`
417			`for J in Source'Range loop`
418			`if Belongs (Source (J), Set, Test) then`
419			`return J;`
420			`end if;`
421			`end loop;`
422
423			`-- Backwards case`
424
425			`else`
426			`for J in reverse Source'Range loop`
427			`if Belongs (Source (J), Set, Test) then`
428			`return J;`
429			`end if;`
430			`end loop;`
431			`end if;`
432
433			`-- Fall through if no match`
434
435			`return 0;`
436			`end Index;`
437
438			`function Index`
439			`(Source : Wide_String;`
440			`Pattern : Wide_String;`
441			`From : Positive;`
442			`Going : Direction := Forward;`
443			`Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)`
444			`return Natural`
445			`is`
446			`begin`
447			`if Going = Forward then`
448			`if From < Source'First then`
449			`raise Index_Error;`
450			`end if;`
451
452			`return`
453			`Index (Source (From .. Source'Last), Pattern, Forward, Mapping);`
454
455			`else`
456			`if From > Source'Last then`
457			`raise Index_Error;`
458			`end if;`
459
460			`return`
461			`Index (Source (Source'First .. From), Pattern, Backward, Mapping);`
462			`end if;`
463			`end Index;`
464
465			`function Index`
466			`(Source : Wide_String;`
467			`Pattern : Wide_String;`
468			`From : Positive;`
469			`Going : Direction := Forward;`
470			`Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural`
471			`is`
472			`begin`
473			`if Going = Forward then`
474			`if From < Source'First then`
475			`raise Index_Error;`
476			`end if;`
477
478			`return Index`
479			`(Source (From .. Source'Last), Pattern, Forward, Mapping);`
480
481			`else`
482			`if From > Source'Last then`
483			`raise Index_Error;`
484			`end if;`
485
486			`return Index`
487			`(Source (Source'First .. From), Pattern, Backward, Mapping);`
488			`end if;`
489			`end Index;`
490
491			`function Index`
492			`(Source : Wide_String;`
493			`Set : Wide_Maps.Wide_Character_Set;`
494			`From : Positive;`
495			`Test : Membership := Inside;`
496			`Going : Direction := Forward) return Natural`
497			`is`
498			`begin`
499			`if Going = Forward then`
500			`if From < Source'First then`
501			`raise Index_Error;`
502			`end if;`
503
504			`return`
505			`Index (Source (From .. Source'Last), Set, Test, Forward);`
506
507			`else`
508			`if From > Source'Last then`
509			`raise Index_Error;`
510			`end if;`
511
512			`return`
513			`Index (Source (Source'First .. From), Set, Test, Backward);`
514			`end if;`
515			`end Index;`
516
517			`---------------------`
518			`-- Index_Non_Blank --`
519			`---------------------`
520
521			`function Index_Non_Blank`
522			`(Source : Wide_String;`
523			`Going : Direction := Forward) return Natural`
524			`is`
525			`begin`
526			`if Going = Forward then`
527			`for J in Source'Range loop`
528			`if Source (J) /= Wide_Space then`
529			`return J;`
530			`end if;`
531			`end loop;`
532
533			`else -- Going = Backward`
534			`for J in reverse Source'Range loop`
535			`if Source (J) /= Wide_Space then`
536			`return J;`
537			`end if;`
538			`end loop;`
539			`end if;`
540
541			`-- Fall through if no match`
542
543			`return 0;`
544			`end Index_Non_Blank;`
545
546			`function Index_Non_Blank`
547			`(Source : Wide_String;`
548			`From : Positive;`
549			`Going : Direction := Forward) return Natural`
550			`is`
551			`begin`
552			`if Going = Forward then`
553			`if From < Source'First then`
554			`raise Index_Error;`
555			`end if;`
556
557			`return`
558			`Index_Non_Blank (Source (From .. Source'Last), Forward);`
559
560			`else`
561			`if From > Source'Last then`
562			`raise Index_Error;`
563			`end if;`
564
565			`return`
566			`Index_Non_Blank (Source (Source'First .. From), Backward);`
567			`end if;`
568			`end Index_Non_Blank;`
569
570			`end Ada.Strings.Wide_Search;`