with Ada.Unchecked_Deallocation;
package body GNAT.Array_Split is
procedure Free is
new Ada.Unchecked_Deallocation (Slices_Indexes, Slices_Access);
procedure Free is
new Ada.Unchecked_Deallocation (Separators_Indexes, Indexes_Access);
function Count
(Source : Element_Sequence;
Pattern : Element_Set)
return Natural;
procedure Adjust (S : in out Slice_Set) is
begin
S.Ref_Counter.all := S.Ref_Counter.all + 1;
end Adjust;
procedure Create
(S : out Slice_Set;
From : Element_Sequence;
Separators : Element_Sequence;
Mode : Separator_Mode := Single)
is
begin
Create (S, From, To_Set (Separators), Mode);
end Create;
procedure Create
(S : out Slice_Set;
From : Element_Sequence;
Separators : Element_Set;
Mode : Separator_Mode := Single)
is
begin
S.Source := new Element_Sequence'(From);
Set (S, Separators, Mode);
end Create;
function Count
(Source : Element_Sequence;
Pattern : Element_Set)
return Natural
is
C : Natural := 0;
begin
for K in Source'Range loop
if Is_In (Source (K), Pattern) then
C := C + 1;
end if;
end loop;
return C;
end Count;
procedure Finalize (S : in out Slice_Set) is
procedure Free is
new Ada.Unchecked_Deallocation (Element_Sequence, Element_Access);
procedure Free is
new Ada.Unchecked_Deallocation (Natural, Counter);
begin
S.Ref_Counter.all := S.Ref_Counter.all - 1;
if S.Ref_Counter.all = 0 then
Free (S.Source);
Free (S.Indexes);
Free (S.Slices);
Free (S.Ref_Counter);
end if;
end Finalize;
procedure Initialize (S : in out Slice_Set) is
begin
S.Ref_Counter := new Natural'(1);
end Initialize;
function Separators
(S : Slice_Set;
Index : Slice_Number)
return Slice_Separators
is
begin
if Index > S.N_Slice then
raise Index_Error;
elsif Index = 0
or else (Index = 1 and then S.N_Slice = 1)
then
return (Before => Array_End,
After => Array_End);
elsif Index = 1 then
return (Before => Array_End,
After => S.Source (S.Slices (Index).Stop + 1));
elsif Index = S.N_Slice then
return (Before => S.Source (S.Slices (Index).Start - 1),
After => Array_End);
else
return (Before => S.Source (S.Slices (Index).Start - 1),
After => S.Source (S.Slices (Index).Stop + 1));
end if;
end Separators;
function Separators (S : Slice_Set) return Separators_Indexes is
begin
return S.Indexes.all;
end Separators;
procedure Set
(S : in out Slice_Set;
Separators : Element_Sequence;
Mode : Separator_Mode := Single)
is
begin
Set (S, To_Set (Separators), Mode);
end Set;
procedure Set
(S : in out Slice_Set;
Separators : Element_Set;
Mode : Separator_Mode := Single)
is
Count_Sep : constant Natural := Count (S.Source.all, Separators);
J : Positive;
begin
Free (S.Indexes);
Free (S.Slices);
S.Indexes := new Separators_Indexes (1 .. Count_Sep);
J := S.Indexes'First;
for K in S.Source'Range loop
if Is_In (S.Source (K), Separators) then
S.Indexes (J) := K;
J := J + 1;
end if;
end loop;
declare
S_Info : Slices_Indexes (1 .. Slice_Number (Count_Sep) + 1);
K : Natural := 1;
Start, Stop : Natural;
begin
S.N_Slice := 0;
Start := S.Source'First;
Stop := 0;
loop
if K > Count_Sep then
Stop := S.Source'Last;
else
Stop := S.Indexes (K) - 1;
end if;
S.N_Slice := S.N_Slice + 1;
S_Info (S.N_Slice) := (Start, Stop);
exit when K > Count_Sep;
case Mode is
when Single =>
Start := S.Indexes (K) + 1;
K := K + 1;
when Multiple =>
loop
Start := S.Indexes (K) + 1;
K := K + 1;
exit when K > Count_Sep
or else S.Indexes (K) > S.Indexes (K - 1) + 1;
end loop;
end case;
end loop;
S.Slices := new Slices_Indexes'(S_Info (1 .. S.N_Slice));
end;
end Set;
function Slice
(S : Slice_Set;
Index : Slice_Number)
return Element_Sequence
is
begin
if Index = 0 then
return S.Source.all;
elsif Index > S.N_Slice then
raise Index_Error;
else
return S.Source (S.Slices (Index).Start .. S.Slices (Index).Stop);
end if;
end Slice;
function Slice_Count (S : Slice_Set) return Slice_Number is
begin
return S.N_Slice;
end Slice_Count;
end GNAT.Array_Split;