Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                        S Y S T E M . R E G E X P                         --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--                     Copyright (C) 1999-2010, AdaCore                     --

--                                                                          --

-- 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.Unchecked_Deallocation;

with System.Case_Util;

package body System.Regexp is

   Open_Paren    : constant Character := '(';

   Close_Paren   : constant Character := ')';

   Open_Bracket  : constant Character := '[';

   Close_Bracket : constant Character := ']';

   type State_Index is new Natural;

   type Column_Index is new Natural;

   type Regexp_Array is array

     (State_Index range <>, Column_Index range <>) of State_Index;

   --  First index is for the state number

   --  Second index is for the character type

   --  Contents is the new State

   type Regexp_Array_Access is access Regexp_Array;

   --  Use this type through the functions Set below, so that it

   --  can grow dynamically depending on the needs.

   type Mapping is array (Character'Range) of Column_Index;

   --  Mapping between characters and column in the Regexp_Array

   type Boolean_Array is array (State_Index range <>) of Boolean;

   type Regexp_Value

     (Alphabet_Size : Column_Index;

      Num_States    : State_Index) is

   record

      Map            : Mapping;

      States         : Regexp_Array (1 .. Num_States, 0 .. Alphabet_Size);

      Is_Final       : Boolean_Array (1 .. Num_States);

      Case_Sensitive : Boolean;

   end record;

   --  Deterministic finite-state machine

   -----------------------

   -- Local Subprograms --

   -----------------------

   procedure Set

     (Table  : in out Regexp_Array_Access;

      State  : State_Index;

      Column : Column_Index;

      Value  : State_Index);

   --  Sets a value in the table. If the table is too small, reallocate it

   --  dynamically so that (State, Column) is a valid index in it.

   function Get

     (Table  : Regexp_Array_Access;

      State  : State_Index;

      Column : Column_Index)

      return   State_Index;

   --  Returns the value in the table at (State, Column).

   --  If this index does not exist in the table, returns 0

   procedure Free is new Ada.Unchecked_Deallocation

     (Regexp_Array, Regexp_Array_Access);

   ------------

   -- Adjust --

   ------------

   procedure Adjust (R : in out Regexp) is

      Tmp : Regexp_Access;

   begin

      Tmp := new Regexp_Value (Alphabet_Size => R.R.Alphabet_Size,

                               Num_States    => R.R.Num_States);

      Tmp.all := R.R.all;

      R.R := Tmp;

   end Adjust;

   -------------

   -- Compile --

   -------------

   function Compile

     (Pattern        : String;

      Glob           : Boolean := False;

      Case_Sensitive : Boolean := True)

      return           Regexp

   is

      S : String := Pattern;

      --  The pattern which is really compiled (when the pattern is case

      --  insensitive, we convert this string to lower-cases

      Map : Mapping := (others => 0);

      --  Mapping between characters and columns in the tables

      Alphabet_Size : Column_Index := 0;

      --  Number of significant characters in the regular expression.

      --  This total does not include special operators, such as *, (, ...

      procedure Check_Well_Formed_Pattern;

      --  Check that the pattern to compile is well-formed, so that subsequent

      --  code can rely on this without performing each time the checks to

      --  avoid accessing the pattern outside its bounds. However, not all

      --  well-formedness rules are checked. In particular, rules about special

      --  characters not being treated as regular characters are not checked.

      procedure Create_Mapping;

      --  Creates a mapping between characters in the regexp and columns

      --  in the tables representing the regexp. Test that the regexp is

      --  well-formed Modifies Alphabet_Size and Map

      procedure Create_Primary_Table

        (Table       : out Regexp_Array_Access;

         Num_States  : out State_Index;

         Start_State : out State_Index;

         End_State   : out State_Index);

      --  Creates the first version of the regexp (this is a non deterministic

      --  finite state machine, which is unadapted for a fast pattern

      --  matching algorithm). We use a recursive algorithm to process the

      --  parenthesis sub-expressions.

      --

      --  Table : at the end of the procedure : Column 0 is for any character

      --  ('.') and the last columns are for no character (closure)

      --  Num_States is set to the number of states in the table

      --  Start_State is the number of the starting state in the regexp

      --  End_State is the number of the final state when the regexp matches

      procedure Create_Primary_Table_Glob

        (Table       : out Regexp_Array_Access;

         Num_States  : out State_Index;

         Start_State : out State_Index;

         End_State   : out State_Index);

      --  Same function as above, but it deals with the second possible

      --  grammar for 'globbing pattern', which is a kind of subset of the

      --  whole regular expression grammar.

      function Create_Secondary_Table

        (First_Table : Regexp_Array_Access;

         Num_States  : State_Index;

         Start_State : State_Index;

         End_State   : State_Index)

         return        Regexp;

      --  Creates the definitive table representing the regular expression

      --  This is actually a transformation of the primary table First_Table,

      --  where every state is grouped with the states in its 'no-character'

      --  columns. The transitions between the new states are then recalculated

      --  and if necessary some new states are created.

      --

      --  Note that the resulting finite-state machine is not optimized in

      --  terms of the number of states : it would be more time-consuming to

      --  add a third pass to reduce the number of states in the machine, with

      --  no speed improvement...

      procedure Raise_Exception (M : String; Index : Integer);

      pragma No_Return (Raise_Exception);

      --  Raise an exception, indicating an error at character Index in S

      -------------------------------

      -- Check_Well_Formed_Pattern --

      -------------------------------

      procedure Check_Well_Formed_Pattern is

         J : Integer;

         Past_Elmt : Boolean := False;

         --  Set to True everywhere an elmt has been parsed, if Glob=False,

         --  meaning there can be now an occurrence of '*', '+' and '?'.

         Past_Term : Boolean := False;

         --  Set to True everywhere a term has been parsed, if Glob=False,

         --  meaning there can be now an occurrence of '|'.

         Parenthesis_Level : Integer := 0;

         Curly_Level       : Integer := 0;

         Last_Open : Integer := S'First - 1;

         --  The last occurrence of an opening parenthesis, if Glob=False,

         --  or the last occurrence of an opening curly brace, if Glob=True.

         procedure Raise_Exception_If_No_More_Chars (K : Integer := 0);

         --  If no more characters are raised, call Raise_Exception

         --------------------------------------

         -- Raise_Exception_If_No_More_Chars --

         --------------------------------------

         procedure Raise_Exception_If_No_More_Chars (K : Integer := 0) is

         begin

            if J + K > S'Last then

               Raise_Exception ("Ill-formed pattern while parsing", J);

            end if;

         end Raise_Exception_If_No_More_Chars;

      --  Start of processing for Check_Well_Formed_Pattern

      begin

         J := S'First;

         while J <= S'Last loop

            case S (J) is

               when Open_Bracket =>

                  J := J + 1;

                  Raise_Exception_If_No_More_Chars;

                  if not Glob then

                     if S (J) = '^' then

                        J := J + 1;

                        Raise_Exception_If_No_More_Chars;

                     end if;

                  end if;

                  --  The first character never has a special meaning

                  if S (J) = ']' or else S (J) = '-' then

                     J := J + 1;

                     Raise_Exception_If_No_More_Chars;

                  end if;

                  --  The set of characters cannot be empty

                  if S (J) = ']' then

                     Raise_Exception

                       ("Set of characters cannot be empty in regular "

                          & "expression", J);

                  end if;

                  declare

                     Possible_Range_Start : Boolean := True;

                     --  Set True everywhere a range character '-' can occur

                  begin

                     loop

                        exit when S (J) = Close_Bracket;

                        --  The current character should be followed by a

                        --  closing bracket.

                        Raise_Exception_If_No_More_Chars (1);

                        if S (J) = '-'

                          and then S (J + 1) /= Close_Bracket

                        then

                           if not Possible_Range_Start then

                              Raise_Exception

                                ("No mix of ranges is allowed in "

                                   & "regular expression", J);

                           end if;

                           J := J + 1;

                           Raise_Exception_If_No_More_Chars;

                           --  Range cannot be followed by '-' character,

                           --  except as last character in the set.

                           Possible_Range_Start := False;

                        else

                           Possible_Range_Start := True;

                        end if;

                        if S (J) = '\' then

                           J := J + 1;

                           Raise_Exception_If_No_More_Chars;

                        end if;

                        J := J + 1;

                     end loop;

                  end;

                  --  A closing bracket can end an elmt or term

                  Past_Elmt := True;

                  Past_Term := True;

               when Close_Bracket =>

                  --  A close bracket must follow a open_bracket, and cannot be

                  --  found alone on the line.

                  Raise_Exception

                    ("Incorrect character ']' in regular expression", J);

               when '\' =>

                  if J < S'Last then

                     J := J + 1;

                     --  Any character can be an elmt or a term

                     Past_Elmt := True;

                     Past_Term := True;

                  else

                     --  \ not allowed at the end of the regexp

                     Raise_Exception

                       ("Incorrect character '\' in regular expression", J);

                  end if;

               when Open_Paren =>

                  if not Glob then

                     Parenthesis_Level := Parenthesis_Level + 1;

                     Last_Open := J;

                     --  An open parenthesis does not end an elmt or term

                     Past_Elmt := False;

                     Past_Term := False;

                  end if;

               when Close_Paren =>

                  if not Glob then

                     Parenthesis_Level := Parenthesis_Level - 1;

                     if Parenthesis_Level < 0 then

                        Raise_Exception

                          ("')' is not associated with '(' in regular "

                           & "expression", J);

                     end if;

                     if J = Last_Open + 1 then

                        Raise_Exception

                          ("Empty parentheses not allowed in regular "

                           & "expression", J);

                     end if;

                     if not Past_Term then

                        Raise_Exception

                          ("Closing parenthesis not allowed here in regular "

                             & "expression", J);

                     end if;

                     --  A closing parenthesis can end an elmt or term

                     Past_Elmt := True;

                     Past_Term := True;

                  end if;

               when '{' =>

                  if Glob then

                     Curly_Level := Curly_Level + 1;

                     Last_Open := J;

                  else

                     --  Any character can be an elmt or a term

                     Past_Elmt := True;

                     Past_Term := True;

                  end if;

                  --  No need to check for ',' as the code always accepts them

               when '}' =>

                  if Glob then

                     Curly_Level := Curly_Level - 1;

                     if Curly_Level < 0 then

                        Raise_Exception

                          ("'}' is not associated with '{' in regular "

                           & "expression", J);

                     end if;

                     if J = Last_Open + 1 then

                        Raise_Exception

                          ("Empty curly braces not allowed in regular "

                           & "expression", J);

                     end if;

                  else

                     --  Any character can be an elmt or a term

                     Past_Elmt := True;

                     Past_Term := True;

                  end if;

               when '*' | '?' | '+' =>

                  if not Glob then

                     --  These operators must apply to an elmt sub-expression,

                     --  and cannot be found if one has not just been parsed.

                     if not Past_Elmt then

                        Raise_Exception

                          ("'*', '+' and '?' operators must be "

                           & "applied to an element in regular expression", J);

                     end if;

                     Past_Elmt := False;

                     Past_Term := True;

                  end if;

               when '|' =>

                  if not Glob then

                     --  This operator must apply to a term sub-expression,

                     --  and cannot be found if one has not just been parsed.

                     if not Past_Term then

                        Raise_Exception

                          ("'|' operator must be "

                           & "applied to a term in regular expression", J);

                     end if;

                     Past_Elmt := False;

                     Past_Term := False;

                  end if;

               when others =>

                  if not Glob then

                     --  Any character can be an elmt or a term

                     Past_Elmt := True;

                     Past_Term := True;

                  end if;

            end case;

            J := J + 1;

         end loop;

         --  A closing parenthesis must follow an open parenthesis

         if Parenthesis_Level /= 0 then

            Raise_Exception

              ("'(' must always be associated with a ')'", J);

         end if;

         --  A closing curly brace must follow an open curly brace

         if Curly_Level /= 0 then

            Raise_Exception

              ("'{' must always be associated with a '}'", J);

         end if;

      end Check_Well_Formed_Pattern;

      --------------------

      -- Create_Mapping --

      --------------------

      procedure Create_Mapping is

         procedure Add_In_Map (C : Character);

         --  Add a character in the mapping, if it is not already defined

         ----------------

         -- Add_In_Map --

         ----------------

         procedure Add_In_Map (C : Character) is

         begin

            if Map (C) = 0 then

               Alphabet_Size := Alphabet_Size + 1;

               Map (C) := Alphabet_Size;

            end if;

         end Add_In_Map;

         J                 : Integer := S'First;

         Parenthesis_Level : Integer := 0;

         Curly_Level       : Integer := 0;

         Last_Open         : Integer := S'First - 1;

      --  Start of processing for Create_Mapping

      begin

         while J <= S'Last loop

            case S (J) is

               when Open_Bracket =>

                  J := J + 1;

                  if S (J) = '^' then

                     J := J + 1;

                  end if;

                  if S (J) = ']' or else S (J) = '-' then

                     J := J + 1;

                  end if;

                  --  The first character never has a special meaning

                  loop

                     if J > S'Last then

                        Raise_Exception

                          ("Ran out of characters while parsing ", J);

                     end if;

                     exit when S (J) = Close_Bracket;

                     if S (J) = '-'

                       and then S (J + 1) /= Close_Bracket

                     then

                        declare

                           Start : constant Integer := J - 1;

                        begin

                           J := J + 1;

                           if S (J) = '\' then

                              J := J + 1;

                           end if;

                           for Char in S (Start) .. S (J) loop

                              Add_In_Map (Char);

                           end loop;

                        end;

                     else

                        if S (J) = '\' then

                           J := J + 1;

                        end if;

                        Add_In_Map (S (J));

                     end if;

                     J := J + 1;

                  end loop;

                  --  A close bracket must follow a open_bracket,

                  --  and cannot be found alone on the line

               when Close_Bracket =>

                  Raise_Exception

                    ("Incorrect character ']' in regular expression", J);

               when '\' =>

                  if J < S'Last  then

                     J := J + 1;

                     Add_In_Map (S (J));

                  else

                     --  \ not allowed at the end of the regexp

                     Raise_Exception

                       ("Incorrect character '\' in regular expression", J);

                  end if;

               when Open_Paren =>

                  if not Glob then

                     Parenthesis_Level := Parenthesis_Level + 1;

                     Last_Open := J;

                  else

                     Add_In_Map (Open_Paren);

                  end if;

               when Close_Paren =>

                  if not Glob then

                     Parenthesis_Level := Parenthesis_Level - 1;

                     if Parenthesis_Level < 0 then

                        Raise_Exception

                          ("')' is not associated with '(' in regular "

                           & "expression", J);

                     end if;

                     if J = Last_Open + 1 then

                        Raise_Exception

                          ("Empty parenthesis not allowed in regular "

                           & "expression", J);

                     end if;

                  else

                     Add_In_Map (Close_Paren);

                  end if;

               when '.' =>

                  if Glob then

                     Add_In_Map ('.');

                  end if;

               when '{' =>

                  if not Glob then

                     Add_In_Map (S (J));

                  else

                     Curly_Level := Curly_Level + 1;

                  end if;

               when '}' =>

                  if not Glob then

                     Add_In_Map (S (J));

                  else

                     Curly_Level := Curly_Level - 1;

                  end if;

               when '*' | '?' =>

                  if not Glob then

                     if J = S'First then

                        Raise_Exception

                          ("'*', '+', '?' and '|' operators cannot be in "

                           & "first position in regular expression", J);

                     end if;

                  end if;

               when '|' | '+' =>

                  if not Glob then

                     if J = S'First then

                        --  These operators must apply to a sub-expression,

                        --  and cannot be found at the beginning of the line

                        Raise_Exception

                          ("'*', '+', '?' and '|' operators cannot be in "

                           & "first position in regular expression", J);

                     end if;

                  else

                     Add_In_Map (S (J));

                  end if;

               when others =>

                  Add_In_Map (S (J));

            end case;

            J := J + 1;

         end loop;

         --  A closing parenthesis must follow an open parenthesis

         if Parenthesis_Level /= 0 then

            Raise_Exception

              ("'(' must always be associated with a ')'", J);

         end if;

         if Curly_Level /= 0 then

            Raise_Exception

              ("'{' must always be associated with a '}'", J);

         end if;

      end Create_Mapping;

      --------------------------

      -- Create_Primary_Table --

      --------------------------

      procedure Create_Primary_Table

        (Table       : out Regexp_Array_Access;

         Num_States  : out State_Index;

         Start_State : out State_Index;

         End_State   : out State_Index)

      is

         Empty_Char : constant Column_Index := Alphabet_Size + 1;

         Current_State : State_Index := 0;

         --  Index of the last created state

         procedure Add_Empty_Char

           (State    : State_Index;

            To_State : State_Index);

         --  Add a empty-character transition from State to To_State

         procedure Create_Repetition

           (Repetition : Character;

            Start_Prev : State_Index;

            End_Prev   : State_Index;

            New_Start  : out State_Index;

            New_End    : in out State_Index);

         --  Create the table in case we have a '*', '+' or '?'.

         --  Start_Prev .. End_Prev should indicate respectively the start and

         --  end index of the previous expression, to which '*', '+' or '?' is

         --  applied.

         procedure Create_Simple

           (Start_Index : Integer;

            End_Index   : Integer;

            Start_State : out State_Index;

            End_State   : out State_Index);

         --  Fill the table for the regexp Simple.

         --  This is the recursive procedure called to handle () expressions

         --  If End_State = 0, then the call to Create_Simple creates an

         --  independent regexp, not a concatenation

         --  Start_Index .. End_Index is the starting index in the string S.

         --

         --  Warning: it may look like we are creating too many empty-string

         --  transitions, but they are needed to get the correct regexp.

         --  The table is filled as follow ( s means start-state, e means

         --  end-state) :

         --

         --  regexp   state_num | a b * empty_string

         --  -------  ------------------------------

         --    a          1 (s) | 2 - - -

         --               2 (e) | - - - -

         --

         --    ab         1 (s) | 2 - - -

         --               2     | - - - 3

         --               3     | - 4 - -

         --               4 (e) | - - - -

         --

         --    a|b        1     | 2 - - -

         --               2     | - - - 6

         --               3     | - 4 - -

         --               4     | - - - 6

         --               5 (s) | - - - 1,3

         --               6 (e) | - - - -

         --

         --    a*         1     | 2 - - -

         --               2     | - - - 4

         --               3 (s) | - - - 1,4

         --               4 (e) | - - - 3

         --

         --    (a)        1 (s) | 2 - - -

         --               2 (e) | - - - -

         --

         --    a+         1     | 2 - - -

         --               2     | - - - 4

         --               3 (s) | - - - 1

         --               4 (e) | - - - 3

         --

         --    a?         1     | 2 - - -

         --               2     | - - - 4

         --               3 (s) | - - - 1,4

         --               4 (e) | - - - -

         --

         --    .          1 (s) | 2 2 2 -

         --               2 (e) | - - - -

         function Next_Sub_Expression

           (Start_Index : Integer;

            End_Index   : Integer)

            return        Integer;

         --  Returns the index of the last character of the next sub-expression

         --  in Simple. Index cannot be greater than End_Index.

         --------------------

         -- Add_Empty_Char --

         --------------------

         procedure Add_Empty_Char

           (State    : State_Index;

            To_State : State_Index)

         is

            J : Column_Index := Empty_Char;

         begin

            while Get (Table, State, J) /= 0 loop

               J := J + 1;

            end loop;

            Set (Table, State, J, To_State);

         end Add_Empty_Char;

         -----------------------

         -- Create_Repetition --

         -----------------------

         procedure Create_Repetition

           (Repetition : Character;

            Start_Prev : State_Index;

            End_Prev   : State_Index;

            New_Start  : out State_Index;

            New_End    : in out State_Index)

         is

         begin

            New_Start := Current_State + 1;

            if New_End /= 0 then

               Add_Empty_Char (New_End, New_Start);

            end if;

            Current_State := Current_State + 2;

            New_End   := Current_State;

            Add_Empty_Char (End_Prev, New_End);

            Add_Empty_Char (New_Start, Start_Prev);

            if Repetition /= '+' then

               Add_Empty_Char (New_Start, New_End);

            end if;

            if Repetition /= '?' then

               Add_Empty_Char (New_End, New_Start);

            end if;

         end Create_Repetition;

         -------------------

         -- Create_Simple --

         -------------------

         procedure Create_Simple

           (Start_Index : Integer;

            End_Index   : Integer;