#line 715 "/home/travis/build/felix-lang/felix/src/packages/lists.fdoc"
Purely functional Random Access List.
Based on design from Okasaki, Purely Functional Datastructures.
Transcribed from Hongwei Xi's encoding for ATS2 library.
//\$ An ralist provides O(log N) indexed access and amortised
O(1) consing. This is roughly the closest thing to
purely functional array available.

class Ralist
{

Auxilliary data structure.
union pt[a] = | N1 of a | N2 of pt[a] * pt[a];

Type of an ralist.
union ralist[a] =
| RAnil
| RAevn of ralist[a]
| RAodd of pt[a] * ralist[a]
;

Length of an ralist.
fun ralist_length[a] : ralist[a] -> int =
| #RAnil => 0
| RAevn xxs => 2 * ralist_length xxs
| RAodd (_,xxs) => 2 * ralist_length xxs + 1
;

private fun cons[a] // O(1), amortized
(x0: pt[a], xs: ralist[a]): ralist [a] =>
match xs with
| #RAnil => RAodd (x0, RAnil[a])
| RAevn xxs => RAodd (x0, xxs)
| RAodd (x1, xxs) =>
let x0x1 = N2 (x0, x1) in
RAevn (cons (x0x1, xxs) )
endmatch  ;

Cons: new list with extra value at the head.
fun ralist_cons[a] (x:a, xs: ralist[a]) =>
cons (N1 x, xs)
;

Check for an empty list.
fun ralist_empty[a]: ralist[a] -> bool  =
| #RAnil => true
| _ => false
;

private proc uncons[a] (xs: ralist[a], phd: &pt[a], ptl: &ralist[a])
{
match xs with
| RAevn xss =>
var nxx: pt[a];
var xxs: ralist[a];
uncons (xss,&nxx, &xxs);
match nxx with
| N2(x0,x1) =>
phd <- x0;
ptl <- RAodd (x1,xxs);
endmatch;

| RAodd (x0,xss) =>
phd <- x0;
match xss with
| #RAnil => ptl <- RAnil[a];
| _ => ptl <- RAevn xss;
endmatch;
endmatch;
}

Proedure to split a non-empty ralist
into a head element and a tail.
proc ralist_uncons[a] (xs: ralist[a], phd: &a, ptl: &ralist[a])
{
var nx: pt[a];
uncons (xs, &nx, ptl);
match nx with
| N1 (x1) => phd <- x1;
endmatch;
}

User define pattern matching support
fun _match_ctor_Cons[T] (x:ralist[T]) =>not ( ralist_empty x);
fun _match_ctor_Empty[T] (x:ralist[T]) => ralist_empty x;

fun _ctor_arg_Cons[T] (x:ralist[T]) : T * ralist[T] =
{
var elt : T;
var tail : ralist[T];
ralist_uncons (x, &elt, &tail);
return elt,tail;
}

Head element of a non-empty ralist.
fun ralist_head[a] (xs: ralist[a]) : a =
{
var nx: a;
var xxs: ralist[a];
ralist_uncons (xs, &nx, &xxs);
return nx;
}

Tail list of a non-empty ralist.
fun ralist_tail[a] (xs: ralist[a]) : ralist[a] =
{
var nx: a;
var xxs: ralist[a];
ralist_uncons (xs, &nx, &xxs);
return xxs;
}

private fun lookup[a]
(
xs: ralist [a],
i: int
) : pt[a] =>
match xs with
| RAevn xxs =>
let x01 = lookup (xxs, i/2) in
if i % 2 == 0 then
let N2 (x0, _) = x01 in x0
else
let N2 (_, x1) = x01 in x1
endif

| RAodd (x, xxs) =>
if i == 0 then x else
let x01 = lookup (xxs, (i - 1)/2) in
if i % 2 == 0 then
let N2 (_, x1) = x01 in x1
else
let N2 (x0, _) = x01 in x0
endif
endif
endmatch
;

fun ralist_lookup[a] (xs:ralist[a],i:int)=>
let N1 x = lookup (xs,i) in x
;

private fun fupdate[a]
(
xs: ralist[a] ,
i:int,
f: pt[a] -> pt[a]
) : ralist[a] =>
match xs with
| RAevn (xxs) => RAevn (fupdate2 (xxs, i, f))
| RAodd (x, xxs) =>
if i == 0 then RAodd (f x, xxs)
else RAodd (x, fupdate2 (xxs, i - 1, f))
endif
endmatch
;

private fun fupdate2[a]
(
xxs: ralist[a],
i: int,
f: pt[a] -> pt[a]
) : ralist[a] =>
if i % 2 == 0 then
let f1 =
fun (xx: pt[a]): pt[a] =>
let N2 (x0, x1) = xx in N2 (f x0, x1)
in
fupdate (xxs, i / 2, f1)
else
let f1 =
fun (xx: pt[a]): pt[a] =>
let N2 (x0, x1) = xx in N2 (x0, f x1)
in
fupdate (xxs, i / 2, f1)
;

Return a list with the i'th element replaced by x0.
Index is unchecked.
fun ralist_update[a] (xs:ralist[a], i:int, x0:a) =>
let f = fun (z:pt[a]) : pt[a] => N1 x0 in
fupdate (xs,i,f)
;

private proc foreach[a]
(
xs: ralist[a],
f: pt[a] -> void
)
{
match xs with
| RAevn (xxs) => foreach2 (xxs, f);
| RAodd (x, xxs) =>
f x;
match xxs with
| #RAnil => ;
| _ => foreach2 (xxs, f);
endmatch;
| #RAnil => ;
endmatch;
}

private proc foreach2[a]
(
xxs: ralist[a],
f: pt[a] -> void
)
{
var f1 =
proc (xx: pt[a]) {
match xx with
| N2 (x0, x1) => f (x0); f (x1);
endmatch;
}
;
foreach (xxs, f1);
}

Callback based iteration.
Apply procedure to each element of the ralist.
proc ralist_foreach[a]
(
xs: ralist[a],
f: a -> void
)
{
var f2 =
proc (x:pt[a]) {
match x with
| N1 y => f y;
endmatch;
}
;
foreach (xs, f2);
}

Convert ralist to a string.
instance[a with Str[a]] Str[ralist[a]]
{
fun str (xx: ralist[a]):string = {
var xs = xx;
var x: a;
var s = "";
while not ralist_empty xs do
ralist_uncons (xs,&x,&xs);
s += (if s != "" then "," else "") + str x;
done
return s;
}
}

// TODO: list membership, folds, etc
}