Package: src/packages/arrays.fdoc
Arrays¶
key | file |
---|---|
array_class.flx | share/lib/std/datatype/array_class.flx |
array.flx | share/lib/std/datatype/array.flx |
varray.flx | share/lib/std/datatype/varray.flx |
darray.flx | share/lib/std/datatype/darray.flx |
sarray.flx | share/lib/std/datatype/sarray.flx |
bsarray.flx | share/lib/std/datatype/bsarray.flx |
Array Abstactions.¶
We specify two core array abstractions: arrays as values and arrays as objects.
Array Value.¶
The ArrayValue class construes an array as a value, that is, a purely functional, immutable data structure characterised by two properties: its length, and a way to fetch a value from the array using a integral index.
Many routines can be written using only these two functions.
Note: an array is not intrinsically a Container
because that
would require it to also be a Set
, which in turn requires
a membership operator which would require some standard
comparison. Arrays don’t come equipped with a comparison.
//[array_class.flx]
//$ Array as Value (immutable).
class ArrayValue[t,v]
{
The length of the array.
//[array_class.flx]
//$ Length.
virtual fun len: t -> size;
Performance routine to fetch the n’th element of an array without any bounds checking.
//[array_class.flx]
//$ Unchecked common indexing.
virtual fun unsafe_get: t * size -> v;
//[array_class.flx]
//$ Checked common indexing.
fun get[I in ints] (x:t, i:I) = {
assert i.size < x.len;
return unsafe_get (x,i.size);
}
The following methods depend only on the implementation
of the core methods. Most are either simple remaps
to provide more convenient nottion, or we use
virtual function so that the default definitions
can be replaced by a more efficient implemention
for some particular types.
We use the special lookup rules for provided by
the apply
function so that an application of
an integer to an array is translated into a
call on the get method:
n a -> get (a,n) a. n -> n a -> get (a,n)
Note that the more usual reverse application using
operator dot .
is also made available this way.
//[array_class.flx]
//$ Checked common indexing.
fun apply [I in ints] (i:I, x:t) => get (x,i.size);
//[array_class.flx]
//$ Callback based value iterator.
virtual proc iter (_f:v->void) (x:t) {
val n = x.len;
if n > 0uz do
for var i:size in 0uz upto n - 1uz do
_f$ unsafe_get(x,i);
done
done
}
//[array_class.flx]
//$ Callback based index and value iterator.
//$ Callback f index value.
virtual proc iiter (_f:size -> v->void) (x:t) {
val n = x.len;
if n > 0uz do
for var i:size in 0uz upto n - 1uz do
_f i (x,i).unsafe_get;
done
done
}
Class Streamable
provides a set of functions based
on a generated named iterator
which returns an
infinite stream of option values. Loops based on such
streams work with any Streamable
data type,
including ArrayValue
.
Such loops operate by providing the loop body with the
argument of the Some
constructor of the option type
obtained by a call to a closure of the iterator
generator.
When that object finally returns None
to signal the end
of data, the loop terminates.
//[array_class.flx]
instance Iterable[t,v] {
//$ Stream value iterator.
gen iterator(xs:t) () : opt[v] =
{
if xs.len > 0uz do
for var j in 0uz upto xs.len - 1uz do
yield Some (xs,j).unsafe_get;
done
done
return None[v];
}
}
inherit Streamable[t,v];
This HOF folds the values in an array into an accumulator using the supplied function. The scan is left to right.
//[array_class.flx]
//$ Traditional left fold.
virtual fun fold_left[u] (_f:u->v->u) (init:u) (x:t): u = {
var o = init;
val n = x.len;
if n > 0uz do
for var i:size in 0uz upto n - 1uz do
o = _f o (unsafe_get(x,i));
done
done
return o;
}
This HOF folds the values in an array into an accumulator using the supplied function. The scan is right to left.
//[array_class.flx]
//$ Traditional right fold.
virtual fun fold_right[u] (_f:v->u->u) (x:t) (init:u): u = {
var o = init;
val n = x.len;
if n > 0uz do
for var i:size in n - 1uz downto 0uz do
o = _f (unsafe_get(x,i)) o;
done
done
return o;
}
This HOF folds array array into an accumulator using an associative user supplied function. Associative here means that the order in which the fold is done does not matter. This constraint is currently not checked. The default order is a left fold but the function is virtual and may be replaced by another more efficient ordering in an overriding function.
//[array_class.flx]
virtual fun fold[u] (_f:u->v->u) (init:u) (x:t): u =>
fold_left _f init x
;
This function searches an array for a value that satifies the given predicate and returns a boolean value indicating whether one exists.
//[array_class.flx]
//$ Membership by predicate.
virtual fun mem(pred:v->bool) (x:t): bool = {
val n = x.len;
if n > 0uz do
for var i:size in 0uz upto n - 1uz do
if pred(unsafe_get(x,i)) do
return true;
done
done
done
return false;
}
This function searches an array for a value i
that stands
in the specified relation rel
to a given value v
,
where the relation is applied in that order: rel(i,v)
.
The usual relation to use is equality.
//[array_class.flx]
//$ Membership by relation to given value.
virtual fun mem[u] (rel:v*u->bool) (x:t) (e:u): bool =>
mem (fun (i:v) => rel(i, e)) x
;
This function uses the default equality operator Eq[v]::==
for
the array value type t to perform a search.
//[array_class.flx]
//$ Array as Set:
//$ Membership by equality of value type.
instance[with Eq[v]] Set[t,v] {
fun \in (elt:v, a:t) => mem eq of (v * v) a elt;
}
inherit[t,v with Eq[v]] Set[t,v];
Same as our mem
function except it returns the located value
as an option type.
//[array_class.flx]
//$ Searching for value satisfying predicate.
virtual fun find(pred:v->bool) (x:t): opt[v] = {
val n = x.len;
if n > 0uz do
for var i:size in 0uz upto n - 1uz do
if pred(unsafe_get(x,i)) do
return Some$ unsafe_get(x,i);
done
done
done
return None[v];
}
Same as our mem
function except it returns the located value
as an option type.
//[array_class.flx ]
//$ Searching for value satisfying relation to given value.
virtual fun find (rel:v*v->bool) (x:t) (e:v): opt[v] = {
val n = x.len;
if n > 0uz do
for var i:size in 0uz upto n - 1uz do
if rel(unsafe_get (x,i), e) do
return Some$ unsafe_get (x,i);
done
done
done
return None[v];
}
//[array_class.flx]
fun \sum [with FloatAddgrp[v]] (it:t) =
{
var init = #zero[v];
for v in it do init = init + v; done
return init;
}
//[array_class.flx]
fun \prod[with FloatMultSemi1[v]] (it:t) =
{
var init = #one[v];
for v in it do init = init * v; done
return init;
}
Should have a functional update? Find methods should have directions. Search method should really be instances of a class derived from Set. Find functions should have a version that also returns the index.
//[array_class.flx]
}
True Arrays.¶
This is an attempt to represent arrays in a more precise setting. Ordinary arrays just use integer indexes. But a true array uses a precise type as the index, an it must provide a value for all possible values of the index. As such, bounds checks are not required.
This work is incomplete.
//[array_class.flx]
class TrueArrayValue [t,x,v]
{
inherit ArrayValue[t,v];
virtual fun render : x -> size;
fun true_unsafe_get (a:t, i:x) => unsafe_get (a, render i);
}
Array Object.¶
The ArrayObject class extends the capabilities of an ArrayValue by allowing mutation. A mutable array is typically abstract and represented by a pointer, so it also uses pass by reference.
//[array_class.flx]
//$ Array as Object (mutable).
class ArrayObject[t,v]
{
inherit ArrayValue[t,v];
Modify an array object at a given index position by assigning a new value without a bounds check.
//[array_class.flx]
// Unsafe store value into array by common index.
virtual proc unsafe_set: t * size * v;
Note this is problematic as it forces a value to addressabe be stored as an object. A bitarray will not satisfy this requirement. Do we need another abstraction?
//[array_class.flx]
virtual fun unsafe_get_ref : t * size -> &v;
Modify an array object by assigning a new value to the slot at a given index position. Bounds checked.
//[array_class.flx]
// Checked store value into array by common index.
proc set[I in ints] (x:t, i:I, a:v) {
assert i.size < x.len; unsafe_set (x,i.size,a);
}
//[array_class.flx]
fun n"&." [I in ints] (x:t, i:I) : &v = {
assert i.size < x.len;
return unsafe_get_ref (x,i.size);
}
}
True Array Object.¶
Incomplete work for arrays in a more precise setting where the index type is fixed.
//[array_class.flx]
class TrueArrayObject[t,x, v]
{
inherit TrueArrayValue[t,x,v];
inherit ArrayObject[t,v];
proc true_unsafe_set(a:t, i:x, e:v) => unsafe_set (a, render i, e);
}
Contiguous Arrays.¶
A contiguous array is one for which the store is certain to be contiguous and admits scanning the array directly using a pointer.
Two methods, stl_begin
and stl_end
provide
pointers to the first element and one past the
location of the last element, for traditional
STL like array operations. These pointers have
type +v
where v
is the element type. The named
type carray[v]
is an alias for +v
.
//[array_class.flx]
//$ Array as Contiguous STL Object.
//$ Provides STL iterators type +v
class ContiguousArrayObject[t,v]
{
inherit ArrayObject[t,v];
//[array_class.flx]
//$ Start of array iterator.
virtual fun stl_begin: t -> +v;
//$ One past the end of array iterator.
virtual fun stl_end: t -> +v;
We allow adding an integer to an array object to yield an incrementable pointer to that element.
//[array_class.flx]
//$ Add integer to iterator.
fun + [I in ints] (pa:t, i:I) : carray [v] = {
assert i.size < pa.len;
return pa.stl_begin + i.size;
}
In place sort the contents of a contiuous array using STL sort and a supplied comparator, which must be a total order.
//[array_class.flx]
//$ In place sort using STL sort with Felix comparator.
proc sort (cmp: v * v -> bool) (a:t) {
var first = a.stl_begin;
var last = a.stl_end;
var z = Sort::stl_comparator (cmp);
Sort::stl_sort (z,first,last);
}
Inplace sort using default comparator.
//[array_class.flx]
//$ In place sort using STL sort with default comparison.
proc sort[with Tord[v]] (a:t) => sort (< of (v*v)) a;
}
True Contiguous Array Object.¶
A contiguous array in a more precise setting. Incomplete.
//[array_class.flx]
class TrueContiguousArrayObject[t,x, v]
{
inherit TrueArrayObject [t,x,v];
inherit ContiguousArrayObject[t,v];
fun + (pa:t, i:x) : carray [v] => pa + render i;
}
Array¶
//[array.flx]
//$ Compile time fix length array.
open class Farray
{
typedef array[t,n] = t ^ n;
//ctor[T,N] array[T,N] (x:array[T,N]) => x;
//$ Array copy.
fun copy[T,N] (var x:array[T,N]) => x;
//$ Array of one element.
ctor[T] array[T,1] (x:T) => x :>> array[T,1];
//$ Array as value.
instance[t,n] ArrayValue[array[t,n], t] {
fun len (x:array[t, n]): size => Typing::arrayindexcount[n];
fun unsafe_get (var a: array[t, n], j: size): t => a . (j :>> n);
}
//$ Pointer to array as value.
instance[t,n] ArrayValue[&array[t,n], &t] {
fun len (x:&array[t, n]): size => Typing::arrayindexcount[n];
fun unsafe_get (var a: &array[t, n], j: size) : &t => a.(aproj (j :>> n) of (&(t^n)));
}
//$ Pointer to array as value.
instance[t,n] ArrayValue[&array[t,n], _pclt<array[t,n],t>] {
fun len (x:&array[t, n]): size => Typing::arrayindexcount[n];
fun unsafe_get (var a: &array[t, n], j: size) : _pclt<array[t,n],t> => a.(aproj (j :>> n) of (&(t^n)));
}
//$ Compact Linear Pointer to array as value.
instance[t,n] ArrayValue[_pclt<array[t,n],t>, _pclt<array[t,n],t>] {
fun len (x:&array[t, n]): size => Typing::arrayindexcount[n];
fun unsafe_get (var a: &array[t, n], j: size) => a.(aproj (j :>> n) of (&(t^n)));
}
// this one should
proc unsafe_set[t,n] (a: &(t^n), i:size, v:t) { a . (i.int) <- v; }
proc set[t,n, I in ints] (a: &array[t,n], i:I,v:t) {
assert i.size < (*a).len;
unsafe_set (a,i.size,v);
}
// these cannot work for compact linear arrays
fun stl_begin[t,n]: &array[t,n] -> +t = "(?1*)($1->data)";
fun stl_end[t,n] ( x:&array[t,n] ) : +t => stl_begin x + x*.len;
//$ Array map.
fun map[V,N,U] (_f:V->U) (x:array[V,N]):array[U,N] = {
var o : array[U,N];
val n = x.len;
if n > 0uz
for var i: size in 0uz upto n - 1uz
call set (&o,i, _f x.i)
;
return o;
}
// not very efficient!
fun rev_map[V,N,U] (_f:V->U) (x:array[V,N]):array[U,N] =>
rev (map _f x)
;
// Note: for many loops below, note we're using unsigned values
// iterating from 0 to N-1. Subtraction N-1 fails for n == 0
// so we need a special test.
//$ Join two arrays (functional).
fun join[T, N:UNITSUM, M:UNITSUM] (x:array[T, N]) (y:array[T, M]):array[T, N `+ M] = {
var o : array[T, N `+ M];
if x.len > 0uz
for var i in 0uz upto len(x) - 1uz
call set (&o, i,x.i)
;
i = x.len;
if y.len > 0uz
for var k in 0uz upto len(y) - 1uz
call set(&o,i + k, y.k)
;
return o;
}
// this routine SHOULD check FIRST + LEN <= N
// we can perform that calculation now .. but there's no way yet to assert it
// we can, actually, add it as a constraint ..
// but we want the constraint to fail on monomorphisation
// NOT during overload resolution .. because that would just reject
// the candidate and lead to a not found error instead of a constraint violation error....
fun subarray[
FIRST:UNITSUM,
LEN:UNITSUM,
T,
N:UNITSUM,
K:UNITSUM=_unitsum_min(LEN, N `- FIRST)
]
(a:T^N) : T ^ K
=
{
var o : T ^ K;
for i in ..[K] do
var first = Typing::arrayindexcount[FIRST].int;
var outix = caseno i;
var inpix = (first + outix) :>> N; // checked at run time?
&o.i <- a.inpix;
done
return o;
}
//$ Append value to end of an array (functional).
fun join[T, N:UNITSUM] (x:array[T, N]) (y:T):array[T, N `+ 1] = {
var o : array[T, N `+ 1];
if x.len > 0uz
for var i in 0uz upto len(x) - 1uz
call set (&o, i,x.i)
;
set(&o,x.len, y);
return o;
}
//$ Prepand value to start of an array (functional).
fun join[T, M:UNITSUM] (x:T) (y:array[T, M]):array[T, 1 `+ M] = {
var o : array[T, 1 `+ M];
set (&o, 0, x);
if y.len > 0uz
for var k in 0uz upto len(y) - 1uz
call set(&o,1uz + k, y.k)
;
return o;
}
//$ Join two arrays (functional).
// will probably clash with tuple joining functions if we implement them
fun + [T, N:UNITSUM, M:UNITSUM] (x:array[T, N], y:array[T, M]):array[T, N `+ M] => join x y;
//$ Transpose and array.
//$ Subsumes zip.
//$ Example: transpose ( (1,2,3), (4,5,6) ) = ( (1,4), (2,5), (3,6) ).
fun transpose[T,N,M] (y:array[array[T,M],N]) : array[array[T,N],M] = {
var o : array[array[T,N],M];
var n = len y;
var m = len y.0;
for var i in 0uz upto n - 1uz
for var j in 0uz upto m - 1uz do
val pfirst : +array[T,N] = &o.stl_begin;
val psub: +array[T,N] = pfirst + j;
val pelt : +T = psub.stl_begin;
set(pelt,i, y.i.j);
done
return o;
}
//$ Reverse elements of an array.
fun rev[T, N] (x:array[T, N]): array[T, N] = {
var o : array[T, N];
var n = len x;
if n > 0uz
for var i:size in 0uz upto n - 1uz
call set(&o,n - 1uz - i, x.i)
;
return o;
}
fun sort[T,N] (cmp: T * T -> bool) (var x:array[T,N]) : array[T,N] = {
Sort::stl_sort (Sort::stl_comparator cmp, stl_begin (&x), stl_end (&x));
return x;
}
fun sort[T,N] (var x:array[T,N]) : array[T,N] = {
Sort::stl_sort (stl_begin (&x), stl_end (&x));
return x;
}
//$ Display: convert to string like (1,2,3).
instance[T,N with Show[T]] Str[array[T, N]] {
fun str (xs:array[T,N]) = {
var o = '(';
val n = xs.len;
if n > 0uz do
o += repr xs.0;
for var i:size in 1uz upto n - 1uz
perform o += ', ' + repr xs.i
;
done
return o + ')';
}
}
//$ Equality and Inequality.
instance[T,N with Eq[T]] Eq[array[T, N]] {
fun == (xs:array[T,N],ys:array[T,N]) = {
val n = xs.len;
// assert n == ys.len;
if n == 0uz do
return true;
else
for var i:size in 0uz upto n - 1uz
if not (xs.i == ys.i) return false;
done
return true;
}
}
//$ Lexicographical total order based on
//$ total order of elements.
instance[T,N with Tord[T]] Tord[array[T,N]] {
fun < (xs:array[T,N],ys:array[T,N]) = {
val n = xs.len;
if n == 0uz return false;
// assert n == ys.len;
var i:size;
ph1:for i in 0uz upto n - 1uz
if not (xs.i < ys.i) break ph1;
for i in i upto n - 1uz
if not (xs.i <= ys.i) return false;
return true;
}
}
}
open[T,N] Eq[array[T,N]];
open[T,N] Tord[array[T,N]];
open[T,N with Eq[T]] Set[array[T,N],T];
open[T,N] ArrayValue[array[T,N], T];
open[T,N] ArrayValue[&array[T,N], &T];
Varray¶
//[varray.flx]
//$ Bounded Variable length arrays, bound set at construction time.
//$ A bound of 0 is allowed, the result is a NULL pointer.
open class Varray
{
//$ A varray is just a pointer.
//$ The current length and bound are maintained by the GC.
_gc_pointer type varray[t] = "?1*";
//$ An ordinary carray, but owned by the GC.
ctor[t] carray[t] : varray[t] = "$1";
//$ Create an empty varray with the given bound.
ctor[t] varray[t]: size =
"(?1*)(PTF gcp->collector->create_empty_array(&@?1,$1))"
requires property "needs_gc"
;
//$ Raw memory initialisation (really, this belongs in C_hack).
private proc _init[T]: &T * T = "new((void*)$1) ?1($2);";
//$ Construct a varray filled up with a default value.
ctor[t] varray[t] (bound:size, default:t) = {
var o = varray[t] bound;
if o.maxlen != bound do
eprintln$ "Constructor failed, wrong bound";
eprintln$ "input Bound = " + bound.str + ", actual maxlen = " + o.maxlen.str;
done
if bound > 0uz do for var i in 0uz upto bound - 1uz do
if o.len >= o.maxlen do
eprintln ("ctor1: attempt to push_back on full varray size " + o.maxlen.str);
eprintln$ "bound = " + bound.str;
eprintln$ "index = " + i.str;
done
push_back(o, default);
done done
return o;
}
//$ Construct a partially filled varray with a default value computed by a function.
ctor[t] varray[t] (bound:size, used:size, f:size->t when used <= bound) = {
var o = varray[t] bound;
if used > 0uz do for var i in 0uz upto used - 1uz do
if o.len >= o.maxlen do
eprintln ("ctor2: attempt to push_back on full varray size " + o.maxlen.str);
done
push_back(o, f i);
done done
return o;
}
//$ Construct a full varray from an array.
// funny, the N isn't explicitly used.
ctor[t,N] varray[t] (x:array[t,N]) =>
varray[t] (len x, len x, (fun (i:size):t =>x.i))
;
//$ Construct a partially full varray from a varray.
ctor[t] varray[t] (x:varray[t], maxlen:size) =>
varray[t] (maxlen, min(maxlen,len x), (fun (i:size):t=> x.i))
;
//$ Construct a full varray from a varray (copy constructor).
ctor[t] varray[t] (x:varray[t]) =>
varray[t] (len x, len x, (fun (i:size):t=> x.i))
;
// Construct a varray from a list
ctor[t] varray[t] (x:list[t]) = {
val n = x.len.size;
var a = varray[t] n;
iter (proc (v:t) {
if a.len >= a.maxlen do
eprintln ("ctor3: attempt to push_back on full varray size " + a.maxlen.str);
done
push_back(a,v);
}) x;
return a;
}
//$ Construct a varray from a string.
//$ Include a trailing nul byte.
ctor varray[char] (var x:string) = {
var n = x.len;
var v = varray[char] (n + 1uz);
var p = &x.stl_begin;
var q = v.stl_begin;
Memory::memcpy (q.address, p.address, n);
set(q,n, char "");
set_used (v,n + 1uz);
return v;
}
//$ Construct a varray from a string.
//$ Exclude trailing nul byte.
fun varray_nonul (var x:string) = {
var n = x.len;
var v = varray[char] (n);
var q = v.stl_begin;
var p = &x.stl_begin;
Memory::memcpy (q.address, p.address, n);
set_used (v,n);
return v;
}
private proc set_used[t]: varray[t] * size =
"PTF gcp->collector->set_used($1,$2);"
requires property "needs_gc"
;
//$ Treat a varray as an ArrayValue.
instance[v] ArrayValue[varray[v],v] {
//$ Length of a varray (used).
fun len: varray[v] -> size =
"PTF gcp->collector->get_used($1)"
requires property "needs_gc"
;
//$ Unsafe get value at position.
fun unsafe_get: varray[v] * size -> v = "$1[$2]";
}
//$ Treat a varray as an ArrayObject.
//$ Allows modifications.
instance[v] ArrayObject[varray[v],v] {
//$ Store the given value at the given position.
proc unsafe_set: varray[v] * size * v = "$1[$2]=$3;";
fun unsafe_get_ref: varray[v] * size -> &v = "$1+$2";
}
//$ Treat a varray as a ContiguousArrayObject.
instance[v] ContiguousArrayObject[varray[v],v] {
//$ STL iterator to start of array.
fun stl_begin: varray[v] -> +v = "$1";
//$ STL iterator to end of array.
fun stl_end: varray[v] -> +v = "($1+PTF gcp->collector->get_used($1))";
}
//$ Get the bound of a varray.
fun maxlen[t]: varray[t] -> size =
"PTF gcp->collector->get_count($1)"
requires property "needs_gc"
;
//$ Append a new element to the end of a varray.
//$ Aborts if you go past the bound.
proc += [t] (pa:&varray[t],v:t) {
if pa*.len >= pa*.maxlen do
eprintln ("attempt to += on full varray size " + (pa*.maxlen).str);
done
push_back (*pa,v);
}
//$ Append a new element to the end of a varray.
//$ Aborts if you go past the bound.
proc _push_back[t] : varray[t] * t = """
{
//?1 * _p = *$1;
size_t n = PTF gcp->collector->get_used($1);
PTF gcp->collector->incr_used($1,1L);
new($1+n) ?1($2);
}
"""
requires property "needs_gc"
;
proc push_back[t] (x: varray[t], v: t)
{
if x.len >= x.maxlen do
eprintln ("attempt to push_back on full varray size " + x.maxlen.str);
done
_push_back (x,v);
}
proc push_back[t] (x:varray[t]) (v:t) => push_back(x,v);
//$ Pop an element off the end of a varray.
//$ Aborts if the array is empty.
proc pop_back[t] : varray[t] = """
{ // pop varray
?1 * _p = $1;
size_t n = PTF gcp->collector->get_used(_p);
PTF gcp->collector->incr_used(_p,-1L);
destroy(_p+n-1); // from flx_compiler_support_bodies
}
"""
requires property "needs_gc";
;
//$ Erase elements of array between and including first and last.
//$ Include first and last, intersect with array span.
//$ Cannot fail.
proc erase[v] (a:varray[v], first:int, last:int)
{
if first > last return;
var l = a.len.int;
var b = if first < 0 then 0 else first;
var e = if last >= l then l - 1 else last;
var d = e - b + 1;
if d > 0 do
for var i in b upto l - d - 1 do
unsafe_set (a, i.size, unsafe_get (a, size (i + d)));
done
var s : carray[v] = a.stl_begin;
for i in l - d upto l - 1 do
var p : carray[v] = s + i;
C_hack::destroy$ -p;
done
set_used$ a, (l - d).size;
done
}
proc erase[v] (a:varray[v], i:int) => erase (a,i,i);
//$ insert (a,i,v) inserts v in a at position i
//$ that is, inserts before element i.
//$ If i is negative, position relative to end,
//$ that is, -1 is last element, so insert (a,-1,v)
//$ inserts before the last element (not after!)
//$ If i equals the length, element is appended.
//$ If the index is out of range, nothing happens.
proc insert[t] (a:varray[t], i:int, v:t)
{
var l = a.len.int;
var n = a.maxlen.int;
if l == n return; // fail: no space
var ix = if i < 0 then l - i else i;
if ix < 0 or ix > l return; // fail: bad index
if ix == l do
if a.len >= a.maxlen do
eprintln ("insert: attempt to push_back on full varray size " + a.maxlen.str);
done
push_back (a,v);
else
assert l > 0;
if a.len >= a.maxlen do
eprintln ("insert: attempt to push_back on full varray size " + a.maxlen.str);
done
push_back (a, a.(l - 1)); // dups last element
if l - 2 > ix do
for var j in l - 2 downto ix do // copy from second last pos
unsafe_set (a, j.size + 1uz, unsafe_get (a, j.size));
done
done
unsafe_set (a, ix.size, v);
done
}
fun apply[T] (x:slice[int], v:varray[T]) {
var minr = max (min x,0);
var maxr = min (max x,v.len.int - 1);
var out = varray[T] (maxr - minr + 1).size;
for var i in minr upto maxr perform
out.push_back v.i;
return out;
}
//$ Traditional map varray to varray.
fun map[T, U] (_f:T->U) (x:varray[T]): varray[U] = {
var o = varray[U]$ len(x);
if len x > 0uz do for var i in 0uz upto len(x) - 1uz do
if o.len >= o.maxlen do
eprintln ("insert: attempt to push_back on full varray size " + o.maxlen.str);
done
push_back (o, _f x.i);
done done
return o;
}
//$ R like operations
fun rop[T] (op:T * T -> T) (x:varray[T], y:varray[T]) : varray[T] =>
let n = x.len in
let m = y.len in
if m == 0uz or n == 0uz then varray[T](0uz) else
let l = max(n,m) in
let fun g (i:size): T => op (x.(i%n), y.(i%m)) in
varray[T] (l,l,g)
;
}
instance[T with Show[T]] Str[Varray::varray[T]] {
//$ Convert a varray[T] to a string.
//$ Requires Show[T]
fun str (xs:varray[T]) = {
var o = 'varray(';
if len xs > 0uz do
o += repr xs.0;
for var i in 1uz upto len xs - 1uz do
o += ', ' + repr xs.i;
done
done
return o + ')';
}
}
//$ Treat varray as Set.
instance[T with Eq[T]] Set[varray[T],T] {
//$ Check is a value is stored in a varray.
fun \in (x:T, a:varray[T]) : bool = {
if len a > 0uz do
for var i in 0uz upto len a - 1uz do
if a.i == x do return true; done
done
done
return false;
}
}
open[T] Show[Varray::varray[T]];
open[T] Set[Varray::varray[T],T];
open[T] ArrayValue[varray[T], T];
open[T] ArrayObject[varray[T], T];
open[T] ContiguousArrayObject[varray[T], T];
Darray¶
//[darray.flx]
<code>darray</code>: an array with dynamic, unbounded length.¶
A darray
is a contiguous store of variable, unbounded length.
It is implemented by a pointer to a varray
. When the varray
becomes
full, a new one with a large bound is created, the contents of
the old array copied over, and the old array forgotten.
Similarly when the varray
is not sufficiently full,
a new varray
of smaller extent is allocated and the contents
of the old array copied over, and the old array is forgotten.
A user specifiable function is used to control the threshholds for and amount of expansion and contraction. The user function defines the amortised performance. With higher expansion factors, O(1) speed is obtained at the cost of a lot of memory wastage.
//[darray.flx]
//$ Unbounded Variable length object array.
open class Darray
{
Representation¶
We use a control block darray_ctl
to store the data
required to access a darray
, it contains a
varray and a resize
function.
The resize function takes two arguments: the current varray
bound and the requested amount of store. It returns a
recommended amount of store.
//[darray.flx]
private struct darray_ctl[T]
{
a: varray[T];
resize: size * size --> size;
}
Default resize function.¶
This function increases the bound to 150% of the requested size when the requested size exceeds the current bound.
It decreases the current bound to 150% of the requested size if the requested size is less that 50% of the current bound.
There is a hard minimum of 20 elements except in the special case the array is empty, when the size is set to 0.
//[darray.flx]
//$ This is the default array resize function.
//$ If we run out of space, allocate what we have + 50%.
//$ If we need less than half the allocated space, return the requested size + 50%.
//$ Otherwise return the existing allocated space.
cfun dflt_resize(old_max:size, requested:size):size=
{
// GOTCHA: don't forget that division has a higher precedence than multiplication!
// sensible minimum size of 20, except if zero length
if requested == 0uz return 0uz;
if requested < 20uz return 20uz;
if requested < old_max / 2uz return (3uz * requested) / 2uz;
if requested > old_max return (requested * 3uz) / 2uz;
return old_max;
}
:code:`darray` type.
We define darray
as a pointer to a darray control block darray_ctl
.
This means, in particular, that darray
is passed by reference.
The definition is abstract, so the client us not able to fiddle with
the underlying control block.
//[darray.flx]
//$ Type of a darray.
type darray[T] = new &darray_ctl[T];
Force a resize of the bound.¶
This procedure forcibly resizes a darray to a new bound. The number of use elements is the maximum of the old number of elements and the new bound.
This procedure is analogous to the C++ string reserve
function,
however it is primarily intended for internal use. If this function
is called the new bound will be adjusted on the next size changing
operation such as a push_back
or pop_back
.
//[darray.flx]
//$ Force a resize.
//$ Similar to C++ vector reserve function.
proc do_resize[T] (pd: darray[T], new_size: size)
{
var old = (_repr_ pd)*.a;
(_repr_ pd).a <- varray[T] (new_size, (len old), (fun(i:size)=>old.i));
}
Constructors.¶
//[darray.flx]
//$ Make an empty darray, give it 20 slots for no particular reason.
ctor[T] darray[T] () =>
_make_darray[T]$ new darray_ctl[T](varray[T] 20uz , dflt_resize);
//$ Make a darray from an array
ctor[T,N] darray[T] (a:array[T,N]) =>
_make_darray[T]$ new darray_ctl[T]( varray[T] a, dflt_resize);
//$ Make a darray from a varray
ctor[T] darray[T] (a:varray[T]) =>
_make_darray[T]$ new darray_ctl[T]( varray[T] a, dflt_resize);
//$ Make a darray from a darray (copy)
ctor[T] darray[T] (a:darray[T]) => darray ((_repr_ a)*.a);
//$ make a darray of a certain size initialised with some default value
ctor[T] darray[T] (n:size, default:T) => darray[T] (varray[T](n,default));
As a value.¶
//[darray.flx]
//$ Basic array value stuff.
instance[v] ArrayValue[darray[v],v] {
fun len (a:darray[v])=> len (_repr_ a)*.a;
fun unsafe_get (a:darray[v], i:size) => (_repr_ a)*.a.i;
}
As an object.¶
//[darray.flx]
//$ Basic array object stuff.
instance[v] ArrayObject[darray[v],v] {
proc unsafe_set (b:darray[v], n:size, x:v) => unsafe_set ((_repr_ b)*.a,n,x);
fun unsafe_get_ref (b:darray[v], n:size) : &v => unsafe_get_ref ((_repr_ b)*.a,n);
}
As an contiguous array.¶
//[darray.flx]
//$ Contrue as contiguous store.
instance[v] ContiguousArrayObject[darray[v],v] {
fun stl_begin(b:darray[v]) => stl_begin b._repr_*.a;
fun stl_end(b:darray[v]) => stl_end b._repr_*.a;
}
Size changing mutators.¶
There’s no push_front
but there should be.
Generally, this class is very incomplete.
//[darray.flx]
//$ Pop a value from the end.
//$ Same as pop_back in C++.
proc pop_back[t](a:darray[t]) {
pop_back (_repr_ a)*.a;
newsize := (_repr_ a)*.resize (maxlen (_repr_ a)*.a, len (_repr_ a)*.a);
if newsize != maxlen (_repr_ a)*.a call do_resize (a,newsize);
}
//$ Push a value onto the end.
//$ Same as push_back in C++.
proc += [t] (a:&darray[t],v:t) {
push_back (*a, v);
}
//$ Push a value onto the end.
//$ Same as push_back in C++.
proc push_back[t] (a:darray[t], v:t) {
r := _repr_ a;
newsize := r*.resize (maxlen r*.a, len r*.a + 1uz);
if newsize != maxlen r*.a call do_resize(a,newsize);
if r*.a.len >= r*.a.maxlen do
eprintln ("darray push_back: attempt to push_back on full varray size " + r*.a.maxlen.str);
done
push_back (r*.a, v); // hack to workaround compiler error Address non variable
}
//$ insert
proc insert[t] (a:darray[t], i:int, v:t)
{
var r = _repr_ a;
newsize := r*.resize (maxlen r*.a, len r*.a + 1uz);
if newsize != maxlen r*.a call do_resize(a,newsize);
r = _repr_ a;
insert (r*.a,i,v);
}
//$ Erase an element, note doesn't resize the varray,
//$ probably should ..
proc erase[t] (a:darray[t], i:int) => erase ((_repr_ a)*.a,i);
//$ Erase multiple elements, note doesn't resize the varray,
//$ probably should ..
proc erase[t] (a:darray[t], first:int, last:int) =>
erase ((_repr_ a)*.a, first,last);
Slice¶
//[darray.flx]
fun apply[T] (x:slice[int], v:darray[T]) {
var minr = max (min x,0);
var maxr = min (max x,v.len.int - 1);
var out = varray[T] (maxr - minr + 1).size;
for var i in minr upto maxr perform
out.push_back v.i;
return darray out;
}
Convert a darray to a string.¶
//[darray.flx]
// uses _repr_ so has to be in the module
instance[T with Show[T]] Str[Darray::darray[T]] {
//$ Convert an array to a string,
//$ provided the element type is convertible.
fun str (x:darray[T])=> str (_repr_ x)*.a;
}
Enable map on darray objects.¶
//[darray.flx]
//$ Traditional map darray to darray.
fun map[T, U] (_f:T->U) (arr:darray[T]): darray[U] = {
var o = darray[U]();
if arr.len > 0uz do
for var i in 0uz upto arr.len - 1uz do
push_back (o, _f arr.i);
done
done
return o;
}
Enable filter on darray objects¶
//[darray.flx]
//$ Return a sub list with elements satisfying the given predicate.
fun filter[T] (P:T -> bool) (arr:darray[T]) : darray[T] =
{
var o = darray[T]();
if arr.len > 0uz do
for var i in 0uz upto arr.len - 1uz do
if (P(arr.i)) do
push_back (o, arr.i);
done
done
done
return o;
}
}
As a set¶
Should be in main class body.
//[darray.flx]
//$ Construe a darray as a Set.
instance[T with Eq[T]] Set[darray[T],T] {
//$ element membership test.
fun \in (x:T, a:darray[T]) : bool = {
for var i in 0uz upto len a -1uz
if a.i == x return true
;
return false;
}
}
open[T] Show[Darray::darray[T]];
open[T] Set[Darray::darray[T],T];
open[T] ArrayValue[darray[T], T];
open[T] ArrayObject[darray[T], T];
open[T] ContiguousArrayObject[darray[T], T];
Sarray¶
//[sarray.flx]
//$ Unbounded sparse psuedo-array sarray.
//$ This data type is not a real array because it has no bounds
//$ and therefore cannot support iteration.
open class Sarray
{
open Judy;
private struct sarray_ctl[T] { a: darray[T]; j:JLArray; free:J1Array; dflt:T; };
//$ Type of a sarray.
type sarray[T] = new &sarray_ctl[T];
//$ Construct an infinite sarray with all values set to the given default.
ctor[T] sarray[T] (dflt:T) => _make_sarray[T]$ new sarray_ctl[T] (darray[T](), JLArray(), J1Array(),dflt);
//$ Get the value at the given position.
fun get[T] (a:sarray[T], i:size) : T = {
var pk: &word;
var e: JError_t;
JudyLGet ( (_repr_ a)*.j, i.word, &e, &pk);
var r = if C_hack::isNULL pk then (_repr_ a)*.dflt else (_repr_ a)*.a.(size(*pk));
return r;
}
//$ Set the given value at the given position.
proc set[T] (a:sarray[T], i:size, v:T) {
var pk: &word;
var e: JError_t;
JudyLGet ( (_repr_ a)*.j, i.word, &e, &pk); // see if already in array
if C_hack::isNULL pk do
var idx: word = word 0;
var b: int;
Judy1First((_repr_ a)*.free,&idx,&e,&b); // try to find a free slot
if b == 0 do // none?
idx = word (len (_repr_ a)*.a);
push_back ((_repr_ a)*.a, v); // then push onto array end
else
Judy1Unset((_repr_ a)*.free,idx,&e,&b); // remove free slot from free set
set ((_repr_ a)*.a,size idx,v); // store value
done
JudyLIns ( (_repr_ a)*.j,i.word, &e, &pk); // add new index to j mapping
pk <- idx;
else
set ((_repr_ a)*.a, size (*pk), v);
done
}
//$ Replace the value at a given position with the default.
proc del[T] (a:sarray[T], i:size) {
var pk: &word;
var e: JError_t;
JudyLGet ( (_repr_ a)*.j, i.word, &e, &pk); // see if already in array
if not C_hack::isNULL pk do // if it is
var b:int;
Judy1Set ((_repr_ a)*.free, i.word, &e, &b); // add slot to free set
set ( (_repr_ a)*.a, pk*.size, (_repr_ a)*.dflt); // replace old value with default
done
}
//$ Pack a sparse array.
//$ This is an optimisation with no semantics.
//$ Reorganises the sarray to reduce memory use and optimise lookup.
//$
// Make a new varray with max number
// of elements in the j mapping, then fill it in order
// of the j mapping, replacing the j value with the new index
// finally replace the original darray with a new one made
// from the constructed varray: this is packed and in sequence
proc pack[T] (a:sarray[T]) {
r := _repr_ a;
var e: JError_t;
var n: word;
JudyLCount (r*.j, word 0, word (-1ul), &e, &n);
var x = varray[T] n.size;
var index = word 0;
var i = 0ul; // slot index for new array
var slot : &word;
JudyLFirst(r*.j, &index, &e, &slot);
while not isNULL slot do
push_back (x, r*.a.((*slot).size));
slot <- i.word; ++i;
JudyLNext(r*.j, &index, &e, &slot);
done
var m : word;
Judy1FreeArray(r*.free,&e,&m);
//println$ m.ulong.str + " bytes freed --> counted "+n.ulong.str;
r.a <- darray x;
}
}
Bsarray¶
//[bsarray.flx]
//$ Bounded sparse array.
//$ Basically a sarray with a given bound.
//$ The bound is ignored for get and set methods.
//$ The bound is used for membership tests and iteration.
include "std/datatype/sarray";
open class Bsarray
{
private struct bsarray_ctl[T] { a: sarray[T]; n:size; };
type bsarray[T] = new &bsarray_ctl[T];
//$ Contruct with default value and bound.
ctor[T,I in ints] bsarray[T] (dflt:T, bound:I) =>
_make_bsarray[T]$ new bsarray_ctl[T] (sarray[T](dflt), bound.size)
;
//$ Contrue as array value.
instance[T] ArrayValue[bsarray[T],T] {
fun len(b:bsarray[T])=> (_repr_ b)*.n;
fun unsafe_get(b:bsarray[T], i:size)=> get ((_repr_ b)*.a, i);
}
//$ Contrue as array object.
instance[T] ArrayObject[bsarray[T],T] {
proc unsafe_set(b:bsarray[T], i:size, v:T)=> set ((_repr_ b)*.a, i, v);
}
//$ Contrue as set: membership test.
instance[T with Eq[T]] Set[bsarray[T],T] {
// FIX ME: inefficient!
fun \in (x:T, a:bsarray[T]) : bool = {
if len a > 0uz
for var i in 0uz upto len a - 1uz
if a.i == x return true
;
return false;
}
}
instance[T with Show[T]] Str[Bsarray::bsarray[T]] {
//$ Convert to string.
fun str (xs:bsarray[T]) = {
var o = 'bsarray(';
if len xs > 0uz do
o += repr xs.0;
for var i in 1uz upto len xs - 1uz do
o += ', ' + repr xs.i;
done
done
return o + ')';
}
}
}
open[T] Show[Bsarray::bsarray[T]];
open[T] Set[Bsarray::bsarray[T],T];
open[T] ArrayValue[bsarray[T], T];
open[T] ArrayObject[bsarray[T], T];
open[T] ContiguousArrayObject[bsarray[T], T];