-- B o d y --
-- --
-- Copyright (C) 1986 by University of Toronto. --
--- Copyright (C) 1996-2003 Ada Core Technologies, Inc. --
+-- Copyright (C) 1999-2006, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- Complex loops
CURLYX, -- 2num node Match this complex thing {n,m} times
- -- The nums are coded on two characters each.
+ -- The nums are coded on two characters each
WHILEM, -- no Do curly processing and see if rest matches
procedure Set_In_Class
(Bitmap : in out Character_Class;
C : Character);
- -- Set the entry to True for C in the class Bitmap.
+ -- Set the entry to True for C in the class Bitmap
function Get_From_Class
(Bitmap : Character_Class;
- C : Character)
- return Boolean;
- -- Return True if the entry is set for C in the class Bitmap.
+ C : Character) return Boolean;
+ -- Return True if the entry is set for C in the class Bitmap
procedure Reset_Class (Bitmap : out Character_Class);
- -- Clear all the entries in the class Bitmap.
+ -- Clear all the entries in the class Bitmap
pragma Inline (Set_In_Class);
pragma Inline (Get_From_Class);
function String_Length
(Program : Program_Data;
- P : Pointer)
- return Program_Size;
+ P : Pointer) return Program_Size;
-- Return the length of the string argument of the node at P
function String_Operand (P : Pointer) return Pointer;
function Get_Next_Offset
(Program : Program_Data;
- IP : Pointer)
- return Pointer;
- -- Get the offset field of a node. Used by Get_Next.
+ IP : Pointer) return Pointer;
+ -- Get the offset field of a node. Used by Get_Next
function Get_Next
(Program : Program_Data;
- IP : Pointer)
- return Pointer;
+ IP : Pointer) return Pointer;
-- Dig the next instruction pointer out of a node
procedure Optimize (Self : in out Pattern_Matcher);
function Read_Natural
(Program : Program_Data;
- IP : Pointer)
- return Natural;
- -- Return the 2-byte natural coded at position IP.
+ IP : Pointer) return Natural;
+ -- Return the 2-byte natural coded at position IP
-- All of the subprograms above are tiny and should be inlined
-- Return value is the location of new opcode, ie old Emit_Ptr.
procedure Emit_Natural (IP : Pointer; N : Natural);
- -- Split N on two characters at position IP.
+ -- Split N on two characters at position IP
procedure Emit_Class (Bitmap : Character_Class);
- -- Emits a character class.
+ -- Emits a character class
procedure Case_Emit (C : Character);
-- Emit C, after converting is to lower-case if the regular
function Next_Instruction (P : Pointer) return Pointer;
-- Dig the "next" pointer out of a node
- procedure Fail (M : in String);
+ procedure Fail (M : String);
pragma No_Return (Fail);
-- Fail with a diagnostic message, if possible
-- Fail --
----------
- procedure Fail (M : in String) is
+ procedure Fail (M : String) is
begin
- raise Expression_Error;
+ raise Expression_Error with M;
end Fail;
-------------------------
-- makes it hard to avoid.
procedure Parse
- (Parenthesized : in Boolean;
+ (Parenthesized : Boolean;
Flags : out Expression_Flags;
IP : out Pointer)
is
Parse_Pos := Parse_Pos + 1;
end if;
- -- First character can be ] or -, without closing the class.
+ -- First character can be ] or - without closing the class
if Parse_Pos <= Parse_End
and then (Expression (Parse_Pos) = ']'
function Compile
(Expression : String;
- Flags : Regexp_Flags := No_Flags)
- return Pattern_Matcher
+ Flags : Regexp_Flags := No_Flags) return Pattern_Matcher
is
Size : Program_Size;
Dummy : Pattern_Matcher (0);
function Get_From_Class
(Bitmap : Character_Class;
- C : Character)
- return Boolean
+ C : Character) return Boolean
is
Value : constant Class_Byte := Character'Pos (C);
function Get_Next_Offset
(Program : Program_Data;
- IP : Pointer)
- return Pointer
+ IP : Pointer) return Pointer
is
begin
return Pointer (Read_Natural (Program, IP + 1));
type Natural_Array is array (Match_Count range <>) of Natural;
Matches_Tmp : Natural_Array (Matches_Full'Range);
- -- Save the opening position of parenthesis.
+ -- Save the opening position of parenthesis
Last_Paren : Natural := 0;
-- Last parenthesis seen
-- operators for complex expressions.
Current_Curly : Current_Curly_Access := null;
- -- The curly currently being processed.
+ -- The curly currently being processed
-----------------------
-- Local Subprograms --
-- Find character C in Data starting at Start and return position
function Repeat
- (IP : Pointer;
- Max : Natural := Natural'Last)
- return Natural;
+ (IP : Pointer;
+ Max : Natural := Natural'Last) return Natural;
-- Repeatedly match something simple, report how many
-- It only matches on things of length 1.
-- Starting from Input_Pos, it matches at most Max CURLY.
- function Try (Pos : in Positive) return Boolean;
+ function Try (Pos : Positive) return Boolean;
-- Try to match at specific point
function Match (IP : Pointer) return Boolean;
(Op : Opcode;
Scan : Pointer;
Next : Pointer;
- Greedy : Boolean)
- return Boolean;
+ Greedy : Boolean) return Boolean;
-- Return True it the simple operator (possibly non-greedy) matches
pragma Inline (Index);
pragma Inline (Repeat);
- -- These are two complex functions, but used only once.
+ -- These are two complex functions, but used only once
pragma Inline (Match_Whilem);
pragma Inline (Match_Simple_Operator);
-- Index --
-----------
- function Index
- (Start : Positive;
- C : Character)
- return Natural
- is
+ function Index (Start : Positive; C : Character) return Natural is
begin
for J in Start .. Last_In_Data loop
if Data (J) = C then
-- Match --
-----------
- function Match (IP : Pointer) return Boolean is
+ function Match (IP : Pointer) return Boolean is
Scan : Pointer := IP;
Next : Pointer;
Op : Opcode;
end if;
Scan := Get_Next (Program, Scan);
- exit when Scan = 0 or Program (Scan) /= BRANCH;
+ exit when Scan = 0 or else Program (Scan) /= BRANCH;
end loop;
exit State_Machine;
(Op : Opcode;
Scan : Pointer;
Next : Pointer;
- Greedy : Boolean)
- return Boolean
+ Greedy : Boolean) return Boolean
is
Next_Char : Character := ASCII.Nul;
Next_Char_Known : Boolean := False;
if Next_Char_Known then
-- Last position to check
- Last_Pos := Input_Pos + Max;
-
- if Last_Pos > Last_In_Data
- or else Max = Natural'Last
- then
+ if Max = Natural'Last then
Last_Pos := Last_In_Data;
+ else
+ Last_Pos := Input_Pos + Max;
+
+ if Last_Pos > Last_In_Data then
+ Last_Pos := Last_In_Data;
+ end if;
end if;
-- Look for the first possible opportunity
function Match_Whilem (IP : Pointer) return Boolean is
pragma Unreferenced (IP);
- Cc : Current_Curly_Access := Current_Curly;
- N : constant Natural := Cc.Cur + 1;
- Ln : Natural := 0;
+ Cc : constant Current_Curly_Access := Current_Curly;
+ N : constant Natural := Cc.Cur + 1;
+ Ln : Natural := 0;
Lastloc : constant Natural := Cc.Lastloc;
- -- Detection of 0-len.
+ -- Detection of 0-len
begin
- -- If degenerate scan matches "", assume scan done.
+ -- If degenerate scan matches "", assume scan done
if Input_Pos = Cc.Lastloc
and then N >= Cc.Min
return False;
end if;
- -- First, just match a string of min scans.
+ -- First, just match a string of min scans
if N < Cc.Min then
Cc.Cur := N;
return False;
end if;
- -- Prefer next over scan for minimal matching.
+ -- Prefer next over scan for minimal matching
if not Cc.Greedy then
Current_Curly := Cc.Old_Cc;
------------
function Repeat
- (IP : Pointer;
- Max : Natural := Natural'Last)
- return Natural
+ (IP : Pointer;
+ Max : Natural := Natural'Last) return Natural
is
Scan : Natural := Input_Pos;
Last : Natural;
-- Try --
---------
- function Try (Pos : in Positive) return Boolean is
+ function Try (Pos : Positive) return Boolean is
begin
Input_Pos := Pos;
Last_Paren := 0;
return;
end Match;
- function Match
- (Self : Pattern_Matcher;
- Data : String;
+ -----------
+ -- Match --
+ -----------
+
+ function Match
+ (Self : Pattern_Matcher;
+ Data : String;
Data_First : Integer := -1;
- Data_Last : Positive := Positive'Last)
- return Natural
+ Data_Last : Positive := Positive'Last) return Natural
is
Matches : Match_Array (0 .. 0);
end if;
end Match;
- function Match
+ function Match
(Self : Pattern_Matcher;
Data : String;
Data_First : Integer := -1;
- Data_Last : Positive := Positive'Last)
- return Boolean
+ Data_Last : Positive := Positive'Last) return Boolean
is
Matches : Match_Array (0 .. 0);
(Expression : String;
Data : String;
Matches : out Match_Array;
- Size : Program_Size := 0;
- Data_First : Integer := -1;
- Data_Last : Positive := Positive'Last)
+ Size : Program_Size := Auto_Size;
+ Data_First : Integer := -1;
+ Data_Last : Positive := Positive'Last)
is
PM : Pattern_Matcher (Size);
Finalize_Size : Program_Size;
end if;
end Match;
- function Match
+ -----------
+ -- Match --
+ -----------
+
+ function Match
(Expression : String;
Data : String;
- Size : Program_Size := 0;
- Data_First : Integer := -1;
- Data_Last : Positive := Positive'Last)
- return Natural
+ Size : Program_Size := Auto_Size;
+ Data_First : Integer := -1;
+ Data_Last : Positive := Positive'Last) return Natural
is
PM : Pattern_Matcher (Size);
Final_Size : Program_Size; -- unused
end if;
end Match;
+ -----------
+ -- Match --
+ -----------
+
function Match
(Expression : String;
Data : String;
- Size : Program_Size := 0;
- Data_First : Integer := -1;
- Data_Last : Positive := Positive'Last)
- return Boolean
+ Size : Program_Size := Auto_Size;
+ Data_First : Integer := -1;
+ Data_Last : Positive := Positive'Last) return Boolean
is
Matches : Match_Array (0 .. 0);
PM : Pattern_Matcher (Size);
function Read_Natural
(Program : Program_Data;
- IP : Pointer)
- return Natural
+ IP : Pointer) return Natural
is
begin
return Character'Pos (Program (IP)) +
C : Character)
is
Value : constant Class_Byte := Character'Pos (C);
-
begin
Bitmap (Value / 8) := Bitmap (Value / 8)
or Bit_Conversion (Value mod 8);
function String_Length
(Program : Program_Data;
- P : Pointer)
- return Program_Size
+ P : Pointer) return Program_Size
is
begin
pragma Assert (Program (P) = EXACT or else Program (P) = EXACTF);
OSDN Git Service
