home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / a-stwise.adb < prev    next >
Text File  |  1996-09-28  |  9KB  |  315 lines

  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. --                                                                          --
  9. --                            $Revision: 1.6 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
  27.  
  28. package body Ada.Strings.Wide_Search is
  29.  
  30.    -----------------------
  31.    -- Local Subprograms --
  32.    -----------------------
  33.  
  34.    function Belongs
  35.      (Element : Wide_Character;
  36.       Set     : Wide_Maps.Wide_Character_Set;
  37.       Test    : Membership)
  38.       return    Boolean;
  39.    pragma Inline (Belongs);
  40.    --  Determines if the given element is in (Test = Inside) or not in
  41.    --  (Test = Outside) the given character set.
  42.  
  43.    -------------
  44.    -- Belongs --
  45.    -------------
  46.  
  47.    function Belongs
  48.      (Element : Wide_Character;
  49.       Set     : Wide_Maps.Wide_Character_Set;
  50.       Test    : Membership)
  51.       return    Boolean is
  52.  
  53.    begin
  54.       if Test = Inside then
  55.          return Is_In (Element, Set);
  56.       else
  57.          return not Is_In (Element, Set);
  58.       end if;
  59.    end Belongs;
  60.  
  61.    -----------
  62.    -- Count --
  63.    -----------
  64.  
  65.    function Count
  66.      (Source   : in Wide_String;
  67.       Pattern  : in Wide_String;
  68.       Mapping  : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
  69.       return     Natural
  70.    is
  71.       N : Natural;
  72.       J : Natural;
  73.  
  74.    begin
  75.       if Pattern = "" then
  76.          raise Pattern_Error;
  77.       end if;
  78.  
  79.       --  Handle the case of non-identity mappings by creating a mapped
  80.       --  string and making a recursive call using the identity mapping
  81.       --  on this mapped string.
  82.  
  83.       if Mapping /= Wide_Maps.Identity then
  84.          declare
  85.             Mapped_Source : Wide_String (Source'Range);
  86.  
  87.          begin
  88.             for J in Source'Range loop
  89.                Mapped_Source (J) := Value (Mapping, Source (J));
  90.             end loop;
  91.  
  92.             return Count (Mapped_Source, Pattern);
  93.          end;
  94.       end if;
  95.  
  96.       N := 0;
  97.       J := Source'First;
  98.  
  99.       while J <= Source'Last - (Pattern'Length - 1) loop
  100.          if Source (J .. J + (Pattern'Length - 1)) = Pattern then
  101.             N := N + 1;
  102.             J := J + Pattern'Length;
  103.          else
  104.             J := J + 1;
  105.          end if;
  106.       end loop;
  107.  
  108.       return N;
  109.    end Count;
  110.  
  111.    function Count
  112.      (Source   : in Wide_String;
  113.       Pattern  : in Wide_String;
  114.       Mapping  : in Wide_Maps.Wide_Character_Mapping_Function)
  115.       return     Natural
  116.    is
  117.       Mapped_Source : Wide_String (Source'Range);
  118.  
  119.    begin
  120.       for J in Source'Range loop
  121.          Mapped_Source (J) := Mapping (Source (J));
  122.       end loop;
  123.  
  124.       return Count (Mapped_Source, Pattern);
  125.    end Count;
  126.  
  127.    function Count (Source : in Wide_String;
  128.                    Set    : in Wide_Maps.Wide_Character_Set)
  129.      return Natural
  130.    is
  131.       N : Natural := 0;
  132.  
  133.    begin
  134.       for J in Source'Range loop
  135.          if Is_In (Source (J), Set) then
  136.             N := N + 1;
  137.          end if;
  138.       end loop;
  139.  
  140.       return N;
  141.    end Count;
  142.  
  143.    ----------------
  144.    -- Find_Token --
  145.    ----------------
  146.  
  147.    procedure Find_Token
  148.      (Source : in Wide_String;
  149.       Set    : in Wide_Maps.Wide_Character_Set;
  150.       Test   : in Membership;
  151.       First  : out Positive;
  152.       Last   : out Natural)
  153.    is
  154.    begin
  155.       for J in Source'Range loop
  156.          if Belongs (Source (J), Set, Test) then
  157.             First := J;
  158.  
  159.             for K in J + 1 .. Source'Last loop
  160.                if not Belongs (Source (K), Set, Test) then
  161.                   Last := K - 1;
  162.                   return;
  163.                end if;
  164.             end loop;
  165.  
  166.             --  Here if J indexes 1st char of token, and all chars
  167.             --  after J are in the token
  168.  
  169.             Last := Source'Last;
  170.             return;
  171.          end if;
  172.       end loop;
  173.  
  174.       --  Here if no token found
  175.  
  176.       First := Source'First;
  177.       Last  := 0;
  178.    end Find_Token;
  179.  
  180.    -----------
  181.    -- Index --
  182.    -----------
  183.  
  184.    function Index
  185.      (Source   : in Wide_String;
  186.       Pattern  : in Wide_String;
  187.       Going    : in Direction := Forward;
  188.       Mapping  : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
  189.       return     Natural
  190.    is
  191.    begin
  192.       if Pattern = "" then
  193.          raise Pattern_Error;
  194.       end if;
  195.  
  196.       --  Handle the case of non-identity mappings by creating a mapped
  197.       --  string and making a recursive call using the identity mapping
  198.       --  on this mapped string.
  199.  
  200.       if Mapping /= Identity then
  201.          declare
  202.             Mapped_Source : Wide_String (Source'Range);
  203.  
  204.          begin
  205.             for J in Source'Range loop
  206.                Mapped_Source (J) := Value (Mapping, Source (J));
  207.             end loop;
  208.  
  209.             return Index (Mapped_Source, Pattern, Going);
  210.          end;
  211.       end if;
  212.  
  213.       if Going = Forward then
  214.          for J in Source'First .. Source'Last - Pattern'Length + 1 loop
  215.             if Pattern = Source (J .. J + Pattern'Length - 1) then
  216.                return J;
  217.             end if;
  218.          end loop;
  219.  
  220.       else -- Going = Backward
  221.          for J in reverse Source'First .. Source'Last - Pattern'Length + 1 loop
  222.             if Pattern = Source (J .. J + Pattern'Length - 1) then
  223.                return J;
  224.             end if;
  225.          end loop;
  226.       end if;
  227.  
  228.       --  Fall through if no match found. Note that the loops are skipped
  229.       --  completely in the case of the pattern being longer than the source.
  230.  
  231.       return 0;
  232.    end Index;
  233.  
  234.    -----------
  235.    -- Index --
  236.    -----------
  237.  
  238.    function Index
  239.      (Source   : in Wide_String;
  240.       Pattern  : in Wide_String;
  241.       Going    : in Direction := Forward;
  242.       Mapping  : in Wide_Maps.Wide_Character_Mapping_Function)
  243.       return     Natural
  244.    is
  245.       Mapped_Source : Wide_String (Source'Range);
  246.  
  247.    begin
  248.       for J in Source'Range loop
  249.          Mapped_Source (J) := Mapping (Source (J));
  250.       end loop;
  251.  
  252.       return Index (Mapped_Source, Pattern, Going);
  253.    end Index;
  254.  
  255.    function Index
  256.      (Source : in Wide_String;
  257.       Set    : in Wide_Maps.Wide_Character_Set;
  258.       Test   : in Membership := Inside;
  259.       Going  : in Direction  := Forward)
  260.       return   Natural
  261.    is
  262.    begin
  263.       if Going = Forward then
  264.          for J in Source'Range loop
  265.             if Belongs (Source (J), Set, Test) then
  266.                return J;
  267.             end if;
  268.          end loop;
  269.  
  270.       else -- Going = Backward
  271.          for J in reverse Source'Range loop
  272.             if Belongs (Source (J), Set, Test) then
  273.                return J;
  274.             end if;
  275.          end loop;
  276.       end if;
  277.  
  278.       --  Fall through if no match
  279.  
  280.       return 0;
  281.    end Index;
  282.  
  283.    ---------------------
  284.    -- Index_Non_Blank --
  285.    ---------------------
  286.  
  287.    function Index_Non_Blank
  288.      (Source : in Wide_String;
  289.       Going  : in Direction := Forward)
  290.       return   Natural
  291.    is
  292.    begin
  293.       if Going = Forward then
  294.          for J in Source'Range loop
  295.             if Source (J) /= Wide_Space then
  296.                return J;
  297.             end if;
  298.          end loop;
  299.  
  300.       else -- Going = Backward
  301.          for J in reverse Source'Range loop
  302.             if Source (J) /= Wide_Space then
  303.                return J;
  304.             end if;
  305.          end loop;
  306.       end if;
  307.  
  308.       --  Fall through if no match
  309.  
  310.       return 0;
  311.  
  312.    end Index_Non_Blank;
  313.  
  314. end Ada.Strings.Wide_Search;
  315.