ExpandCollapse

+ 1 Array Abstactions.

We specify two core array abstractions: arrays as values and arrays as objects.

+ 1.1 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. 

share/lib/std/datatype/array_class.flx

  Array as Value (immutable).
  class ArrayValue[t,v]
  {

+ 1.1.1 Core methods.

+ 1.1.1.1 Array length len.

The length of the array. 

share/lib/std/datatype/array_class.flx

    Length.
    virtual fun len: t -> size;

+ 1.1.1.2 Get element by index unsafe_get.

Performance routine to fetch the n'th element of an array without any bounds checking. 

share/lib/std/datatype/array_class.flx

    Unchecked common indexing.
    virtual fun unsafe_get: t * size -> v;

+ 1.1.1.3 Get element by index with bound check: get.

share/lib/std/datatype/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);
    }

+ 1.1.2 Derived methods.

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.

+ 1.1.2.1 Projection function wrapper.

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. 

share/lib/std/datatype/array_class.flx

  
     Checked common indexing.
    fun apply [I in ints] (i:I, x:t) => get (x,i.size);

+ 1.1.2.2 Callback based value iterator iter.

share/lib/std/datatype/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
    }

+ 1.1.2.3 Callback based index and value iterator iiter.

share/lib/std/datatype/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
    }

+ 1.1.2.4 Streaming iterator iterator.

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. 

share/lib/std/datatype/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];

+ 1.1.2.5 Callback based left fold fold_left.

This HOF folds the values in an array into an accumulator using the supplied function. The scan is left to right. 

share/lib/std/datatype/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;
    }

+ 1.1.2.6 Callback based right fold fold_right.

This HOF folds the values in an array into an accumulator using the supplied function. The scan is right to left. 

share/lib/std/datatype/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;
    }

+ 1.1.2.7 Callback base fold fold

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. 

share/lib/std/datatype/array_class.flx

    virtual fun fold[u] (_f:u->v->u) (init:u) (x:t): u => 
      fold_left _f init x
    ;

+ 1.1.2.8 Value search by predicate mem.

This function searches an array for a value that satifies the given predicate and returns a boolean value indicating whether one exists. 

share/lib/std/datatype/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;
    }

+ 1.1.2.9 Value search by relation to given value mem.

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. 

share/lib/std/datatype/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
    ;

+ 1.1.2.10 Value search by default equality in.

This function uses the default equality operator Eq[v]::== for the array value type t to perform a search. 

share/lib/std/datatype/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];

+ 1.1.2.11 Value find and return using predicate find

Same as our mem function except it returns the located value as an option type. 

share/lib/std/datatype/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];
    }

+ 1.1.2.12 Value find and return using relation find

Same as our mem function except it returns the located value as an option type. 

share/lib/std/datatype/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];
    }

+ 1.1.2.13 Sum

share/lib/std/datatype/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;
    }

+ 1.1.2.14 Product

share/lib/std/datatype/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;
    }

+ 1.1.2.15 Missing.

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. 

share/lib/std/datatype/array_class.flx

  }

+ 1.2 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. 

share/lib/std/datatype/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);
  }

+ 1.3 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. 

share/lib/std/datatype/array_class.flx

  Array as Object (mutable).
  class ArrayObject[t,v]
  {
    inherit ArrayValue[t,v];

+ 1.3.1 Storing a value with unsafe_set.

Modify an array object at a given index position by assigning a new value without a bounds check. 

share/lib/std/datatype/array_class.flx

    // Unsafe store value into array by common index.
    virtual proc unsafe_set: t * size * v;

+ 1.3.2 Fetching a pointer to an element with unsafe_get_ref.

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? 

share/lib/std/datatype/array_class.flx

    virtual fun unsafe_get_ref : t * size -> &v;

+ 1.3.3 Storing a value with set.

Modify an array object by assigning a new value to the slot at a given index position. Bounds checked. 

share/lib/std/datatype/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); 
    }

+ 1.3.4 Getting a pointer to an array element.

share/lib/std/datatype/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); 
    }
  }

+ 1.4 True Array Object.

Incomplete work for arrays in a more precise setting where the index type is fixed. 

share/lib/std/datatype/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);
  }

+ 1.5 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. 

share/lib/std/datatype/array_class.flx

  Array as Contiguous STL Object.
  Provides STL iterators type +v
  class ContiguousArrayObject[t,v]
  {
    inherit ArrayObject[t,v];

+ 1.5.1 The stl_begin and stl_end methods.

share/lib/std/datatype/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;

+ 1.5.2 A pointer to an element by index +.

We allow adding an integer to an array object to yield an incrementable pointer to that element. 

share/lib/std/datatype/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; 
    }

+ 1.5.3 Sort method using supplied comparator sort.

In place sort the contents of a contiuous array using STL sort and a supplied comparator, which must be a total order. 

share/lib/std/datatype/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);
    }

+ 1.5.4 Sort method using default comparator sort.

Inplace sort using default comparator. 

share/lib/std/datatype/array_class.flx

    In place sort using STL sort with default comparison.
    proc sort[with Tord[v]] (a:t) => sort (< of (v*v)) a;
  
  }

+ 1.6 True Contiguous Array Object.

A contiguous array in a more precise setting. Incomplete. 

share/lib/std/datatype/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;
  }

+ 2 Array

share/lib/std/datatype/array.flx

  
  Compile time fix length array.
  open class Farray
  {
    typedef array[t,n:COMPACTLINEAR] = t ^ n;
  
    //ctor[T,N] array[T,N] (x:array[T,N]) => x;
  
    Array copy.
    fun copy[T,N:COMPACTLINEAR] (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:COMPACTLINEAR] 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:COMPACTLINEAR] 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:COMPACTLINEAR] 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:COMPACTLINEAR] 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:COMPACTLINEAR] (a: &(t^n), i:size, v:t) { a . (i.int) <- v; }
  
    proc set[t,n:COMPACTLINEAR, 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:COMPACTLINEAR]: &array[t,n] -> +t = "(?1*)($1->data)";
    fun stl_end[t,n:COMPACTLINEAR] ( x:&array[t,n] ) : +t => stl_begin x + x*.len;
  
    Array map.
    fun map[V,N:COMPACTLINEAR,U] (_f:V->U) (x:array[V,N]):array[U,N] = {
      var o : array[U,N];
      C_hack::ignore(&o); // fool use before init algo
      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:COMPACTLINEAR,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];
      C_hack::ignore(&o); // fool use before init algo
      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
    = 
    {
      C_hack::ignore(&o); // fool use before init algo
      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];
      C_hack::ignore(&o); // fool use before init algo
  
      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:COMPACTLINEAR,M:COMPACTLINEAR] (y:array[array[T,M],N]) : array[array[T,N],M] = {
      var o : array[array[T,N],M];
      C_hack::ignore(&o); // fool use before init algo
      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:COMPACTLINEAR] (x:array[T, N]): array[T, N] = {
      var o : array[T, N];
      var n = len x;
      C_hack::ignore(&o); // to fool use before init
      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:COMPACTLINEAR] (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:COMPACTLINEAR] (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:COMPACTLINEAR 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:COMPACTLINEAR 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:COMPACTLINEAR 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:COMPACTLINEAR] Eq[array[T,N]];
  open[T,N:COMPACTLINEAR] Tord[array[T,N]];
  open[T,N:COMPACTLINEAR with Eq[T]] Set[array[T,N],T];
  
  open[T,N:COMPACTLINEAR] ArrayValue[array[T,N], T];
  open[T,N:COMPACTLINEAR] ArrayValue[&array[T,N], &T];

+ 3 Varray

share/lib/std/datatype/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:COMPACTLINEAR] 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)
    ;
  
    fun as_list[T] (x:varray[T]): List::list[T]  {
      var y = List::Empty[T];
      for elt in x perform y = List::Snoc(y,elt);
      return y.rev.unbox; 
    }
  }
  
  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];

+ 4 Darray

share/lib/std/datatype/darray.flx

+ 5 darray: 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. 

share/lib/std/datatype/darray.flx

  Unbounded Variable length object array.
  open class Darray
  {

+ 5.1 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. 

share/lib/std/datatype/darray.flx

    private struct darray_ctl[T]
    {
      a: varray[T];
      resize: size * size --> size;
    }

+ 5.2 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. 

share/lib/std/datatype/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;
    }

+ 5.3 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. 

share/lib/std/datatype/darray.flx

    Type of a darray.
    type darray[T] = new &darray_ctl[T];

+ 5.4 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. 

share/lib/std/datatype/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));
    }

+ 5.5 Constructors.

share/lib/std/datatype/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:UNITSUM] 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));

+ 5.6 As a value.

share/lib/std/datatype/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;
    }

+ 5.7 As an object.

share/lib/std/datatype/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);
    }

+ 5.8 As an contiguous array.

share/lib/std/datatype/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;
    }

+ 5.9 Size changing mutators.

There's no push_front but there should be. Generally, this class is very incomplete. 

share/lib/std/datatype/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);

+ 5.10 Slice

share/lib/std/datatype/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;
    }

+ 5.11 Convert a darray to a string.

share/lib/std/datatype/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;
    }

+ 5.12 Enable map on darray objects.

share/lib/std/datatype/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;
    }

+ 5.13 Enable filter on darray objects

share/lib/std/datatype/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;
    }
  
  
  }

+ 5.14 As a set

Should be in main class body. 

share/lib/std/datatype/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];

+ 6 Sarray

share/lib/std/datatype/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;
    }
  }

+ 7 Bsarray

share/lib/std/datatype/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];