1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- G N A T . R E G P A T --
9 -- Copyright (C) 1986 by University of Toronto. --
10 -- Copyright (C) 1999-2007, AdaCore --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
21 -- Boston, MA 02110-1301, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 ------------------------------------------------------------------------------
35 -- This is an altered Ada 95 version of the original V8 style regular
36 -- expression library written in C by Henry Spencer. Apart from the
37 -- translation to Ada, the interface has been considerably changed to
38 -- use the Ada String type instead of C-style nul-terminated strings.
40 -- Beware that some of this code is subtly aware of the way operator
41 -- precedence is structured in regular expressions. Serious changes in
42 -- regular-expression syntax might require a total rethink.
44 with System.IO; use System.IO;
45 with Ada.Characters.Handling; use Ada.Characters.Handling;
46 with Ada.Unchecked_Conversion;
48 package body System.Regpat is
50 MAGIC : constant Character := Character'Val (10#0234#);
51 -- The first byte of the regexp internal "program" is actually
52 -- this magic number; the start node begins in the second byte.
54 -- This is used to make sure that a regular expression was correctly
57 ----------------------------
58 -- Implementation details --
59 ----------------------------
61 -- This is essentially a linear encoding of a nondeterministic
62 -- finite-state machine, also known as syntax charts or
63 -- "railroad normal form" in parsing technology.
65 -- Each node is an opcode plus a "next" pointer, possibly plus an
66 -- operand. "Next" pointers of all nodes except BRANCH implement
67 -- concatenation; a "next" pointer with a BRANCH on both ends of it
68 -- is connecting two alternatives.
70 -- The operand of some types of node is a literal string; for others,
71 -- it is a node leading into a sub-FSM. In particular, the operand of
72 -- a BRANCH node is the first node of the branch.
73 -- (NB this is *not* a tree structure: the tail of the branch connects
74 -- to the thing following the set of BRANCHes).
76 -- You can see the exact byte-compiled version by using the Dump
77 -- subprogram. However, here are a few examples:
80 -- 2 : BRANCH (next at 10)
81 -- 5 : EXACT (next at 18) operand=a
82 -- 10 : BRANCH (next at 18)
83 -- 13 : EXACT (next at 18) operand=b
84 -- 18 : EOP (next at 0)
87 -- 2 : CURLYX (next at 26) { 0, 32767}
88 -- 9 : OPEN 1 (next at 13)
89 -- 13 : EXACT (next at 19) operand=ab
90 -- 19 : CLOSE 1 (next at 23)
91 -- 23 : WHILEM (next at 0)
92 -- 26 : NOTHING (next at 29)
93 -- 29 : EOP (next at 0)
99 -- Name Operand? Meaning
101 (EOP, -- no End of program
102 MINMOD, -- no Next operator is not greedy
104 -- Classes of characters
106 ANY, -- no Match any one character except newline
107 SANY, -- no Match any character, including new line
108 ANYOF, -- class Match any character in this class
109 EXACT, -- str Match this string exactly
110 EXACTF, -- str Match this string (case-folding is one)
111 NOTHING, -- no Match empty string
112 SPACE, -- no Match any whitespace character
113 NSPACE, -- no Match any non-whitespace character
114 DIGIT, -- no Match any numeric character
115 NDIGIT, -- no Match any non-numeric character
116 ALNUM, -- no Match any alphanumeric character
117 NALNUM, -- no Match any non-alphanumeric character
121 BRANCH, -- node Match this alternative, or the next
123 -- Simple loops (when the following node is one character in length)
125 STAR, -- node Match this simple thing 0 or more times
126 PLUS, -- node Match this simple thing 1 or more times
127 CURLY, -- 2num node Match this simple thing between n and m times.
131 CURLYX, -- 2num node Match this complex thing {n,m} times
132 -- The nums are coded on two characters each
134 WHILEM, -- no Do curly processing and see if rest matches
136 -- Matches after or before a word
138 BOL, -- no Match "" at beginning of line
139 MBOL, -- no Same, assuming mutiline (match after \n)
140 SBOL, -- no Same, assuming single line (don't match at \n)
141 EOL, -- no Match "" at end of line
142 MEOL, -- no Same, assuming mutiline (match before \n)
143 SEOL, -- no Same, assuming single line (don't match at \n)
145 BOUND, -- no Match "" at any word boundary
146 NBOUND, -- no Match "" at any word non-boundary
148 -- Parenthesis groups handling
150 REFF, -- num Match some already matched string, folded
151 OPEN, -- num Mark this point in input as start of #n
152 CLOSE); -- num Analogous to OPEN
154 for Opcode'Size use 8;
159 -- The set of branches constituting a single choice are hooked
160 -- together with their "next" pointers, since precedence prevents
161 -- anything being concatenated to any individual branch. The
162 -- "next" pointer of the last BRANCH in a choice points to the
163 -- thing following the whole choice. This is also where the
164 -- final "next" pointer of each individual branch points; each
165 -- branch starts with the operand node of a BRANCH node.
168 -- '?', and complex '*' and '+', are implemented with CURLYX.
169 -- branches. Simple cases (one character per match) are implemented with
170 -- STAR and PLUS for speed and to minimize recursive plunges.
173 -- ...are numbered at compile time.
176 -- There are in fact two arguments, the first one is the length (minus
177 -- one of the string argument), coded on one character, the second
178 -- argument is the string itself, coded on length + 1 characters.
180 -- A node is one char of opcode followed by two chars of "next" pointer.
181 -- "Next" pointers are stored as two 8-bit pieces, high order first. The
182 -- value is a positive offset from the opcode of the node containing it.
183 -- An operand, if any, simply follows the node. (Note that much of the
184 -- code generation knows about this implicit relationship.)
186 -- Using two bytes for the "next" pointer is vast overkill for most
187 -- things, but allows patterns to get big without disasters.
189 -----------------------
190 -- Character classes --
191 -----------------------
192 -- This is the implementation for character classes ([...]) in the
193 -- syntax for regular expressions. Each character (0..256) has an
194 -- entry into the table. This makes for a very fast matching
197 type Class_Byte is mod 256;
198 type Character_Class is array (Class_Byte range 0 .. 31) of Class_Byte;
200 type Bit_Conversion_Array is array (Class_Byte range 0 .. 7) of Class_Byte;
201 Bit_Conversion : constant Bit_Conversion_Array :=
202 (1, 2, 4, 8, 16, 32, 64, 128);
204 type Std_Class is (ANYOF_NONE,
205 ANYOF_ALNUM, -- Alphanumeric class [a-zA-Z0-9]
207 ANYOF_SPACE, -- Space class [ \t\n\r\f]
209 ANYOF_DIGIT, -- Digit class [0-9]
211 ANYOF_ALNUMC, -- Alphanumeric class [a-zA-Z0-9]
213 ANYOF_ALPHA, -- Alpha class [a-zA-Z]
215 ANYOF_ASCII, -- Ascii class (7 bits) 0..127
217 ANYOF_CNTRL, -- Control class
219 ANYOF_GRAPH, -- Graphic class
221 ANYOF_LOWER, -- Lower case class [a-z]
223 ANYOF_PRINT, -- printable class
227 ANYOF_UPPER, -- Upper case class [A-Z]
229 ANYOF_XDIGIT, -- Hexadecimal digit
233 procedure Set_In_Class
234 (Bitmap : in out Character_Class;
236 -- Set the entry to True for C in the class Bitmap
238 function Get_From_Class
239 (Bitmap : Character_Class;
240 C : Character) return Boolean;
241 -- Return True if the entry is set for C in the class Bitmap
243 procedure Reset_Class (Bitmap : out Character_Class);
244 -- Clear all the entries in the class Bitmap
246 pragma Inline (Set_In_Class);
247 pragma Inline (Get_From_Class);
248 pragma Inline (Reset_Class);
250 -----------------------
251 -- Local Subprograms --
252 -----------------------
254 function "=" (Left : Character; Right : Opcode) return Boolean;
256 function Is_Alnum (C : Character) return Boolean;
257 -- Return True if C is an alphanum character or an underscore ('_')
259 function Is_White_Space (C : Character) return Boolean;
260 -- Return True if C is a whitespace character
262 function Is_Printable (C : Character) return Boolean;
263 -- Return True if C is a printable character
265 function Operand (P : Pointer) return Pointer;
266 -- Return a pointer to the first operand of the node at P
268 function String_Length
269 (Program : Program_Data;
270 P : Pointer) return Program_Size;
271 -- Return the length of the string argument of the node at P
273 function String_Operand (P : Pointer) return Pointer;
274 -- Return a pointer to the string argument of the node at P
276 procedure Bitmap_Operand
277 (Program : Program_Data;
279 Op : out Character_Class);
280 -- Return a pointer to the string argument of the node at P
282 function Get_Next_Offset
283 (Program : Program_Data;
284 IP : Pointer) return Pointer;
285 -- Get the offset field of a node. Used by Get_Next
288 (Program : Program_Data;
289 IP : Pointer) return Pointer;
290 -- Dig the next instruction pointer out of a node
292 procedure Optimize (Self : in out Pattern_Matcher);
293 -- Optimize a Pattern_Matcher by noting certain special cases
295 function Read_Natural
296 (Program : Program_Data;
297 IP : Pointer) return Natural;
298 -- Return the 2-byte natural coded at position IP
300 -- All of the subprograms above are tiny and should be inlined
303 pragma Inline (Is_Alnum);
304 pragma Inline (Is_White_Space);
305 pragma Inline (Get_Next);
306 pragma Inline (Get_Next_Offset);
307 pragma Inline (Operand);
308 pragma Inline (Read_Natural);
309 pragma Inline (String_Length);
310 pragma Inline (String_Operand);
312 type Expression_Flags is record
313 Has_Width, -- Known never to match null string
314 Simple, -- Simple enough to be STAR/PLUS operand
315 SP_Start : Boolean; -- Starts with * or +
318 Worst_Expression : constant Expression_Flags := (others => False);
325 function "=" (Left : Character; Right : Opcode) return Boolean is
327 return Character'Pos (Left) = Opcode'Pos (Right);
334 procedure Bitmap_Operand
335 (Program : Program_Data;
337 Op : out Character_Class)
339 function Convert is new Ada.Unchecked_Conversion
340 (Program_Data, Character_Class);
343 Op (0 .. 31) := Convert (Program (P + 3 .. P + 34));
351 (Matcher : out Pattern_Matcher;
353 Final_Code_Size : out Program_Size;
354 Flags : Regexp_Flags := No_Flags)
356 -- We can't allocate space until we know how big the compiled form
357 -- will be, but we can't compile it (and thus know how big it is)
358 -- until we've got a place to put the code. So we cheat: we compile
359 -- it twice, once with code generation turned off and size counting
360 -- turned on, and once "for real".
362 -- This also means that we don't allocate space until we are sure
363 -- that the thing really will compile successfully, and we never
364 -- have to move the code and thus invalidate pointers into it.
366 -- Beware that the optimization-preparation code in here knows
367 -- about some of the structure of the compiled regexp.
369 PM : Pattern_Matcher renames Matcher;
370 Program : Program_Data renames PM.Program;
372 Emit_Code : constant Boolean := PM.Size > 0;
373 Emit_Ptr : Pointer := Program_First;
375 Parse_Pos : Natural := Expression'First; -- Input-scan pointer
376 Parse_End : constant Natural := Expression'Last;
378 ----------------------------
379 -- Subprograms for Create --
380 ----------------------------
382 procedure Emit (B : Character);
383 -- Output the Character B to the Program. If code-generation is
384 -- disabled, simply increments the program counter.
386 function Emit_Node (Op : Opcode) return Pointer;
387 -- If code-generation is enabled, Emit_Node outputs the
388 -- opcode Op and reserves space for a pointer to the next node.
389 -- Return value is the location of new opcode, ie old Emit_Ptr.
391 procedure Emit_Natural (IP : Pointer; N : Natural);
392 -- Split N on two characters at position IP
394 procedure Emit_Class (Bitmap : Character_Class);
395 -- Emits a character class
397 procedure Case_Emit (C : Character);
398 -- Emit C, after converting is to lower-case if the regular
399 -- expression is case insensitive.
402 (Parenthesized : Boolean;
403 Flags : out Expression_Flags;
405 -- Parse regular expression, i.e. main body or parenthesized thing
406 -- Caller must absorb opening parenthesis.
408 procedure Parse_Branch
409 (Flags : out Expression_Flags;
412 -- Implements the concatenation operator and handles '|'
413 -- First should be true if this is the first item of the alternative.
415 procedure Parse_Piece
416 (Expr_Flags : out Expression_Flags;
418 -- Parse something followed by possible [*+?]
421 (Expr_Flags : out Expression_Flags;
423 -- Parse_Atom is the lowest level parse procedure.
424 -- Optimization: gobbles an entire sequence of ordinary characters
425 -- so that it can turn them into a single node, which is smaller to
426 -- store and faster to run. Backslashed characters are exceptions,
427 -- each becoming a separate node; the code is simpler that way and
428 -- it's not worth fixing.
430 procedure Insert_Operator
433 Greedy : Boolean := True);
434 -- Insert_Operator inserts an operator in front of an
435 -- already-emitted operand and relocates the operand.
436 -- This applies to PLUS and STAR.
437 -- If Minmod is True, then the operator is non-greedy.
439 procedure Insert_Curly_Operator
444 Greedy : Boolean := True);
445 -- Insert an operator for CURLY ({Min}, {Min,} or {Min,Max}).
446 -- If Minmod is True, then the operator is non-greedy.
448 procedure Link_Tail (P, Val : Pointer);
449 -- Link_Tail sets the next-pointer at the end of a node chain
451 procedure Link_Operand_Tail (P, Val : Pointer);
452 -- Link_Tail on operand of first argument; nop if operandless
454 function Next_Instruction (P : Pointer) return Pointer;
455 -- Dig the "next" pointer out of a node
457 procedure Fail (M : String);
458 pragma No_Return (Fail);
459 -- Fail with a diagnostic message, if possible
461 function Is_Curly_Operator (IP : Natural) return Boolean;
462 -- Return True if IP is looking at a '{' that is the beginning
463 -- of a curly operator, ie it matches {\d+,?\d*}
465 function Is_Mult (IP : Natural) return Boolean;
466 -- Return True if C is a regexp multiplier: '+', '*' or '?'
468 procedure Get_Curly_Arguments
472 Greedy : out Boolean);
473 -- Parse the argument list for a curly operator.
474 -- It is assumed that IP is indeed pointing at a valid operator.
475 -- So what is IP and how come IP is not referenced in the body ???
477 procedure Parse_Character_Class (IP : out Pointer);
478 -- Parse a character class.
479 -- The calling subprogram should consume the opening '[' before.
481 procedure Parse_Literal
482 (Expr_Flags : out Expression_Flags;
484 -- Parse_Literal encodes a string of characters to be matched exactly
486 function Parse_Posix_Character_Class return Std_Class;
487 -- Parse a posic character class, like [:alpha:] or [:^alpha:].
488 -- The called is suppoed to absorbe the opening [.
490 pragma Inline (Is_Mult);
491 pragma Inline (Emit_Natural);
492 pragma Inline (Parse_Character_Class); -- since used only once
498 procedure Case_Emit (C : Character) is
500 if (Flags and Case_Insensitive) /= 0 then
504 -- Dump current character
514 procedure Emit (B : Character) is
517 Program (Emit_Ptr) := B;
520 Emit_Ptr := Emit_Ptr + 1;
527 procedure Emit_Class (Bitmap : Character_Class) is
528 subtype Program31 is Program_Data (0 .. 31);
530 function Convert is new Ada.Unchecked_Conversion
531 (Character_Class, Program31);
535 Program (Emit_Ptr .. Emit_Ptr + 31) := Convert (Bitmap);
538 Emit_Ptr := Emit_Ptr + 32;
545 procedure Emit_Natural (IP : Pointer; N : Natural) is
548 Program (IP + 1) := Character'Val (N / 256);
549 Program (IP) := Character'Val (N mod 256);
557 function Emit_Node (Op : Opcode) return Pointer is
558 Result : constant Pointer := Emit_Ptr;
562 Program (Emit_Ptr) := Character'Val (Opcode'Pos (Op));
563 Program (Emit_Ptr + 1) := ASCII.NUL;
564 Program (Emit_Ptr + 2) := ASCII.NUL;
567 Emit_Ptr := Emit_Ptr + 3;
575 procedure Fail (M : String) is
577 raise Expression_Error with M;
580 -------------------------
581 -- Get_Curly_Arguments --
582 -------------------------
584 procedure Get_Curly_Arguments
588 Greedy : out Boolean)
590 pragma Unreferenced (IP);
592 Save_Pos : Natural := Parse_Pos + 1;
596 Max := Max_Curly_Repeat;
598 while Expression (Parse_Pos) /= '}'
599 and then Expression (Parse_Pos) /= ','
601 Parse_Pos := Parse_Pos + 1;
604 Min := Natural'Value (Expression (Save_Pos .. Parse_Pos - 1));
606 if Expression (Parse_Pos) = ',' then
607 Save_Pos := Parse_Pos + 1;
608 while Expression (Parse_Pos) /= '}' loop
609 Parse_Pos := Parse_Pos + 1;
612 if Save_Pos /= Parse_Pos then
613 Max := Natural'Value (Expression (Save_Pos .. Parse_Pos - 1));
620 if Parse_Pos < Expression'Last
621 and then Expression (Parse_Pos + 1) = '?'
624 Parse_Pos := Parse_Pos + 1;
629 end Get_Curly_Arguments;
631 ---------------------------
632 -- Insert_Curly_Operator --
633 ---------------------------
635 procedure Insert_Curly_Operator
640 Greedy : Boolean := True)
642 Dest : constant Pointer := Emit_Ptr;
647 -- If the operand is not greedy, insert an extra operand before it
653 -- Move the operand in the byte-compilation, so that we can insert
654 -- the operator before it.
657 Program (Operand + Size .. Emit_Ptr + Size) :=
658 Program (Operand .. Emit_Ptr);
661 -- Insert the operator at the position previously occupied by the
667 Old := Emit_Node (MINMOD);
668 Link_Tail (Old, Old + 3);
671 Old := Emit_Node (Op);
672 Emit_Natural (Old + 3, Min);
673 Emit_Natural (Old + 5, Max);
675 Emit_Ptr := Dest + Size;
676 end Insert_Curly_Operator;
678 ---------------------
679 -- Insert_Operator --
680 ---------------------
682 procedure Insert_Operator
685 Greedy : Boolean := True)
687 Dest : constant Pointer := Emit_Ptr;
692 pragma Warnings (Off, Discard);
695 -- If not greedy, we have to emit another opcode first
701 -- Move the operand in the byte-compilation, so that we can insert
702 -- the operator before it.
705 Program (Operand + Size .. Emit_Ptr + Size) :=
706 Program (Operand .. Emit_Ptr);
709 -- Insert the operator at the position previously occupied by the
715 Old := Emit_Node (MINMOD);
716 Link_Tail (Old, Old + 3);
719 Discard := Emit_Node (Op);
720 Emit_Ptr := Dest + Size;
723 -----------------------
724 -- Is_Curly_Operator --
725 -----------------------
727 function Is_Curly_Operator (IP : Natural) return Boolean is
728 Scan : Natural := IP;
731 if Expression (Scan) /= '{'
732 or else Scan + 2 > Expression'Last
733 or else not Is_Digit (Expression (Scan + 1))
745 if Scan > Expression'Last then
749 exit when not Is_Digit (Expression (Scan));
752 if Expression (Scan) = ',' then
756 if Scan > Expression'Last then
760 exit when not Is_Digit (Expression (Scan));
764 return Expression (Scan) = '}';
765 end Is_Curly_Operator;
771 function Is_Mult (IP : Natural) return Boolean is
772 C : constant Character := Expression (IP);
778 or else (C = '{' and then Is_Curly_Operator (IP));
781 -----------------------
782 -- Link_Operand_Tail --
783 -----------------------
785 procedure Link_Operand_Tail (P, Val : Pointer) is
787 if Emit_Code and then Program (P) = BRANCH then
788 Link_Tail (Operand (P), Val);
790 end Link_Operand_Tail;
796 procedure Link_Tail (P, Val : Pointer) is
802 if not Emit_Code then
810 Temp := Next_Instruction (Scan);
815 Offset := Val - Scan;
817 Emit_Natural (Scan + 1, Natural (Offset));
820 ----------------------
821 -- Next_Instruction --
822 ----------------------
824 function Next_Instruction (P : Pointer) return Pointer is
828 if not Emit_Code then
832 Offset := Get_Next_Offset (Program, P);
839 end Next_Instruction;
845 -- Combining parenthesis handling with the base level
846 -- of regular expression is a trifle forced, but the
847 -- need to tie the tails of the branches to what follows
848 -- makes it hard to avoid.
851 (Parenthesized : Boolean;
852 Flags : out Expression_Flags;
855 E : String renames Expression;
859 New_Flags : Expression_Flags;
860 Have_Branch : Boolean := False;
863 Flags := (Has_Width => True, others => False); -- Tentatively
865 -- Make an OPEN node, if parenthesized
867 if Parenthesized then
868 if Matcher.Paren_Count > Max_Paren_Count then
869 Fail ("too many ()");
872 Par_No := Matcher.Paren_Count + 1;
873 Matcher.Paren_Count := Matcher.Paren_Count + 1;
874 IP := Emit_Node (OPEN);
875 Emit (Character'Val (Par_No));
882 -- Pick up the branches, linking them together
884 Parse_Branch (New_Flags, True, Br);
891 if Parse_Pos <= Parse_End
892 and then E (Parse_Pos) = '|'
894 Insert_Operator (BRANCH, Br);
899 Link_Tail (IP, Br); -- OPEN -> first
904 if not New_Flags.Has_Width then
905 Flags.Has_Width := False;
908 Flags.SP_Start := Flags.SP_Start or New_Flags.SP_Start;
910 while Parse_Pos <= Parse_End
911 and then (E (Parse_Pos) = '|')
913 Parse_Pos := Parse_Pos + 1;
914 Parse_Branch (New_Flags, False, Br);
921 Link_Tail (IP, Br); -- BRANCH -> BRANCH
923 if not New_Flags.Has_Width then
924 Flags.Has_Width := False;
927 Flags.SP_Start := Flags.SP_Start or New_Flags.SP_Start;
930 -- Make a closing node, and hook it on the end
932 if Parenthesized then
933 Ender := Emit_Node (CLOSE);
934 Emit (Character'Val (Par_No));
936 Ender := Emit_Node (EOP);
939 Link_Tail (IP, Ender);
943 -- Hook the tails of the branches to the closing node
948 Link_Operand_Tail (Br, Ender);
949 Br := Next_Instruction (Br);
953 -- Check for proper termination
955 if Parenthesized then
956 if Parse_Pos > Parse_End or else E (Parse_Pos) /= ')' then
957 Fail ("unmatched ()");
960 Parse_Pos := Parse_Pos + 1;
962 elsif Parse_Pos <= Parse_End then
963 if E (Parse_Pos) = ')' then
964 Fail ("unmatched ()");
966 Fail ("junk on end"); -- "Can't happen"
976 (Expr_Flags : out Expression_Flags;
982 -- Tentatively set worst expression case
984 Expr_Flags := Worst_Expression;
986 C := Expression (Parse_Pos);
987 Parse_Pos := Parse_Pos + 1;
991 if (Flags and Multiple_Lines) /= 0 then
992 IP := Emit_Node (MBOL);
993 elsif (Flags and Single_Line) /= 0 then
994 IP := Emit_Node (SBOL);
996 IP := Emit_Node (BOL);
1000 if (Flags and Multiple_Lines) /= 0 then
1001 IP := Emit_Node (MEOL);
1002 elsif (Flags and Single_Line) /= 0 then
1003 IP := Emit_Node (SEOL);
1005 IP := Emit_Node (EOL);
1009 if (Flags and Single_Line) /= 0 then
1010 IP := Emit_Node (SANY);
1012 IP := Emit_Node (ANY);
1015 Expr_Flags.Has_Width := True;
1016 Expr_Flags.Simple := True;
1019 Parse_Character_Class (IP);
1020 Expr_Flags.Has_Width := True;
1021 Expr_Flags.Simple := True;
1025 New_Flags : Expression_Flags;
1028 Parse (True, New_Flags, IP);
1034 Expr_Flags.Has_Width :=
1035 Expr_Flags.Has_Width or New_Flags.Has_Width;
1036 Expr_Flags.SP_Start :=
1037 Expr_Flags.SP_Start or New_Flags.SP_Start;
1040 when '|' | ASCII.LF | ')' =>
1041 Fail ("internal urp"); -- Supposed to be caught earlier
1043 when '?' | '+' | '*' =>
1044 Fail (C & " follows nothing");
1047 if Is_Curly_Operator (Parse_Pos - 1) then
1048 Fail (C & " follows nothing");
1050 Parse_Literal (Expr_Flags, IP);
1054 if Parse_Pos > Parse_End then
1055 Fail ("trailing \");
1058 Parse_Pos := Parse_Pos + 1;
1060 case Expression (Parse_Pos - 1) is
1062 IP := Emit_Node (BOUND);
1065 IP := Emit_Node (NBOUND);
1068 IP := Emit_Node (SPACE);
1069 Expr_Flags.Simple := True;
1070 Expr_Flags.Has_Width := True;
1073 IP := Emit_Node (NSPACE);
1074 Expr_Flags.Simple := True;
1075 Expr_Flags.Has_Width := True;
1078 IP := Emit_Node (DIGIT);
1079 Expr_Flags.Simple := True;
1080 Expr_Flags.Has_Width := True;
1083 IP := Emit_Node (NDIGIT);
1084 Expr_Flags.Simple := True;
1085 Expr_Flags.Has_Width := True;
1088 IP := Emit_Node (ALNUM);
1089 Expr_Flags.Simple := True;
1090 Expr_Flags.Has_Width := True;
1093 IP := Emit_Node (NALNUM);
1094 Expr_Flags.Simple := True;
1095 Expr_Flags.Has_Width := True;
1098 IP := Emit_Node (SBOL);
1101 IP := Emit_Node (SEOL);
1104 IP := Emit_Node (REFF);
1107 Save : constant Natural := Parse_Pos - 1;
1110 while Parse_Pos <= Expression'Last
1111 and then Is_Digit (Expression (Parse_Pos))
1113 Parse_Pos := Parse_Pos + 1;
1116 Emit (Character'Val (Natural'Value
1117 (Expression (Save .. Parse_Pos - 1))));
1121 Parse_Pos := Parse_Pos - 1;
1122 Parse_Literal (Expr_Flags, IP);
1126 Parse_Literal (Expr_Flags, IP);
1134 procedure Parse_Branch
1135 (Flags : out Expression_Flags;
1139 E : String renames Expression;
1142 New_Flags : Expression_Flags;
1145 pragma Warnings (Off, Discard);
1148 Flags := Worst_Expression; -- Tentatively
1153 IP := Emit_Node (BRANCH);
1158 while Parse_Pos <= Parse_End
1159 and then E (Parse_Pos) /= ')'
1160 and then E (Parse_Pos) /= ASCII.LF
1161 and then E (Parse_Pos) /= '|'
1163 Parse_Piece (New_Flags, Last);
1170 Flags.Has_Width := Flags.Has_Width or New_Flags.Has_Width;
1172 if Chain = 0 then -- First piece
1173 Flags.SP_Start := Flags.SP_Start or New_Flags.SP_Start;
1175 Link_Tail (Chain, Last);
1181 -- Case where loop ran zero CURLY
1184 Discard := Emit_Node (NOTHING);
1188 ---------------------------
1189 -- Parse_Character_Class --
1190 ---------------------------
1192 procedure Parse_Character_Class (IP : out Pointer) is
1193 Bitmap : Character_Class;
1194 Invert : Boolean := False;
1195 In_Range : Boolean := False;
1196 Named_Class : Std_Class := ANYOF_NONE;
1198 Last_Value : Character := ASCII.Nul;
1201 Reset_Class (Bitmap);
1203 -- Do we have an invert character class ?
1205 if Parse_Pos <= Parse_End
1206 and then Expression (Parse_Pos) = '^'
1209 Parse_Pos := Parse_Pos + 1;
1212 -- First character can be ] or - without closing the class
1214 if Parse_Pos <= Parse_End
1215 and then (Expression (Parse_Pos) = ']'
1216 or else Expression (Parse_Pos) = '-')
1218 Set_In_Class (Bitmap, Expression (Parse_Pos));
1219 Parse_Pos := Parse_Pos + 1;
1222 -- While we don't have the end of the class
1224 while Parse_Pos <= Parse_End
1225 and then Expression (Parse_Pos) /= ']'
1227 Named_Class := ANYOF_NONE;
1228 Value := Expression (Parse_Pos);
1229 Parse_Pos := Parse_Pos + 1;
1231 -- Do we have a Posix character class
1233 Named_Class := Parse_Posix_Character_Class;
1235 elsif Value = '\' then
1236 if Parse_Pos = Parse_End then
1237 Fail ("Trailing \");
1239 Value := Expression (Parse_Pos);
1240 Parse_Pos := Parse_Pos + 1;
1243 when 'w' => Named_Class := ANYOF_ALNUM;
1244 when 'W' => Named_Class := ANYOF_NALNUM;
1245 when 's' => Named_Class := ANYOF_SPACE;
1246 when 'S' => Named_Class := ANYOF_NSPACE;
1247 when 'd' => Named_Class := ANYOF_DIGIT;
1248 when 'D' => Named_Class := ANYOF_NDIGIT;
1249 when 'n' => Value := ASCII.LF;
1250 when 'r' => Value := ASCII.CR;
1251 when 't' => Value := ASCII.HT;
1252 when 'f' => Value := ASCII.FF;
1253 when 'e' => Value := ASCII.ESC;
1254 when 'a' => Value := ASCII.BEL;
1256 -- when 'x' => ??? hexadecimal value
1257 -- when 'c' => ??? control character
1258 -- when '0'..'9' => ??? octal character
1260 when others => null;
1264 -- Do we have a character class?
1266 if Named_Class /= ANYOF_NONE then
1268 -- A range like 'a-\d' or 'a-[:digit:] is not a range
1271 Set_In_Class (Bitmap, Last_Value);
1272 Set_In_Class (Bitmap, '-');
1279 when ANYOF_NONE => null;
1281 when ANYOF_ALNUM | ANYOF_ALNUMC =>
1282 for Value in Class_Byte'Range loop
1283 if Is_Alnum (Character'Val (Value)) then
1284 Set_In_Class (Bitmap, Character'Val (Value));
1288 when ANYOF_NALNUM | ANYOF_NALNUMC =>
1289 for Value in Class_Byte'Range loop
1290 if not Is_Alnum (Character'Val (Value)) then
1291 Set_In_Class (Bitmap, Character'Val (Value));
1296 for Value in Class_Byte'Range loop
1297 if Is_White_Space (Character'Val (Value)) then
1298 Set_In_Class (Bitmap, Character'Val (Value));
1302 when ANYOF_NSPACE =>
1303 for Value in Class_Byte'Range loop
1304 if not Is_White_Space (Character'Val (Value)) then
1305 Set_In_Class (Bitmap, Character'Val (Value));
1310 for Value in Class_Byte'Range loop
1311 if Is_Digit (Character'Val (Value)) then
1312 Set_In_Class (Bitmap, Character'Val (Value));
1316 when ANYOF_NDIGIT =>
1317 for Value in Class_Byte'Range loop
1318 if not Is_Digit (Character'Val (Value)) then
1319 Set_In_Class (Bitmap, Character'Val (Value));
1324 for Value in Class_Byte'Range loop
1325 if Is_Letter (Character'Val (Value)) then
1326 Set_In_Class (Bitmap, Character'Val (Value));
1330 when ANYOF_NALPHA =>
1331 for Value in Class_Byte'Range loop
1332 if not Is_Letter (Character'Val (Value)) then
1333 Set_In_Class (Bitmap, Character'Val (Value));
1338 for Value in 0 .. 127 loop
1339 Set_In_Class (Bitmap, Character'Val (Value));
1342 when ANYOF_NASCII =>
1343 for Value in 128 .. 255 loop
1344 Set_In_Class (Bitmap, Character'Val (Value));
1348 for Value in Class_Byte'Range loop
1349 if Is_Control (Character'Val (Value)) then
1350 Set_In_Class (Bitmap, Character'Val (Value));
1354 when ANYOF_NCNTRL =>
1355 for Value in Class_Byte'Range loop
1356 if not Is_Control (Character'Val (Value)) then
1357 Set_In_Class (Bitmap, Character'Val (Value));
1362 for Value in Class_Byte'Range loop
1363 if Is_Graphic (Character'Val (Value)) then
1364 Set_In_Class (Bitmap, Character'Val (Value));
1368 when ANYOF_NGRAPH =>
1369 for Value in Class_Byte'Range loop
1370 if not Is_Graphic (Character'Val (Value)) then
1371 Set_In_Class (Bitmap, Character'Val (Value));
1376 for Value in Class_Byte'Range loop
1377 if Is_Lower (Character'Val (Value)) then
1378 Set_In_Class (Bitmap, Character'Val (Value));
1382 when ANYOF_NLOWER =>
1383 for Value in Class_Byte'Range loop
1384 if not Is_Lower (Character'Val (Value)) then
1385 Set_In_Class (Bitmap, Character'Val (Value));
1390 for Value in Class_Byte'Range loop
1391 if Is_Printable (Character'Val (Value)) then
1392 Set_In_Class (Bitmap, Character'Val (Value));
1396 when ANYOF_NPRINT =>
1397 for Value in Class_Byte'Range loop
1398 if not Is_Printable (Character'Val (Value)) then
1399 Set_In_Class (Bitmap, Character'Val (Value));
1404 for Value in Class_Byte'Range loop
1405 if Is_Printable (Character'Val (Value))
1406 and then not Is_White_Space (Character'Val (Value))
1407 and then not Is_Alnum (Character'Val (Value))
1409 Set_In_Class (Bitmap, Character'Val (Value));
1413 when ANYOF_NPUNCT =>
1414 for Value in Class_Byte'Range loop
1415 if not Is_Printable (Character'Val (Value))
1416 or else Is_White_Space (Character'Val (Value))
1417 or else Is_Alnum (Character'Val (Value))
1419 Set_In_Class (Bitmap, Character'Val (Value));
1424 for Value in Class_Byte'Range loop
1425 if Is_Upper (Character'Val (Value)) then
1426 Set_In_Class (Bitmap, Character'Val (Value));
1430 when ANYOF_NUPPER =>
1431 for Value in Class_Byte'Range loop
1432 if not Is_Upper (Character'Val (Value)) then
1433 Set_In_Class (Bitmap, Character'Val (Value));
1437 when ANYOF_XDIGIT =>
1438 for Value in Class_Byte'Range loop
1439 if Is_Hexadecimal_Digit (Character'Val (Value)) then
1440 Set_In_Class (Bitmap, Character'Val (Value));
1444 when ANYOF_NXDIGIT =>
1445 for Value in Class_Byte'Range loop
1446 if not Is_Hexadecimal_Digit
1447 (Character'Val (Value))
1449 Set_In_Class (Bitmap, Character'Val (Value));
1455 -- Not a character range
1457 elsif not In_Range then
1458 Last_Value := Value;
1460 if Expression (Parse_Pos) = '-'
1461 and then Parse_Pos < Parse_End
1462 and then Expression (Parse_Pos + 1) /= ']'
1464 Parse_Pos := Parse_Pos + 1;
1466 -- Do we have a range like '\d-a' and '[:space:]-a'
1467 -- which is not a real range
1469 if Named_Class /= ANYOF_NONE then
1470 Set_In_Class (Bitmap, '-');
1476 Set_In_Class (Bitmap, Value);
1480 -- Else in a character range
1483 if Last_Value > Value then
1484 Fail ("Invalid Range [" & Last_Value'Img
1485 & "-" & Value'Img & "]");
1488 while Last_Value <= Value loop
1489 Set_In_Class (Bitmap, Last_Value);
1490 Last_Value := Character'Succ (Last_Value);
1499 -- Optimize case-insensitive ranges (put the upper case or lower
1500 -- case character into the bitmap)
1502 if (Flags and Case_Insensitive) /= 0 then
1503 for C in Character'Range loop
1504 if Get_From_Class (Bitmap, C) then
1505 Set_In_Class (Bitmap, To_Lower (C));
1506 Set_In_Class (Bitmap, To_Upper (C));
1511 -- Optimize inverted classes
1514 for J in Bitmap'Range loop
1515 Bitmap (J) := not Bitmap (J);
1519 Parse_Pos := Parse_Pos + 1;
1523 IP := Emit_Node (ANYOF);
1524 Emit_Class (Bitmap);
1525 end Parse_Character_Class;
1531 -- This is a bit tricky due to quoted chars and due to
1532 -- the multiplier characters '*', '+', and '?' that
1533 -- take the SINGLE char previous as their operand.
1535 -- On entry, the character at Parse_Pos - 1 is going to go
1536 -- into the string, no matter what it is. It could be
1537 -- following a \ if Parse_Atom was entered from the '\' case.
1539 -- Basic idea is to pick up a good char in C and examine
1540 -- the next char. If Is_Mult (C) then twiddle, if it's a \
1541 -- then frozzle and if it's another magic char then push C and
1542 -- terminate the string. If none of the above, push C on the
1543 -- string and go around again.
1545 -- Start_Pos is used to remember where "the current character"
1546 -- starts in the string, if due to an Is_Mult we need to back
1547 -- up and put the current char in a separate 1-character string.
1548 -- When Start_Pos is 0, C is the only char in the string;
1549 -- this is used in Is_Mult handling, and in setting the SIMPLE
1552 procedure Parse_Literal
1553 (Expr_Flags : out Expression_Flags;
1556 Start_Pos : Natural := 0;
1558 Length_Ptr : Pointer;
1560 Has_Special_Operator : Boolean := False;
1563 Parse_Pos := Parse_Pos - 1; -- Look at current character
1565 if (Flags and Case_Insensitive) /= 0 then
1566 IP := Emit_Node (EXACTF);
1568 IP := Emit_Node (EXACT);
1571 Length_Ptr := Emit_Ptr;
1572 Emit_Ptr := String_Operand (IP);
1576 C := Expression (Parse_Pos); -- Get current character
1579 when '.' | '[' | '(' | ')' | '|' | ASCII.LF | '$' | '^' =>
1581 if Start_Pos = 0 then
1582 Start_Pos := Parse_Pos;
1583 Emit (C); -- First character is always emitted
1585 exit Parse_Loop; -- Else we are done
1588 when '?' | '+' | '*' | '{' =>
1590 if Start_Pos = 0 then
1591 Start_Pos := Parse_Pos;
1592 Emit (C); -- First character is always emitted
1594 -- Are we looking at an operator, or is this
1595 -- simply a normal character ?
1597 elsif not Is_Mult (Parse_Pos) then
1598 Start_Pos := Parse_Pos;
1602 -- We've got something like "abc?d". Mark this as a
1603 -- special case. What we want to emit is a first
1604 -- constant string for "ab", then one for "c" that will
1605 -- ultimately be transformed with a CURLY operator, A
1606 -- special case has to be handled for "a?", since there
1607 -- is no initial string to emit.
1609 Has_Special_Operator := True;
1614 Start_Pos := Parse_Pos;
1616 if Parse_Pos = Parse_End then
1617 Fail ("Trailing \");
1620 case Expression (Parse_Pos + 1) is
1621 when 'b' | 'B' | 's' | 'S' | 'd' | 'D'
1622 | 'w' | 'W' | '0' .. '9' | 'G' | 'A'
1624 when 'n' => Emit (ASCII.LF);
1625 when 't' => Emit (ASCII.HT);
1626 when 'r' => Emit (ASCII.CR);
1627 when 'f' => Emit (ASCII.FF);
1628 when 'e' => Emit (ASCII.ESC);
1629 when 'a' => Emit (ASCII.BEL);
1630 when others => Emit (Expression (Parse_Pos + 1));
1633 Parse_Pos := Parse_Pos + 1;
1637 Start_Pos := Parse_Pos;
1641 exit Parse_Loop when Emit_Ptr - Length_Ptr = 254;
1643 Parse_Pos := Parse_Pos + 1;
1645 exit Parse_Loop when Parse_Pos > Parse_End;
1646 end loop Parse_Loop;
1648 -- Is the string followed by a '*+?{' operator ? If yes, and if there
1649 -- is an initial string to emit, do it now.
1651 if Has_Special_Operator
1652 and then Emit_Ptr >= Length_Ptr + 3
1654 Emit_Ptr := Emit_Ptr - 1;
1655 Parse_Pos := Start_Pos;
1659 Program (Length_Ptr) := Character'Val (Emit_Ptr - Length_Ptr - 2);
1662 Expr_Flags.Has_Width := True;
1664 -- Slight optimization when there is a single character
1666 if Emit_Ptr = Length_Ptr + 2 then
1667 Expr_Flags.Simple := True;
1675 -- Note that the branching code sequences used for '?' and the
1676 -- general cases of '*' and + are somewhat optimized: they use
1677 -- the same NOTHING node as both the endmarker for their branch
1678 -- list and the body of the last branch. It might seem that
1679 -- this node could be dispensed with entirely, but the endmarker
1680 -- role is not redundant.
1682 procedure Parse_Piece
1683 (Expr_Flags : out Expression_Flags;
1687 New_Flags : Expression_Flags;
1688 Greedy : Boolean := True;
1691 Parse_Atom (New_Flags, IP);
1697 if Parse_Pos > Parse_End
1698 or else not Is_Mult (Parse_Pos)
1700 Expr_Flags := New_Flags;
1704 Op := Expression (Parse_Pos);
1707 Expr_Flags := (SP_Start => True, others => False);
1709 Expr_Flags := (Has_Width => True, others => False);
1712 -- Detect non greedy operators in the easy cases
1715 and then Parse_Pos + 1 <= Parse_End
1716 and then Expression (Parse_Pos + 1) = '?'
1719 Parse_Pos := Parse_Pos + 1;
1722 -- Generate the byte code
1727 if New_Flags.Simple then
1728 Insert_Operator (STAR, IP, Greedy);
1730 Link_Tail (IP, Emit_Node (WHILEM));
1731 Insert_Curly_Operator
1732 (CURLYX, 0, Max_Curly_Repeat, IP, Greedy);
1733 Link_Tail (IP, Emit_Node (NOTHING));
1738 if New_Flags.Simple then
1739 Insert_Operator (PLUS, IP, Greedy);
1741 Link_Tail (IP, Emit_Node (WHILEM));
1742 Insert_Curly_Operator
1743 (CURLYX, 1, Max_Curly_Repeat, IP, Greedy);
1744 Link_Tail (IP, Emit_Node (NOTHING));
1748 if New_Flags.Simple then
1749 Insert_Curly_Operator (CURLY, 0, 1, IP, Greedy);
1751 Link_Tail (IP, Emit_Node (WHILEM));
1752 Insert_Curly_Operator (CURLYX, 0, 1, IP, Greedy);
1753 Link_Tail (IP, Emit_Node (NOTHING));
1761 Get_Curly_Arguments (Parse_Pos, Min, Max, Greedy);
1763 if New_Flags.Simple then
1764 Insert_Curly_Operator (CURLY, Min, Max, IP, Greedy);
1766 Link_Tail (IP, Emit_Node (WHILEM));
1767 Insert_Curly_Operator (CURLYX, Min, Max, IP, Greedy);
1768 Link_Tail (IP, Emit_Node (NOTHING));
1776 Parse_Pos := Parse_Pos + 1;
1778 if Parse_Pos <= Parse_End
1779 and then Is_Mult (Parse_Pos)
1781 Fail ("nested *+{");
1785 ---------------------------------
1786 -- Parse_Posix_Character_Class --
1787 ---------------------------------
1789 function Parse_Posix_Character_Class return Std_Class is
1790 Invert : Boolean := False;
1791 Class : Std_Class := ANYOF_NONE;
1792 E : String renames Expression;
1794 -- Class names. Note that code assumes that the length of all
1795 -- classes starting with the same letter have the same length.
1797 Alnum : constant String := "alnum:]";
1798 Alpha : constant String := "alpha:]";
1799 Ascii_C : constant String := "ascii:]";
1800 Cntrl : constant String := "cntrl:]";
1801 Digit : constant String := "digit:]";
1802 Graph : constant String := "graph:]";
1803 Lower : constant String := "lower:]";
1804 Print : constant String := "print:]";
1805 Punct : constant String := "punct:]";
1806 Space : constant String := "space:]";
1807 Upper : constant String := "upper:]";
1808 Word : constant String := "word:]";
1809 Xdigit : constant String := "xdigit:]";
1812 -- Case of character class specified
1814 if Parse_Pos <= Parse_End
1815 and then Expression (Parse_Pos) = ':'
1817 Parse_Pos := Parse_Pos + 1;
1819 -- Do we have something like: [[:^alpha:]]
1821 if Parse_Pos <= Parse_End
1822 and then Expression (Parse_Pos) = '^'
1825 Parse_Pos := Parse_Pos + 1;
1828 -- Check for class names based on first letter
1830 case Expression (Parse_Pos) is
1833 -- All 'a' classes have the same length (Alnum'Length)
1835 if Parse_Pos + Alnum'Length - 1 <= Parse_End then
1837 E (Parse_Pos .. Parse_Pos + Alnum'Length - 1) = Alnum
1840 Class := ANYOF_NALNUMC;
1842 Class := ANYOF_ALNUMC;
1845 Parse_Pos := Parse_Pos + Alnum'Length;
1848 E (Parse_Pos .. Parse_Pos + Alpha'Length - 1) = Alpha
1851 Class := ANYOF_NALPHA;
1853 Class := ANYOF_ALPHA;
1856 Parse_Pos := Parse_Pos + Alpha'Length;
1858 elsif E (Parse_Pos .. Parse_Pos + Ascii_C'Length - 1) =
1862 Class := ANYOF_NASCII;
1864 Class := ANYOF_ASCII;
1867 Parse_Pos := Parse_Pos + Ascii_C'Length;
1870 Fail ("Invalid character class: " & E);
1874 Fail ("Invalid character class: " & E);
1878 if Parse_Pos + Cntrl'Length - 1 <= Parse_End
1880 E (Parse_Pos .. Parse_Pos + Cntrl'Length - 1) = Cntrl
1883 Class := ANYOF_NCNTRL;
1885 Class := ANYOF_CNTRL;
1888 Parse_Pos := Parse_Pos + Cntrl'Length;
1891 Fail ("Invalid character class: " & E);
1895 if Parse_Pos + Digit'Length - 1 <= Parse_End
1897 E (Parse_Pos .. Parse_Pos + Digit'Length - 1) = Digit
1900 Class := ANYOF_NDIGIT;
1902 Class := ANYOF_DIGIT;
1905 Parse_Pos := Parse_Pos + Digit'Length;
1909 if Parse_Pos + Graph'Length - 1 <= Parse_End
1911 E (Parse_Pos .. Parse_Pos + Graph'Length - 1) = Graph
1914 Class := ANYOF_NGRAPH;
1916 Class := ANYOF_GRAPH;
1919 Parse_Pos := Parse_Pos + Graph'Length;
1922 Fail ("Invalid character class: " & E);
1926 if Parse_Pos + Lower'Length - 1 <= Parse_End
1928 E (Parse_Pos .. Parse_Pos + Lower'Length - 1) = Lower
1931 Class := ANYOF_NLOWER;
1933 Class := ANYOF_LOWER;
1936 Parse_Pos := Parse_Pos + Lower'Length;
1939 Fail ("Invalid character class: " & E);
1944 -- All 'p' classes have the same length
1946 if Parse_Pos + Print'Length - 1 <= Parse_End then
1948 E (Parse_Pos .. Parse_Pos + Print'Length - 1) = Print
1951 Class := ANYOF_NPRINT;
1953 Class := ANYOF_PRINT;
1956 Parse_Pos := Parse_Pos + Print'Length;
1959 E (Parse_Pos .. Parse_Pos + Punct'Length - 1) = Punct
1962 Class := ANYOF_NPUNCT;
1964 Class := ANYOF_PUNCT;
1967 Parse_Pos := Parse_Pos + Punct'Length;
1970 Fail ("Invalid character class: " & E);
1974 Fail ("Invalid character class: " & E);
1978 if Parse_Pos + Space'Length - 1 <= Parse_End
1980 E (Parse_Pos .. Parse_Pos + Space'Length - 1) = Space
1983 Class := ANYOF_NSPACE;
1985 Class := ANYOF_SPACE;
1988 Parse_Pos := Parse_Pos + Space'Length;
1991 Fail ("Invalid character class: " & E);
1995 if Parse_Pos + Upper'Length - 1 <= Parse_End
1997 E (Parse_Pos .. Parse_Pos + Upper'Length - 1) = Upper
2000 Class := ANYOF_NUPPER;
2002 Class := ANYOF_UPPER;
2005 Parse_Pos := Parse_Pos + Upper'Length;
2008 Fail ("Invalid character class: " & E);
2012 if Parse_Pos + Word'Length - 1 <= Parse_End
2014 E (Parse_Pos .. Parse_Pos + Word'Length - 1) = Word
2017 Class := ANYOF_NALNUM;
2019 Class := ANYOF_ALNUM;
2022 Parse_Pos := Parse_Pos + Word'Length;
2025 Fail ("Invalid character class: " & E);
2029 if Parse_Pos + Xdigit'Length - 1 <= Parse_End
2031 E (Parse_Pos .. Parse_Pos + Xdigit'Length - 1) = Xdigit
2034 Class := ANYOF_NXDIGIT;
2036 Class := ANYOF_XDIGIT;
2039 Parse_Pos := Parse_Pos + Xdigit'Length;
2042 Fail ("Invalid character class: " & E);
2046 Fail ("Invalid character class: " & E);
2049 -- Character class not specified
2056 end Parse_Posix_Character_Class;
2058 Expr_Flags : Expression_Flags;
2061 -- Start of processing for Compile
2065 Parse (False, Expr_Flags, Result);
2068 Fail ("Couldn't compile expression");
2071 Final_Code_Size := Emit_Ptr - 1;
2073 -- Do we want to actually compile the expression, or simply get the
2084 (Expression : String;
2085 Flags : Regexp_Flags := No_Flags) return Pattern_Matcher
2087 Size : Program_Size;
2088 Dummy : Pattern_Matcher (0);
2091 Compile (Dummy, Expression, Size, Flags);
2094 Result : Pattern_Matcher (Size);
2096 Compile (Result, Expression, Size, Flags);
2102 (Matcher : out Pattern_Matcher;
2103 Expression : String;
2104 Flags : Regexp_Flags := No_Flags)
2106 Size : Program_Size;
2108 Compile (Matcher, Expression, Size, Flags);
2115 procedure Dump (Self : Pattern_Matcher) is
2117 Program : Program_Data renames Self.Program;
2119 procedure Dump_Until
2122 Indent : Natural := 0);
2123 -- Dump the program until the node Till (not included) is met.
2124 -- Every line is indented with Index spaces at the beginning
2125 -- Dumps till the end if Till is 0.
2131 procedure Dump_Until
2134 Indent : Natural := 0)
2138 Local_Indent : Natural := Indent;
2143 while Index < Till loop
2144 Op := Opcode'Val (Character'Pos ((Self.Program (Index))));
2147 Local_Indent := Local_Indent - 3;
2151 Point : constant String := Pointer'Image (Index);
2154 for J in 1 .. 6 - Point'Length loop
2160 & (1 .. Local_Indent => ' ')
2161 & Opcode'Image (Op));
2164 -- Print the parenthesis number
2166 if Op = OPEN or else Op = CLOSE or else Op = REFF then
2167 Put (Natural'Image (Character'Pos (Program (Index + 3))));
2170 Next := Index + Get_Next_Offset (Program, Index);
2172 if Next = Index then
2173 Put (" (next at 0)");
2175 Put (" (next at " & Pointer'Image (Next) & ")");
2180 -- Character class operand
2184 Bitmap : Character_Class;
2185 Last : Character := ASCII.Nul;
2186 Current : Natural := 0;
2188 Current_Char : Character;
2191 Bitmap_Operand (Program, Index, Bitmap);
2194 while Current <= 255 loop
2195 Current_Char := Character'Val (Current);
2197 -- First item in a range
2199 if Get_From_Class (Bitmap, Current_Char) then
2200 Last := Current_Char;
2202 -- Search for the last item in the range
2205 Current := Current + 1;
2206 exit when Current > 255;
2207 Current_Char := Character'Val (Current);
2209 not Get_From_Class (Bitmap, Current_Char);
2219 if Character'Succ (Last) /= Current_Char then
2220 Put ("-" & Character'Pred (Current_Char));
2224 Current := Current + 1;
2229 Index := Index + 3 + Bitmap'Length;
2234 when EXACT | EXACTF =>
2235 Length := String_Length (Program, Index);
2236 Put (" operand (length:" & Program_Size'Image (Length + 1)
2238 & String (Program (String_Operand (Index)
2239 .. String_Operand (Index)
2241 Index := String_Operand (Index) + Length + 1;
2248 Dump_Until (Index + 3, Next, Local_Indent + 3);
2254 -- Only one instruction
2256 Dump_Until (Index + 3, Index + 4, Local_Indent + 3);
2259 when CURLY | CURLYX =>
2261 & Natural'Image (Read_Natural (Program, Index + 3))
2263 & Natural'Image (Read_Natural (Program, Index + 5))
2266 Dump_Until (Index + 7, Next, Local_Indent + 3);
2272 Local_Indent := Local_Indent + 3;
2274 when CLOSE | REFF =>
2292 -- Start of processing for Dump
2295 pragma Assert (Self.Program (Program_First) = MAGIC,
2296 "Corrupted Pattern_Matcher");
2298 Put_Line ("Must start with (Self.First) = "
2299 & Character'Image (Self.First));
2301 if (Self.Flags and Case_Insensitive) /= 0 then
2302 Put_Line (" Case_Insensitive mode");
2305 if (Self.Flags and Single_Line) /= 0 then
2306 Put_Line (" Single_Line mode");
2309 if (Self.Flags and Multiple_Lines) /= 0 then
2310 Put_Line (" Multiple_Lines mode");
2313 Put_Line (" 1 : MAGIC");
2314 Dump_Until (Program_First + 1, Self.Program'Last + 1);
2317 --------------------
2318 -- Get_From_Class --
2319 --------------------
2321 function Get_From_Class
2322 (Bitmap : Character_Class;
2323 C : Character) return Boolean
2325 Value : constant Class_Byte := Character'Pos (C);
2328 (Bitmap (Value / 8) and Bit_Conversion (Value mod 8)) /= 0;
2335 function Get_Next (Program : Program_Data; IP : Pointer) return Pointer is
2336 Offset : constant Pointer := Get_Next_Offset (Program, IP);
2345 ---------------------
2346 -- Get_Next_Offset --
2347 ---------------------
2349 function Get_Next_Offset
2350 (Program : Program_Data;
2351 IP : Pointer) return Pointer
2354 return Pointer (Read_Natural (Program, IP + 1));
2355 end Get_Next_Offset;
2361 function Is_Alnum (C : Character) return Boolean is
2363 return Is_Alphanumeric (C) or else C = '_';
2370 function Is_Printable (C : Character) return Boolean is
2372 -- Printable if space or graphic character or other whitespace
2373 -- Other white space includes (HT/LF/VT/FF/CR = codes 9-13)
2375 return C in Character'Val (32) .. Character'Val (126)
2376 or else C in ASCII.HT .. ASCII.CR;
2379 --------------------
2380 -- Is_White_Space --
2381 --------------------
2383 function Is_White_Space (C : Character) return Boolean is
2385 -- Note: HT = 9, LF = 10, VT = 11, FF = 12, CR = 13
2387 return C = ' ' or else C in ASCII.HT .. ASCII.CR;
2395 (Self : Pattern_Matcher;
2397 Matches : out Match_Array;
2398 Data_First : Integer := -1;
2399 Data_Last : Positive := Positive'Last)
2401 Program : Program_Data renames Self.Program; -- Shorter notation
2403 First_In_Data : constant Integer := Integer'Max (Data_First, Data'First);
2404 Last_In_Data : constant Integer := Integer'Min (Data_Last, Data'Last);
2406 -- Global work variables
2408 Input_Pos : Natural; -- String-input pointer
2409 BOL_Pos : Natural; -- Beginning of input, for ^ check
2410 Matched : Boolean := False; -- Until proven True
2412 Matches_Full : Match_Array (0 .. Natural'Max (Self.Paren_Count,
2414 -- Stores the value of all the parenthesis pairs.
2415 -- We do not use directly Matches, so that we can also use back
2416 -- references (REFF) even if Matches is too small.
2418 type Natural_Array is array (Match_Count range <>) of Natural;
2419 Matches_Tmp : Natural_Array (Matches_Full'Range);
2420 -- Save the opening position of parenthesis
2422 Last_Paren : Natural := 0;
2423 -- Last parenthesis seen
2425 Greedy : Boolean := True;
2426 -- True if the next operator should be greedy
2428 type Current_Curly_Record;
2429 type Current_Curly_Access is access all Current_Curly_Record;
2430 type Current_Curly_Record is record
2431 Paren_Floor : Natural; -- How far back to strip parenthesis data
2432 Cur : Integer; -- How many instances of scan we've matched
2433 Min : Natural; -- Minimal number of scans to match
2434 Max : Natural; -- Maximal number of scans to match
2435 Greedy : Boolean; -- Whether to work our way up or down
2436 Scan : Pointer; -- The thing to match
2437 Next : Pointer; -- What has to match after it
2438 Lastloc : Natural; -- Where we started matching this scan
2439 Old_Cc : Current_Curly_Access; -- Before we started this one
2441 -- Data used to handle the curly operator and the plus and star
2442 -- operators for complex expressions.
2444 Current_Curly : Current_Curly_Access := null;
2445 -- The curly currently being processed
2447 -----------------------
2448 -- Local Subprograms --
2449 -----------------------
2451 function Index (Start : Positive; C : Character) return Natural;
2452 -- Find character C in Data starting at Start and return position
2456 Max : Natural := Natural'Last) return Natural;
2457 -- Repeatedly match something simple, report how many
2458 -- It only matches on things of length 1.
2459 -- Starting from Input_Pos, it matches at most Max CURLY.
2461 function Try (Pos : Positive) return Boolean;
2462 -- Try to match at specific point
2464 function Match (IP : Pointer) return Boolean;
2465 -- This is the main matching routine. Conceptually the strategy
2466 -- is simple: check to see whether the current node matches,
2467 -- call self recursively to see whether the rest matches,
2468 -- and then act accordingly.
2470 -- In practice Match makes some effort to avoid recursion, in
2471 -- particular by going through "ordinary" nodes (that don't
2472 -- need to know whether the rest of the match failed) by
2473 -- using a loop instead of recursion.
2474 -- Why is the above comment part of the spec rather than body ???
2476 function Match_Whilem (IP : Pointer) return Boolean;
2477 -- Return True if a WHILEM matches
2478 -- How come IP is unreferenced in the body ???
2480 function Recurse_Match (IP : Pointer; From : Natural) return Boolean;
2481 pragma Inline (Recurse_Match);
2482 -- Calls Match recursively. It saves and restores the parenthesis
2483 -- status and location in the input stream correctly, so that
2484 -- backtracking is possible
2486 function Match_Simple_Operator
2490 Greedy : Boolean) return Boolean;
2491 -- Return True it the simple operator (possibly non-greedy) matches
2493 pragma Inline (Index);
2494 pragma Inline (Repeat);
2496 -- These are two complex functions, but used only once
2498 pragma Inline (Match_Whilem);
2499 pragma Inline (Match_Simple_Operator);
2505 function Index (Start : Positive; C : Character) return Natural is
2507 for J in Start .. Last_In_Data loop
2508 if Data (J) = C then
2520 function Recurse_Match (IP : Pointer; From : Natural) return Boolean is
2521 L : constant Natural := Last_Paren;
2523 Tmp_F : constant Match_Array :=
2524 Matches_Full (From + 1 .. Matches_Full'Last);
2526 Start : constant Natural_Array :=
2527 Matches_Tmp (From + 1 .. Matches_Tmp'Last);
2528 Input : constant Natural := Input_Pos;
2536 Matches_Full (Tmp_F'Range) := Tmp_F;
2537 Matches_Tmp (Start'Range) := Start;
2546 function Match (IP : Pointer) return Boolean is
2547 Scan : Pointer := IP;
2554 pragma Assert (Scan /= 0);
2556 -- Determine current opcode and count its usage in debug mode
2558 Op := Opcode'Val (Character'Pos (Program (Scan)));
2560 -- Calculate offset of next instruction.
2561 -- Second character is most significant in Program_Data.
2563 Next := Get_Next (Program, Scan);
2567 return True; -- Success !
2570 if Program (Next) /= BRANCH then
2571 Next := Operand (Scan); -- No choice, avoid recursion
2575 if Recurse_Match (Operand (Scan), 0) then
2579 Scan := Get_Next (Program, Scan);
2580 exit when Scan = 0 or else Program (Scan) /= BRANCH;
2590 exit State_Machine when Input_Pos /= BOL_Pos
2591 and then ((Self.Flags and Multiple_Lines) = 0
2592 or else Data (Input_Pos - 1) /= ASCII.LF);
2595 exit State_Machine when Input_Pos /= BOL_Pos
2596 and then Data (Input_Pos - 1) /= ASCII.LF;
2599 exit State_Machine when Input_Pos /= BOL_Pos;
2602 exit State_Machine when Input_Pos <= Data'Last
2603 and then ((Self.Flags and Multiple_Lines) = 0
2604 or else Data (Input_Pos) /= ASCII.LF);
2607 exit State_Machine when Input_Pos <= Data'Last
2608 and then Data (Input_Pos) /= ASCII.LF;
2611 exit State_Machine when Input_Pos <= Data'Last;
2613 when BOUND | NBOUND =>
2615 -- Was last char in word ?
2618 N : Boolean := False;
2619 Ln : Boolean := False;
2622 if Input_Pos /= First_In_Data then
2623 N := Is_Alnum (Data (Input_Pos - 1));
2626 if Input_Pos > Last_In_Data then
2629 Ln := Is_Alnum (Data (Input_Pos));
2644 exit State_Machine when Input_Pos > Last_In_Data
2645 or else not Is_White_Space (Data (Input_Pos));
2646 Input_Pos := Input_Pos + 1;
2649 exit State_Machine when Input_Pos > Last_In_Data
2650 or else Is_White_Space (Data (Input_Pos));
2651 Input_Pos := Input_Pos + 1;
2654 exit State_Machine when Input_Pos > Last_In_Data
2655 or else not Is_Digit (Data (Input_Pos));
2656 Input_Pos := Input_Pos + 1;
2659 exit State_Machine when Input_Pos > Last_In_Data
2660 or else Is_Digit (Data (Input_Pos));
2661 Input_Pos := Input_Pos + 1;
2664 exit State_Machine when Input_Pos > Last_In_Data
2665 or else not Is_Alnum (Data (Input_Pos));
2666 Input_Pos := Input_Pos + 1;
2669 exit State_Machine when Input_Pos > Last_In_Data
2670 or else Is_Alnum (Data (Input_Pos));
2671 Input_Pos := Input_Pos + 1;
2674 exit State_Machine when Input_Pos > Last_In_Data
2675 or else Data (Input_Pos) = ASCII.LF;
2676 Input_Pos := Input_Pos + 1;
2679 exit State_Machine when Input_Pos > Last_In_Data;
2680 Input_Pos := Input_Pos + 1;
2684 Opnd : Pointer := String_Operand (Scan);
2685 Current : Positive := Input_Pos;
2687 Last : constant Pointer :=
2688 Opnd + String_Length (Program, Scan);
2691 while Opnd <= Last loop
2692 exit State_Machine when Current > Last_In_Data
2693 or else Program (Opnd) /= Data (Current);
2694 Current := Current + 1;
2698 Input_Pos := Current;
2703 Opnd : Pointer := String_Operand (Scan);
2704 Current : Positive := Input_Pos;
2706 Last : constant Pointer :=
2707 Opnd + String_Length (Program, Scan);
2710 while Opnd <= Last loop
2711 exit State_Machine when Current > Last_In_Data
2712 or else Program (Opnd) /= To_Lower (Data (Current));
2713 Current := Current + 1;
2717 Input_Pos := Current;
2722 Bitmap : Character_Class;
2724 Bitmap_Operand (Program, Scan, Bitmap);
2725 exit State_Machine when Input_Pos > Last_In_Data
2726 or else not Get_From_Class (Bitmap, Data (Input_Pos));
2727 Input_Pos := Input_Pos + 1;
2732 No : constant Natural :=
2733 Character'Pos (Program (Operand (Scan)));
2735 Matches_Tmp (No) := Input_Pos;
2740 No : constant Natural :=
2741 Character'Pos (Program (Operand (Scan)));
2744 Matches_Full (No) := (Matches_Tmp (No), Input_Pos - 1);
2746 if Last_Paren < No then
2753 No : constant Natural :=
2754 Character'Pos (Program (Operand (Scan)));
2759 -- If we haven't seen that parenthesis yet
2761 if Last_Paren < No then
2765 Data_Pos := Matches_Full (No).First;
2767 while Data_Pos <= Matches_Full (No).Last loop
2768 if Input_Pos > Last_In_Data
2769 or else Data (Input_Pos) /= Data (Data_Pos)
2774 Input_Pos := Input_Pos + 1;
2775 Data_Pos := Data_Pos + 1;
2782 when STAR | PLUS | CURLY =>
2784 Greed : constant Boolean := Greedy;
2787 return Match_Simple_Operator (Op, Scan, Next, Greed);
2792 -- Looking at something like:
2794 -- 1: CURLYX {n,m} (->4)
2795 -- 2: code for complex thing (->3)
2800 Min : constant Natural :=
2801 Read_Natural (Program, Scan + 3);
2802 Max : constant Natural :=
2803 Read_Natural (Program, Scan + 5);
2804 Cc : aliased Current_Curly_Record;
2806 Has_Match : Boolean;
2809 Cc := (Paren_Floor => Last_Paren,
2817 Old_Cc => Current_Curly);
2818 Current_Curly := Cc'Unchecked_Access;
2820 Has_Match := Match (Next - 3);
2822 -- Start on the WHILEM
2824 Current_Curly := Cc.Old_Cc;
2829 return Match_Whilem (IP);
2833 end loop State_Machine;
2835 -- If we get here, there is no match.
2836 -- For successful matches when EOP is the terminating point.
2841 ---------------------------
2842 -- Match_Simple_Operator --
2843 ---------------------------
2845 function Match_Simple_Operator
2849 Greedy : Boolean) return Boolean
2851 Next_Char : Character := ASCII.Nul;
2852 Next_Char_Known : Boolean := False;
2853 No : Integer; -- Can be negative
2855 Max : Natural := Natural'Last;
2856 Operand_Code : Pointer;
2859 Save : constant Natural := Input_Pos;
2862 -- Lookahead to avoid useless match attempts
2863 -- when we know what character comes next.
2865 if Program (Next) = EXACT then
2866 Next_Char := Program (String_Operand (Next));
2867 Next_Char_Known := True;
2870 -- Find the minimal and maximal values for the operator
2875 Operand_Code := Operand (Scan);
2879 Operand_Code := Operand (Scan);
2882 Min := Read_Natural (Program, Scan + 3);
2883 Max := Read_Natural (Program, Scan + 5);
2884 Operand_Code := Scan + 7;
2887 -- Non greedy operators
2891 -- Test the minimal repetitions
2894 and then Repeat (Operand_Code, Min) < Min
2901 -- Find the place where 'next' could work
2903 if Next_Char_Known then
2904 -- Last position to check
2906 if Max = Natural'Last then
2907 Last_Pos := Last_In_Data;
2909 Last_Pos := Input_Pos + Max;
2911 if Last_Pos > Last_In_Data then
2912 Last_Pos := Last_In_Data;
2916 -- Look for the first possible opportunity
2919 -- Find the next possible position
2921 while Input_Pos <= Last_Pos
2922 and then Data (Input_Pos) /= Next_Char
2924 Input_Pos := Input_Pos + 1;
2927 if Input_Pos > Last_Pos then
2931 -- Check that we still match if we stop
2932 -- at the position we just found.
2935 Num : constant Natural := Input_Pos - Old;
2940 if Repeat (Operand_Code, Num) < Num then
2945 -- Input_Pos now points to the new position
2947 if Match (Get_Next (Program, Scan)) then
2952 Input_Pos := Input_Pos + 1;
2955 -- We know what the next character is
2958 while Max >= Min loop
2960 -- If the next character matches
2962 if Match (Next) then
2966 Input_Pos := Save + Min;
2968 -- Could not or did not match -- move forward
2970 if Repeat (Operand_Code, 1) /= 0 then
2983 No := Repeat (Operand_Code, Max);
2985 -- ??? Perl has some special code here in case the
2986 -- next instruction is of type EOL, since $ and \Z
2987 -- can match before *and* after newline at the end.
2989 -- ??? Perl has some special code here in case (paren)
2992 -- Else, if we don't have any parenthesis
2994 while No >= Min loop
2995 if not Next_Char_Known
2996 or else (Input_Pos <= Last_In_Data
2997 and then Data (Input_Pos) = Next_Char)
2999 if Match (Next) then
3004 -- Could not or did not work, we back up
3007 Input_Pos := Save + No;
3012 end Match_Simple_Operator;
3018 -- This is really hard to understand, because after we match what we
3019 -- are trying to match, we must make sure the rest of the REx is going
3020 -- to match for sure, and to do that we have to go back UP the parse
3021 -- tree by recursing ever deeper. And if it fails, we have to reset
3022 -- our parent's current state that we can try again after backing off.
3024 function Match_Whilem (IP : Pointer) return Boolean is
3025 pragma Unreferenced (IP);
3027 Cc : constant Current_Curly_Access := Current_Curly;
3028 N : constant Natural := Cc.Cur + 1;
3031 Lastloc : constant Natural := Cc.Lastloc;
3032 -- Detection of 0-len
3035 -- If degenerate scan matches "", assume scan done
3037 if Input_Pos = Cc.Lastloc
3038 and then N >= Cc.Min
3040 -- Temporarily restore the old context, and check that we
3041 -- match was comes after CURLYX.
3043 Current_Curly := Cc.Old_Cc;
3045 if Current_Curly /= null then
3046 Ln := Current_Curly.Cur;
3049 if Match (Cc.Next) then
3053 if Current_Curly /= null then
3054 Current_Curly.Cur := Ln;
3057 Current_Curly := Cc;
3061 -- First, just match a string of min scans
3065 Cc.Lastloc := Input_Pos;
3067 if Match (Cc.Scan) then
3072 Cc.Lastloc := Lastloc;
3076 -- Prefer next over scan for minimal matching
3078 if not Cc.Greedy then
3079 Current_Curly := Cc.Old_Cc;
3081 if Current_Curly /= null then
3082 Ln := Current_Curly.Cur;
3085 if Recurse_Match (Cc.Next, Cc.Paren_Floor) then
3089 if Current_Curly /= null then
3090 Current_Curly.Cur := Ln;
3093 Current_Curly := Cc;
3095 -- Maximum greed exceeded ?
3101 -- Try scanning more and see if it helps
3103 Cc.Lastloc := Input_Pos;
3105 if Recurse_Match (Cc.Scan, Cc.Paren_Floor) then
3110 Cc.Lastloc := Lastloc;
3114 -- Prefer scan over next for maximal matching
3116 if N < Cc.Max then -- more greed allowed ?
3118 Cc.Lastloc := Input_Pos;
3120 if Recurse_Match (Cc.Scan, Cc.Paren_Floor) then
3125 -- Failed deeper matches of scan, so see if this one works
3127 Current_Curly := Cc.Old_Cc;
3129 if Current_Curly /= null then
3130 Ln := Current_Curly.Cur;
3133 if Match (Cc.Next) then
3137 if Current_Curly /= null then
3138 Current_Curly.Cur := Ln;
3141 Current_Curly := Cc;
3143 Cc.Lastloc := Lastloc;
3153 Max : Natural := Natural'Last) return Natural
3155 Scan : Natural := Input_Pos;
3157 Op : constant Opcode := Opcode'Val (Character'Pos (Program (IP)));
3160 Is_First : Boolean := True;
3161 Bitmap : Character_Class;
3164 if Max = Natural'Last or else Scan + Max - 1 > Last_In_Data then
3165 Last := Last_In_Data;
3167 Last := Scan + Max - 1;
3173 and then Data (Scan) /= ASCII.LF
3183 -- The string has only one character if Repeat was called
3185 C := Program (String_Operand (IP));
3187 and then C = Data (Scan)
3194 -- The string has only one character if Repeat was called
3196 C := Program (String_Operand (IP));
3198 and then To_Lower (C) = Data (Scan)
3205 Bitmap_Operand (Program, IP, Bitmap);
3210 and then Get_From_Class (Bitmap, Data (Scan))
3217 and then Is_Alnum (Data (Scan))
3224 and then not Is_Alnum (Data (Scan))
3231 and then Is_White_Space (Data (Scan))
3238 and then not Is_White_Space (Data (Scan))
3245 and then Is_Digit (Data (Scan))
3252 and then not Is_Digit (Data (Scan))
3258 raise Program_Error;
3261 Count := Scan - Input_Pos;
3270 function Try (Pos : Positive) return Boolean is
3274 Matches_Full := (others => No_Match);
3276 if Match (Program_First + 1) then
3277 Matches_Full (0) := (Pos, Input_Pos - 1);
3284 -- Start of processing for Match
3287 -- Do we have the regexp Never_Match?
3289 if Self.Size = 0 then
3290 Matches := (others => No_Match);
3294 -- Check validity of program
3297 (Program (Program_First) = MAGIC,
3298 "Corrupted Pattern_Matcher");
3300 -- If there is a "must appear" string, look for it
3302 if Self.Must_Have_Length > 0 then
3304 First : constant Character := Program (Self.Must_Have);
3305 Must_First : constant Pointer := Self.Must_Have;
3306 Must_Last : constant Pointer :=
3307 Must_First + Pointer (Self.Must_Have_Length - 1);
3308 Next_Try : Natural := Index (First_In_Data, First);
3312 and then Data (Next_Try .. Next_Try + Self.Must_Have_Length - 1)
3313 = String (Program (Must_First .. Must_Last))
3315 Next_Try := Index (Next_Try + 1, First);
3318 if Next_Try = 0 then
3319 Matches := (others => No_Match);
3320 return; -- Not present
3325 -- Mark beginning of line for ^
3327 BOL_Pos := Data'First;
3329 -- Simplest case first: an anchored match need be tried only once
3331 if Self.Anchored and then (Self.Flags and Multiple_Lines) = 0 then
3332 Matched := Try (First_In_Data);
3334 elsif Self.Anchored then
3336 Next_Try : Natural := First_In_Data;
3338 -- Test the first position in the buffer
3339 Matched := Try (Next_Try);
3341 -- Else only test after newlines
3344 while Next_Try <= Last_In_Data loop
3345 while Next_Try <= Last_In_Data
3346 and then Data (Next_Try) /= ASCII.LF
3348 Next_Try := Next_Try + 1;
3351 Next_Try := Next_Try + 1;
3353 if Next_Try <= Last_In_Data then
3354 Matched := Try (Next_Try);
3361 elsif Self.First /= ASCII.NUL then
3362 -- We know what char it must start with
3365 Next_Try : Natural := Index (First_In_Data, Self.First);
3368 while Next_Try /= 0 loop
3369 Matched := Try (Next_Try);
3371 Next_Try := Index (Next_Try + 1, Self.First);
3376 -- Messy cases: try all locations (including for the empty string)
3378 Matched := Try (First_In_Data);
3381 for S in First_In_Data + 1 .. Last_In_Data loop
3388 -- Matched has its value
3390 for J in Last_Paren + 1 .. Matches'Last loop
3391 Matches_Full (J) := No_Match;
3394 Matches := Matches_Full (Matches'Range);
3402 (Self : Pattern_Matcher;
3404 Data_First : Integer := -1;
3405 Data_Last : Positive := Positive'Last) return Natural
3407 Matches : Match_Array (0 .. 0);
3410 Match (Self, Data, Matches, Data_First, Data_Last);
3411 if Matches (0) = No_Match then
3412 return Data'First - 1;
3414 return Matches (0).First;
3419 (Self : Pattern_Matcher;
3421 Data_First : Integer := -1;
3422 Data_Last : Positive := Positive'Last) return Boolean
3424 Matches : Match_Array (0 .. 0);
3427 Match (Self, Data, Matches, Data_First, Data_Last);
3428 return Matches (0).First >= Data'First;
3432 (Expression : String;
3434 Matches : out Match_Array;
3435 Size : Program_Size := Auto_Size;
3436 Data_First : Integer := -1;
3437 Data_Last : Positive := Positive'Last)
3439 PM : Pattern_Matcher (Size);
3440 Finalize_Size : Program_Size;
3444 Match (Compile (Expression), Data, Matches, Data_First, Data_Last);
3446 Compile (PM, Expression, Finalize_Size);
3447 Match (PM, Data, Matches, Data_First, Data_Last);
3456 (Expression : String;
3458 Size : Program_Size := Auto_Size;
3459 Data_First : Integer := -1;
3460 Data_Last : Positive := Positive'Last) return Natural
3462 PM : Pattern_Matcher (Size);
3463 Final_Size : Program_Size; -- unused
3467 return Match (Compile (Expression), Data, Data_First, Data_Last);
3469 Compile (PM, Expression, Final_Size);
3470 return Match (PM, Data, Data_First, Data_Last);
3479 (Expression : String;
3481 Size : Program_Size := Auto_Size;
3482 Data_First : Integer := -1;
3483 Data_Last : Positive := Positive'Last) return Boolean
3485 Matches : Match_Array (0 .. 0);
3486 PM : Pattern_Matcher (Size);
3487 Final_Size : Program_Size; -- unused
3491 Match (Compile (Expression), Data, Matches, Data_First, Data_Last);
3493 Compile (PM, Expression, Final_Size);
3494 Match (PM, Data, Matches, Data_First, Data_Last);
3497 return Matches (0).First >= Data'First;
3504 function Operand (P : Pointer) return Pointer is
3513 procedure Optimize (Self : in out Pattern_Matcher) is
3515 Program : Program_Data renames Self.Program;
3518 -- Start with safe defaults (no optimization):
3519 -- * No known first character of match
3520 -- * Does not necessarily start at beginning of line
3521 -- * No string known that has to appear in data
3523 Self.First := ASCII.NUL;
3524 Self.Anchored := False;
3525 Self.Must_Have := Program'Last + 1;
3526 Self.Must_Have_Length := 0;
3528 Scan := Program_First + 1; -- First instruction (can be anything)
3530 if Program (Scan) = EXACT then
3531 Self.First := Program (String_Operand (Scan));
3533 elsif Program (Scan) = BOL
3534 or else Program (Scan) = SBOL
3535 or else Program (Scan) = MBOL
3537 Self.Anchored := True;
3545 function Paren_Count (Regexp : Pattern_Matcher) return Match_Count is
3547 return Regexp.Paren_Count;
3554 function Quote (Str : String) return String is
3555 S : String (1 .. Str'Length * 2);
3556 Last : Natural := 0;
3559 for J in Str'Range loop
3561 when '^' | '$' | '|' | '*' | '+' | '?' | '{' |
3562 '}' | '[' | ']' | '(' | ')' | '\' | '.' =>
3564 S (Last + 1) := '\';
3565 S (Last + 2) := Str (J);
3569 S (Last + 1) := Str (J);
3574 return S (1 .. Last);
3581 function Read_Natural
3582 (Program : Program_Data;
3583 IP : Pointer) return Natural
3586 return Character'Pos (Program (IP)) +
3587 256 * Character'Pos (Program (IP + 1));
3594 procedure Reset_Class (Bitmap : out Character_Class) is
3596 Bitmap := (others => 0);
3603 procedure Set_In_Class
3604 (Bitmap : in out Character_Class;
3607 Value : constant Class_Byte := Character'Pos (C);
3609 Bitmap (Value / 8) := Bitmap (Value / 8)
3610 or Bit_Conversion (Value mod 8);
3617 function String_Length
3618 (Program : Program_Data;
3619 P : Pointer) return Program_Size
3622 pragma Assert (Program (P) = EXACT or else Program (P) = EXACTF);
3623 return Character'Pos (Program (P + 3));
3626 --------------------
3627 -- String_Operand --
3628 --------------------
3630 function String_Operand (P : Pointer) return Pointer is