From e5803404034018421fbf587cc496f8b0c91c994c Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Tue, 22 Jul 2014 00:04:32 +0200
Subject: [PATCH] big upgrade of RAL (random access lists)

---
 misc/RAL.ml  | 68 ++++++++++++++++++++++++++++++++++++++++++++++------
 misc/RAL.mli | 28 +++++++++++++++++++---
 2 files changed, 86 insertions(+), 10 deletions(-)

diff --git a/misc/RAL.ml b/misc/RAL.ml
index dcb57e93..f1b3f7ca 100644
--- a/misc/RAL.ml
+++ b/misc/RAL.ml
@@ -33,6 +33,9 @@ type +'a tree =
 and +'a t = (int * 'a tree) list
   (** Functional array of complete trees *)
 
+(* TODO: inline list's nodes
+  TODO: encode "complete binary tree" into types *)
+
 
 (** {2 Functions on trees} *)
 
@@ -62,6 +65,8 @@ let rec tree_update size t i v =match t, i with
 
 let empty = []
 
+let return x = [1, Leaf x]
+
 let is_empty = function
   | [] -> true
   | _ -> false
@@ -95,24 +100,52 @@ let tl l = match l with
     let size' = size / 2 in
     (size', t1) :: (size', t2) :: l'
 
+let front l = match l with
+  | [] -> None
+  | (_, Leaf x) :: tl -> Some (x, tl)
+  | (size, Node (x, t1, t2)) :: l' ->
+    let size' = size / 2 in
+    Some (x, (size', t1) :: (size', t2) :: l')
+
+let front_exn l = match l with
+  | [] -> raise (Invalid_argument "RAL.front")
+  | (_, Leaf x) :: tl -> x, tl
+  | (size, Node (x, t1, t2)) :: l' ->
+    let size' = size / 2 in
+    x, (size', t1) :: (size', t2) :: l'
+
+let rec _remove prefix l i =
+  let x, l' = front_exn l in
+  if i=0
+    then List.fold_left (fun l x -> cons x l) l prefix
+    else _remove (x::prefix) l' (i-1)
+
+let remove l i = _remove [] l i
+
+let rec _map_tree f t = match t with
+  | Leaf x -> Leaf (f x)
+  | Node (x, l, r) -> Node (f x, _map_tree f l, _map_tree f r)
+
+let map f l = List.map (fun (i,t) -> i, _map_tree f t) l
+
 let rec length l = match l with
   | [] -> 0
   | (size,_) :: l' -> size + length l'
 
-let rec iter l f = match l with
+let rec iter f l = match l with
   | [] -> ()
-  | (_, Leaf x) :: l' -> f x; iter l' f
-  | (_, t) :: l' -> iter_tree t f; iter l' f
+  | (_, Leaf x) :: l' -> f x; iter f l'
+  | (_, t) :: l' -> iter_tree t f; iter f l'
 and iter_tree t f = match t with
   | Leaf x -> f x
   | Node (x, t1, t2) -> f x; iter_tree t1 f; iter_tree t2 f
 
-let rec fold l acc f = match l with
+let rec fold f acc l = match l with
   | [] -> acc
-  | (_, Leaf x) :: l' -> fold l' (f acc x) f
+  | (_, Leaf x) :: l' -> fold f (f acc x) l'
   | (_, t) :: l' ->
     let acc' = fold_tree t acc f in
-    fold l' acc' f
+    fold f acc' l'
 and fold_tree t acc f = match t with
   | Leaf x -> f acc x
   | Node (x, t1, t2) ->
@@ -120,6 +153,27 @@ and fold_tree t acc f = match t with
     let acc = fold_tree t1 acc f in
     fold_tree t2 acc f
 
+let rec fold_rev f acc l = match l with
+  | [] -> acc
+  | (_, Leaf x) :: l' -> f (fold f acc l') x
+  | (_, t) :: l' ->
+    let acc = fold_rev f acc l' in
+    fold_tree_rev t acc f
+and fold_tree_rev t acc f = match t with
+  | Leaf x -> f acc x
+  | Node (x, t1, t2) ->
+    let acc = fold_tree_rev t2 acc f in
+    let acc = fold_tree_rev t1 acc f in
+    f acc x
+
+let append l1 l2 = fold_rev (fun l2 x -> cons x l2) l2 l1
+
 let of_list l = List.fold_right cons l empty
 
-let to_list l = List.rev (fold l [] (fun l x -> x :: l))
+let rec of_list_map f l = match l with
+  | [] -> empty
+  | x::l' ->
+      let y = f x in
+      cons y (of_list_map f l')
+
+let to_list l = List.rev (fold (fun l x -> x :: l) [] l)
diff --git a/misc/RAL.mli b/misc/RAL.mli
index 31dc223e..daca6d0b 100644
--- a/misc/RAL.mli
+++ b/misc/RAL.mli
@@ -43,13 +43,26 @@ val is_empty : _ t -> bool
 val cons : 'a -> 'a t -> 'a t
   (** Add an element at the front of the list *)
 
+val return : 'a -> 'a t
+
+val map : ('a -> 'b) -> 'a t -> 'b t
+  (** Map on elements *)
+
 val hd : 'a t -> 'a
-  (** First element of the list, or @raise Invalid_argument if the list is empty *)
+  (** First element of the list, or
+      @raise Invalid_argument if the list is empty *)
 
 val tl : 'a t -> 'a t
   (** Remove the first element from the list,
       or @raise Invalid_argument if the list is empty *)
 
+val front : 'a t -> ('a * 'a t) option
+  (** Remove and return the first element of the list *)
+
+val front_exn : 'a t -> 'a * 'a t
+  (** Unsafe version of {!front}.
+      @raise Invalid_argument if the list is empty *)
+
 val length : 'a t -> int
   (** Number of elements *)
 
@@ -61,13 +74,22 @@ val set : 'a t -> int -> 'a -> 'a t
   (** [set l i v] sets the [i]-th element of the list to [v]. O(log(n)).
       @raise Invalid_argument if the list has less than [i+1] elements. *)
 
-val iter : 'a t -> ('a -> unit) -> unit
+val remove : 'a t -> int -> 'a t
+  (** [remove l i] removes the [i]-th element of [v].
+      @raise Invalid_argument if the list has less than [i+1] elements. *)
+
+val append : 'a t -> 'a t -> 'a t
+
+val iter : ('a -> unit) -> 'a t -> unit
   (** Iterate on the list's elements *)
 
-val fold : 'a t -> 'b -> ('b -> 'a -> 'b) -> 'b
+val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
   (** Fold on the list's elements *)
 
 val of_list : 'a list -> 'a t
   (** Convert a list to a RAL. {b Caution}: non tail-rec *)
 
+val of_list_map : ('a -> 'b) -> 'a list -> 'b t
+  (** Combination of {!of_list} and {!map} *)
+
 val to_list : 'a t -> 'a list