## binary-random-access-list.pkg
## Random Access Lists (due to Chris Okasaki)
##
## -- Allen Leung
#
# Random access lists combine list-style head/tail
# access with the ability to efficiently access any
# list element by number.
#
# This implementation of them is inspired by binary
# numbers, and comes from Chris Okasaki's seminal book
# "Purely Functional Data Structures" Section 9.2.1 (p119)
# Compiled by:
# src/lib/std/standard.lib# Compare with:
# src/lib/src/red-black-numbered-list.pkg ### "Fifty years into the First Computing Era
### some of us in the computing arena have come
### to realize we've made a false start, and for
### us to finally be able to produce lasting,
### correct, beautiful, usable, scalable, enjoyable
### software that stands the tests of time and
### moral human endeavor, we need to start over."
###
### -- Richard P Gabriel
package binary_random_access_list: Random_Access_List # Random_Access_List is from src/lib/src/random-access-list.api{
Tree(X)
= LEAF X
| NODE ((Tree(X), X, Tree(X)));
Random_Access_List(X)
=
List( (Int, Tree(X) ) );
fun tree_get (LEAF x, 0, _) => x;
tree_get (LEAF _, _, _) => raise exception INDEX_OUT_OF_BOUNDS;
tree_get (NODE(_, x, _), 0, _) => x;
tree_get (NODE (l, x, r), i, n)
=>
{ n' = n / 2;
if (i <= n' ) tree_get (l, i - 1, n');
else tree_get (r, i - 1 - n', n'); fi;
};
end;
fun tree_set (LEAF _, 0, x, _) => LEAF x;
tree_set (LEAF _, _, _, _) => raise exception INDEX_OUT_OF_BOUNDS;
tree_set (NODE (l, _, r), 0, x, _) => NODE (l, x, r);
tree_set (NODE (l, y, r), i, x, n)
=>
{ n' = n / 2;
if (i <= n' ) NODE (tree_set (l, i - 1, x, n'), y, r);
else NODE (l, y, tree_set (r, i - 1 - n', x, n')); fi;
};
end;
empty = [];
fun null [] => TRUE;
null _ => FALSE;
end;
fun length rl
=
f (rl, 0)
where
fun f ([], n) => n;
f ((m, _) ! l, n) => f (l, m+n);
end;
end;
fun cons (x, rl as ((m, t) ! (n, u) ! l))
=>
if (m == n) (m+n+1, NODE (t, x, u)) ! l;
else (1, LEAF x) ! rl;
fi;
cons (x, rl)
=>
(1, LEAF x) ! rl;
end;
fun head ((_, LEAF x) ! _) => x;
head ((_, NODE(_, x, _)) ! _) => x;
head [] => raise exception EMPTY;
end;
fun tail ((_, LEAF x) ! rl)
=>
rl;
tail ((n, NODE (l, x, r)) ! rl)
=>
{ n' = n / 2;
(n', l) ! (n', r) ! rl;
};
tail []
=>
raise exception EMPTY;
end;
fun get ([], _)
=>
raise exception INDEX_OUT_OF_BOUNDS;
get ((n, t) ! rl, i)
=>
if (i < n) tree_get (t, i, n);
else get (rl, i-n);
fi;
end;
fun set ([], _, _)
=>
raise exception INDEX_OUT_OF_BOUNDS;
set ((p as (n, t)) ! rl, i, x)
=>
if (i < n) (n, tree_set (t, i, x, n)) ! rl;
else p ! set (rl, i-n, x);
fi;
end;
fun map f rl
=
list::map (\\ (n, t) = (n, g t)) rl
where
fun g (LEAF x) => LEAF (f x);
g (NODE (l, x, r)) => NODE (g l, f x, g r);
end;
end;
fun apply f rl
=
list::apply (\\ (_, t) = g t) rl
where
fun g (LEAF x)
=>
f x;
g (NODE (l, x, r))
=>
{ f x;
g l;
g r;
};
end;
end;
fun fold_forward f u rl
=
list::fold_forward (\\ ((_, t), x) = g (t, x)) u rl
where
fun g (LEAF x, u) => f (x, u);
g (NODE (l, x, r), u) => g (r, g (l, f (x, u)));
end;
end;
fun fold_backward f u rl
=
list::fold_backward (\\ ((_, t), x) = g (t, x)) u rl
where
fun g (LEAF x, u) => f (x, u);
g (NODE (l, x, r), u) => f (x, g (l, g (r, u)));
end;
end;
fun from_list l = list::fold_backward cons empty l;
fun to_list rl = fold_backward (!) [] rl;
};