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 "**";
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);
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;