-- a direct translation, but the approach is followed closely. In particular,
-- we use the one stack approach developed in the SPITBOL implementation.
-with Ada.Exceptions; use Ada.Exceptions;
with Ada.Strings.Unbounded.Aux; use Ada.Strings.Unbounded.Aux;
with GNAT.Debug_Utilities; use GNAT.Debug_Utilities;
-- I parameter(s) I
-- +------------------------------------+
- -- Pcode is a code value indicating the type of the patterm node. This
+ -- Pcode is a code value indicating the type of the pattern node. This
-- code is used both as the discriminant value for the record, and as
-- the case index in the main match routine that branches to the proper
-- match code for the given element.
-- Pthen is a pointer to the successor node, i.e the node to be matched
-- if the attempt to match the node succeeds. If this is the last node
-- of the pattern to be matched, then Pthen points to a dummy node
- -- of kind PC_EOP (end of pattern), which initiales pattern exit.
+ -- of kind PC_EOP (end of pattern), which initializes pattern exit.
-- The parameter or parameters are present for certain node types,
-- and the type varies with the pattern code.
---------------------------------------------------
-- The serial index numbers for the pattern elements are assigned as
- -- a pattern is consructed from its constituent elements. Note that there
+ -- a pattern is constructed from its constituent elements. Note that there
-- is never any sharing of pattern elements between patterns (copies are
-- always made), so the serial index numbers are unique to a particular
-- pattern as referenced from the P field of a value of type Pattern.
-- pattern (e.g. copy and finalization processing). Once constructed
-- patterns are strictly read only. This is necessary to allow sharing
-- of patterns between tasks. This means that we cannot go marking the
- -- pattern (e.g. with a visited bit). Instead we cosntuct a separate
+ -- pattern (e.g. with a visited bit). Instead we construct a separate
-- vector that contains the necessary information indexed by the Index
-- values in the pattern elements. For this purpose the only requirement
-- is that they be uniquely assigned.
-- Third, as compound pattern structures are constructed, the way in which
-- constituent parts of the pattern are constructed is stylized. This is
- -- an automatic consequence of the way that these compounjd structures
+ -- an automatic consequence of the way that these compound structures
-- are constructed, and basically what we are doing is simply documenting
-- and specifying the natural result of the pattern construction. The
-- section describing compound pattern structures gives details of the
-- stack is used to control the backtracking. Finally, it notes the
-- way in which the Index numbers are assigned to the structure.
- -- In all diagrams, solid lines (built witth minus signs or vertical
+ -- In all diagrams, solid lines (built with minus signs or vertical
-- bars, represent successor pointers (Pthen fields) with > or V used
-- to indicate the direction of the pointer. The initial node of the
-- structure is in the upper left of the diagram. A dotted line is an
-------------------
-- In the pattern structures listed in this section, a line that looks
- -- lile ----> with nothing to the right indicates an end of pattern
+ -- like ----> with nothing to the right indicates an end of pattern
-- (EOP) pointer that represents the end of the match.
-- When a pattern concatenation (L & R) occurs, the resulting structure
-- occurs in constructing a pattern, and it means that the pattern
-- matching circuitry does not have to keep track of the structure
-- of a pattern with respect to concatenation, since the appropriate
- -- succesor is always at hand.
+ -- successor is always at hand.
-- Concatenation itself generates no additional possibilities for
-- backtracking, but the constituent patterns of the concatenated
-- it stacks a pointer to the leading element of R on the history stack
-- so that on subsequent failure, a match of R is attempted.
- -- The A node is the higest numbered element in the pattern. The
+ -- The A node is the highest numbered element in the pattern. The
-- original index numbers of R are unchanged, but the index numbers
-- of the L pattern are adjusted up by the count of elements in R.
-- described below.
-- It then stores a pointer to itself in the special entry node field.
- -- This was otherwise unused, and is now used to retrive the address
+ -- This was otherwise unused, and is now used to retrieve the address
-- of the variable to be assigned at the end of the pattern.
-- After that the inner region is terminated in the usual manner,
-- string, starting at the current cursor position. It then updates
-- the cursor past this matched string, and stacks a pointer to itself
-- with this updated cursor value on the history stack, to extend the
- -- matched string on a subequent failure.
+ -- matched string on a subsequent failure.
-- Since this is a single node it is numbered 1 (the reason we include
-- it in the compound patterns section is that it backtracks).
-- The following pattern elements are referenced only from the pattern
-- history stack. In each case the processing for the pattern element
- -- results in pattern match abort, or futher failure, so there is no
+ -- results in pattern match abort, or further failure, so there is no
-- need for a successor and no need for a node number
CP_Assign : aliased PE := (PC_Assign, 0, N);
-- understand a typical use of this function).
function BreakX_Make (B : PE_Ptr) return Pattern;
- -- Given a pattern element for a Break patternx, returns the
+ -- Given a pattern element for a Break pattern, returns the
-- corresponding BreakX compound pattern structure.
function Concat (L, R : PE_Ptr; Incr : Natural) return PE_Ptr;
- -- Creates a pattern eelement that represents a concatenation of the
+ -- Creates a pattern element that represents a concatenation of the
-- two given pattern elements (i.e. the pattern L followed by R).
-- The result returned is always the same as L, but the pattern
-- referenced by L is modified to have R as a successor. This
Start : out Natural;
Stop : out Natural);
-- Identical in all respects to XMatch, except that trace information is
- -- output on Standard_Ouput during execution of the match. This is the
+ -- output on Standard_Output during execution of the match. This is the
-- version that is called if the original Match call has Debug => True.
---------
E : constant PE_Ptr := new PE'(PC_R_Enter, 0, EOP);
A : constant PE_Ptr :=
new PE'(PC_Assign_Imm, 0, EOP, Var'Unrestricted_Access);
-
begin
return (AFC with P.Stk + 3, Bracket (E, Pat, A));
end "*";
E : constant PE_Ptr := new PE'(PC_R_Enter, 0, EOP);
A : constant PE_Ptr :=
new PE'(PC_Assign_Imm, 0, EOP, Var'Unrestricted_Access);
-
begin
return (AFC with 3, Bracket (E, Pat, A));
end "*";
E : constant PE_Ptr := new PE'(PC_R_Enter, 0, EOP);
A : constant PE_Ptr :=
new PE'(PC_Assign_Imm, 0, EOP, Var'Unrestricted_Access);
-
begin
return (AFC with 3, Bracket (E, Pat, A));
end "*";
Pat : constant PE_Ptr := Copy (P.P);
E : constant PE_Ptr := new PE'(PC_R_Enter, 0, EOP);
W : constant PE_Ptr := new PE'(PC_Write_Imm, 0, EOP, Fil);
-
begin
return (AFC with 3, Bracket (E, Pat, W));
end "*";
Pat : constant PE_Ptr := S_To_PE (P);
E : constant PE_Ptr := new PE'(PC_R_Enter, 0, EOP);
W : constant PE_Ptr := new PE'(PC_Write_Imm, 0, EOP, Fil);
-
begin
return (AFC with 3, Bracket (E, Pat, W));
end "*";
Pat : constant PE_Ptr := C_To_PE (P);
E : constant PE_Ptr := new PE'(PC_R_Enter, 0, EOP);
W : constant PE_Ptr := new PE'(PC_Write_Imm, 0, EOP, Fil);
-
begin
return (AFC with 3, Bracket (E, Pat, W));
end "*";
E : constant PE_Ptr := new PE'(PC_R_Enter, 0, EOP);
A : constant PE_Ptr :=
new PE'(PC_Assign_OnM, 0, EOP, Var'Unrestricted_Access);
-
begin
return (AFC with P.Stk + 3, Bracket (E, Pat, A));
end "**";
E : constant PE_Ptr := new PE'(PC_R_Enter, 0, EOP);
A : constant PE_Ptr :=
new PE'(PC_Assign_OnM, 0, EOP, Var'Unrestricted_Access);
-
begin
return (AFC with 3, Bracket (E, Pat, A));
end "**";
E : constant PE_Ptr := new PE'(PC_R_Enter, 0, EOP);
A : constant PE_Ptr :=
new PE'(PC_Assign_OnM, 0, EOP, Var'Unrestricted_Access);
-
begin
return (AFC with 3, Bracket (E, Pat, A));
end "**";
Pat : constant PE_Ptr := Copy (P.P);
E : constant PE_Ptr := new PE'(PC_R_Enter, 0, EOP);
W : constant PE_Ptr := new PE'(PC_Write_OnM, 0, EOP, Fil);
-
begin
return (AFC with P.Stk + 3, Bracket (E, Pat, W));
end "**";
Pat : constant PE_Ptr := S_To_PE (P);
E : constant PE_Ptr := new PE'(PC_R_Enter, 0, EOP);
W : constant PE_Ptr := new PE'(PC_Write_OnM, 0, EOP, Fil);
-
begin
return (AFC with 3, Bracket (E, Pat, W));
end "**";
Pat : constant PE_Ptr := C_To_PE (P);
E : constant PE_Ptr := new PE'(PC_R_Enter, 0, EOP);
W : constant PE_Ptr := new PE'(PC_Write_OnM, 0, EOP, Fil);
-
begin
return (AFC with 3, Bracket (E, Pat, W));
end "**";
return new PE'(PC_Alt, R.Index + 1, EOP, R);
-- If the left pattern is non-null, then build a reference vector
- -- for its elements, and adjust their index values to acccomodate
+ -- for its elements, and adjust their index values to accommodate
-- the right hand elements. Then add the alternation node.
else
function Arb return Pattern is
Y : constant PE_Ptr := new PE'(PC_Arb_Y, 1, EOP);
X : constant PE_Ptr := new PE'(PC_Arb_X, 2, EOP, Y);
-
begin
return (AFC with 1, X);
end Arb;
begin
if P'Length = 0 then
return (AFC with 0, EOP);
-
else
return (AFC with 0, Arbno_Simple (S_To_PE (P)));
end if;
X : constant PE_Ptr := new PE'(PC_Arbno_X, 0, EOP, E);
Y : constant PE_Ptr := new PE'(PC_Arbno_Y, 0, X, P.Stk + 3);
EPY : constant PE_Ptr := Bracket (E, Pat, Y);
-
begin
X.Alt := EPY;
X.Index := EPY.Index + 1;
function Arbno_Simple (P : PE_Ptr) return PE_Ptr is
S : constant PE_Ptr := new PE'(PC_Arbno_S, P.Index + 1, EOP, P);
-
begin
Set_Successor (P, S);
return S;
function Break (Str : not null access VString) return Pattern is
begin
- return (AFC with 0, new PE'(PC_Break_VP, 1, EOP, VString_Ptr (Str)));
+ return (AFC with 0,
+ new PE'(PC_Break_VP, 1, EOP, Str.all'Unchecked_Access));
end Break;
function Break (Str : VString_Func) return Pattern is
function BreakX_Make (B : PE_Ptr) return Pattern is
X : constant PE_Ptr := new PE'(PC_BreakX_X, 2, B);
A : constant PE_Ptr := new PE'(PC_Alt, 1, EOP, X);
-
begin
B.Pthen := A;
return (AFC with 2, B);
-- Record given pattern element if not already recorded in RA,
-- and also record any referenced pattern elements recursively.
+ ---------------
+ -- Record_PE --
+ ---------------
+
procedure Record_PE (E : PE_Ptr) is
begin
PutD (" Record_PE called with PE_Ptr = " & Image (E));
procedure Write_Node_Id (E : PE_Ptr);
-- Writes out a string identifying the given pattern element
+ -------------------
+ -- Write_Node_Id --
+ -------------------
+
procedure Write_Node_Id (E : PE_Ptr) is
begin
if E = EOP then
end if;
end Write_Node_Id;
+ -- Start of processing for Dump
+
begin
New_Line;
Put ("Pattern Dump Output (pattern at " &
Pat : constant PE_Ptr := Copy (P.P);
E : constant PE_Ptr := new PE'(PC_R_Enter, 0, EOP);
X : constant PE_Ptr := new PE'(PC_Fence_X, 0, EOP);
-
begin
return (AFC with P.Stk + 1, Bracket (E, Pat, X));
end Fence;
procedure Delete_Ampersand is
L : constant Natural := Length (Result);
-
begin
if L > 2 then
Delete (Result, L - 1, L);
procedure Logic_Error is
begin
- Raise_Exception
- (Program_Error'Identity,
- "Internal logic error in GNAT.Spitbol.Patterns");
+ raise Program_Error with
+ "Internal logic error in GNAT.Spitbol.Patterns";
end Logic_Error;
-----------
procedure Uninitialized_Pattern is
begin
- Raise_Exception
- (Program_Error'Identity,
- "uninitialized value of type GNAT.Spitbol.Patterns.Pattern");
+ raise Program_Error with
+ "uninitialized value of type GNAT.Spitbol.Patterns.Pattern";
end Uninitialized_Pattern;
------------
procedure Pop_Region;
pragma Inline (Pop_Region);
- -- Used at the end of processing of an inner region. if the inner
+ -- Used at the end of processing of an inner region. If the inner
-- region left no stack entries, then all trace of it is removed.
-- Otherwise a PC_Restore_Region entry is pushed to ensure proper
-- handling of alternatives in the inner region.
procedure Push (Node : PE_Ptr);
pragma Inline (Push);
- -- Make entry in pattern matching stack with current cursor valeu
+ -- Make entry in pattern matching stack with current cursor value
procedure Push_Region;
pragma Inline (Push_Region);
when PC_Len_NF => declare
N : constant Natural := Node.NF.all;
-
begin
if Cursor + N > Length then
goto Fail;
when PC_Pos_NF => declare
N : constant Natural := Node.NF.all;
-
begin
if Cursor = N then
goto Succeed;
when PC_RPos_NF => declare
N : constant Natural := Node.NF.all;
-
begin
if Length - Cursor = N then
goto Succeed;
when PC_RTab_NF => declare
N : constant Natural := Node.NF.all;
-
begin
if Length - Cursor >= N then
Cursor := Length - N;
-- Span (one character case)
when PC_Span_CH => declare
- P : Natural := Cursor;
+ P : Natural;
begin
+ P := Cursor;
while P < Length
and then Subject (P + 1) = Node.Char
loop
-- Span (character set case)
when PC_Span_CS => declare
- P : Natural := Cursor;
+ P : Natural;
begin
+ P := Cursor;
while P < Length
and then Is_In (Subject (P + 1), Node.CS)
loop
when PC_String => declare
Len : constant Natural := Node.Str'Length;
-
begin
if (Length - Cursor) >= Len
and then Node.Str.all = Subject (Cursor + 1 .. Cursor + Len)
when PC_Tab_NF => declare
N : constant Natural := Node.NF.all;
-
begin
if Cursor <= N then
Cursor := N;
procedure Pop_Region;
pragma Inline (Pop_Region);
- -- Used at the end of processing of an inner region. if the inner
+ -- Used at the end of processing of an inner region. If the inner
-- region left no stack entries, then all trace of it is removed.
-- Otherwise a PC_Restore_Region entry is pushed to ensure proper
-- handling of alternatives in the inner region.
procedure Push (Node : PE_Ptr);
pragma Inline (Push);
- -- Make entry in pattern matching stack with current cursor valeu
+ -- Make entry in pattern matching stack with current cursor value
procedure Push_Region;
pragma Inline (Push_Region);
OSDN Git Service
