gcc/ada/s-regexp.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                        S Y S T E M . R E G E X P                         --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 1999-2009, AdaCore                     --
  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 2,  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.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 with Ada.Unchecked_Deallocation;
  35
  36 with System.Case_Util;
  37
  38 package body System.Regexp is
  39
  40    Open_Paren    : constant Character := '(';
  41    Close_Paren   : constant Character := ')';
  42    Open_Bracket  : constant Character := '[';
  43    Close_Bracket : constant Character := ']';
  44
  45    type State_Index is new Natural;
  46    type Column_Index is new Natural;
  47
  48    type Regexp_Array is array
  49      (State_Index range <>, Column_Index range <>) of State_Index;
  50    --  First index is for the state number
  51    --  Second index is for the character type
  52    --  Contents is the new State
  53
  54    type Regexp_Array_Access is access Regexp_Array;
  55    --  Use this type through the functions Set below, so that it
  56    --  can grow dynamically depending on the needs.
  57
  58    type Mapping is array (Character'Range) of Column_Index;
  59    --  Mapping between characters and column in the Regexp_Array
  60
  61    type Boolean_Array is array (State_Index range <>) of Boolean;
  62
  63    type Regexp_Value
  64      (Alphabet_Size : Column_Index;
  65       Num_States    : State_Index) is
  66    record
  67       Map            : Mapping;
  68       States         : Regexp_Array (1 .. Num_States, 0 .. Alphabet_Size);
  69       Is_Final       : Boolean_Array (1 .. Num_States);
  70       Case_Sensitive : Boolean;
  71    end record;
  72    --  Deterministic finite-state machine
  73
  74    -----------------------
  75    -- Local Subprograms --
  76    -----------------------
  77
  78    procedure Set
  79      (Table  : in out Regexp_Array_Access;
  80       State  : State_Index;
  81       Column : Column_Index;
  82       Value  : State_Index);
  83    --  Sets a value in the table. If the table is too small, reallocate it
  84    --  dynamically so that (State, Column) is a valid index in it.
  85
  86    function Get
  87      (Table  : Regexp_Array_Access;
  88       State  : State_Index;
  89       Column : Column_Index)
  90       return   State_Index;
  91    --  Returns the value in the table at (State, Column).
  92    --  If this index does not exist in the table, returns 0
  93
  94    procedure Free is new Ada.Unchecked_Deallocation
  95      (Regexp_Array, Regexp_Array_Access);
  96
  97    ------------
  98    -- Adjust --
  99    ------------
 100
 101    procedure Adjust (R : in out Regexp) is
 102       Tmp : Regexp_Access;
 103
 104    begin
 105       Tmp := new Regexp_Value (Alphabet_Size => R.R.Alphabet_Size,
 106                                Num_States    => R.R.Num_States);
 107       Tmp.all := R.R.all;
 108       R.R := Tmp;
 109    end Adjust;
 110
 111    -------------
 112    -- Compile --
 113    -------------
 114
 115    function Compile
 116      (Pattern        : String;
 117       Glob           : Boolean := False;
 118       Case_Sensitive : Boolean := True)
 119       return           Regexp
 120    is
 121       S : String := Pattern;
 122       --  The pattern which is really compiled (when the pattern is case
 123       --  insensitive, we convert this string to lower-cases
 124
 125       Map : Mapping := (others => 0);
 126       --  Mapping between characters and columns in the tables
 127
 128       Alphabet_Size : Column_Index := 0;
 129       --  Number of significant characters in the regular expression.
 130       --  This total does not include special operators, such as *, (, ...
 131
 132       procedure Check_Well_Formed_Pattern;
 133       --  Check that the pattern to compile is well-formed, so that
 134       --  subsequent code can rely on this without performing each time
 135       --  the checks to avoid accessing the pattern outside its bounds.
 136       --  Except that, not all well-formedness rules are checked.
 137       --  In particular, the rules about special characters not being
 138       --  treated as regular characters are not checked.
 139
 140       procedure Create_Mapping;
 141       --  Creates a mapping between characters in the regexp and columns
 142       --  in the tables representing the regexp. Test that the regexp is
 143       --  well-formed Modifies Alphabet_Size and Map
 144
 145       procedure Create_Primary_Table
 146         (Table       : out Regexp_Array_Access;
 147          Num_States  : out State_Index;
 148          Start_State : out State_Index;
 149          End_State   : out State_Index);
 150       --  Creates the first version of the regexp (this is a non deterministic
 151       --  finite state machine, which is unadapted for a fast pattern
 152       --  matching algorithm). We use a recursive algorithm to process the
 153       --  parenthesis sub-expressions.
 154       --
 155       --  Table : at the end of the procedure : Column 0 is for any character
 156       --  ('.') and the last columns are for no character (closure)
 157       --  Num_States is set to the number of states in the table
 158       --  Start_State is the number of the starting state in the regexp
 159       --  End_State is the number of the final state when the regexp matches
 160
 161       procedure Create_Primary_Table_Glob
 162         (Table       : out Regexp_Array_Access;
 163          Num_States  : out State_Index;
 164          Start_State : out State_Index;
 165          End_State   : out State_Index);
 166       --  Same function as above, but it deals with the second possible
 167       --  grammar for 'globbing pattern', which is a kind of subset of the
 168       --  whole regular expression grammar.
 169
 170       function Create_Secondary_Table
 171         (First_Table : Regexp_Array_Access;
 172          Num_States  : State_Index;
 173          Start_State : State_Index;
 174          End_State   : State_Index)
 175          return        Regexp;
 176       --  Creates the definitive table representing the regular expression
 177       --  This is actually a transformation of the primary table First_Table,
 178       --  where every state is grouped with the states in its 'no-character'
 179       --  columns. The transitions between the new states are then recalculated
 180       --  and if necessary some new states are created.
 181       --
 182       --  Note that the resulting finite-state machine is not optimized in
 183       --  terms of the number of states : it would be more time-consuming to
 184       --  add a third pass to reduce the number of states in the machine, with
 185       --  no speed improvement...
 186
 187       procedure Raise_Exception (M : String; Index : Integer);
 188       pragma No_Return (Raise_Exception);
 189       --  Raise an exception, indicating an error at character Index in S
 190
 191       -------------------------------
 192       -- Check_Well_Formed_Pattern --
 193       -------------------------------
 194
 195       procedure Check_Well_Formed_Pattern is
 196
 197          J                 : Integer := S'First;
 198          Past_Elmt         : Boolean := False;
 199          --  Set to True everywhere an elmt has been parsed, if Glob=False,
 200          --  meaning there can be now an occurence of '*', '+' and '?'.
 201          Past_Term         : Boolean := False;
 202          --  Set to True everywhere a term has been parsed, if Glob=False,
 203          --  meaning there can be now an occurence of '|'.
 204          Parenthesis_Level : Integer := 0;
 205          Curly_Level       : Integer := 0;
 206          Last_Open         : Integer := S'First - 1;
 207          --  The last occurence of an opening parenthesis, if Glob=False,
 208          --  or the last occurence of an opening curly brace, if Glob=True.
 209
 210          procedure Raise_Exception_If_No_More_Chars (K : Integer := 0);
 211
 212          --------------------------------------
 213          -- Raise_Exception_If_No_More_Chars --
 214          --------------------------------------
 215
 216          procedure Raise_Exception_If_No_More_Chars (K : Integer := 0) is
 217          begin
 218             if J + K > S'Last then
 219                Raise_Exception
 220                  ("Ill-formed pattern while parsing", J);
 221             end if;
 222          end Raise_Exception_If_No_More_Chars;
 223
 224       --  Start of processing for Check_Well_Formed_Pattern
 225
 226       begin
 227          while J <= S'Last loop
 228             case S (J) is
 229                when Open_Bracket =>
 230                   J := J + 1;
 231                   Raise_Exception_If_No_More_Chars;
 232
 233                   if not Glob then
 234                      if S (J) = '^' then
 235                         J := J + 1;
 236                         Raise_Exception_If_No_More_Chars;
 237                      end if;
 238                   end if;
 239
 240                   --  The first character never has a special meaning
 241
 242                   if S (J) = ']' or else S (J) = '-' then
 243                      J := J + 1;
 244                      Raise_Exception_If_No_More_Chars;
 245                   end if;
 246
 247                   --  The set of characters cannot be empty
 248
 249                   if S (J) = ']' then
 250                      Raise_Exception
 251                        ("Set of characters cannot be empty in regular "
 252                           & "expression", J);
 253                   end if;
 254
 255                   declare
 256                      Possible_Range_Start : Boolean := True;
 257                      --  Set to True everywhere a range character '-'
 258                      --  can occur.
 259                   begin
 260                      loop
 261                         exit when S (J) = Close_Bracket;
 262
 263                         --  The current character should be followed by
 264                         --  a closing bracket.
 265
 266                         Raise_Exception_If_No_More_Chars (1);
 267
 268                         if S (J) = '-'
 269                           and then S (J + 1) /= Close_Bracket
 270                         then
 271                            if not Possible_Range_Start then
 272                               Raise_Exception
 273                                 ("No mix of ranges is allowed in "
 274                                    & "regular expression", J);
 275                            end if;
 276
 277                            J := J + 1;
 278                            Raise_Exception_If_No_More_Chars;
 279
 280                            --  Range cannot be followed by '-' character,
 281                            --  except as last character in the set.
 282
 283                            Possible_Range_Start := False;
 284                         else
 285                            Possible_Range_Start := True;
 286                         end if;
 287
 288                         if S (J) = '\' then
 289                            J := J + 1;
 290                            Raise_Exception_If_No_More_Chars;
 291                         end if;
 292
 293                         J := J + 1;
 294                      end loop;
 295                   end;
 296
 297                   --  A closing bracket can end an elmt or term
 298
 299                   Past_Elmt := True;
 300                   Past_Term := True;
 301
 302                when Close_Bracket =>
 303                   --  A close bracket must follow a open_bracket,
 304                   --  and cannot be found alone on the line.
 305
 306                   Raise_Exception
 307                     ("Incorrect character ']' in regular expression", J);
 308
 309                when '\' =>
 310                   if J < S'Last then
 311                      J := J + 1;
 312
 313                      --  Any character can be an elmt or a term
 314
 315                      Past_Elmt := True;
 316                      Past_Term := True;
 317                   else
 318                      --  \ not allowed at the end of the regexp
 319
 320                      Raise_Exception
 321                        ("Incorrect character '\' in regular expression", J);
 322                   end if;
 323
 324                when Open_Paren =>
 325                   if not Glob then
 326                      Parenthesis_Level := Parenthesis_Level + 1;
 327                      Last_Open := J;
 328
 329                      --  An open parenthesis does not end an elmt or term
 330
 331                      Past_Elmt := False;
 332                      Past_Term := False;
 333                   end if;
 334
 335                when Close_Paren =>
 336                   if not Glob then
 337                      Parenthesis_Level := Parenthesis_Level - 1;
 338
 339                      if Parenthesis_Level < 0 then
 340                         Raise_Exception
 341                           ("')' is not associated with '(' in regular "
 342                            & "expression", J);
 343                      end if;
 344
 345                      if J = Last_Open + 1 then
 346                         Raise_Exception
 347                           ("Empty parentheses not allowed in regular "
 348                            & "expression", J);
 349                      end if;
 350
 351                      if not Past_Term then
 352                         Raise_Exception
 353                           ("Closing parenthesis not allowed here in regular "
 354                              & "expression", J);
 355                      end if;
 356
 357                      --  A closing parenthesis can end an elmt or term
 358
 359                      Past_Elmt := True;
 360                      Past_Term := True;
 361                   end if;
 362
 363                when '{' =>
 364                   if Glob then
 365                      Curly_Level := Curly_Level + 1;
 366                      Last_Open := J;
 367                   else
 368                      --  Any character can be an elmt or a term
 369
 370                      Past_Elmt := True;
 371                      Past_Term := True;
 372                   end if;
 373
 374                   --  No need to check for ',' as the code always accepts them
 375
 376                when '}' =>
 377                   if Glob then
 378                      Curly_Level := Curly_Level - 1;
 379
 380                      if Curly_Level < 0 then
 381                         Raise_Exception
 382                           ("'}' is not associated with '{' in regular "
 383                            & "expression", J);
 384                      end if;
 385
 386                      if J = Last_Open + 1 then
 387                         Raise_Exception
 388                           ("Empty curly braces not allowed in regular "
 389                            & "expression", J);
 390                      end if;
 391                   else
 392                      --  Any character can be an elmt or a term
 393
 394                      Past_Elmt := True;
 395                      Past_Term := True;
 396                   end if;
 397
 398                when '*' | '?' | '+' =>
 399                   if not Glob then
 400                      --  These operators must apply to an elmt sub-expression,
 401                      --  and cannot be found if one has not just been parsed.
 402
 403                      if not Past_Elmt then
 404                         Raise_Exception
 405                           ("'*', '+' and '?' operators must be "
 406                            & "applied to an element in regular expression", J);
 407                      end if;
 408
 409                      Past_Elmt := False;
 410                      Past_Term := True;
 411                   end if;
 412
 413                when '|' =>
 414                   if not Glob then
 415                      --  This operator must apply to a term sub-expression,
 416                      --  and cannot be found if one has not just been parsed.
 417
 418                      if not Past_Term then
 419                         Raise_Exception
 420                           ("'|' operator must be "
 421                            & "applied to a term in regular expression", J);
 422                      end if;
 423
 424                      Past_Elmt := False;
 425                      Past_Term := False;
 426                   end if;
 427
 428                when others =>
 429                   if not Glob then
 430                      --  Any character can be an elmt or a term
 431
 432                      Past_Elmt := True;
 433                      Past_Term := True;
 434                   end if;
 435             end case;
 436
 437             J := J + 1;
 438          end loop;
 439
 440          --  A closing parenthesis must follow an open parenthesis
 441
 442          if Parenthesis_Level /= 0 then
 443             Raise_Exception
 444               ("'(' must always be associated with a ')'", J);
 445          end if;
 446
 447          --  A closing curly brace must follow an open curly brace
 448
 449          if Curly_Level /= 0 then
 450             Raise_Exception
 451               ("'{' must always be associated with a '}'", J);
 452          end if;
 453       end Check_Well_Formed_Pattern;
 454
 455       --------------------
 456       -- Create_Mapping --
 457       --------------------
 458
 459       procedure Create_Mapping is
 460
 461          procedure Add_In_Map (C : Character);
 462          --  Add a character in the mapping, if it is not already defined
 463
 464          ----------------
 465          -- Add_In_Map --
 466          ----------------
 467
 468          procedure Add_In_Map (C : Character) is
 469          begin
 470             if Map (C) = 0 then
 471                Alphabet_Size := Alphabet_Size + 1;
 472                Map (C) := Alphabet_Size;
 473             end if;
 474          end Add_In_Map;
 475
 476          J                 : Integer := S'First;
 477          Parenthesis_Level : Integer := 0;
 478          Curly_Level       : Integer := 0;
 479          Last_Open         : Integer := S'First - 1;
 480
 481       --  Start of processing for Create_Mapping
 482
 483       begin
 484          while J <= S'Last loop
 485             case S (J) is
 486                when Open_Bracket =>
 487                   J := J + 1;
 488
 489                   if S (J) = '^' then
 490                      J := J + 1;
 491                   end if;
 492
 493                   if S (J) = ']' or else S (J) = '-' then
 494                      J := J + 1;
 495                   end if;
 496
 497                   --  The first character never has a special meaning
 498
 499                   loop
 500                      if J > S'Last then
 501                         Raise_Exception
 502                           ("Ran out of characters while parsing ", J);
 503                      end if;
 504
 505                      exit when S (J) = Close_Bracket;
 506
 507                      if S (J) = '-'
 508                        and then S (J + 1) /= Close_Bracket
 509                      then
 510                         declare
 511                            Start : constant Integer := J - 1;
 512
 513                         begin
 514                            J := J + 1;
 515
 516                            if S (J) = '\' then
 517                               J := J + 1;
 518                            end if;
 519
 520                            for Char in S (Start) .. S (J) loop
 521                               Add_In_Map (Char);
 522                            end loop;
 523                         end;
 524                      else
 525                         if S (J) = '\' then
 526                            J := J + 1;
 527                         end if;
 528
 529                         Add_In_Map (S (J));
 530                      end if;
 531
 532                      J := J + 1;
 533                   end loop;
 534
 535                   --  A close bracket must follow a open_bracket,
 536                   --  and cannot be found alone on the line
 537
 538                when Close_Bracket =>
 539                   Raise_Exception
 540                     ("Incorrect character ']' in regular expression", J);
 541
 542                when '\' =>
 543                   if J < S'Last  then
 544                      J := J + 1;
 545                      Add_In_Map (S (J));
 546
 547                   else
 548                      --  \ not allowed at the end of the regexp
 549
 550                      Raise_Exception
 551                        ("Incorrect character '\' in regular expression", J);
 552                   end if;
 553
 554                when Open_Paren =>
 555                   if not Glob then
 556                      Parenthesis_Level := Parenthesis_Level + 1;
 557                      Last_Open := J;
 558                   else
 559                      Add_In_Map (Open_Paren);
 560                   end if;
 561
 562                when Close_Paren =>
 563                   if not Glob then
 564                      Parenthesis_Level := Parenthesis_Level - 1;
 565
 566                      if Parenthesis_Level < 0 then
 567                         Raise_Exception
 568                           ("')' is not associated with '(' in regular "
 569                            & "expression", J);
 570                      end if;
 571
 572                      if J = Last_Open + 1 then
 573                         Raise_Exception
 574                           ("Empty parenthesis not allowed in regular "
 575                            & "expression", J);
 576                      end if;
 577
 578                   else
 579                      Add_In_Map (Close_Paren);
 580                   end if;
 581
 582                when '.' =>
 583                   if Glob then
 584                      Add_In_Map ('.');
 585                   end if;
 586
 587                when '{' =>
 588                   if not Glob then
 589                      Add_In_Map (S (J));
 590                   else
 591                      Curly_Level := Curly_Level + 1;
 592                   end if;
 593
 594                when '}' =>
 595                   if not Glob then
 596                      Add_In_Map (S (J));
 597                   else
 598                      Curly_Level := Curly_Level - 1;
 599                   end if;
 600
 601                when '*' | '?' =>
 602                   if not Glob then
 603                      if J = S'First then
 604                         Raise_Exception
 605                           ("'*', '+', '?' and '|' operators cannot be in "
 606                            & "first position in regular expression", J);
 607                      end if;
 608                   end if;
 609
 610                when '|' | '+' =>
 611                   if not Glob then
 612                      if J = S'First then
 613
 614                         --  These operators must apply to a sub-expression,
 615                         --  and cannot be found at the beginning of the line
 616
 617                         Raise_Exception
 618                           ("'*', '+', '?' and '|' operators cannot be in "
 619                            & "first position in regular expression", J);
 620                      end if;
 621
 622                   else
 623                      Add_In_Map (S (J));
 624                   end if;
 625
 626                when others =>
 627                   Add_In_Map (S (J));
 628             end case;
 629
 630             J := J + 1;
 631          end loop;
 632
 633          --  A closing parenthesis must follow an open parenthesis
 634
 635          if Parenthesis_Level /= 0 then
 636             Raise_Exception
 637               ("'(' must always be associated with a ')'", J);
 638          end if;
 639
 640          if Curly_Level /= 0 then
 641             Raise_Exception
 642               ("'{' must always be associated with a '}'", J);
 643          end if;
 644       end Create_Mapping;
 645
 646       --------------------------
 647       -- Create_Primary_Table --
 648       --------------------------
 649
 650       procedure Create_Primary_Table
 651         (Table       : out Regexp_Array_Access;
 652          Num_States  : out State_Index;
 653          Start_State : out State_Index;
 654          End_State   : out State_Index)
 655       is
 656          Empty_Char : constant Column_Index := Alphabet_Size + 1;
 657
 658          Current_State : State_Index := 0;
 659          --  Index of the last created state
 660
 661          procedure Add_Empty_Char
 662            (State    : State_Index;
 663             To_State : State_Index);
 664          --  Add a empty-character transition from State to To_State
 665
 666          procedure Create_Repetition
 667            (Repetition : Character;
 668             Start_Prev : State_Index;
 669             End_Prev   : State_Index;
 670             New_Start  : out State_Index;
 671             New_End    : in out State_Index);
 672          --  Create the table in case we have a '*', '+' or '?'.
 673          --  Start_Prev .. End_Prev should indicate respectively the start and
 674          --  end index of the previous expression, to which '*', '+' or '?' is
 675          --  applied.
 676
 677          procedure Create_Simple
 678            (Start_Index : Integer;
 679             End_Index   : Integer;
 680             Start_State : out State_Index;
 681             End_State   : out State_Index);
 682          --  Fill the table for the regexp Simple.
 683          --  This is the recursive procedure called to handle () expressions
 684          --  If End_State = 0, then the call to Create_Simple creates an
 685          --  independent regexp, not a concatenation
 686          --  Start_Index .. End_Index is the starting index in the string S.
 687          --
 688          --  Warning: it may look like we are creating too many empty-string
 689          --  transitions, but they are needed to get the correct regexp.
 690          --  The table is filled as follow ( s means start-state, e means
 691          --  end-state) :
 692          --
 693          --  regexp   state_num | a b * empty_string
 694          --  -------  ------------------------------
 695          --    a          1 (s) | 2 - - -
 696          --               2 (e) | - - - -
 697          --
 698          --    ab         1 (s) | 2 - - -
 699          --               2     | - - - 3
 700          --               3     | - 4 - -
 701          --               4 (e) | - - - -
 702          --
 703          --    a|b        1     | 2 - - -
 704          --               2     | - - - 6
 705          --               3     | - 4 - -
 706          --               4     | - - - 6
 707          --               5 (s) | - - - 1,3
 708          --               6 (e) | - - - -
 709          --
 710          --    a*         1     | 2 - - -
 711          --               2     | - - - 4
 712          --               3 (s) | - - - 1,4
 713          --               4 (e) | - - - 3
 714          --
 715          --    (a)        1 (s) | 2 - - -
 716          --               2 (e) | - - - -
 717          --
 718          --    a+         1     | 2 - - -
 719          --               2     | - - - 4
 720          --               3 (s) | - - - 1
 721          --               4 (e) | - - - 3
 722          --
 723          --    a?         1     | 2 - - -
 724          --               2     | - - - 4
 725          --               3 (s) | - - - 1,4
 726          --               4 (e) | - - - -
 727          --
 728          --    .          1 (s) | 2 2 2 -
 729          --               2 (e) | - - - -
 730
 731          function Next_Sub_Expression
 732            (Start_Index : Integer;
 733             End_Index   : Integer)
 734             return        Integer;
 735          --  Returns the index of the last character of the next sub-expression
 736          --  in Simple. Index cannot be greater than End_Index.
 737
 738          --------------------
 739          -- Add_Empty_Char --
 740          --------------------
 741
 742          procedure Add_Empty_Char
 743            (State    : State_Index;
 744             To_State : State_Index)
 745          is
 746             J : Column_Index := Empty_Char;
 747
 748          begin
 749             while Get (Table, State, J) /= 0 loop
 750                J := J + 1;
 751             end loop;
 752
 753             Set (Table, State, J, To_State);
 754          end Add_Empty_Char;
 755
 756          -----------------------
 757          -- Create_Repetition --
 758          -----------------------
 759
 760          procedure Create_Repetition
 761            (Repetition : Character;
 762             Start_Prev : State_Index;
 763             End_Prev   : State_Index;
 764             New_Start  : out State_Index;
 765             New_End    : in out State_Index)
 766          is
 767          begin
 768             New_Start := Current_State + 1;
 769
 770             if New_End /= 0 then
 771                Add_Empty_Char (New_End, New_Start);
 772             end if;
 773
 774             Current_State := Current_State + 2;
 775             New_End   := Current_State;
 776
 777             Add_Empty_Char (End_Prev, New_End);
 778             Add_Empty_Char (New_Start, Start_Prev);
 779
 780             if Repetition /= '+' then
 781                Add_Empty_Char (New_Start, New_End);
 782             end if;
 783
 784             if Repetition /= '?' then
 785                Add_Empty_Char (New_End, New_Start);
 786             end if;
 787          end Create_Repetition;
 788
 789          -------------------
 790          -- Create_Simple --
 791          -------------------
 792
 793          procedure Create_Simple
 794            (Start_Index : Integer;
 795             End_Index   : Integer;
 796             Start_State : out State_Index;
 797             End_State   : out State_Index)
 798          is
 799             J          : Integer := Start_Index;
 800             Last_Start : State_Index := 0;
 801
 802          begin
 803             Start_State := 0;
 804             End_State   := 0;
 805             while J <= End_Index loop
 806                case S (J) is
 807                   when Open_Paren =>
 808                      declare
 809                         J_Start    : constant Integer := J + 1;
 810                         Next_Start : State_Index;
 811                         Next_End   : State_Index;
 812
 813                      begin
 814                         J := Next_Sub_Expression (J, End_Index);
 815                         Create_Simple (J_Start, J - 1, Next_Start, Next_End);
 816
 817                         if J < End_Index
 818                           and then (S (J + 1) = '*' or else
 819                                     S (J + 1) = '+' or else
 820                                     S (J + 1) = '?')
 821                         then
 822                            J := J + 1;
 823                            Create_Repetition
 824                              (S (J),
 825                               Next_Start,
 826                               Next_End,
 827                               Last_Start,
 828                               End_State);
 829
 830                         else
 831                            Last_Start := Next_Start;
 832
 833                            if End_State /= 0 then
 834                               Add_Empty_Char (End_State, Last_Start);
 835                            end if;
 836
 837                            End_State := Next_End;
 838                         end if;
 839                      end;
 840
 841                   when '|' =>
 842                      declare
 843                         Start_Prev : constant State_Index := Start_State;
 844                         End_Prev   : constant State_Index := End_State;
 845                         Start_J    : constant Integer     := J + 1;
 846                         Start_Next : State_Index := 0;
 847                         End_Next   : State_Index := 0;
 848
 849                      begin
 850                         J := Next_Sub_Expression (J, End_Index);
 851
 852                         --  Create a new state for the start of the alternative
 853
 854                         Current_State := Current_State + 1;
 855                         Last_Start := Current_State;
 856                         Start_State := Last_Start;
 857
 858                         --  Create the tree for the second part of alternative
 859
 860                         Create_Simple (Start_J, J, Start_Next, End_Next);
 861
 862                         --  Create the end state
 863
 864                         Add_Empty_Char (Last_Start, Start_Next);
 865                         Add_Empty_Char (Last_Start, Start_Prev);
 866                         Current_State := Current_State + 1;
 867                         End_State := Current_State;
 868                         Add_Empty_Char (End_Prev, End_State);
 869                         Add_Empty_Char (End_Next, End_State);
 870                      end;
 871
 872                   when Open_Bracket =>
 873                      Current_State := Current_State + 1;
 874
 875                      declare
 876                         Next_State : State_Index := Current_State + 1;
 877
 878                      begin
 879                         J := J + 1;
 880
 881                         if S (J) = '^' then
 882                            J := J + 1;
 883
 884                            Next_State := 0;
 885
 886                            for Column in 0 .. Alphabet_Size loop
 887                               Set (Table, Current_State, Column,
 888                                    Value => Current_State + 1);
 889                            end loop;
 890                         end if;
 891
 892                         --  Automatically add the first character
 893
 894                         if S (J) = '-' or else S (J) = ']' then
 895                            Set (Table, Current_State, Map (S (J)),
 896                                 Value => Next_State);
 897                            J := J + 1;
 898                         end if;
 899
 900                         --  Loop till closing bracket found
 901
 902                         loop
 903                            exit when S (J) = Close_Bracket;
 904
 905                            if S (J) = '-'
 906                              and then S (J + 1) /= ']'
 907                            then
 908                               declare
 909                                  Start : constant Integer := J - 1;
 910
 911                               begin
 912                                  J := J + 1;
 913
 914                                  if S (J) = '\' then
 915                                     J := J + 1;
 916                                  end if;
 917
 918                                  for Char in S (Start) .. S (J) loop
 919                                     Set (Table, Current_State, Map (Char),
 920                                          Value => Next_State);
 921                                  end loop;
 922                               end;
 923
 924                            else
 925                               if S (J) = '\' then
 926                                  J := J + 1;
 927                               end if;
 928
 929                               Set (Table, Current_State, Map (S (J)),
 930                                    Value => Next_State);
 931                            end if;
 932                            J := J + 1;
 933                         end loop;
 934                      end;
 935
 936                      Current_State := Current_State + 1;
 937
 938                      --  If the next symbol is a special symbol
 939
 940                      if J < End_Index
 941                        and then (S (J + 1) = '*' or else
 942                                  S (J + 1) = '+' or else
 943                                  S (J + 1) = '?')
 944                      then
 945                         J := J + 1;
 946                         Create_Repetition
 947                           (S (J),
 948                            Current_State - 1,
 949                            Current_State,
 950                            Last_Start,
 951                            End_State);
 952
 953                      else
 954                         Last_Start := Current_State - 1;
 955
 956                         if End_State /= 0 then
 957                            Add_Empty_Char (End_State, Last_Start);
 958                         end if;
 959
 960                         End_State := Current_State;
 961                      end if;
 962
 963                   when '*' | '+' | '?' | Close_Paren | Close_Bracket =>
 964                      Raise_Exception
 965                        ("Incorrect character in regular expression :", J);
 966
 967                   when others =>
 968                      Current_State := Current_State + 1;
 969
 970                      --  Create the state for the symbol S (J)
 971
 972                      if S (J) = '.' then
 973                         for K in 0 .. Alphabet_Size loop
 974                            Set (Table, Current_State, K,
 975                                 Value => Current_State + 1);
 976                         end loop;
 977
 978                      else
 979                         if S (J) = '\' then
 980                            J := J + 1;
 981                         end if;
 982
 983                         Set (Table, Current_State, Map (S (J)),
 984                              Value => Current_State + 1);
 985                      end if;
 986
 987                      Current_State := Current_State + 1;
 988
 989                      --  If the next symbol is a special symbol
 990
 991                      if J < End_Index
 992                        and then (S (J + 1) = '*' or else
 993                                  S (J + 1) = '+' or else
 994                                  S (J + 1) = '?')
 995                      then
 996                         J := J + 1;
 997                         Create_Repetition
 998                           (S (J),
 999                            Current_State - 1,
1000                            Current_State,
1001                            Last_Start,
1002                            End_State);
1003
1004                      else
1005                         Last_Start := Current_State - 1;
1006
1007                         if End_State /= 0 then
1008                            Add_Empty_Char (End_State, Last_Start);
1009                         end if;
1010
1011                         End_State := Current_State;
1012                      end if;
1013
1014                end case;
1015
1016                if Start_State = 0 then
1017                   Start_State := Last_Start;
1018                end if;
1019
1020                J := J + 1;
1021             end loop;
1022          end Create_Simple;
1023
1024          -------------------------
1025          -- Next_Sub_Expression --
1026          -------------------------
1027
1028          function Next_Sub_Expression
1029            (Start_Index : Integer;
1030             End_Index   : Integer)
1031             return        Integer
1032          is
1033             J              : Integer := Start_Index;
1034             Start_On_Alter : Boolean := False;
1035
1036          begin
1037             if S (J) = '|' then
1038                Start_On_Alter := True;
1039             end if;
1040
1041             loop
1042                exit when J = End_Index;
1043                J := J + 1;
1044
1045                case S (J) is
1046                   when '\' =>
1047                      J := J + 1;
1048
1049                   when Open_Bracket =>
1050                      loop
1051                         J := J + 1;
1052                         exit when S (J) = Close_Bracket;
1053
1054                         if S (J) = '\' then
1055                            J := J + 1;
1056                         end if;
1057                      end loop;
1058
1059                   when Open_Paren =>
1060                      J := Next_Sub_Expression (J, End_Index);
1061
1062                   when Close_Paren =>
1063                      return J;
1064
1065                   when '|' =>
1066                      if Start_On_Alter then
1067                         return J - 1;
1068                      end if;
1069
1070                   when others =>
1071                      null;
1072                end case;
1073             end loop;
1074
1075             return J;
1076          end Next_Sub_Expression;
1077
1078       --  Start of Create_Primary_Table
1079
1080       begin
1081          Table.all := (others => (others => 0));
1082          Create_Simple (S'First, S'Last, Start_State, End_State);
1083          Num_States := Current_State;
1084       end Create_Primary_Table;
1085
1086       -------------------------------
1087       -- Create_Primary_Table_Glob --
1088       -------------------------------
1089
1090       procedure Create_Primary_Table_Glob
1091         (Table       : out Regexp_Array_Access;
1092          Num_States  : out State_Index;
1093          Start_State : out State_Index;
1094          End_State   : out State_Index)
1095       is
1096          Empty_Char : constant Column_Index := Alphabet_Size + 1;
1097
1098          Current_State : State_Index := 0;
1099          --  Index of the last created state
1100
1101          procedure Add_Empty_Char
1102            (State    : State_Index;
1103             To_State : State_Index);
1104          --  Add a empty-character transition from State to To_State
1105
1106          procedure Create_Simple
1107            (Start_Index : Integer;
1108             End_Index   : Integer;
1109             Start_State : out State_Index;
1110             End_State   : out State_Index);
1111          --  Fill the table for the S (Start_Index .. End_Index).
1112          --  This is the recursive procedure called to handle () expressions
1113
1114          --------------------
1115          -- Add_Empty_Char --
1116          --------------------
1117
1118          procedure Add_Empty_Char
1119            (State    : State_Index;
1120             To_State : State_Index)
1121          is
1122             J : Column_Index := Empty_Char;
1123
1124          begin
1125             while Get (Table, State, J) /= 0 loop
1126                J := J + 1;
1127             end loop;
1128
1129             Set (Table, State, J,
1130                  Value => To_State);
1131          end Add_Empty_Char;
1132
1133          -------------------
1134          -- Create_Simple --
1135          -------------------
1136
1137          procedure Create_Simple
1138            (Start_Index : Integer;
1139             End_Index   : Integer;
1140             Start_State : out State_Index;
1141             End_State   : out State_Index)
1142          is
1143             J          : Integer := Start_Index;
1144             Last_Start : State_Index := 0;
1145
1146          begin
1147             Start_State := 0;
1148             End_State   := 0;
1149
1150             while J <= End_Index loop
1151                case S (J) is
1152
1153                   when Open_Bracket =>
1154                      Current_State := Current_State + 1;
1155
1156                      declare
1157                         Next_State : State_Index := Current_State + 1;
1158
1159                      begin
1160                         J := J + 1;
1161
1162                         if S (J) = '^' then
1163                            J := J + 1;
1164                            Next_State := 0;
1165
1166                            for Column in 0 .. Alphabet_Size loop
1167                               Set (Table, Current_State, Column,
1168                                    Value => Current_State + 1);
1169                            end loop;
1170                         end if;
1171
1172                         --  Automatically add the first character
1173
1174                         if S (J) = '-' or else S (J) = ']' then
1175                            Set (Table, Current_State, Map (S (J)),
1176                                 Value => Current_State);
1177                            J := J + 1;
1178                         end if;
1179
1180                         --  Loop till closing bracket found
1181
1182                         loop
1183                            exit when S (J) = Close_Bracket;
1184
1185                            if S (J) = '-'
1186                              and then S (J + 1) /= ']'
1187                            then
1188                               declare
1189                                  Start : constant Integer := J - 1;
1190                               begin
1191                                  J := J + 1;
1192
1193                                  if S (J) = '\' then
1194                                     J := J + 1;
1195                                  end if;
1196
1197                                  for Char in S (Start) .. S (J) loop
1198                                     Set (Table, Current_State, Map (Char),
1199                                          Value => Next_State);
1200                                  end loop;
1201                               end;
1202
1203                            else
1204                               if S (J) = '\' then
1205                                  J := J + 1;
1206                               end if;
1207
1208                               Set (Table, Current_State, Map (S (J)),
1209                                    Value => Next_State);
1210                            end if;
1211                            J := J + 1;
1212                         end loop;
1213                      end;
1214
1215                      Last_Start := Current_State;
1216                      Current_State := Current_State + 1;
1217
1218                      if End_State /= 0 then
1219                         Add_Empty_Char (End_State, Last_Start);
1220                      end if;
1221
1222                      End_State := Current_State;
1223
1224                   when '{' =>
1225                      declare
1226                         End_Sub          : Integer;
1227                         Start_Regexp_Sub : State_Index;
1228                         End_Regexp_Sub   : State_Index;
1229                         Create_Start     : State_Index := 0;
1230
1231                         Create_End : State_Index := 0;
1232                         --  Initialized to avoid junk warning
1233
1234                      begin
1235                         while S (J) /= '}' loop
1236
1237                            --  First step : find sub pattern
1238
1239                            End_Sub := J + 1;
1240                            while S (End_Sub) /= ','
1241                              and then S (End_Sub) /= '}'
1242                            loop
1243                               End_Sub := End_Sub + 1;
1244                            end loop;
1245
1246                            --  Second step : create a sub pattern
1247
1248                            Create_Simple
1249                              (J + 1,
1250                               End_Sub - 1,
1251                               Start_Regexp_Sub,
1252                               End_Regexp_Sub);
1253
1254                            J := End_Sub;
1255
1256                            --  Third step : create an alternative
1257
1258                            if Create_Start = 0 then
1259                               Current_State := Current_State + 1;
1260                               Create_Start := Current_State;
1261                               Add_Empty_Char (Create_Start, Start_Regexp_Sub);
1262                               Current_State := Current_State + 1;
1263                               Create_End := Current_State;
1264                               Add_Empty_Char (End_Regexp_Sub, Create_End);
1265
1266                            else
1267                               Current_State := Current_State + 1;
1268                               Add_Empty_Char (Current_State, Create_Start);
1269                               Create_Start := Current_State;
1270                               Add_Empty_Char (Create_Start, Start_Regexp_Sub);
1271                               Add_Empty_Char (End_Regexp_Sub, Create_End);
1272                            end if;
1273                         end loop;
1274
1275                         if End_State /= 0 then
1276                            Add_Empty_Char (End_State, Create_Start);
1277                         end if;
1278
1279                         End_State := Create_End;
1280                         Last_Start := Create_Start;
1281                      end;
1282
1283                   when '*' =>
1284                      Current_State := Current_State + 1;
1285
1286                      if End_State /= 0 then
1287                         Add_Empty_Char (End_State, Current_State);
1288                      end if;
1289
1290                      Add_Empty_Char (Current_State, Current_State + 1);
1291                      Add_Empty_Char (Current_State, Current_State + 3);
1292                      Last_Start := Current_State;
1293
1294                      Current_State := Current_State + 1;
1295
1296                      for K in 0 .. Alphabet_Size loop
1297                         Set (Table, Current_State, K,
1298                              Value => Current_State + 1);
1299                      end loop;
1300
1301                      Current_State := Current_State + 1;
1302                      Add_Empty_Char (Current_State, Current_State + 1);
1303
1304                      Current_State := Current_State + 1;
1305                      Add_Empty_Char (Current_State,  Last_Start);
1306                      End_State := Current_State;
1307
1308                   when others =>
1309                      Current_State := Current_State + 1;
1310
1311                      if S (J) = '?' then
1312                         for K in 0 .. Alphabet_Size loop
1313                            Set (Table, Current_State, K,
1314                                 Value => Current_State + 1);
1315                         end loop;
1316
1317                      else
1318                         if S (J) = '\' then
1319                            J := J + 1;
1320                         end if;
1321
1322                         --  Create the state for the symbol S (J)
1323
1324                         Set (Table, Current_State, Map (S (J)),
1325                              Value => Current_State + 1);
1326                      end if;
1327
1328                      Last_Start := Current_State;
1329                      Current_State := Current_State + 1;
1330
1331                      if End_State /= 0 then
1332                         Add_Empty_Char (End_State, Last_Start);
1333                      end if;
1334
1335                      End_State := Current_State;
1336
1337                end case;
1338
1339                if Start_State = 0 then
1340                   Start_State := Last_Start;
1341                end if;
1342
1343                J := J + 1;
1344             end loop;
1345          end Create_Simple;
1346
1347       --  Start of processing for Create_Primary_Table_Glob
1348
1349       begin
1350          Table.all := (others => (others => 0));
1351          Create_Simple (S'First, S'Last, Start_State, End_State);
1352          Num_States := Current_State;
1353       end Create_Primary_Table_Glob;
1354
1355       ----------------------------
1356       -- Create_Secondary_Table --
1357       ----------------------------
1358
1359       function Create_Secondary_Table
1360         (First_Table : Regexp_Array_Access;
1361          Num_States  : State_Index;
1362          Start_State : State_Index;
1363          End_State   : State_Index) return Regexp
1364       is
1365          pragma Warnings (Off, Num_States);
1366
1367          Last_Index : constant State_Index := First_Table'Last (1);
1368          type Meta_State is array (1 .. Last_Index) of Boolean;
1369
1370          Table : Regexp_Array (1 .. Last_Index, 0 .. Alphabet_Size) :=
1371                    (others => (others => 0));
1372
1373          Meta_States : array (1 .. Last_Index + 1) of Meta_State :=
1374                          (others => (others => False));
1375
1376          Temp_State_Not_Null : Boolean;
1377
1378          Is_Final : Boolean_Array (1 .. Last_Index) := (others => False);
1379
1380          Current_State       : State_Index := 1;
1381          Nb_State            : State_Index := 1;
1382
1383          procedure Closure
1384            (State : in out Meta_State;
1385             Item  :        State_Index);
1386          --  Compute the closure of the state (that is every other state which
1387          --  has a empty-character transition) and add it to the state
1388
1389          -------------
1390          -- Closure --
1391          -------------
1392
1393          procedure Closure
1394            (State : in out Meta_State;
1395             Item  : State_Index)
1396          is
1397          begin
1398             if State (Item) then
1399                return;
1400             end if;
1401
1402             State (Item) := True;
1403
1404             for Column in Alphabet_Size + 1 .. First_Table'Last (2) loop
1405                if First_Table (Item, Column) = 0 then
1406                   return;
1407                end if;
1408
1409                Closure (State, First_Table (Item, Column));
1410             end loop;
1411          end Closure;
1412
1413       --  Start of processing for Create_Secondary_Table
1414
1415       begin
1416          --  Create a new state
1417
1418          Closure (Meta_States (Current_State), Start_State);
1419
1420          while Current_State <= Nb_State loop
1421
1422             --  If this new meta-state includes the primary table end state,
1423             --  then this meta-state will be a final state in the regexp
1424
1425             if Meta_States (Current_State)(End_State) then
1426                Is_Final (Current_State) := True;
1427             end if;
1428
1429             --  For every character in the regexp, calculate the possible
1430             --  transitions from Current_State
1431
1432             for Column in 0 .. Alphabet_Size loop
1433                Meta_States (Nb_State + 1) := (others => False);
1434                Temp_State_Not_Null := False;
1435
1436                for K in Meta_States (Current_State)'Range loop
1437                   if Meta_States (Current_State)(K)
1438                     and then First_Table (K, Column) /= 0
1439                   then
1440                      Closure
1441                        (Meta_States (Nb_State + 1), First_Table (K, Column));
1442                      Temp_State_Not_Null := True;
1443                   end if;
1444                end loop;
1445
1446                --  If at least one transition existed
1447
1448                if Temp_State_Not_Null then
1449
1450                   --  Check if this new state corresponds to an old one
1451
1452                   for K in 1 .. Nb_State loop
1453                      if Meta_States (K) = Meta_States (Nb_State + 1) then
1454                         Table (Current_State, Column) := K;
1455                         exit;
1456                      end if;
1457                   end loop;
1458
1459                   --  If not, create a new state
1460
1461                   if Table (Current_State, Column) = 0 then
1462                      Nb_State := Nb_State + 1;
1463                      Table (Current_State, Column) := Nb_State;
1464                   end if;
1465                end if;
1466             end loop;
1467
1468             Current_State := Current_State + 1;
1469          end loop;
1470
1471          --  Returns the regexp
1472
1473          declare
1474             R : Regexp_Access;
1475
1476          begin
1477             R := new Regexp_Value (Alphabet_Size => Alphabet_Size,
1478                                    Num_States    => Nb_State);
1479             R.Map            := Map;
1480             R.Is_Final       := Is_Final (1 .. Nb_State);
1481             R.Case_Sensitive := Case_Sensitive;
1482
1483             for State in 1 .. Nb_State loop
1484                for K in 0 .. Alphabet_Size loop
1485                   R.States (State, K) := Table (State, K);
1486                end loop;
1487             end loop;
1488
1489             return (Ada.Finalization.Controlled with R => R);
1490          end;
1491       end Create_Secondary_Table;
1492
1493       ---------------------
1494       -- Raise_Exception --
1495       ---------------------
1496
1497       procedure Raise_Exception (M : String; Index : Integer) is
1498       begin
1499          raise Error_In_Regexp with M & " at offset" & Index'Img;
1500       end Raise_Exception;
1501
1502    --  Start of processing for Compile
1503
1504    begin
1505       --  Special case for the empty string: it always matches, and the
1506       --  following processing would fail on it.
1507       if S = "" then
1508          return (Ada.Finalization.Controlled with
1509                  R => new Regexp_Value'
1510                       (Alphabet_Size => 0,
1511                        Num_States    => 1,
1512                        Map           => (others => 0),
1513                        States        => (others => (others => 1)),
1514                        Is_Final      => (others => True),
1515                        Case_Sensitive => True));
1516       end if;
1517
1518       if not Case_Sensitive then
1519          System.Case_Util.To_Lower (S);
1520       end if;
1521
1522       --  Check the pattern is well-formed before any treatment
1523
1524       Check_Well_Formed_Pattern;
1525
1526       Create_Mapping;
1527
1528       --  Creates the primary table
1529
1530       declare
1531          Table       : Regexp_Array_Access;
1532          Num_States  : State_Index;
1533          Start_State : State_Index;
1534          End_State   : State_Index;
1535          R           : Regexp;
1536
1537       begin
1538          Table := new Regexp_Array (1 .. 100,
1539                                     0 .. Alphabet_Size + 10);
1540          if not Glob then
1541             Create_Primary_Table (Table, Num_States, Start_State, End_State);
1542          else
1543             Create_Primary_Table_Glob
1544               (Table, Num_States, Start_State, End_State);
1545          end if;
1546
1547          --  Creates the secondary table
1548
1549          R := Create_Secondary_Table
1550            (Table, Num_States, Start_State, End_State);
1551          Free (Table);
1552          return R;
1553       end;
1554    end Compile;
1555
1556    --------------
1557    -- Finalize --
1558    --------------
1559
1560    procedure Finalize (R : in out Regexp) is
1561       procedure Free is new
1562         Ada.Unchecked_Deallocation (Regexp_Value, Regexp_Access);
1563
1564    begin
1565       Free (R.R);
1566    end Finalize;
1567
1568    ---------
1569    -- Get --
1570    ---------
1571
1572    function Get
1573      (Table  : Regexp_Array_Access;
1574       State  : State_Index;
1575       Column : Column_Index) return State_Index
1576    is
1577    begin
1578       if State <= Table'Last (1)
1579         and then Column <= Table'Last (2)
1580       then
1581          return Table (State, Column);
1582       else
1583          return 0;
1584       end if;
1585    end Get;
1586
1587    -----------
1588    -- Match --
1589    -----------
1590
1591    function Match (S : String; R : Regexp) return Boolean is
1592       Current_State : State_Index := 1;
1593
1594    begin
1595       if R.R = null then
1596          raise Constraint_Error;
1597       end if;
1598
1599       for Char in S'Range loop
1600
1601          if R.R.Case_Sensitive then
1602             Current_State := R.R.States (Current_State, R.R.Map (S (Char)));
1603          else
1604             Current_State :=
1605               R.R.States (Current_State,
1606                           R.R.Map (System.Case_Util.To_Lower (S (Char))));
1607          end if;
1608
1609          if Current_State = 0 then
1610             return False;
1611          end if;
1612
1613       end loop;
1614
1615       return R.R.Is_Final (Current_State);
1616    end Match;
1617
1618    ---------
1619    -- Set --
1620    ---------
1621
1622    procedure Set
1623      (Table  : in out Regexp_Array_Access;
1624       State  : State_Index;
1625       Column : Column_Index;
1626       Value  : State_Index)
1627    is
1628       New_Lines   : State_Index;
1629       New_Columns : Column_Index;
1630       New_Table   : Regexp_Array_Access;
1631
1632    begin
1633       if State <= Table'Last (1)
1634         and then Column <= Table'Last (2)
1635       then
1636          Table (State, Column) := Value;
1637       else
1638          --  Doubles the size of the table until it is big enough that
1639          --  (State, Column) is a valid index
1640
1641          New_Lines := Table'Last (1) * (State / Table'Last (1) + 1);
1642          New_Columns := Table'Last (2) * (Column / Table'Last (2) + 1);
1643          New_Table := new Regexp_Array (Table'First (1) .. New_Lines,
1644                                         Table'First (2) .. New_Columns);
1645          New_Table.all := (others => (others => 0));
1646
1647          for J in Table'Range (1) loop
1648             for K in Table'Range (2) loop
1649                New_Table (J, K) := Table (J, K);
1650             end loop;
1651          end loop;
1652
1653          Free (Table);
1654          Table := New_Table;
1655          Table (State, Column) := Value;
1656       end if;
1657    end Set;
1658
1659 end System.Regexp;