# sparse-rw-vector.pkg
# Dynamic (sparse) rw_vector that uses hashing
#
# -- Allen Leung
# Compiled by:
# src/lib/std/standard.libstipulate
package lst = list; # list is from src/lib/std/src/list.pkg package rov = vector; # vector is from src/lib/std/src/vector.pkg package rwv = rw_vector; # rw_vector is from src/lib/std/src/rw-vector.pkgherein
package sparse_rw_vector
: (weak)
api {
include api Rw_Vector; # Rw_Vector is from src/lib/std/src/rw-vector.api make_rw_vector' : (Int, (Int -> X)) -> Rw_Vector(X);
make_rw_vector'': (Int, (Int -> X)) -> Rw_Vector(X);
remove: (Rw_Vector(X), Int) -> Void;
clear: Rw_Vector(X) -> Void;
dom: Rw_Vector(X) -> List( Int );
copy_rw_vector: Rw_Vector(X) -> Rw_Vector(X);
}
{
Default(X) = VVV(X)
| FFF Int -> X
| UUU Int -> X
;
Rw_Vector(X)
=
RW_VECTOR (Ref( rwv::Rw_Vector( List ((Int, X)) ) ), Default(X), Ref( Int ), Ref( Int ));
Vector(X) = rov::Vector(X);
maximum_vector_length = rwv::maximum_vector_length;
fun make_rw_vector (n, d) = RW_VECTOR (REF (rwv::make_rw_vector (16,[])), VVV d, REF n, REF 0);
fun make_rw_vector' (n, f) = RW_VECTOR (REF (rwv::make_rw_vector (16,[])), FFF f, REF n, REF 0);
fun make_rw_vector''(n, f) = RW_VECTOR (REF (rwv::make_rw_vector (16,[])), UUU f, REF n, REF 0);
fun clear (RW_VECTOR (r, d, n, c))
=
{ r := rwv::make_rw_vector (16,[]);
n := 0;
c := 0;
};
fun roundsize n
=
loop 1
where
fun loop i
=
if (i >= n) i;
else loop (i+i);
fi;
end;
fun copy_rw_vector (RW_VECTOR (REF from, d, REF n, REF c))
=
{ into = rwv::make_rw_vector (n,[]);
#
rwv::copy { from, into, at=>0 };
#
RW_VECTOR (REF into, d, REF n, REF c);
};
itow = unt::from_int;
wtoi = unt::to_int_x;
fun index (v, i)
=
wtoi (unt::bitwise_and (itow i, itow (rwv::length v - 1)));
fun from_fn (n, f)
=
{ nnn = n*n+1;
nnn = if (nnn < 16 ) 16; else roundsize nnn;fi;
v = rwv::make_rw_vector (nnn,[]);
fun ins i
=
{ pos = index (v, i);
x = f i;
rwv::set (v, pos, (i, x) ! rwv::get (v, pos)); x;
};
fun insert 0 => ins 0;
insert i => { ins i; insert (i - 1); };
end;
if (n < 0) RW_VECTOR (REF v, FFF (\\ _ = raise exception INDEX_OUT_OF_BOUNDS), REF 0, REF 0);
else RW_VECTOR (REF v, VVV (insert (n - 1)), REF n, REF n);
fi;
};
fun from_list l
=
{ n = length l;
nnn = n*n+1;
nnn = if (nnn < 16 ) 16; else roundsize nnn;fi;
v = rwv::make_rw_vector (nnn,[]);
fun ins (i, x)
=
{ pos = index (v, i);
#
rwv::set (v, pos, (i, x) ! rwv::get (v, pos)); x;
};
fun insert (i,[]) => FFF (\\ _ = raise exception INDEX_OUT_OF_BOUNDS);
insert (i,[x]) => VVV (ins (i, x));
insert (i, x ! l) => { ins (i, x); insert (i+1, l);};
end;
RW_VECTOR (REF v, insert (0, l), REF n, REF n);
};
fun length (RW_VECTOR(_, _, REF n, _))
=
n;
fun get (v' as RW_VECTOR (REF v, d, _, _), i)
=
search (rwv::get (v, pos))
where
pos = index (v, i);
fun search []
=>
case d
#
VVV d => d;
FFF f => f i;
UUU f => { x = f i;
set (v', i, x);
x;
};
esac;
search ((j, x) ! l)
=>
if (i == j ) x; else search l;fi;
end;
end
also
fun set (v' as RW_VECTOR (REF v, _, n, s as REF size), i, x)
=
{ nnn = rwv::length v;
pos = index (v, i);
fun change ([], l)
=>
if (size + size >= nnn)
#
grow (v', i, x);
else
s := size + 1;
rwv::set (v, pos, (i, x) ! l);
fi;
change ((y as (j, _)) ! l', l)
=>
if (j == i) rwv::set (v, pos, (i, x) ! l'@l);
else change (l', y ! l);
fi;
end;
change (rwv::get (v, pos),[]);
if (i >= *n) n := i+1; fi;
}
also
fun grow (RW_VECTOR (v' as REF v, _, _, _), i, x)
=
{ nnn = rwv::length v;
nnn' = nnn+nnn;
v'' = rwv::make_rw_vector (nnn',[]);
fun insert (i, x)
=
{ pos = index (v'', i);
rwv::set (v'', pos, (i, x) ! rwv::get (v'', pos));
};
rwv::apply (lst::apply insert) v;
insert (i, x);
v' := v'';
};
# Note: The (_[]) enables 'vec[index]' notation;
# The (_[]:=) enables 'vec[index] := value' notation;
(_[]) = get;
fun remove (v' as RW_VECTOR (REF v, _, n, s as REF size), i)
=
change (rwv::get (v, pos),[])
where
nnn = rwv::length v;
pos = index (v, i);
fun change ([], _) => ();
#
change ((y as (j, _)) ! l', l)
=>
if (j == i)
#
s := size - 1;
rwv::set (v, pos, l'@l);
else
change (l', y ! l);
fi;
end;
end;
# These seem bogus since they do not run in order
#
fun keyed_apply f (RW_VECTOR (REF v, _, REF n, _))
=
rwv::apply (lst::apply f) v;
fun apply f (RW_VECTOR (REF v, _, _, _))
=
rwv::apply (lst::apply (\\ (_, x) => f x; end )) v;
fun copy { from, into, at }
=
keyed_apply (\\ (i, x) = set (into, at + i, x)) from;
fun copy_vector { from, into, at }
=
rov::keyed_apply (\\ (i, x) = set (into, at + i, x)) from;
# These seem bogus since they do not run in order
#
fun keyed_fold_forward f e (RW_VECTOR (REF v, _, _, _))
=
rwv::fold_forward (\\ (l, e) = lst::fold_forward (\\ ((i, x), e) = f (i, x, e)) e l) e v;
fun keyed_fold_backward f e (RW_VECTOR (REF v, _, _, _))
=
rwv::fold_backward (\\ (l, e) = lst::fold_backward (\\ ((i, x), e) = f (i, x, e)) e l) e v;
fun fold_forward f e (RW_VECTOR (REF v, _, _, _))
=
rwv::fold_forward (\\ (l, e) = lst::fold_forward (\\ ((_, x), e) = f (x, e)) e l) e v;
fun fold_backward f e (RW_VECTOR (REF v, _, _, _))
=
rwv::fold_backward (\\ (l, e) = lst::fold_backward (\\ ((_, x), e) = f (x, e)) e l) e v;
fun keyed_map_in_place f (RW_VECTOR (REF v, _, _, _))
=
rwv::map_in_place (lst::map (\\ (i, x) = (i, f (i, x)))) v;
fun map_in_place f (RW_VECTOR (REF v, _, _, _))
=
rwv::map_in_place (lst::map (\\ (i, x) = (i, f x))) v;
fun dom (RW_VECTOR (REF v, _, _, _))
=
rwv::fold_forward
( \\ (e, l)
=
lst::fold_backward
(\\ ((i, _), l) = i ! l)
l
e
)
[]
v;
fun keyed_find p (RW_VECTOR (REF v, _, _, _))
=
fnd 0
where
len = rwv::length v;
fun fnd i
=
if (i >= len)
#
NULL;
else
case (lst::find p (rwv::get (v, i)))
#
NULL => fnd (i + 1);
some => some;
esac;
fi;
end;
fun find p (RW_VECTOR (REF v, _, _, _))
=
fnd 0
where
len = rwv::length v;
fun fnd i
=
if (i >= len)
#
NULL;
else
case (lst::find (p o #2) (rwv::get (v, i)))
#
THE (_, x) => THE x;
NULL => fnd (i + 1);
esac;
fi;
end;
fun exists p v
=
not_null (find p v);
fun all p v
=
not (not_null (find (not o p) v));
fun compare_sequences _ _
=
raise exception DIE "sparse_rw_vector::compare_sequences unimplemented";
fun to_vector v
=
rov::from_list (reverse (fold_forward (!) [] v));
(_[]:=) = set;
};
end;