File: [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Supports / generic_lists_of_vectors.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:27 2000 UTC (23 years, 10 months ago) by maekawa
Branch: PHC, MAIN
CVS Tags: v2, maekawa-ipv6, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, HEAD Changes since 1.1: +0 -0
lines
Import the second public release of PHCpack.
OKed by Jan Verschelde.
|
package body Generic_Lists_of_Vectors is
-- CONSTRUCTORS :
function Deep_Create ( v : VecVec ) return List is
res,res_last : List;
begin
for i in v'range loop
Append(res,res_last,v(i).all);
end loop;
return res;
end Deep_Create;
function Shallow_Create ( v : VecVec ) return List is
res,res_last : List;
begin
for i in v'range loop
Append(res,res_last,v(i));
end loop;
return res;
end Shallow_Create;
function Deep_Create ( l : List ) return VecVec is
res : VecVec(1..Length_Of(l));
tmp : List := l;
begin
for i in res'range loop
declare
v : constant Vectors.Vector := Head_Of(tmp).all;
begin
res(i) := new vector'(v);
end;
tmp := Tail_Of(tmp);
end loop;
return res;
end Deep_Create;
function Shallow_Create ( l : List ) return VecVec is
res : VecVec(1..Length_Of(l));
tmp : List := l;
begin
for i in res'range loop
res(i) := Head_Of(tmp);
tmp := Tail_Of(tmp);
end loop;
return res;
end Shallow_Create;
procedure Copy ( l1 : in List; l2 : in out List ) is
tmp,l2_last : List;
lv : Link_to_Vector;
begin
Deep_Clear(l2);
tmp := l1;
while not Is_Null(tmp) loop
lv := Head_Of(tmp);
Append(l2,l2_last,lv.all);
tmp := Tail_Of(tmp);
end loop;
end Copy;
procedure Append ( first,last : in out List; v : in Vector ) is
lv : Link_to_Vector := new Vector'(v);
begin
if Is_Null(first)
then Construct(lv,first);
last := first;
else declare
tmp : List;
begin
Construct(lv,tmp);
Swap_Tail(last,tmp);
last := Tail_Of(last);
end;
end if;
end Append;
procedure Append_Diff ( first,last : in out List; v : in Vector ) is
begin
if not Is_In(first,v)
then Append(first,last,v);
end if;
end Append_Diff;
procedure Append_Diff ( first,last : in out List; v : in Link_to_Vector ) is
begin
if v /= null and then not Is_In(first,v)
then Append(first,last,v);
end if;
end Append_Diff;
procedure Deep_Concat ( first,last : in out List; l : in List ) is
tmp : List;
lv : Link_to_Vector;
begin
if not Is_Null(l)
then tmp := l;
while not Is_Null(tmp) loop
lv := Head_Of(tmp);
Append(first,last,lv.all);
tmp := Tail_Of(tmp);
end loop;
end if;
end Deep_Concat;
procedure Shallow_Concat ( first,last : in out List; l : in List ) is
begin
Concat(first,last,l);
end Shallow_Concat;
procedure Deep_Concat_Diff ( first,last : in out List; l : in List ) is
tmp : List;
lv : Link_to_Vector;
begin
if not Is_Null(l)
then tmp := l;
while not Is_Null(tmp) loop
lv := Head_Of(tmp);
Append_Diff(first,last,lv.all);
tmp := Tail_Of(tmp);
end loop;
end if;
end Deep_Concat_Diff;
procedure Shallow_Concat_Diff ( first,last : in out List; l : in List ) is
tmp : List;
lv : Link_to_Vector;
begin
if not Is_Null(l)
then tmp := l;
while not Is_Null(tmp) loop
lv := Head_Of(tmp);
Append_Diff(first,last,lv);
tmp := Tail_Of(tmp);
end loop;
end if;
end Shallow_Concat_Diff;
procedure Remove ( l : in out List; x : in Vector ) is
lpt : Link_to_Vector;
found : boolean;
l1,l2 : List;
begin
if not Is_Null(l)
then
lpt := Head_Of(l);
if lpt.all = x
then Clear(lpt);
l := Tail_Of(l);
else found := false;
l1 := l;
l2 := Tail_Of(l1);
while not Is_Null(l2) loop
lpt := Head_Of(l2);
found := (lpt.all = x);
exit when found;
l1 := l2;
l2 := Tail_Of(l1);
end loop;
if found
then Clear(lpt);
l2 := Tail_Of(l2);
Swap_Tail(l1,l2);
end if;
end if;
end if;
end Remove;
procedure Remove ( l : in out List; x : in Link_to_Vector ) is
begin
if x /= null
then Remove(l,x.all);
end if;
end Remove;
procedure Swap_to_Front ( l : in out List; x : in Vector ) is
first : Link_to_Vector;
pt : Link_to_Vector;
tmp : List;
done : boolean := false;
begin
if not Is_Null(l)
then first := Head_Of(l);
if first.all /= x
then tmp := Tail_Of(l);
while not Is_Null(tmp) loop
pt := Head_Of(tmp);
if pt.all = x
then Set_Head(tmp,first);
Set_Head(l,pt);
done := true;
end if;
exit when done;
tmp := Tail_Of(tmp);
end loop;
end if;
end if;
end Swap_to_Front;
procedure Swap_to_Front ( l : in out List; x : in Link_to_Vector ) is
begin
if x /= null
then Swap_to_Front(l,x.all);
end if;
end Swap_to_Front;
-- SELECTORS :
function Is_In ( l : List; v : Vector ) return boolean is
tmp : List;
v2 : Link_to_Vector;
begin
tmp := l;
while not Is_Null(tmp) loop
v2 := Head_Of(tmp);
if Equal(v2.all,v)
then return true;
else tmp := Tail_Of(tmp);
end if;
end loop;
return false;
end Is_In;
function Is_In ( l : List; v : Link_to_Vector ) return boolean is
begin
if v = null
then return false;
else return Is_In(l,v.all);
end if;
end Is_In;
function Sub_List ( l1,l2 : List ) return boolean is
tmp : List := l1;
begin
while not Is_Null(tmp) loop
if not Is_In(l2,Head_Of(tmp))
then return false;
else tmp := Tail_Of(tmp);
end if;
end loop;
return true;
end Sub_List;
function Equal ( l1,l2 : List ) return boolean is
begin
if not Sub_List(l1,l2)
then return false;
elsif not Sub_List(l2,l1)
then return false;
else return true;
end if;
end Equal;
-- DESTRUCTORS :
procedure Deep_Clear ( l : in out List ) is
tmp : List;
v : Link_to_Vector;
begin
tmp := l;
while not Is_Null(tmp) loop
v := Head_Of(tmp);
Clear(v);
tmp := Tail_Of(tmp);
end loop;
Shallow_Clear(l);
end Deep_Clear;
procedure Shallow_Clear ( l : in out List ) is
begin
Vector_Lists.Clear(Vector_Lists.List(l));
end Shallow_Clear;
end Generic_Lists_of_Vectors;