home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / adav313.zip / gnat-3_13p-os2-bin-20010916.zip / emx / gnatlib / a-strsea.adb < prev    next >
Text File  |  2000-07-19  |  11KB  |  392 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --                   A D A . S T R I N G S . S E A R C H                    --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.15 $                             --
  10. --                                                                          --
  11. --   Copyright (C) 1992,1993,1994,1995,1996 Free Software Foundation, Inc.  --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22. -- MA 02111-1307, USA.                                                      --
  23. --                                                                          --
  24. -- As a special exception,  if other files  instantiate  generics from this --
  25. -- unit, or you link  this unit with other files  to produce an executable, --
  26. -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27. -- covered  by the  GNU  General  Public  License.  This exception does not --
  28. -- however invalidate  any other reasons why  the executable file  might be --
  29. -- covered by the  GNU Public License.                                      --
  30. --                                                                          --
  31. -- GNAT was originally developed  by the GNAT team at  New York University. --
  32. -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  33. --                                                                          --
  34. ------------------------------------------------------------------------------
  35.  
  36. --  Note: This code is derived from the ADAR.CSH public domain Ada 83
  37. --  versions of the Appendix C string handling packages (code extracted
  38. --  from Ada.Strings.Fixed). A significant change is that we optimize the
  39. --  case of identity mappings for Count and Index, and also Index_Non_Blank
  40. --  is specialized (rather than using the general Index routine).
  41.  
  42.  
  43. with Ada.Strings.Maps; use Ada.Strings.Maps;
  44.  
  45. package body Ada.Strings.Search is
  46.  
  47.    -----------------------
  48.    -- Local Subprograms --
  49.    -----------------------
  50.  
  51.    function Belongs
  52.      (Element : Character;
  53.       Set     : Maps.Character_Set;
  54.       Test    : Membership)
  55.       return    Boolean;
  56.    pragma Inline (Belongs);
  57.    --  Determines if the given element is in (Test = Inside) or not in
  58.    --  (Test = Outside) the given character set.
  59.  
  60.    -------------
  61.    -- Belongs --
  62.    -------------
  63.  
  64.    function Belongs
  65.      (Element : Character;
  66.       Set     : Maps.Character_Set;
  67.       Test    : Membership)
  68.       return    Boolean
  69.    is
  70.    begin
  71.       if Test = Inside then
  72.          return Is_In (Element, Set);
  73.       else
  74.          return not Is_In (Element, Set);
  75.       end if;
  76.    end Belongs;
  77.  
  78.    -----------
  79.    -- Count --
  80.    -----------
  81.  
  82.    function Count
  83.      (Source   : in String;
  84.       Pattern  : in String;
  85.       Mapping  : in Maps.Character_Mapping := Maps.Identity)
  86.       return     Natural
  87.    is
  88.       N : Natural;
  89.       J : Natural;
  90.  
  91.       Mapped_Source : String (Source'Range);
  92.  
  93.    begin
  94.       for J in Source'Range loop
  95.          Mapped_Source (J) := Value (Mapping, Source (J));
  96.       end loop;
  97.  
  98.       if Pattern = "" then
  99.          raise Pattern_Error;
  100.       end if;
  101.  
  102.       N := 0;
  103.       J := Source'First;
  104.  
  105.       while J <= Source'Last - (Pattern'Length - 1) loop
  106.          if Mapped_Source (J .. J + (Pattern'Length - 1)) = Pattern then
  107.             N := N + 1;
  108.             J := J + Pattern'Length;
  109.          else
  110.             J := J + 1;
  111.          end if;
  112.       end loop;
  113.  
  114.       return N;
  115.    end Count;
  116.  
  117.    function Count
  118.      (Source   : in String;
  119.       Pattern  : in String;
  120.       Mapping  : in Maps.Character_Mapping_Function)
  121.       return     Natural
  122.    is
  123.       Mapped_Source : String (Source'Range);
  124.       N             : Natural;
  125.       J             : Natural;
  126.  
  127.    begin
  128.       if Pattern = "" then
  129.          raise Pattern_Error;
  130.       end if;
  131.  
  132.       --  We make sure Access_Check is unsuppressed so that the Mapping.all
  133.       --  call will generate a friendly Constraint_Error if the value for
  134.       --  Mapping is uninitialized (and hence null).
  135.  
  136.       declare
  137.          pragma Unsuppress (Access_Check);
  138.  
  139.       begin
  140.          for J in Source'Range loop
  141.             Mapped_Source (J) := Mapping.all (Source (J));
  142.          end loop;
  143.       end;
  144.  
  145.       N := 0;
  146.       J := Source'First;
  147.  
  148.       while J <= Source'Last - (Pattern'Length - 1) loop
  149.          if Mapped_Source (J .. J + (Pattern'Length - 1)) = Pattern then
  150.             N := N + 1;
  151.             J := J + Pattern'Length;
  152.          else
  153.             J := J + 1;
  154.          end if;
  155.       end loop;
  156.  
  157.       return N;
  158.    end Count;
  159.  
  160.    function Count
  161.      (Source : in String;
  162.       Set    : in Maps.Character_Set)
  163.       return   Natural
  164.    is
  165.       N : Natural := 0;
  166.  
  167.    begin
  168.       for J in Source'Range loop
  169.          if Is_In (Source (J), Set) then
  170.             N := N + 1;
  171.          end if;
  172.       end loop;
  173.  
  174.       return N;
  175.    end Count;
  176.  
  177.    ----------------
  178.    -- Find_Token --
  179.    ----------------
  180.  
  181.    procedure Find_Token
  182.      (Source : in String;
  183.       Set    : in Maps.Character_Set;
  184.       Test   : in Membership;
  185.       First  : out Positive;
  186.       Last   : out Natural)
  187.    is
  188.    begin
  189.       for J in Source'Range loop
  190.          if Belongs (Source (J), Set, Test) then
  191.             First := J;
  192.  
  193.             for K in J + 1 .. Source'Last loop
  194.                if not Belongs (Source (K), Set, Test) then
  195.                   Last := K - 1;
  196.                   return;
  197.                end if;
  198.             end loop;
  199.  
  200.             --  Here if J indexes 1st char of token, and all chars
  201.             --  after J are in the token
  202.  
  203.             Last := Source'Last;
  204.             return;
  205.          end if;
  206.       end loop;
  207.  
  208.       --  Here if no token found
  209.  
  210.       First := Source'First;
  211.       Last  := 0;
  212.    end Find_Token;
  213.  
  214.    -----------
  215.    -- Index --
  216.    -----------
  217.  
  218.    function Index
  219.      (Source   : in String;
  220.       Pattern  : in String;
  221.       Going    : in Direction := Forward;
  222.       Mapping  : in Maps.Character_Mapping := Maps.Identity)
  223.       return     Natural
  224.    is
  225.       Cur_Index     : Natural;
  226.       Mapped_Source : String (Source'Range);
  227.  
  228.  
  229.    begin
  230.       if Pattern = "" then
  231.          raise Pattern_Error;
  232.       end if;
  233.  
  234.       for J in Source'Range loop
  235.          Mapped_Source (J) := Value (Mapping, Source (J));
  236.       end loop;
  237.  
  238.       --  Forwards case
  239.  
  240.       if Going = Forward then
  241.          for J in 1 .. Source'Length - Pattern'Length + 1 loop
  242.             Cur_Index := Source'First + J - 1;
  243.  
  244.             if Pattern = Mapped_Source
  245.                            (Cur_Index .. Cur_Index + Pattern'Length - 1)
  246.             then
  247.                return Cur_Index;
  248.             end if;
  249.          end loop;
  250.  
  251.       --  Backwards case
  252.  
  253.       else
  254.          for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
  255.             Cur_Index := Source'First + J - 1;
  256.  
  257.             if Pattern = Mapped_Source
  258.                            (Cur_Index .. Cur_Index + Pattern'Length - 1)
  259.             then
  260.                return Cur_Index;
  261.             end if;
  262.          end loop;
  263.       end if;
  264.  
  265.       --  Fall through if no match found. Note that the loops are skipped
  266.       --  completely in the case of the pattern being longer than the source.
  267.  
  268.       return 0;
  269.    end Index;
  270.  
  271.    function Index (Source   : in String;
  272.                    Pattern  : in String;
  273.                    Going    : in Direction := Forward;
  274.                    Mapping  : in Maps.Character_Mapping_Function)
  275.       return Natural
  276.    is
  277.       Mapped_Source : String (Source'Range);
  278.       Cur_Index     : Natural;
  279.  
  280.    begin
  281.       if Pattern = "" then
  282.          raise Pattern_Error;
  283.       end if;
  284.  
  285.       --  We make sure Access_Check is unsuppressed so that the Mapping.all
  286.       --  call will generate a friendly Constraint_Error if the value for
  287.       --  Mapping is uninitialized (and hence null).
  288.  
  289.       declare
  290.          pragma Unsuppress (Access_Check);
  291.  
  292.       begin
  293.          for J in Source'Range loop
  294.             Mapped_Source (J) := Mapping.all (Source (J));
  295.          end loop;
  296.       end;
  297.  
  298.       --  Forwards case
  299.  
  300.       if Going = Forward then
  301.          for J in 1 .. Source'Length - Pattern'Length + 1 loop
  302.             Cur_Index := Source'First + J - 1;
  303.  
  304.             if Pattern = Mapped_Source
  305.                            (Cur_Index .. Cur_Index + Pattern'Length - 1)
  306.             then
  307.                return Cur_Index;
  308.             end if;
  309.          end loop;
  310.  
  311.       --  Backwards case
  312.  
  313.       else
  314.          for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
  315.             Cur_Index := Source'First + J - 1;
  316.  
  317.             if Pattern = Mapped_Source
  318.                            (Cur_Index .. Cur_Index + Pattern'Length - 1)
  319.             then
  320.                return Cur_Index;
  321.             end if;
  322.          end loop;
  323.       end if;
  324.  
  325.       return 0;
  326.    end Index;
  327.  
  328.    function Index
  329.      (Source : in String;
  330.       Set    : in Maps.Character_Set;
  331.       Test   : in Membership := Inside;
  332.       Going  : in Direction  := Forward)
  333.       return   Natural
  334.    is
  335.    begin
  336.       --  Forwards case
  337.  
  338.       if Going = Forward then
  339.          for J in Source'Range loop
  340.             if Belongs (Source (J), Set, Test) then
  341.                return J;
  342.             end if;
  343.          end loop;
  344.  
  345.       --  Backwards case
  346.  
  347.       else
  348.          for J in reverse Source'Range loop
  349.             if Belongs (Source (J), Set, Test) then
  350.                return J;
  351.             end if;
  352.          end loop;
  353.       end if;
  354.  
  355.       --  Fall through if no match
  356.  
  357.       return 0;
  358.    end Index;
  359.  
  360.    ---------------------
  361.    -- Index_Non_Blank --
  362.    ---------------------
  363.  
  364.    function Index_Non_Blank
  365.      (Source : in String;
  366.       Going  : in Direction := Forward)
  367.       return   Natural
  368.    is
  369.    begin
  370.       if Going = Forward then
  371.          for J in Source'Range loop
  372.             if Source (J) /= ' ' then
  373.                return J;
  374.             end if;
  375.          end loop;
  376.  
  377.       else -- Going = Backward
  378.          for J in reverse Source'Range loop
  379.             if Source (J) /= ' ' then
  380.                return J;
  381.             end if;
  382.          end loop;
  383.       end if;
  384.  
  385.       --  Fall through if no match
  386.  
  387.       return 0;
  388.  
  389.    end Index_Non_Blank;
  390.  
  391. end Ada.Strings.Search;
  392.