From 9ebf44d84754adc5b64fcf612c6816c02c80462d Mon Sep 17 00:00:00 2001
From: Benjamin Barenblat <bbaren@debian.org>
Date: Sat, 2 Feb 2019 19:29:23 -0500
Subject: Imported Upstream version 8.9.0

---
 clib/cArray.ml    |  300 +++++++++----
 clib/cArray.mli   |   84 +++-
 clib/cList.ml     | 1217 ++++++++++++++++++++++++++++++-----------------------
 clib/cList.mli    |  380 ++++++++++++-----
 clib/cMap.ml      |   58 ++-
 clib/cMap.mli     |   13 +-
 clib/canary.ml    |   28 --
 clib/canary.mli   |   27 --
 clib/clib.mllib   |    3 +-
 clib/diff2.ml     |  158 +++++++
 clib/diff2.mli    |  101 +++++
 clib/dyn.ml       |  194 +++++----
 clib/dyn.mli      |   63 +--
 clib/hMap.ml      |   20 +-
 clib/hashcons.ml  |   40 --
 clib/hashcons.mli |    3 -
 clib/option.ml    |   21 +-
 clib/option.mli   |   13 +-
 clib/terminal.ml  |   48 ++-
 clib/terminal.mli |    6 +
 20 files changed, 1751 insertions(+), 1026 deletions(-)
 delete mode 100644 clib/canary.ml
 delete mode 100644 clib/canary.mli
 create mode 100644 clib/diff2.ml
 create mode 100644 clib/diff2.mli

(limited to 'clib')

diff --git a/clib/cArray.ml b/clib/cArray.ml
index e2b1a7be..d509c55b 100644
--- a/clib/cArray.ml
+++ b/clib/cArray.ml
@@ -41,6 +41,8 @@ sig
     ('a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a
   val fold_left3 :
     ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'a
+  val fold_left4 :
+    ('a -> 'b -> 'c -> 'd -> 'e -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'e array -> 'a
   val fold_left2_i :
     (int -> 'a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a
   val fold_left_from : int -> ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a
@@ -48,13 +50,16 @@ sig
   val map_of_list : ('a -> 'b) -> 'a list -> 'b array
   val chop : int -> 'a array -> 'a array * 'a array
   val smartmap : ('a -> 'a) -> 'a array -> 'a array
+  [@@ocaml.deprecated "Same as [Smart.map]"]
   val smartfoldmap : ('r -> 'a -> 'r * 'a) -> 'r -> 'a array -> 'r * 'a array
+  [@@ocaml.deprecated "Same as [Smart.fold_left_map]"]
   val map2 : ('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
   val map2_i : (int -> 'a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
   val map3 :
     ('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array
   val map_left : ('a -> 'b) -> 'a array -> 'b array
   val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit
+  val iter2_i : (int -> 'a -> 'b -> unit) -> 'a array -> 'b array -> unit
   val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
   val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
   val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array
@@ -70,6 +75,25 @@ sig
   val rev_of_list : 'a list -> 'a array
   val rev_to_list : 'a array -> 'a list
   val filter_with : bool list -> 'a array -> 'a array
+  module Smart :
+  sig
+    val map : ('a -> 'a) -> 'a array -> 'a array
+    val map2 : ('a -> 'b -> 'b) -> 'a array -> 'b array -> 'b array
+    val fold_left_map : ('a -> 'b -> 'a * 'b) -> 'a -> 'b array -> 'a * 'b array
+    val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'c) -> 'a -> 'b array -> 'c array -> 'a * 'c array
+  end
+  module Fun1 :
+  sig
+    val map : ('r -> 'a -> 'b) -> 'r -> 'a array -> 'b array
+    val smartmap : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array
+    [@@ocaml.deprecated "Same as [Fun1.Smart.map]"]
+    val iter : ('r -> 'a -> unit) -> 'r -> 'a array -> unit
+    val iter2 : ('r -> 'a -> 'b -> unit) -> 'r -> 'a array -> 'b array -> unit
+    module Smart :
+    sig
+      val map : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array
+    end
+  end
 end
 
 include Array
@@ -257,7 +281,7 @@ let fold_left2_i f a v1 v2 =
   let rec fold a n =
     if n >= lv1 then a else fold (f n a (uget v1 n) (uget v2 n)) (succ n)
   in
-  if Array.length v2 <> lv1 then invalid_arg "Array.fold_left2";
+  if Array.length v2 <> lv1 then invalid_arg "Array.fold_left2_i";
   fold a 0
 
 let fold_left3 f a v1 v2 v3 =
@@ -267,7 +291,17 @@ let fold_left3 f a v1 v2 v3 =
     else fold (f a (uget v1 n) (uget v2 n) (uget v3 n)) (succ n)
   in
   if Array.length v2 <> lv1 || Array.length v3 <> lv1 then
-    invalid_arg "Array.fold_left2";
+    invalid_arg "Array.fold_left3";
+  fold a 0
+
+let fold_left4 f a v1 v2 v3 v4 =
+  let lv1 = Array.length v1 in
+  let rec fold a n =
+    if n >= lv1 then a
+    else fold (f a (uget v1 n) (uget v2 n) (uget v3 n) (uget v4 n)) (succ n)
+  in
+  if Array.length v2 <> lv1 || Array.length v3 <> lv1 || Array.length v4 <> lv1 then
+    invalid_arg "Array.fold_left4";
   fold a 0
 
 let fold_left_from n f a v =
@@ -314,72 +348,6 @@ let chop n v =
   if n > vlen then failwith "Array.chop";
   (Array.sub v 0 n, Array.sub v n (vlen-n))
 
-(* If none of the elements is changed by f we return ar itself.
-   The while loop looks for the first such an element.
-   If found, we break here and the new array is produced,
-   but f is not re-applied to elements that are already checked *)
-let smartmap f (ar : 'a array) =
-  let len = Array.length ar in
-  let i = ref 0 in
-  let break = ref true in
-  let temp = ref None in
-  while !break && (!i < len) do
-    let v = Array.unsafe_get ar !i in
-    let v' = f v in
-    if v == v' then incr i
-    else begin
-      break := false;
-      temp := Some v';
-    end
-  done;
-  if !i < len then begin
-    (** The array is not the same as the original one *)
-    let ans : 'a array = Array.copy ar in
-    let v = match !temp with None -> assert false | Some x -> x in
-    Array.unsafe_set ans !i v;
-    incr i;
-    while !i < len do
-      let v = Array.unsafe_get ans !i in
-      let v' = f v in
-      if v != v' then Array.unsafe_set ans !i v';
-      incr i
-    done;
-    ans
-  end else ar
-
-(** Same as [smartmap] but threads a state meanwhile *)
-let smartfoldmap f accu (ar : 'a array) =
-  let len = Array.length ar in
-  let i = ref 0 in
-  let break = ref true in
-  let r = ref accu in
-  (** This variable is never accessed unset *)
-  let temp = ref None in
-  while !break && (!i < len) do
-    let v = Array.unsafe_get ar !i in
-    let (accu, v') = f !r v in
-    r := accu;
-    if v == v' then incr i
-    else begin
-      break := false;
-      temp := Some v';
-    end
-  done;
-  if !i < len then begin
-    let ans : 'a array = Array.copy ar in
-    let v = match !temp with None -> assert false | Some x -> x in
-    Array.unsafe_set ans !i v;
-    incr i;
-    while !i < len do
-      let v = Array.unsafe_get ar !i in
-      let (accu, v') = f !r v in
-      r := accu;
-      if v != v' then Array.unsafe_set ans !i v';
-      incr i
-    done;
-    !r, ans
-  end else !r, ar
-
 let map2 f v1 v2 =
   let len1 = Array.length v1 in
   let len2 = Array.length v2 in
@@ -440,6 +408,12 @@ let iter2 f v1 v2 =
   let () = if not (Int.equal len2 len1) then invalid_arg "Array.iter2" in
   for i = 0 to len1 - 1 do f (uget v1 i) (uget v2 i) done
 
+let iter2_i f v1 v2 =
+  let len1 = Array.length v1 in
+  let len2 = Array.length v2 in
+  let () = if not (Int.equal len2 len1) then invalid_arg "Array.iter2" in
+  for i = 0 to len1 - 1 do f i (uget v1 i) (uget v2 i) done
+
 let pure_functional = false
 
 let fold_right_map f v e =
@@ -496,29 +470,53 @@ let rev_to_list a =
 let filter_with filter v =
   Array.of_list (CList.filter_with filter (Array.to_list v))
 
-module Fun1 =
+module Smart =
 struct
 
-  let map f arg v = match v with
-  | [| |] -> [| |]
-  | _ ->
-    let len = Array.length v in
-    let x0 = Array.unsafe_get v 0 in
-    let ans = Array.make len (f arg x0) in
-    for i = 1 to pred len do
-      let x = Array.unsafe_get v i in
-      Array.unsafe_set ans i (f arg x)
+  (* If none of the elements is changed by f we return ar itself.
+     The while loop looks for the first such an element.
+     If found, we break here and the new array is produced,
+     but f is not re-applied to elements that are already checked *)
+  let map f (ar : 'a array) =
+    let len = Array.length ar in
+    let i = ref 0 in
+    let break = ref true in
+    let temp = ref None in
+    while !break && (!i < len) do
+      let v = Array.unsafe_get ar !i in
+      let v' = f v in
+      if v == v' then incr i
+      else begin
+        break := false;
+        temp := Some v';
+      end
     done;
-    ans
+    if !i < len then begin
+      (** The array is not the same as the original one *)
+      let ans : 'a array = Array.copy ar in
+      let v = match !temp with None -> assert false | Some x -> x in
+      Array.unsafe_set ans !i v;
+      incr i;
+      while !i < len do
+        let v = Array.unsafe_get ans !i in
+        let v' = f v in
+        if v != v' then Array.unsafe_set ans !i v';
+        incr i
+      done;
+      ans
+    end else ar
 
-  let smartmap f arg (ar : 'a array) =
+  let map2 f aux_ar ar =
     let len = Array.length ar in
+    let aux_len = Array.length aux_ar in
+    let () = if not (Int.equal len aux_len) then invalid_arg "Array.Smart.map2" in
     let i = ref 0 in
     let break = ref true in
     let temp = ref None in
     while !break && (!i < len) do
       let v = Array.unsafe_get ar !i in
-      let v' = f arg v in
+      let w = Array.unsafe_get aux_ar !i in
+      let v' = f w v in
       if v == v' then incr i
       else begin
         break := false;
@@ -533,13 +531,105 @@ struct
       incr i;
       while !i < len do
         let v = Array.unsafe_get ans !i in
-        let v' = f arg v in
+        let w = Array.unsafe_get aux_ar !i in
+        let v' = f w v in
         if v != v' then Array.unsafe_set ans !i v';
         incr i
       done;
       ans
     end else ar
 
+  (** Same as [Smart.map] but threads a state meanwhile *)
+  let fold_left_map f accu (ar : 'a array) =
+    let len = Array.length ar in
+    let i = ref 0 in
+    let break = ref true in
+    let r = ref accu in
+    (** This variable is never accessed unset *)
+    let temp = ref None in
+    while !break && (!i < len) do
+      let v = Array.unsafe_get ar !i in
+      let (accu, v') = f !r v in
+      r := accu;
+      if v == v' then incr i
+      else begin
+        break := false;
+        temp := Some v';
+      end
+    done;
+    if !i < len then begin
+      let ans : 'a array = Array.copy ar in
+      let v = match !temp with None -> assert false | Some x -> x in
+      Array.unsafe_set ans !i v;
+      incr i;
+      while !i < len do
+        let v = Array.unsafe_get ar !i in
+        let (accu, v') = f !r v in
+        r := accu;
+        if v != v' then Array.unsafe_set ans !i v';
+        incr i
+      done;
+      !r, ans
+    end else !r, ar
+
+  (** Same as [Smart.map2] but threads a state meanwhile *)
+  let fold_left2_map f accu aux_ar ar =
+    let len = Array.length ar in
+    let aux_len = Array.length aux_ar in
+    let () = if not (Int.equal len aux_len) then invalid_arg "Array.Smart.fold_left2_map" in
+    let i = ref 0 in
+    let break = ref true in
+    let r = ref accu in
+    (** This variable is never accessed unset *)
+    let temp = ref None in
+    while !break && (!i < len) do
+      let v = Array.unsafe_get ar !i in
+      let w = Array.unsafe_get aux_ar !i in
+      let (accu, v') = f !r w v in
+      r := accu;
+      if v == v' then incr i
+      else begin
+        break := false;
+        temp := Some v';
+      end
+    done;
+    if !i < len then begin
+      let ans : 'a array = Array.copy ar in
+      let v = match !temp with None -> assert false | Some x -> x in
+      Array.unsafe_set ans !i v;
+      incr i;
+      while !i < len do
+        let v = Array.unsafe_get ar !i in
+        let w = Array.unsafe_get aux_ar !i in
+        let (accu, v') = f !r w v in
+        r := accu;
+        if v != v' then Array.unsafe_set ans !i v';
+        incr i
+      done;
+      !r, ans
+    end else !r, ar
+
+end
+
+(* Deprecated aliases *)
+let smartmap = Smart.map
+let smartfoldmap = Smart.fold_left_map
+
+module Fun1 =
+struct
+
+  let map f arg v = match v with
+  | [| |] -> [| |]
+  | _ ->
+    let len = Array.length v in
+    let x0 = Array.unsafe_get v 0 in
+    let ans = Array.make len (f arg x0) in
+    for i = 1 to pred len do
+      let x = Array.unsafe_get v i in
+      Array.unsafe_set ans i (f arg x)
+    done;
+    ans
+
   let iter f arg v =
     let len = Array.length v in
     for i = 0 to pred len do
@@ -547,4 +637,50 @@ struct
       f arg x
     done
 
+  let iter2 f arg v1 v2 =
+    let len1 = Array.length v1 in
+    let len2 = Array.length v2 in
+    let () = if not (Int.equal len2 len1) then invalid_arg "Array.Fun1.iter2" in
+    for i = 0 to pred len1 do
+      let x1 = uget v1 i in
+      let x2 = uget v2 i in
+      f arg x1 x2
+    done
+
+  module Smart =
+  struct
+
+    let map f arg (ar : 'a array) =
+      let len = Array.length ar in
+      let i = ref 0 in
+      let break = ref true in
+      let temp = ref None in
+      while !break && (!i < len) do
+        let v = Array.unsafe_get ar !i in
+        let v' = f arg v in
+        if v == v' then incr i
+        else begin
+          break := false;
+          temp := Some v';
+        end
+      done;
+      if !i < len then begin
+        (** The array is not the same as the original one *)
+        let ans : 'a array = Array.copy ar in
+        let v = match !temp with None -> assert false | Some x -> x in
+        Array.unsafe_set ans !i v;
+        incr i;
+        while !i < len do
+          let v = Array.unsafe_get ans !i in
+          let v' = f arg v in
+          if v != v' then Array.unsafe_set ans !i v';
+          incr i
+        done;
+        ans
+      end else ar
+
+  end
+
+  let smartmap = Smart.map
+
 end
diff --git a/clib/cArray.mli b/clib/cArray.mli
index fa3978bd..5c7e09ee 100644
--- a/clib/cArray.mli
+++ b/clib/cArray.mli
@@ -66,6 +66,8 @@ sig
     ('a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a
   val fold_left3 :
     ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'a
+  val fold_left4 :
+    ('a -> 'b -> 'c -> 'd -> 'e -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'e array -> 'a
   val fold_left2_i :
     (int -> 'a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a
   val fold_left_from : int -> ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a
@@ -81,13 +83,14 @@ sig
       Raise [Failure "Array.chop"] if [i] is not a valid index. *)
 
   val smartmap : ('a -> 'a) -> 'a array -> 'a array
-  (** [smartmap f a] behaves as [map f a] but returns [a] instead of a copy when
-      [f x == x] for all [x] in [a]. *)
+  [@@ocaml.deprecated "Same as [Smart.map]"]
 
   val smartfoldmap : ('r -> 'a -> 'r * 'a) -> 'r -> 'a array -> 'r * 'a array
-  (** Same as [smartmap] but threads an additional state left-to-right. *)
+  [@@ocaml.deprecated "Same as [Smart.fold_left_map]"]
 
   val map2 : ('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
+  (** See also [Smart.map2] *)
+
   val map2_i : (int -> 'a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
   val map3 :
     ('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array
@@ -98,15 +101,18 @@ sig
   val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit
   (** Iter on two arrays. Raise [Invalid_argument "Array.iter2"] if sizes differ. *)
 
+  val iter2_i : (int -> 'a -> 'b -> unit) -> 'a array -> 'b array -> unit
+  (** Iter on two arrays. Raise [Invalid_argument "Array.iter2_i"] if sizes differ. *)
+
   val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
   (** [fold_left_map f e_0 [|l_1...l_n|] = e_n,[|k_1...k_n|]]
-    where [(e_i,k_i)=f e_{i-1} l_i] *)
+    where [(e_i,k_i)=f e_{i-1} l_i]; see also [Smart.fold_left_map] *)
 
   val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
   (** Same, folding on the right *)
 
   val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array
-  (** Same with two arrays, folding on the left *)
+  (** Same with two arrays, folding on the left; see also [Smart.fold_left2_map] *)
 
   val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
   (** Same with two arrays, folding on the left *)
@@ -135,23 +141,57 @@ sig
   (** [filter_with b a] selects elements of [a] whose corresponding element in
       [b] is [true].  Raise [Invalid_argument _] when sizes differ. *)
 
+  module Smart :
+  sig
+    val map : ('a -> 'a) -> 'a array -> 'a array
+    (** [Smart.map f a] behaves as [map f a] but returns [a] instead of a copy when
+        [f x == x] for all [x] in [a]. *)
+
+    val map2 : ('a -> 'b -> 'b) -> 'a array -> 'b array -> 'b array
+    (** [Smart.map2 f a b] behaves as [map2 f a b] but returns [a] instead of a copy when
+        [f x y == y] for all [x] in [a] and [y] in [b] pointwise. *)
+
+    val fold_left_map : ('a -> 'b -> 'a * 'b) -> 'a -> 'b array -> 'a * 'b array
+    (** [Smart.fold_left_mapf a b] behaves as [fold_left_map] but
+        returns [b] as second component instead of a copy of [b] when
+        the output array is pointwise the same as the input array [b] *)
+
+    val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'c) -> 'a -> 'b array -> 'c array -> 'a * 'c array
+    (** [Smart.fold_left2_map f a b c] behaves as [fold_left2_map] but
+        returns [c] as second component instead of a copy of [c] when
+        the output array is pointwise the same as the input array [c] *)
+
+  end
+  (** The functions defined in this module are optimized specializations
+      of the main ones, when the returned array is of same type as one of
+      the original array. *)
+
+  module Fun1 :
+  sig
+    val map : ('r -> 'a -> 'b) -> 'r -> 'a array -> 'b array
+    (** [Fun1.map f x v = map (f x) v] *)
+
+    val smartmap : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array
+    [@@ocaml.deprecated "Same as [Fun1.Smart.map]"]
+
+    val iter : ('r -> 'a -> unit) -> 'r -> 'a array -> unit
+    (** [Fun1.iter f x v = iter (f x) v] *)
+
+    val iter2 : ('r -> 'a -> 'b -> unit) -> 'r -> 'a array -> 'b array -> unit
+    (** [Fun1.iter2 f x v1 v2 = iter (f x) v1 v2] *)
+
+    module Smart :
+    sig
+      val map : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array
+      (** [Fun1.Smart.map f x v = Smart.map (f x) v] *)
+    end
+
+  end
+  (** The functions defined in this module are the same as the main ones, except
+      that they are all higher-order, and their function arguments have an
+      additional parameter. This allows us to prevent closure creation in critical
+      cases. *)
+
 end
 
 include ExtS
-
-module Fun1 :
-sig
-  val map : ('r -> 'a -> 'b) -> 'r -> 'a array -> 'b array
-  (** [Fun1.map f x v = map (f x) v] *)
-
-  val smartmap : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array
-  (** [Fun1.smartmap f x v = smartmap (f x) v] *)
-
-  val iter : ('r -> 'a -> unit) -> 'r -> 'a array -> unit
-  (** [Fun1.iter f x v = iter (f x) v] *)
-
-end
-(** The functions defined in this module are the same as the main ones, except
-    that they are all higher-order, and their function arguments have an
-    additional parameter. This allows us to prevent closure creation in critical
-    cases. *)
diff --git a/clib/cList.ml b/clib/cList.ml
index b25c4ffd..dc59ff29 100644
--- a/clib/cList.ml
+++ b/clib/cList.ml
@@ -19,26 +19,33 @@ sig
   val compare : 'a cmp -> 'a list cmp
   val equal : 'a eq -> 'a list eq
   val is_empty : 'a list -> bool
-  val init : int -> (int -> 'a) -> 'a list
   val mem_f : 'a eq -> 'a -> 'a list -> bool
-  val add_set : 'a eq -> 'a -> 'a list -> 'a list
-  val eq_set : 'a eq -> 'a list -> 'a list -> bool
-  val intersect : 'a eq -> 'a list -> 'a list -> 'a list
-  val union : 'a eq -> 'a list -> 'a list -> 'a list
-  val unionq : 'a list -> 'a list -> 'a list
-  val subtract : 'a eq -> 'a list -> 'a list -> 'a list
-  val subtractq : 'a list -> 'a list -> 'a list
+  val for_all_i : (int -> 'a -> bool) -> int -> 'a list -> bool
+  val for_all2eq : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+  val prefix_of : 'a eq -> 'a list -> 'a list -> bool
   val interval : int -> int -> int list
   val make : int -> 'a -> 'a list
+  val addn : int -> 'a -> 'a list -> 'a list
+  val init : int -> (int -> 'a) -> 'a list
+  val append : 'a list -> 'a list -> 'a list
+  val concat : 'a list list -> 'a list
+  val flatten : 'a list list -> 'a list
   val assign : 'a list -> int -> 'a -> 'a list
-  val distinct : 'a list -> bool
-  val distinct_f : 'a cmp -> 'a list -> bool
-  val duplicates : 'a eq -> 'a list -> 'a list
+  val filter : ('a -> bool) -> 'a list -> 'a list
   val filter2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> 'a list * 'b list
+  val filteri :
+    (int -> 'a -> bool) -> 'a list -> 'a list
+  val filter_with : bool list -> 'a list -> 'a list
+  val smartfilter : ('a -> bool) -> 'a list -> 'a list
+  [@@ocaml.deprecated "Same as [filter]"]
   val map_filter : ('a -> 'b option) -> 'a list -> 'b list
   val map_filter_i : (int -> 'a -> 'b option) -> 'a list -> 'b list
-  val filter_with : bool list -> 'a list -> 'a list
+  val partitioni :
+    (int -> 'a -> bool) -> 'a list -> 'a list * 'a list
+  val map : ('a -> 'b) -> 'a list -> 'b list
+  val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
   val smartmap : ('a -> 'a) -> 'a list -> 'a list
+  [@@ocaml.deprecated "Same as [Smart.map]"]
   val map_left : ('a -> 'b) -> 'a list -> 'b list
   val map_i : (int -> 'a -> 'b) -> int -> 'a list -> 'b list
   val map2_i :
@@ -47,17 +54,14 @@ sig
     ('a -> 'b -> 'c -> 'd) -> 'a list -> 'b list -> 'c list -> 'd list
   val map4 :
     ('a -> 'b -> 'c -> 'd -> 'e) -> 'a list -> 'b list -> 'c list -> 'd list -> 'e list
-  val filteri :
-    (int -> 'a -> bool) -> 'a list -> 'a list
-  val partitioni :
-    (int -> 'a -> bool) -> 'a list -> 'a list * 'a list
   val map_of_array : ('a -> 'b) -> 'a array -> 'b list
-  val smartfilter : ('a -> bool) -> 'a list -> 'a list
+  val map_append : ('a -> 'b list) -> 'a list -> 'b list
+  val map_append2 : ('a -> 'b -> 'c list) -> 'a list -> 'b list -> 'c list
   val extend : bool list -> 'a -> 'a list -> 'a list
   val count : ('a -> bool) -> 'a list -> int
   val index : 'a eq -> 'a -> 'a list -> int
+  val safe_index : 'a eq -> 'a -> 'a list -> int option
   val index0 : 'a eq -> 'a -> 'a list -> int
-  val iteri :  (int -> 'a -> unit) -> 'a list -> unit
   val fold_left_until : ('c -> 'a -> 'c CSig.until) -> 'c -> 'a list -> 'c
   val fold_right_i :  (int -> 'a -> 'b -> 'b) -> int -> 'a list -> 'b -> 'b
   val fold_left_i :  (int -> 'a -> 'b -> 'a) -> int -> 'a -> 'b list -> 'a
@@ -65,58 +69,71 @@ sig
       ('a -> 'b -> 'b list -> 'a) -> 'b list -> 'a -> 'a
   val fold_left3 : ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b list -> 'c list -> 'd list -> 'a
   val fold_left2_set : exn -> ('a -> 'b -> 'c -> 'b list -> 'c list -> 'a) -> 'a -> 'b list -> 'c list -> 'a
-  val for_all_i : (int -> 'a -> bool) -> int -> 'a list -> bool
+  val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+  val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
+  val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b list -> 'c list -> 'a * 'd list
+  val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a
+  val fold_left3_map : ('a -> 'b -> 'c -> 'd -> 'a * 'e) -> 'a -> 'b list -> 'c list -> 'd list -> 'a * 'e list
+  val fold_left4_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a * 'r list
+  val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+  [@@ocaml.deprecated "Same as [fold_left_map]"]
+  val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
+  [@@ocaml.deprecated "Same as [fold_right_map]"]
   val except : 'a eq -> 'a -> 'a list -> 'a list
   val remove : 'a eq -> 'a -> 'a list -> 'a list
   val remove_first : ('a -> bool) -> 'a list -> 'a list
   val extract_first : ('a -> bool) -> 'a list -> 'a list * 'a
-  val insert : ('a -> 'a -> bool) -> 'a -> 'a list -> 'a list
-  val for_all2eq : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
-  val sep_last : 'a list -> 'a * 'a list
   val find_map : ('a -> 'b option) -> 'a list -> 'b
-  val uniquize : 'a list -> 'a list
-  val sort_uniquize : 'a cmp -> 'a list -> 'a list
-  val merge_uniq : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
-  val subset : 'a list -> 'a list -> bool
-  val chop : int -> 'a list -> 'a list * 'a list
   exception IndexOutOfRange
   val goto : int -> 'a list -> 'a list * 'a list
   val split_when : ('a -> bool) -> 'a list -> 'a list * 'a list
-  val split3 : ('a * 'b * 'c) list -> 'a list * 'b list * 'c list
-  val firstn : int -> 'a list -> 'a list
+  val sep_last : 'a list -> 'a * 'a list
+  val drop_last : 'a list -> 'a list
   val last : 'a list -> 'a
   val lastn : int -> 'a list -> 'a list
+  val chop : int -> 'a list -> 'a list * 'a list
+  val firstn : int -> 'a list -> 'a list
   val skipn : int -> 'a list -> 'a list
   val skipn_at_least : int -> 'a list -> 'a list
-  val addn : int -> 'a -> 'a list -> 'a list
-  val prefix_of : 'a eq -> 'a list -> 'a list -> bool
   val drop_prefix : 'a eq -> 'a list -> 'a list -> 'a list
-  val drop_last : 'a list -> 'a list
-  val map_append : ('a -> 'b list) -> 'a list -> 'b list
-  val map_append2 : ('a -> 'b -> 'c list) -> 'a list -> 'b list -> 'c list
+  val insert : ('a -> 'a -> bool) -> 'a -> 'a list -> 'a list
   val share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list
-  val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
-  val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
-  val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b list -> 'c list -> 'a * 'd list
-  val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a
-  val fold_left3_map : ('a -> 'b -> 'c -> 'd -> 'a * 'e) -> 'a -> 'b list -> 'c list -> 'd list -> 'a * 'e list
-  val fold_left4_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a * 'r list
-  val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
-  [@@ocaml.deprecated "Same as [fold_left_map]"]
-  val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
-  [@@ocaml.deprecated "Same as [fold_right_map]"]
   val map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list
   val assoc_f : 'a eq -> 'a -> ('a * 'b) list -> 'b
   val remove_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> ('a * 'b) list
   val mem_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> bool
+  val factorize_left : 'a eq -> ('a * 'b) list -> ('a * 'b list) list
+  val split : ('a * 'b) list -> 'a list * 'b list
+  val combine : 'a list -> 'b list -> ('a * 'b) list
+  val split3 : ('a * 'b * 'c) list -> 'a list * 'b list * 'c list
+  val combine3 : 'a list -> 'b list -> 'c list -> ('a * 'b * 'c) list
+  val add_set : 'a eq -> 'a -> 'a list -> 'a list
+  val eq_set : 'a eq -> 'a list -> 'a list -> bool
+  val subset : 'a list -> 'a list -> bool
+  val merge_set : 'a cmp -> 'a list -> 'a list -> 'a list
+  val intersect : 'a eq -> 'a list -> 'a list -> 'a list
+  val union : 'a eq -> 'a list -> 'a list -> 'a list
+  val unionq : 'a list -> 'a list -> 'a list
+  val subtract : 'a eq -> 'a list -> 'a list -> 'a list
+  val subtractq : 'a list -> 'a list -> 'a list
+  val merge_uniq : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
+  [@@ocaml.deprecated "Same as [merge_set]"]
+  val distinct : 'a list -> bool
+  val distinct_f : 'a cmp -> 'a list -> bool
+  val duplicates : 'a eq -> 'a list -> 'a list
+  val uniquize : 'a list -> 'a list
+  val sort_uniquize : 'a cmp -> 'a list -> 'a list
   val min : 'a cmp -> 'a list -> 'a
   val cartesian : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
   val cartesians : ('a -> 'b -> 'b) -> 'b -> 'a list list -> 'b list
   val combinations : 'a list list -> 'a list list
-  val combine3 : 'a list -> 'b list -> 'c list -> ('a * 'b * 'c) list
   val cartesians_filter :
     ('a -> 'b -> 'b option) -> 'b -> 'a list list -> 'b list
-  val factorize_left : 'a eq -> ('a * 'b) list -> ('a * 'b list) list
+
+  module Smart :
+  sig
+    val map : ('a -> 'a) -> 'a list -> 'a list
+  end
 
   module type MonoS = sig
     type elt
@@ -142,71 +159,71 @@ type 'a cell = {
 
 external cast : 'a cell -> 'a list = "%identity"
 
-let rec map_loop f p = function
-| [] -> ()
-| x :: l ->
-  let c = { head = f x; tail = [] } in
-  p.tail <- cast c;
-  map_loop f c l
+(** Extensions and redefinitions of OCaml Stdlib *)
 
-let map f = function
-| [] -> []
-| x :: l ->
-  let c = { head = f x; tail = [] } in
-  map_loop f c l;
-  cast c
+(** {6 Equality, testing} *)
 
-let rec map2_loop f p l1 l2 = match l1, l2 with
-| [], [] -> ()
-| x :: l1, y :: l2 ->
-  let c = { head = f x y; tail = [] } in
-  p.tail <- cast c;
-  map2_loop f c l1 l2
-| _ -> invalid_arg "List.map2"
+let rec compare cmp l1 l2 =
+  if l1 == l2 then 0 else
+  match l1,l2 with
+  | [], [] -> 0
+  | _::_, [] -> 1
+  | [], _::_ -> -1
+  | x1::l1, x2::l2 ->
+    match cmp x1 x2 with
+    | 0 -> compare cmp l1 l2
+    | c -> c
 
-let map2 f l1 l2 = match l1, l2 with
-| [], [] -> []
-| x :: l1, y :: l2 ->
-  let c = { head = f x y; tail = [] } in
-  map2_loop f c l1 l2;
-  cast c
-| _ -> invalid_arg "List.map2"
+let rec equal cmp l1 l2 =
+  l1 == l2 ||
+  match l1, l2 with
+  | [], [] -> true
+  | x1 :: l1, x2 :: l2 -> cmp x1 x2 && equal cmp l1 l2
+  | _ -> false
 
-let rec map_of_array_loop f p a i l =
-  if Int.equal i l then ()
-  else
-    let c = { head = f (Array.unsafe_get a i); tail = [] } in
-    p.tail <- cast c;
-    map_of_array_loop f c a (i + 1) l
+let is_empty = function
+  | [] -> true
+  | _ -> false
 
-let map_of_array f a =
-  let l = Array.length a in
-  if Int.equal l 0 then []
-  else
-    let c = { head = f (Array.unsafe_get a 0); tail = [] } in
-    map_of_array_loop f c a 1 l;
-    cast c
+let mem_f cmp x l =
+  List.exists (cmp x) l
 
-let rec append_loop p tl = function
-| [] -> p.tail <- tl
-| x :: l ->
-  let c = { head = x; tail = [] } in
-  p.tail <- cast c;
-  append_loop c tl l
+let for_all_i p =
+  let rec for_all_p i = function
+    | [] -> true
+    | a::l -> p i a && for_all_p (i+1) l
+  in
+  for_all_p
 
-let append l1 l2 = match l1 with
-| [] -> l2
-| x :: l ->
-  let c = { head = x; tail = [] } in
-  append_loop c l2 l;
-  cast c
+let for_all2eq f l1 l2 =
+  try List.for_all2 f l1 l2 with Invalid_argument _ -> false
 
-let rec copy p = function
-| [] -> p
-| x :: l ->
-  let c = { head = x; tail = [] } in
-  p.tail <- cast c;
-  copy c l
+let prefix_of cmp prefl l =
+  let rec prefrec = function
+    | (h1::t1, h2::t2) -> cmp h1 h2 && prefrec (t1,t2)
+    | ([], _) -> true
+    | _ -> false
+  in
+  prefrec (prefl,l)
+
+(** {6 Creating lists} *)
+
+let interval n m =
+  let rec interval_n (l,m) =
+    if n > m then l else interval_n (m::l, pred m)
+  in
+  interval_n ([], m)
+
+let addn n v =
+  let rec aux n l =
+    if Int.equal n 0 then l
+    else aux (pred n) (v :: l)
+  in
+  if n < 0 then invalid_arg "List.addn"
+  else aux n
+
+let make n v =
+  addn n v []
 
 let rec init_loop len f p i =
   if Int.equal i len then ()
@@ -223,9 +240,30 @@ let init len f =
     init_loop len f c 1;
     cast c
 
+let rec append_loop p tl = function
+  | [] -> p.tail <- tl
+  | x :: l ->
+    let c = { head = x; tail = [] } in
+    p.tail <- cast c;
+    append_loop c tl l
+
+let append l1 l2 = match l1 with
+  | [] -> l2
+  | x :: l ->
+    let c = { head = x; tail = [] } in
+    append_loop c l2 l;
+    cast c
+
+let rec copy p = function
+  | [] -> p
+  | x :: l ->
+    let c = { head = x; tail = [] } in
+    p.tail <- cast c;
+    copy c l
+
 let rec concat_loop p = function
-| [] -> ()
-| x :: l -> concat_loop (copy p x) l
+  | [] -> ()
+  | x :: l -> concat_loop (copy p x) l
 
 let concat l =
   let dummy = { head = Obj.magic 0; tail = [] } in
@@ -234,230 +272,310 @@ let concat l =
 
 let flatten = concat
 
-let rec split_loop p q = function
-| [] -> ()
-| (x, y) :: l ->
-  let cl = { head = x; tail = [] } in
-  let cr = { head = y; tail = [] } in
-  p.tail <- cast cl;
-  q.tail <- cast cr;
-  split_loop cl cr l
-
-let split = function
-| [] -> [], []
-| (x, y) :: l ->
-  let cl = { head = x; tail = [] } in
-  let cr = { head = y; tail = [] } in
-  split_loop cl cr l;
-  (cast cl, cast cr)
+(** {6 Lists as arrays} *)
 
-let rec combine_loop p l1 l2 = match l1, l2 with
-| [], [] -> ()
-| x :: l1, y :: l2 ->
-  let c = { head = (x, y); tail = [] } in
-  p.tail <- cast c;
-  combine_loop c l1 l2
-| _ -> invalid_arg "List.combine"
+let assign l n e =
+  let rec assrec stk l i = match l, i with
+    | (h :: t, 0) -> List.rev_append stk (e :: t)
+    | (h :: t, n) -> assrec (h :: stk) t (pred n)
+    | ([], _) -> failwith "List.assign"
+  in
+  assrec [] l n
 
-let combine l1 l2 = match l1, l2 with
-| [], [] -> []
-| x :: l1, y :: l2 ->
-  let c = { head = (x, y); tail = [] } in
-  combine_loop c l1 l2;
-  cast c
-| _ -> invalid_arg "List.combine"
+(** {6 Filtering} *)
 
 let rec filter_loop f p = function
-| [] -> ()
-| x :: l ->
-  if f x then
-    let c = { head = x; tail = [] } in
-    let () = p.tail <- cast c in
-    filter_loop f c l
-  else
-    filter_loop f p l
+  | [] -> ()
+  | x :: l' as l ->
+    let b = f x in
+    filter_loop f p l';
+    if b then if p.tail == l' then p.tail <- l else p.tail <- x :: p.tail
 
-let filter f l =
-  let c = { head = Obj.magic 0; tail = [] } in
-  filter_loop f c l;
-  c.tail
+let rec filter f = function
+  | [] -> []
+  | x :: l' as l ->
+    if f x then
+      let c = { head = x; tail = [] } in
+      filter_loop f c l';
+      if c.tail == l' then l else cast c
+    else
+      filter f l'
 
-(** FIXME: Already present in OCaml 4.00 *)
+let rec filter2_loop f p q l1 l2 = match l1, l2 with
+  | [], [] -> ()
+  | x :: l1', y :: l2' ->
+    let b = f x y in
+    filter2_loop f p q l1' l2';
+    if b then
+      if p.tail == l1' then begin
+          p.tail <- l1;
+          q.tail <- l2
+        end
+      else begin
+          p.tail <- x :: p.tail;
+          q.tail <- y :: q.tail
+        end
+  | _ -> invalid_arg "List.filter2"
+
+let rec filter2 f l1 l2 = match l1, l2 with
+  | [], [] -> ([],[])
+  | x1 :: l1', x2 :: l2' ->
+    let b = f x1 x2 in
+    if b then
+      let c1 = { head = x1; tail = [] } in
+      let c2 = { head = x2; tail = [] } in
+      filter2_loop f c1 c2 l1' l2';
+      if c1.tail == l1' then (l1, l2) else (cast c1, cast c2)
+    else
+      filter2 f l1' l2'
+  | _ -> invalid_arg "List.filter2"
 
-let rec map_i_loop f i p = function
-| [] -> ()
-| x :: l ->
-  let c = { head = f i x; tail = [] } in
-  p.tail <- cast c;
-  map_i_loop f (succ i) c l
+let filteri p =
+  let rec filter_i_rec i = function
+    | [] -> []
+    | x :: l -> let l' = filter_i_rec (succ i) l in if p i x then x :: l' else l'
+  in
+  filter_i_rec 0
 
-let map_i f i = function
-| [] -> []
-| x :: l ->
-  let c = { head = f i x; tail = [] } in
-  map_i_loop f (succ i) c l;
-  cast c
+let smartfilter = filter (* Alias *)
 
-(** Extensions of OCaml Stdlib *)
+let rec filter_with_loop filter p l = match filter, l with
+  | [], [] -> ()
+  | b :: filter, x :: l' ->
+    filter_with_loop filter p l';
+    if b then if p.tail == l' then p.tail <- l else p.tail <- x :: p.tail
+  | _ -> invalid_arg "List.filter_with"
 
-let rec compare cmp l1 l2 =
-  if l1 == l2 then 0 else
-  match l1,l2 with
-      [], [] -> 0
-    | _::_, [] -> 1
-    | [], _::_ -> -1
-    | x1::l1, x2::l2 ->
-        (match cmp x1 x2 with
-           | 0 -> compare cmp l1 l2
-           | c -> c)
+let rec filter_with filter l = match filter, l with
+  | [], [] -> []
+  | b :: filter, x :: l' ->
+    if b then
+      let c = { head = x; tail = [] } in
+      filter_with_loop filter c l';
+      if c.tail == l' then l else cast c
+    else filter_with filter l'
+  | _ -> invalid_arg "List.filter_with"
 
-let rec equal cmp l1 l2 =
-  l1 == l2 ||
-  match l1, l2 with
-    | [], [] -> true
-    | x1 :: l1, x2 :: l2 ->
-      cmp x1 x2 && equal cmp l1 l2
-    | _ -> false
+let rec map_filter_loop f p = function
+  | [] -> ()
+  | x :: l ->
+    match f x with
+    | None -> map_filter_loop f p l
+    | Some y ->
+      let c = { head = y; tail = [] } in
+      p.tail <- cast c;
+      map_filter_loop f c l
 
-let is_empty = function
-| [] -> true
-| _ -> false
+let rec map_filter f = function
+  | [] -> []
+  | x :: l' ->
+    match f x with
+    | None -> map_filter f l'
+    | Some y ->
+      let c = { head = y; tail = [] } in
+      map_filter_loop f c l';
+      cast c
 
-let mem_f cmp x l = List.exists (cmp x) l
+let rec map_filter_i_loop f i p = function
+  | [] -> ()
+  | x :: l ->
+    match f i x with
+    | None -> map_filter_i_loop f (succ i) p l
+    | Some y ->
+      let c = { head = y; tail = [] } in
+      p.tail <- cast c;
+      map_filter_i_loop f (succ i) c l
 
-let intersect cmp l1 l2 =
-  filter (fun x -> mem_f cmp x l2) l1
+let rec map_filter_i_loop' f i = function
+  | [] -> []
+  | x :: l' ->
+    match f i x with
+    | None -> map_filter_i_loop' f (succ i) l'
+    | Some y ->
+      let c = { head = y; tail = [] } in
+      map_filter_i_loop f (succ i) c l';
+      cast c
 
-let union cmp l1 l2 =
-  let rec urec = function
-    | [] -> l2
-    | a::l -> if mem_f cmp a l2 then urec l else a::urec l
+let map_filter_i f l =
+  map_filter_i_loop' f 0 l
+
+let partitioni p =
+  let rec aux i = function
+    | [] -> [], []
+    | x :: l ->
+      let (l1, l2) = aux (succ i) l in
+      if p i x then (x :: l1, l2)
+      else (l1, x :: l2)
   in
-  urec l1
+  aux 0
 
-let subtract cmp l1 l2 =
-  if is_empty l2 then l1
-  else List.filter (fun x -> not (mem_f cmp x l2)) l1
+(** {6 Applying functorially} *)
 
-let unionq l1 l2 = union (==) l1 l2
-let subtractq l1 l2 = subtract (==) l1 l2
+let rec map_loop f p = function
+  | [] -> ()
+  | x :: l ->
+    let c = { head = f x; tail = [] } in
+    p.tail <- cast c;
+    map_loop f c l
 
-let interval n m =
-  let rec interval_n (l,m) =
-    if n > m then l else interval_n (m::l, pred m)
-  in
-  interval_n ([], m)
+let map f = function
+  | [] -> []
+  | x :: l ->
+    let c = { head = f x; tail = [] } in
+    map_loop f c l;
+    cast c
 
-let addn n v =
-  let rec aux n l =
-    if Int.equal n 0 then l
-    else aux (pred n) (v :: l)
-  in
-  if n < 0 then invalid_arg "List.addn"
-  else aux n
+let rec map2_loop f p l1 l2 = match l1, l2 with
+  | [], [] -> ()
+  | x :: l1, y :: l2 ->
+    let c = { head = f x y; tail = [] } in
+    p.tail <- cast c;
+    map2_loop f c l1 l2
+  | _ -> invalid_arg "List.map2"
 
-let make n v = addn n v []
+let map2 f l1 l2 = match l1, l2 with
+  | [], [] -> []
+  | x :: l1, y :: l2 ->
+    let c = { head = f x y; tail = [] } in
+    map2_loop f c l1 l2;
+    cast c
+  | _ -> invalid_arg "List.map2"
 
-let assign l n e =
-  let rec assrec stk l i = match l, i with
-    | ((h::t), 0) -> List.rev_append stk (e :: t)
-    | ((h::t), n) -> assrec (h :: stk) t (pred n)
-    | ([], _) -> failwith "List.assign"
-  in
-  assrec [] l n
+(** Like OCaml [List.mapi] but tail-recursive *)
+
+let rec map_i_loop f i p = function
+  | [] -> ()
+  | x :: l ->
+    let c = { head = f i x; tail = [] } in
+    p.tail <- cast c;
+    map_i_loop f (succ i) c l
 
-let rec smartmap f l = match l with
-    [] -> l
-  | h::tl ->
-      let h' = f h and tl' = smartmap f tl in
-        if h'==h && tl'==tl then l
-        else h'::tl'
+let map_i f i = function
+  | [] -> []
+  | x :: l ->
+    let c = { head = f i x; tail = [] } in
+    map_i_loop f (succ i) c l;
+    cast c
 
 let map_left = map
 
 let map2_i f i l1 l2 =
   let rec map_i i = function
     | ([], []) -> []
-    | ((h1::t1), (h2::t2)) -> let v = f i h1 h2 in v :: map_i (succ i) (t1,t2)
+    | (h1 :: t1, h2 :: t2) -> let v = f i h1 h2 in v :: map_i (succ i) (t1,t2)
     | (_, _) -> invalid_arg "map2_i"
   in
   map_i i (l1,l2)
 
-let map3 f l1 l2 l3 =
-  let rec map = function
-    | ([], [], []) -> []
-    | ((h1::t1), (h2::t2), (h3::t3)) -> let v = f h1 h2 h3 in v::map (t1,t2,t3)
-    | (_, _, _) -> invalid_arg "map3"
-  in
-  map (l1,l2,l3)
+let rec map3_loop f p l1 l2 l3 = match l1, l2, l3 with
+  | [], [], [] -> ()
+  | x :: l1, y :: l2, z :: l3 ->
+    let c = { head = f x y z; tail = [] } in
+    p.tail <- cast c;
+    map3_loop f c l1 l2 l3
+  | _ -> invalid_arg "List.map3"
 
-let map4 f l1 l2 l3 l4 =
-  let rec map = function
-    | ([], [], [], []) -> []
-    | ((h1::t1), (h2::t2), (h3::t3), (h4::t4)) -> let v = f h1 h2 h3 h4 in v::map (t1,t2,t3,t4)
-    | (_, _, _, _) -> invalid_arg "map4"
-  in
-  map (l1,l2,l3,l4)
+let map3 f l1 l2 l3 = match l1, l2, l3 with
+  | [], [], [] -> []
+  | x :: l1, y :: l2, z :: l3 ->
+    let c = { head = f x y z; tail = [] } in
+    map3_loop f c l1 l2 l3;
+    cast c
+  | _ -> invalid_arg "List.map3"
+
+let rec map4_loop f p l1 l2 l3 l4 = match l1, l2, l3, l4 with
+  | [], [], [], [] -> ()
+  | x :: l1, y :: l2, z :: l3, t :: l4 ->
+    let c = { head = f x y z t; tail = [] } in
+    p.tail <- cast c;
+    map4_loop f c l1 l2 l3 l4
+  | _ -> invalid_arg "List.map4"
+
+let map4 f l1 l2 l3 l4 = match l1, l2, l3, l4 with
+  | [], [], [], [] -> []
+  | x :: l1, y :: l2, z :: l3, t :: l4 ->
+    let c = { head = f x y z t; tail = [] } in
+    map4_loop f c l1 l2 l3 l4;
+    cast c
+  | _ -> invalid_arg "List.map4"
+
+let rec map_of_array_loop f p a i l =
+  if Int.equal i l then ()
+  else
+    let c = { head = f (Array.unsafe_get a i); tail = [] } in
+    p.tail <- cast c;
+    map_of_array_loop f c a (i + 1) l
+
+let map_of_array f a =
+  let l = Array.length a in
+  if Int.equal l 0 then []
+  else
+    let c = { head = f (Array.unsafe_get a 0); tail = [] } in
+    map_of_array_loop f c a 1 l;
+    cast c
+
+let map_append f l = flatten (map f l)
 
-let rec smartfilter f l = match l with
-    [] -> l
-  | h::tl ->
-      let tl' = smartfilter f tl in
-        if f h then
-          if tl' == tl then l
-          else h :: tl'
-        else tl'
+let map_append2 f l1 l2 = flatten (map2 f l1 l2)
 
 let rec extend l a l' = match l,l' with
-  | true::l, b::l' -> b :: extend l a l'
-  | false::l, l' -> a :: extend l a l'
+  | true :: l, b :: l' -> b :: extend l a l'
+  | false :: l, l' -> a :: extend l a l'
   | [], [] -> []
   | _ -> invalid_arg "extend"
 
 let count f l =
   let rec aux acc = function
     | [] -> acc
-    | h :: t -> if f h then aux (acc + 1) t else aux acc t in
+    | h :: t -> if f h then aux (acc + 1) t else aux acc t
+  in
   aux 0 l
 
+(** {6 Finding position} *)
+
 let rec index_f f x l n = match l with
-| [] -> raise Not_found
-| y :: l -> if f x y then n else index_f f x l (succ n)
+  | [] -> raise Not_found
+  | y :: l -> if f x y then n else index_f f x l (succ n)
 
 let index f x l = index_f f x l 1
 
+let safe_index f x l = try Some (index f x l) with Not_found -> None
+
 let index0 f x l = index_f f x l 0
 
+(** {6 Folding} *)
+
 let fold_left_until f accu s =
   let rec aux accu = function
     | [] -> accu
-    | x :: xs -> match f accu x with CSig.Stop x -> x | CSig.Cont i -> aux i xs in
+    | x :: xs -> match f accu x with CSig.Stop x -> x | CSig.Cont i -> aux i xs
+  in
   aux accu s
 
 let fold_right_i f i l =
   let rec it_f i l a = match l with
     | [] -> a
-    | b::l -> f (i-1) b (it_f (i-1) l a)
+    | b :: l -> f (i-1) b (it_f (i-1) l a)
   in
   it_f (List.length l + i) l
 
 let fold_left_i f =
   let rec it_list_f i a = function
     | [] -> a
-    | b::l -> it_list_f (i+1) (f i a b) l
+    | b :: l -> it_list_f (i+1) (f i a b) l
   in
   it_list_f
 
 let rec fold_left3 f accu l1 l2 l3 =
   match (l1, l2, l3) with
-    ([], [], []) -> accu
-  | (a1::l1, a2::l2, a3::l3) -> fold_left3 f (f accu a1 a2 a3) l1 l2 l3
+  | ([], [], []) -> accu
+  | (a1 :: l1, a2 :: l2, a3 :: l3) -> fold_left3 f (f accu a1 a2 a3) l1 l2 l3
   | (_, _, _) -> invalid_arg "List.fold_left3"
 
 let rec fold_left4 f accu l1 l2 l3 l4 =
   match (l1, l2, l3, l4) with
-    ([], [], [], []) -> accu
-  | (a1::l1, a2::l2, a3::l3, a4::l4) -> fold_left4 f (f accu a1 a2 a3 a4) l1 l2 l3 l4
+  | ([], [], [], []) -> accu
+  | (a1 :: l1, a2 :: l2, a3 :: l3, a4 :: l4) -> fold_left4 f (f accu a1 a2 a3 a4) l1 l2 l3 l4
   | (_,_, _, _) -> invalid_arg "List.fold_left4"
 
 (* [fold_right_and_left f [a1;...;an] hd =
@@ -475,223 +593,103 @@ let rec fold_left4 f accu l1 l2 l3 l4 =
 let fold_right_and_left f l hd =
   let rec aux tl = function
     | [] -> hd
-    | a::l -> let hd = aux (a::tl) l in f hd a tl
-   in aux [] l
+    | a :: l -> let hd = aux (a :: tl) l in f hd a tl
+  in
+  aux [] l
 
 (* Match sets as lists according to a matching function, also folding a side effect *)
 let rec fold_left2_set e f x l1 l2 =
   match l1 with
-  | a1::l1 ->
-     let rec find seen = function
-       | [] -> raise e
-       | a2::l2 ->
-          try fold_left2_set e f (f x a1 a2 l1 l2) l1 (List.rev_append seen l2)
-          with e' when e' = e -> find (a2::seen) l2 in
-     find [] l2
+  | a1 :: l1 ->
+      let rec find seen = function
+        | [] -> raise e
+        | a2 :: l2 ->
+            try fold_left2_set e f (f x a1 a2 l1 l2) l1 (List.rev_append seen l2)
+            with e' when e' = e -> find (a2 :: seen) l2 in
+      find [] l2
   | [] ->
-     if l2 = [] then x else raise e
-
-let iteri f l = fold_left_i (fun i _ x -> f i x) 0 () l
-
-let for_all_i p =
-  let rec for_all_p i = function
-    | [] -> true
-    | a::l -> p i a && for_all_p (i+1) l
-  in
-  for_all_p
-
-let except cmp x l = List.filter (fun y -> not (cmp x y)) l
-
-let remove = except (* Alias *)
-
-let rec remove_first p = function
-  | b::l when p b -> l
-  | b::l -> b::remove_first p l
-  | [] -> raise Not_found
+      if l2 = [] then x else raise e
 
-let extract_first p li =
-  let rec loop rev_left = function
-    | [] -> raise Not_found
-    | x::right ->
-       if p x then List.rev_append rev_left right, x
-       else loop (x :: rev_left) right
-  in loop [] li
-
-let insert p v l =
-  let rec insrec = function
-    | [] -> [v]
-    | h::tl -> if p v h then v::h::tl else h::insrec tl
-  in
-  insrec l
-
-let add_set cmp x l = if mem_f cmp x l then l else x :: l
-
-(** List equality up to permutation (but considering multiple occurrences) *)
-
-let eq_set cmp l1 l2 =
-  let rec aux l1 = function
-  | [] -> is_empty l1
-  | a::l2 -> aux (remove_first (cmp a) l1) l2 in
-  try aux l1 l2 with Not_found -> false
+(* Poor man's monadic map *)
+let rec fold_left_map f e = function
+  | []  -> (e,[])
+  | h :: t ->
+    let e',h' = f e h in
+    let e'',t' = fold_left_map f e' t in
+    e'',h' :: t'
 
-let for_all2eq f l1 l2 =
-  try List.for_all2 f l1 l2 with Invalid_argument _ -> false
+let fold_map = fold_left_map
 
-let filteri p =
-  let rec filter_i_rec i = function
-    | [] -> []
-    | x::l -> let l' = filter_i_rec (succ i) l in if p i x then x::l' else l'
+(* (* tail-recursive version of the above function *)
+let fold_left_map f e l =
+  let g (e,b') h =
+    let (e',h') = f e h in
+      (e',h'::b')
   in
-  filter_i_rec 0
-
-let partitioni p =
-  let rec aux i = function
-    | [] -> [], []
-    | x :: l ->
-        let (l1, l2) = aux (succ i) l in
-        if p i x then (x :: l1, l2)
-        else (l1, x :: l2)
-  in aux 0
-
-let rec sep_last = function
-  | [] -> failwith "sep_last"
-  | hd::[] -> (hd,[])
-  | hd::tl -> let (l,tl) = sep_last tl in (l,hd::tl)
-
-let rec find_map f = function
-| [] -> raise Not_found
-| x :: l ->
-  match f x with
-  | None -> find_map f l
-  | Some y -> y
-
-(* FIXME: we should avoid relying on the generic hash function,
-   just as we'd better avoid Pervasives.compare *)
-
-let uniquize l =
-  let visited = Hashtbl.create 23 in
-  let rec aux acc changed = function
-    | h::t -> if Hashtbl.mem visited h then aux acc true t else
-          begin
-            Hashtbl.add visited h h;
-            aux (h::acc) changed t
-          end
-    | [] -> if changed then List.rev acc else l
-  in aux [] false l
-
-(** [sort_uniquize] might be an alternative to the hashtbl-based
-    [uniquize], when the order of the elements is irrelevant *)
-
-let rec uniquize_sorted cmp = function
-  | a::b::l when Int.equal (cmp a b) 0 -> uniquize_sorted cmp (a::l)
-  | a::l -> a::uniquize_sorted cmp l
-  | [] -> []
-
-let sort_uniquize cmp l = uniquize_sorted cmp (List.sort cmp l)
+  let (e',lrev) = List.fold_left g (e,[]) l in
+    (e',List.rev lrev)
+*)
 
-let min cmp l =
-  let rec aux cur = function
-    | [] -> cur
-    | x :: l -> if cmp x cur < 0 then aux x l else aux cur l
-  in
-  match l with
-  | x :: l -> aux x l
-  | [] -> raise Not_found
+(* The same, based on fold_right, with the effect accumulated on the right *)
+let fold_right_map f l e =
+  List.fold_right (fun x (l,e) -> let (y,e) = f x e in (y::l,e)) l ([],e)
 
-(* FIXME: again, generic hash function *)
+let fold_map' = fold_right_map
 
-let distinct l =
-  let visited = Hashtbl.create 23 in
-  let rec loop = function
-    | h::t ->
-        if Hashtbl.mem visited h then false
-        else
-          begin
-            Hashtbl.add visited h h;
-            loop t
-          end
-    | [] -> true
-  in loop l
+let on_snd f (x,y) = (x,f y)
 
-let distinct_f cmp l =
-  let rec loop = function
-    | a::b::_ when Int.equal (cmp a b) 0 -> false
-    | a::l -> loop l
-    | [] -> true
-  in loop (List.sort cmp l)
+let fold_left2_map f e l l' =
+  on_snd List.rev @@
+  List.fold_left2 (fun (e,l) x x' ->
+      let (e,y) = f e x x' in
+      (e, y::l)
+    ) (e, []) l l'
 
-let rec merge_uniq cmp l1 l2 =
-  match l1, l2 with
-  | [], l2 -> l2
-  | l1, [] -> l1
-  | h1 :: t1, h2 :: t2 ->
-      let c = cmp h1 h2 in
-      if Int.equal c 0
-      then h1 :: merge_uniq cmp t1 t2
-      else if c <= 0
-      then h1 :: merge_uniq cmp t1 l2
-      else h2 :: merge_uniq cmp l1 t2
+let fold_right2_map f l l' e =
+  List.fold_right2 (fun x x' (l,e) -> let (y,e) = f x x' e in (y::l,e)) l l' ([],e)
 
-let rec duplicates cmp = function
-  | [] -> []
-  | x::l ->
-      let l' = duplicates cmp l in
-      if mem_f cmp x l then add_set cmp x l' else l'
+let fold_left3_map f e l l' l'' =
+  on_snd List.rev @@
+  fold_left3 (fun (e,l) x x' x'' -> let (e,y) = f e x x' x'' in (e,y::l)) (e,[]) l l' l''
 
-let rec filter2_loop f p q l1 l2 = match l1, l2 with
-| [], [] -> ()
-| x :: l1, y :: l2 ->
-  if f x y then
-    let c1 = { head = x; tail = [] } in
-    let c2 = { head = y; tail = [] } in
-    let () = p.tail <- cast c1 in
-    let () = q.tail <- cast c2 in
-    filter2_loop f c1 c2 l1 l2
-  else
-    filter2_loop f p q l1 l2
-| _ -> invalid_arg "List.filter2"
+let fold_left4_map f e l1 l2 l3 l4 =
+  on_snd List.rev @@
+  fold_left4 (fun (e,l) x1 x2 x3 x4 -> let (e,y) = f e x1 x2 x3 x4 in (e,y::l)) (e,[]) l1 l2 l3 l4
 
-let filter2 f l1 l2 =
-  let c1 = { head = Obj.magic 0; tail = [] } in
-  let c2 = { head = Obj.magic 0; tail = [] } in
-  filter2_loop f c1 c2 l1 l2;
-  (c1.tail, c2.tail)
+(** {6 Splitting} *)
 
-let rec map_filter_loop f p = function
-  | [] -> ()
-  | x :: l ->
-    match f x with
-    | None -> map_filter_loop f p l
-    | Some y ->
-      let c = { head = y; tail = [] } in
-      p.tail <- cast c;
-      map_filter_loop f c l
+let except cmp x l =
+  List.filter (fun y -> not (cmp x y)) l
 
-let map_filter f l =
-  let c = { head = Obj.magic 0; tail = [] } in
-  map_filter_loop f c l;
-  c.tail
+let remove = except (* Alias *)
 
-let rec map_filter_i_loop f i p = function
-  | [] -> ()
-  | x :: l ->
-    match f i x with
-    | None -> map_filter_i_loop f (succ i) p l
-    | Some y ->
-      let c = { head = y; tail = [] } in
-      p.tail <- cast c;
-      map_filter_i_loop f (succ i) c l
+let rec remove_first p = function
+  | b :: l when p b -> l
+  | b :: l -> b :: remove_first p l
+  | [] -> raise Not_found
 
-let map_filter_i f l =
-  let c = { head = Obj.magic 0; tail = [] } in
-  map_filter_i_loop f 0 c l;
-  c.tail
+let extract_first p li =
+  let rec loop rev_left = function
+    | [] -> raise Not_found
+    | x :: right ->
+       if p x then List.rev_append rev_left right, x
+       else loop (x :: rev_left) right
+  in
+  loop [] li
 
-let rec filter_with filter l = match filter, l with
-| [], [] -> []
-| true :: filter, x :: l -> x :: filter_with filter l
-| false :: filter, _ :: l -> filter_with filter l
-| _ -> invalid_arg "List.filter_with"
+let insert p v l =
+  let rec insrec = function
+    | [] -> [v]
+    | h :: tl -> if p v h then v :: h :: tl else h :: insrec tl
+  in
+  insrec l
+
+let rec find_map f = function
+  | [] -> raise Not_found
+  | x :: l ->
+    match f x with
+    | None -> find_map f l
+    | Some y -> y
 
 (* FIXME: again, generic hash function *)
 
@@ -700,7 +698,7 @@ let subset l1 l2 =
   List.iter (fun x -> Hashtbl.add t2 x ()) l2;
   let rec look = function
     | [] -> true
-    | x::ll -> try Hashtbl.find t2 x; look ll with Not_found -> false
+    | x :: ll -> try Hashtbl.find t2 x; look ll with Not_found -> false
   in
   look l1
 
@@ -712,7 +710,7 @@ exception IndexOutOfRange
 let goto n l =
   let rec goto i acc = function
     | tl when Int.equal i 0 -> (acc, tl)
-    | h::t -> goto (pred i) (h::acc) t
+    | h :: t -> goto (pred i) (h :: acc) t
     | [] -> raise IndexOutOfRange
   in
   goto n [] l
@@ -733,29 +731,36 @@ let chop n l =
 let split_when p =
   let rec split_when_loop x y =
     match y with
-      | []      -> (List.rev x,[])
-      | (a::l)  -> if (p a) then (List.rev x,y) else split_when_loop (a::x) l
+    | [] -> (List.rev x,[])
+    | (a :: l)  -> if (p a) then (List.rev x,y) else split_when_loop (a :: x) l
   in
   split_when_loop []
 
-let rec split3 = function
-  | [] -> ([], [], [])
-  | (x,y,z)::l ->
-      let (rx, ry, rz) = split3 l in (x::rx, y::ry, z::rz)
-
 let firstn n l =
   let rec aux acc n l =
     match n, l with
     | 0, _ -> List.rev acc
-    | n, h::t -> aux (h::acc) (pred n) t
+    | n, h :: t -> aux (h :: acc) (pred n) t
     | _ -> failwith "firstn"
   in
   aux [] n l
 
+let rec sep_last = function
+  | [] -> failwith "sep_last"
+  | hd :: [] -> (hd,[])
+  | hd :: tl -> let (l,tl) = sep_last tl in (l,hd :: tl)
+
+(* Drop the last element of a list *)
+
+let rec drop_last = function
+  | [] -> failwith "drop_last"
+  | hd :: [] -> []
+  | hd :: tl -> hd :: drop_last tl
+
 let rec last = function
   | [] -> failwith "List.last"
-  | [x] -> x
-  | _ :: l -> last l
+  | hd :: [] -> hd
+  | _ :: tl -> last tl
 
 let lastn n l =
   let len = List.length l in
@@ -767,96 +772,225 @@ let lastn n l =
 let rec skipn n l = match n,l with
   | 0, _ -> l
   | _, [] -> failwith "List.skipn"
-  | n, _::l -> skipn (pred n) l
+  | n, _ :: l -> skipn (pred n) l
 
 let skipn_at_least n l =
-  try skipn n l with Failure _ -> []
-
-let prefix_of cmp prefl l =
-  let rec prefrec = function
-    | (h1::t1, h2::t2) -> cmp h1 h2 && prefrec (t1,t2)
-    | ([], _) -> true
-    | _ -> false
-  in
-  prefrec (prefl,l)
+  try skipn n l with Failure _ when n >= 0 -> []
 
 (** if [l=p++t] then [drop_prefix p l] is [t] else [l] *)
 
 let drop_prefix cmp p l =
   let rec drop_prefix_rec = function
-    | (h1::tp, h2::tl) when cmp h1 h2 -> drop_prefix_rec (tp,tl)
+    | (h1 :: tp, h2 :: tl) when cmp h1 h2 -> drop_prefix_rec (tp,tl)
     | ([], tl) -> tl
     | _ -> l
   in
   drop_prefix_rec (p,l)
 
-let map_append f l = List.flatten (List.map f l)
-
-let map_append2 f l1 l2 = List.flatten (List.map2 f l1 l2)
-
 let share_tails l1 l2 =
   let rec shr_rev acc = function
-    | ((x1::l1), (x2::l2)) when x1 == x2 -> shr_rev (x1::acc) (l1,l2)
-    | (l1,l2) -> (List.rev l1, List.rev l2, acc)
+    | (x1 :: l1, x2 :: l2) when x1 == x2 -> shr_rev (x1 :: acc) (l1,l2)
+    | (l1, l2) -> (List.rev l1, List.rev l2, acc)
   in
   shr_rev [] (List.rev l1, List.rev l2)
 
-(* Poor man's monadic map *)
-let rec fold_left_map f e = function
-  | []  -> (e,[])
-  | h::t ->
-    let e',h' = f e h in
-    let e'',t' = fold_left_map f e' t in
-    e'',h'::t'
+(** {6 Association lists} *)
 
-let fold_map = fold_left_map
+let map_assoc f = List.map (fun (x,a) -> (x,f a))
 
-(* (* tail-recursive version of the above function *)
-let fold_map f e l =
-  let g (e,b') h =
-    let (e',h') = f e h in
-      (e',h'::b')
+let rec assoc_f f a = function
+  | (x, e) :: xs -> if f a x then e else assoc_f f a xs
+  | [] -> raise Not_found
+
+let remove_assoc_f f a l =
+  try remove_first (fun (x,_) -> f a x) l with Not_found -> l
+
+let mem_assoc_f f a l = List.exists (fun (x,_) -> f a x) l
+
+(** {6 Operations on lists of tuples} *)
+
+let rec split_loop p q = function
+  | [] -> ()
+  | (x, y) :: l ->
+    let cl = { head = x; tail = [] } in
+    let cr = { head = y; tail = [] } in
+    p.tail <- cast cl;
+    q.tail <- cast cr;
+    split_loop cl cr l
+
+let split = function
+  | [] -> [], []
+  | (x, y) :: l ->
+    let cl = { head = x; tail = [] } in
+    let cr = { head = y; tail = [] } in
+    split_loop cl cr l;
+    (cast cl, cast cr)
+
+let rec combine_loop p l1 l2 = match l1, l2 with
+  | [], [] -> ()
+  | x :: l1, y :: l2 ->
+    let c = { head = (x, y); tail = [] } in
+    p.tail <- cast c;
+    combine_loop c l1 l2
+  | _ -> invalid_arg "List.combine"
+
+let combine l1 l2 = match l1, l2 with
+  | [], [] -> []
+  | x :: l1, y :: l2 ->
+    let c = { head = (x, y); tail = [] } in
+    combine_loop c l1 l2;
+    cast c
+  | _ -> invalid_arg "List.combine"
+
+let rec split3_loop p q r = function
+  | [] -> ()
+  | (x, y, z) :: l ->
+    let cp = { head = x; tail = [] } in
+    let cq = { head = y; tail = [] } in
+    let cr = { head = z; tail = [] } in
+    p.tail <- cast cp;
+    q.tail <- cast cq;
+    r.tail <- cast cr;
+    split3_loop cp cq cr l
+
+let split3 = function
+  | [] -> [], [], []
+  | (x, y, z) :: l ->
+    let cp = { head = x; tail = [] } in
+    let cq = { head = y; tail = [] } in
+    let cr = { head = z; tail = [] } in
+    split3_loop cp cq cr l;
+    (cast cp, cast cq, cast cr)
+
+let rec combine3_loop p l1 l2 l3 = match l1, l2, l3 with
+  | [], [], [] -> ()
+  | x :: l1, y :: l2, z :: l3 ->
+    let c = { head = (x, y, z); tail = [] } in
+    p.tail <- cast c;
+    combine3_loop c l1 l2 l3
+  | _ -> invalid_arg "List.combine3"
+
+let combine3 l1 l2 l3 = match l1, l2, l3 with
+  | [], [], [] -> []
+  | x :: l1, y :: l2, z :: l3 ->
+    let c = { head = (x, y, z); tail = [] } in
+    combine3_loop c l1 l2 l3;
+    cast c
+  | _ -> invalid_arg "List.combine3"
+
+(** {6 Operations on lists seen as sets, preserving uniqueness of elements} *)
+
+(** Add an element, preserving uniqueness of elements *)
+
+let add_set cmp x l =
+  if mem_f cmp x l then l else x :: l
+
+(** List equality up to permutation (but considering multiple occurrences) *)
+
+let eq_set cmp l1 l2 =
+  let rec aux l1 = function
+  | [] -> is_empty l1
+  | a :: l2 -> aux (remove_first (cmp a) l1) l2
   in
-  let (e',lrev) = List.fold_left g (e,[]) l in
-    (e',List.rev lrev)
-*)
+  try aux l1 l2 with Not_found -> false
 
-(* The same, based on fold_right, with the effect accumulated on the right *)
-let fold_right_map f l e =
-  List.fold_right (fun x (l,e) -> let (y,e) = f x e in (y::l,e)) l ([],e)
+let rec merge_set cmp l1 l2 = match l1, l2 with
+  | [], l2 -> l2
+  | l1, [] -> l1
+  | h1 :: t1, h2 :: t2 ->
+    let c = cmp h1 h2 in
+    if Int.equal c 0
+    then h1 :: merge_set cmp t1 t2
+    else if c <= 0
+    then h1 :: merge_set cmp t1 l2
+    else h2 :: merge_set cmp l1 t2
 
-let fold_map' = fold_right_map
+let merge_uniq = merge_set
 
-let on_snd f (x,y) = (x,f y)
+let intersect cmp l1 l2 =
+  filter (fun x -> mem_f cmp x l2) l1
 
-let fold_left2_map f e l l' =
-  on_snd List.rev @@
-  List.fold_left2 (fun (e,l) x x' ->
-      let (e,y) = f e x x' in
-      (e, y::l)
-    ) (e, []) l l'
+let union cmp l1 l2 =
+  let rec urec = function
+    | [] -> l2
+    | a :: l -> if mem_f cmp a l2 then urec l else a :: urec l
+  in
+  urec l1
 
-let fold_right2_map f l l' e =
-  List.fold_right2 (fun x x' (l,e) -> let (y,e) = f x x' e in (y::l,e)) l l' ([],e)
+let subtract cmp l1 l2 =
+  if is_empty l2 then l1
+  else List.filter (fun x -> not (mem_f cmp x l2)) l1
 
-let fold_left3_map f e l l' l'' =
-  on_snd List.rev @@
-  fold_left3 (fun (e,l) x x' x'' -> let (e,y) = f e x x' x'' in (e,y::l)) (e,[]) l l' l''
+let unionq l1 l2 = union (==) l1 l2
+let subtractq l1 l2 = subtract (==) l1 l2
 
-let fold_left4_map f e l1 l2 l3 l4 =
-  on_snd List.rev @@
-  fold_left4 (fun (e,l) x1 x2 x3 x4 -> let (e,y) = f e x1 x2 x3 x4 in (e,y::l)) (e,[]) l1 l2 l3 l4
+(** {6 Uniqueness and duplication} *)
 
-let map_assoc f = List.map (fun (x,a) -> (x,f a))
+(* FIXME: we should avoid relying on the generic hash function,
+   just as we'd better avoid Pervasives.compare *)
 
-let rec assoc_f f a = function
-  | (x, e) :: xs -> if f a x then e else assoc_f f a xs
+let distinct l =
+  let visited = Hashtbl.create 23 in
+  let rec loop = function
+    | h :: t ->
+        if Hashtbl.mem visited h then false
+        else
+          begin
+            Hashtbl.add visited h h;
+            loop t
+          end
+    | [] -> true
+  in
+  loop l
+
+let distinct_f cmp l =
+  let rec loop = function
+    | a :: b :: _ when Int.equal (cmp a b) 0 -> false
+    | a :: l -> loop l
+    | [] -> true
+  in loop (List.sort cmp l)
+
+(* FIXME: again, generic hash function *)
+
+let uniquize l =
+  let visited = Hashtbl.create 23 in
+  let rec aux acc changed = function
+    | h :: t -> if Hashtbl.mem visited h then aux acc true t else
+          begin
+            Hashtbl.add visited h h;
+            aux (h :: acc) changed t
+          end
+    | [] -> if changed then List.rev acc else l
+  in
+  aux [] false l
+
+(** [sort_uniquize] might be an alternative to the hashtbl-based
+    [uniquize], when the order of the elements is irrelevant *)
+
+let rec uniquize_sorted cmp = function
+  | a :: b :: l when Int.equal (cmp a b) 0 -> uniquize_sorted cmp (a :: l)
+  | a :: l -> a :: uniquize_sorted cmp l
+  | [] -> []
+
+let sort_uniquize cmp l =
+  uniquize_sorted cmp (List.sort cmp l)
+
+let min cmp l =
+  let rec aux cur = function
+    | [] -> cur
+    | x :: l -> if cmp x cur < 0 then aux x l else aux cur l
+  in
+  match l with
+  | x :: l -> aux x l
   | [] -> raise Not_found
 
-let remove_assoc_f f a l =
-  try remove_first (fun (x,_) -> f a x) l with Not_found -> l
+let rec duplicates cmp = function
+  | [] -> []
+  | x :: l ->
+      let l' = duplicates cmp l in
+      if mem_f cmp x l then add_set cmp x l' else l'
 
-let mem_assoc_f f a l = List.exists (fun (x,_) -> f a x) l
+(** {6 Cartesian product} *)
 
 (* A generic cartesian product: for any operator (**),
    [cartesian (**) [x1;x2] [y1;y2] = [x1**y1; x1**y2; x2**y1; x2**y1]],
@@ -873,15 +1007,9 @@ let cartesians op init ll =
 
 (* combinations [[a;b];[c;d]] gives [[a;c];[a;d];[b;c];[b;d]] *)
 
-let combinations l = cartesians (fun x l -> x::l) [] l
+let combinations l =
+  cartesians (fun x l -> x :: l) [] l
 
-let rec combine3 x y z = 
-  match x, y, z with
-  | [], [], [] -> []
-  | (x :: xs), (y :: ys), (z :: zs) ->
-      (x, y, z) :: combine3 xs ys zs
-  | _, _, _ -> invalid_arg "List.combine3"
-  
 (* Keep only those products that do not return None *)
 
 let cartesian_filter op l1 l2 =
@@ -892,20 +1020,35 @@ let cartesian_filter op l1 l2 =
 let cartesians_filter op init ll =
   List.fold_right (cartesian_filter op) ll [init]
 
-(* Drop the last element of a list *)
-
-let rec drop_last = function
-  | [] -> assert false
-  | hd :: [] -> []
-  | hd :: tl -> hd :: drop_last tl
-
 (* Factorize lists of pairs according to the left argument *)
 let rec factorize_left cmp = function
-  | (a,b)::l ->
+  | (a,b) :: l ->
       let al,l' = partition (fun (a',_) -> cmp a a') l in
-      (a,(b::List.map snd al)) :: factorize_left cmp l'
+      (a,(b :: List.map snd al)) :: factorize_left cmp l'
   | [] -> []
 
+module Smart =
+struct
+
+  let rec map_loop f p = function
+    | [] -> ()
+    | x :: l' as l ->
+      let x' = f x in
+      map_loop f p l';
+      if x' == x && !p == l' then p := l else p := x' :: !p
+
+  let map f = function
+    | [] -> []
+    | x :: l' as l ->
+      let p = ref [] in
+      let x' = f x in
+      map_loop f p l';
+      if x' == x && !p == l' then l else x' :: !p
+
+end
+
+let smartmap = Smart.map
+
 module type MonoS = sig
   type elt
   val equal : elt list -> elt list -> bool
diff --git a/clib/cList.mli b/clib/cList.mli
index e025f7b4..39d9a5e5 100644
--- a/clib/cList.mli
+++ b/clib/cList.mli
@@ -18,33 +18,31 @@ module type ExtS =
 sig
   include S
 
+  (** {6 Equality, testing} *)
+
   val compare : 'a cmp -> 'a list cmp
   (** Lexicographic order on lists. *)
 
   val equal : 'a eq -> 'a list eq
-  (** Lifts equality to list type. *)
+  (** Lift equality to list type. *)
 
   val is_empty : 'a list -> bool
-  (** Checks whether a list is empty *)
-
-  val init : int -> (int -> 'a) -> 'a list
-  (** [init n f] constructs the list [f 0; ... ; f (n - 1)]. *)
+  (** Check whether a list is empty *)
 
   val mem_f : 'a eq -> 'a -> 'a list -> bool
-  (* Same as [List.mem], for some specific equality *)
+  (** Same as [List.mem], for some specific equality *)
 
-  val add_set : 'a eq -> 'a -> 'a list -> 'a list
-  (** [add_set x l] adds [x] in [l] if it is not already there, or returns [l]
-      otherwise. *)
+  val for_all_i : (int -> 'a -> bool) -> int -> 'a list -> bool
+  (** Same as [List.for_all] but with an index *)
 
-  val eq_set : 'a eq -> 'a list eq
-  (** Test equality up to permutation (but considering multiple occurrences) *)
+  val for_all2eq : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+  (** Same as [List.for_all2] but returning [false] when of different length *)
 
-  val intersect : 'a eq -> 'a list -> 'a list -> 'a list
-  val union : 'a eq -> 'a list -> 'a list -> 'a list
-  val unionq : 'a list -> 'a list -> 'a list
-  val subtract : 'a eq -> 'a list -> 'a list -> 'a list
-  val subtractq : 'a list -> 'a list -> 'a list
+  val prefix_of : 'a eq -> 'a list eq
+  (** [prefix_of eq l1 l2] returns [true] if [l1] is a prefix of [l2], [false]
+      otherwise. It uses [eq] to compare elements *)
+
+  (** {6 Creating lists} *)
 
   val interval : int -> int -> int list
   (** [interval i j] creates the list [[i; i + 1; ...; j]], or [[]] when 
@@ -52,88 +50,177 @@ sig
 
   val make : int -> 'a -> 'a list
   (** [make n x] returns a list made of [n] times [x]. Raise
-      [Invalid_argument "List.make"] if [n] is negative. *)
+      [Invalid_argument _] if [n] is negative. *)
 
-  val assign : 'a list -> int -> 'a -> 'a list
-  (** [assign l i x] sets the [i]-th element of [l] to [x], starting from [0]. *)
+  val addn : int -> 'a -> 'a list -> 'a list
+  (** [addn n x l] adds [n] times [x] on the left of [l]. *)
 
-  val distinct : 'a list -> bool
-  (** Return [true] if all elements of the list are distinct. *)
+  val init : int -> (int -> 'a) -> 'a list
+  (** [init n f] constructs the list [f 0; ... ; f (n - 1)]. Raise
+      [Invalid_argument _] if [n] is negative *)
 
-  val distinct_f : 'a cmp -> 'a list -> bool
+  val append : 'a list -> 'a list -> 'a list
+  (** Like OCaml's [List.append] but tail-recursive. *)
 
-  val duplicates : 'a eq -> 'a list -> 'a list
-  (** Return the list of unique elements which appear at least twice. Elements
-      are kept in the order of their first appearance. *)
+  val concat : 'a list list -> 'a list
+  (** Like OCaml's [List.concat] but tail-recursive. *)
+
+  val flatten : 'a list list -> 'a list
+  (** Synonymous of [concat] *)
+
+  (** {6 Lists as arrays} *)
+
+  val assign : 'a list -> int -> 'a -> 'a list
+  (** [assign l i x] sets the [i]-th element of [l] to [x], starting
+      from [0]. Raise [Failure _] if [i] is out of range. *)
+
+  (** {6 Filtering} *)
+
+  val filter : ('a -> bool) -> 'a list -> 'a list
+  (** Like OCaml [List.filter] but tail-recursive and physically returns
+      the original list if the predicate holds for all elements. *)
 
   val filter2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> 'a list * 'b list
+  (** Like [List.filter] but with 2 arguments, raise [Invalid_argument _]
+      if the lists are not of same length. *)
+
+  val filteri : (int -> 'a -> bool) -> 'a list -> 'a list
+  (** Like [List.filter] but with an index starting from [0] *)
+
+  val filter_with : bool list -> 'a list -> 'a list
+  (** [filter_with bl l] selects elements of [l] whose corresponding element in
+      [bl] is [true]. Raise [Invalid_argument _] if sizes differ. *)
+
+  val smartfilter : ('a -> bool) -> 'a list -> 'a list
+  [@@ocaml.deprecated "Same as [filter]"]
+
   val map_filter : ('a -> 'b option) -> 'a list -> 'b list
+  (** Like [map] but keeping only non-[None] elements *)
+
   val map_filter_i : (int -> 'a -> 'b option) -> 'a list -> 'b list
+  (** Like [map_filter] but with an index starting from [0] *)
 
-  val filter_with : bool list -> 'a list -> 'a list
-  (** [filter_with b a] selects elements of [a] whose corresponding element in
-      [b] is [true]. Raise [Invalid_argument _] when sizes differ. *)
+  val partitioni : (int -> 'a -> bool) -> 'a list -> 'a list * 'a list
+  (** Like [List.partition] but with an index starting from [0] *)
+
+  (** {6 Applying functorially} *)
+
+  val map : ('a -> 'b) -> 'a list -> 'b list
+  (** Like OCaml [List.map] but tail-recursive *)
+
+  val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
+  (** Like OCaml [List.map2] but tail-recursive *)
 
   val smartmap : ('a -> 'a) -> 'a list -> 'a list
-  (** [smartmap f [a1...an] = List.map f [a1...an]] but if for all i
-    [f ai == ai], then [smartmap f l == l] *)
+  [@@ocaml.deprecated "Same as [Smart.map]"]
 
   val map_left : ('a -> 'b) -> 'a list -> 'b list
   (** As [map] but ensures the left-to-right order of evaluation. *)
 
   val map_i : (int -> 'a -> 'b) -> int -> 'a list -> 'b list
-  (** As [map] but with the index, which starts from [0]. *)
+  (** Like OCaml [List.mapi] but tail-recursive. Alternatively, like
+      [map] but with an index *)
 
   val map2_i :
     (int -> 'a -> 'b -> 'c) -> int -> 'a list -> 'b list -> 'c list
+  (** Like [map2] but with an index *)
+
   val map3 :
     ('a -> 'b -> 'c -> 'd) -> 'a list -> 'b list -> 'c list -> 'd list
+  (** Like [map] but for 3 lists. *)
+
   val map4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a list -> 'b list -> 'c list ->
     'd list -> 'e list
-  val filteri : (int -> 'a -> bool) -> 'a list -> 'a list
-  val partitioni : (int -> 'a -> bool) -> 'a list -> 'a list * 'a list
+  (** Like [map] but for 4 lists. *)
 
   val map_of_array : ('a -> 'b) -> 'a array -> 'b list
   (** [map_of_array f a] behaves as [List.map f (Array.to_list a)] *)
 
-  val smartfilter : ('a -> bool) -> 'a list -> 'a list
-  (** [smartfilter f [a1...an] = List.filter f [a1...an]] but if for all i
-    [f ai = true], then [smartfilter f l == l] *)
+  val map_append : ('a -> 'b list) -> 'a list -> 'b list
+  (** [map_append f [x1; ...; xn]] returns [f x1 @ ... @ f xn]. *)
+
+  val map_append2 : ('a -> 'b -> 'c list) -> 'a list -> 'b list -> 'c list
+  (** Like [map_append] but for two lists; raises [Invalid_argument _]
+      if the two lists do not have the same length. *)
 
   val extend : bool list -> 'a -> 'a list -> 'a list
-(** [extend l a [a1..an]] assumes that the number of [true] in [l] is [n];
+  (** [extend l a [a1..an]] assumes that the number of [true] in [l] is [n];
     it extends [a1..an] by inserting [a] at the position of [false] in [l] *)
+
   val count : ('a -> bool) -> 'a list -> int
+  (** Count the number of elements satisfying a predicate *)
+
+  (** {6 Finding position} *)
 
   val index : 'a eq -> 'a -> 'a list -> int
   (** [index] returns the 1st index of an element in a list (counting from 1). *)
 
+  val safe_index : 'a eq -> 'a -> 'a list -> int option
+  (** [safe_index] returns the 1st index of an element in a list (counting from 1)
+      and None otherwise. *)
+
   val index0 : 'a eq -> 'a -> 'a list -> int
   (** [index0] behaves as [index] except that it starts counting at 0. *)
 
-  val iteri :  (int -> 'a -> unit) -> 'a list -> unit
-  (** As [iter] but with the index argument (starting from 0). *)
+  (** {6 Folding} *)
 
   val fold_left_until : ('c -> 'a -> 'c CSig.until) -> 'c -> 'a list -> 'c
   (** acts like [fold_left f acc s] while [f] returns
       [Cont acc']; it stops returning [c] as soon as [f] returns [Stop c]. *)
 
   val fold_right_i :  (int -> 'a -> 'b -> 'b) -> int -> 'a list -> 'b -> 'b
+  (** Like [List.fold_right] but with an index *)
+
   val fold_left_i :  (int -> 'a -> 'b -> 'a) -> int -> 'a -> 'b list -> 'a
-  val fold_right_and_left :
-      ('a -> 'b -> 'b list -> 'a) -> 'b list -> 'a -> 'a
+  (** Like [List.fold_left] but with an index *)
+
+  val fold_right_and_left : ('b -> 'a -> 'a list -> 'b) -> 'a list -> 'b -> 'b
+  (** [fold_right_and_left f [a1;...;an] hd] is
+      [f (f (... (f (f hd an [an-1;...;a1]) an-1 [an-2;...;a1]) ...) a2 [a1]) a1 []] *)
+
   val fold_left3 : ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b list -> 'c list -> 'd list -> 'a
+  (** Like [List.fold_left] but for 3 lists; raise [Invalid_argument _] if
+      not all lists of the same size *)
 
+  val fold_left2_set : exn -> ('a -> 'b -> 'c -> 'b list -> 'c list -> 'a) -> 'a -> 'b list -> 'c list -> 'a
   (** Fold sets, i.e. lists up to order; the folding function tells
       when elements match by returning a value and raising the given
       exception otherwise; sets should have the same size; raise the
       given exception if no pairing of the two sets is found;;
       complexity in O(n^2) *)
-  val fold_left2_set : exn -> ('a -> 'b -> 'c -> 'b list -> 'c list -> 'a) -> 'a -> 'b list -> 'c list -> 'a
 
-  val for_all_i : (int -> 'a -> bool) -> int -> 'a list -> bool
+  val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+  (** [fold_left_map f e_0 [a1;...;an]] is [e_n,[k_1...k_n]]
+      where [(e_i,k_i)] is [f e_{i-1} ai] for each i<=n *)
+
+  val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
+  (** Same, folding on the right *)
+
+  val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b list -> 'c list -> 'a * 'd list
+  (** Same with two lists, folding on the left *)
+
+  val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a
+  (** Same with two lists, folding on the right *)
+
+  val fold_left3_map : ('a -> 'b -> 'c -> 'd -> 'a * 'e) -> 'a -> 'b list -> 'c list -> 'd list -> 'a * 'e list
+  (** Same with three lists, folding on the left *)
+
+  val fold_left4_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a * 'r list
+  (** Same with four lists, folding on the left *)
+
+  val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+  [@@ocaml.deprecated "Same as [fold_left_map]"]
+
+  val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
+  [@@ocaml.deprecated "Same as [fold_right_map]"]
+
+  (** {6 Splitting} *)
+
   val except : 'a eq -> 'a -> 'a list -> 'a list
+  (** [except eq a l] Remove all occurrences of [a] in [l] *)
+
   val remove : 'a eq -> 'a -> 'a list -> 'a list
+  (** Alias of [except] *)
 
   val remove_first : ('a -> bool) -> 'a list -> 'a list
   (** Remove the first element satisfying a predicate, or raise [Not_found] *)
@@ -142,35 +229,10 @@ sig
   (** Remove and return the first element satisfying a predicate,
       or raise [Not_found] *)
 
-  val insert : ('a -> 'a -> bool) -> 'a -> 'a list -> 'a list
-  (** Insert at the (first) position so that if the list is ordered wrt to the
-      total order given as argument, the order is preserved *)
-
-  val for_all2eq : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
-  val sep_last : 'a list -> 'a * 'a list
-
   val find_map : ('a -> 'b option) -> 'a list -> 'b
   (** Returns the first element that is mapped to [Some _]. Raise [Not_found] if
       there is none. *)
 
-  val uniquize : 'a list -> 'a list
-  (** Return the list of elements without duplicates.
-      This is the list unchanged if there was none. *)
-
-  val sort_uniquize : 'a cmp -> 'a list -> 'a list
-  (** Return a sorted and de-duplicated version of a list,
-      according to some comparison function. *)
-
-  val merge_uniq : 'a cmp -> 'a list -> 'a list -> 'a list
-  (** Merge two sorted lists and preserves the uniqueness property. *)
-
-  val subset : 'a list -> 'a list -> bool
-
-  val chop : int -> 'a list -> 'a list * 'a list
-  (** [chop i l] splits [l] into two lists [(l1,l2)] such that
-      [l1++l2=l] and [l1] has length [i].  It raises [Failure] when [i]
-      is negative or greater than the length of [l] *)
-
   exception IndexOutOfRange
   val goto: int -> 'a list -> 'a list * 'a list
   (** [goto i l] splits [l] into two lists [(l1,l2)] such that
@@ -178,90 +240,180 @@ sig
       [IndexOutOfRange] when [i] is negative or greater than the
       length of [l]. *)
 
-
   val split_when : ('a -> bool) -> 'a list -> 'a list * 'a list
-  val split3 : ('a * 'b * 'c) list -> 'a list * 'b list * 'c list
-  val firstn : int -> 'a list -> 'a list
+  (** [split_when p l] splits [l] into two lists [(l1,a::l2)] such that
+      [l1++(a::l2)=l], [p a=true] and [p b = false] for every element [b] of [l1].
+      if there is no such [a], then it returns [(l,[])] instead. *)
+
+  val sep_last : 'a list -> 'a * 'a list
+  (** [sep_last l] returns [(a,l')] such that [l] is [l'@[a]].
+      It raises [Failure _] if the list is empty. *)
+
+  val drop_last : 'a list -> 'a list
+  (** Remove the last element of the list. It raises [Failure _] if the
+      list is empty. This is the second part of [sep_last]. *)
+
   val last : 'a list -> 'a
+  (** Return the last element of the list. It raises [Failure _] if the
+      list is empty. This is the first part of [sep_last]. *)
+
   val lastn : int -> 'a list -> 'a list
+  (** [lastn n l] returns the [n] last elements of [l]. It raises
+      [Failure _] if [n] is less than 0 or larger than the length of [l] *)
+
+  val chop : int -> 'a list -> 'a list * 'a list
+  (** [chop i l] splits [l] into two lists [(l1,l2)] such that
+      [l1++l2=l] and [l1] has length [i]. It raises [Failure _] when
+      [i] is negative or greater than the length of [l]. *)
+
+  val firstn : int -> 'a list -> 'a list
+  (** [firstn n l] Returns the [n] first elements of [l]. It raises
+      [Failure _] if [n] negative or too large. This is the first part
+      of [chop]. *)
+
   val skipn : int -> 'a list -> 'a list
+  (** [skipn n l] drops the [n] first elements of [l]. It raises
+      [Failure _] if [n] is less than 0 or larger than the length of [l].
+      This is the second part of [chop]. *)
+
   val skipn_at_least : int -> 'a list -> 'a list
+  (** Same as [skipn] but returns [] if [n] is larger than the list of
+      the list. *)
 
-  val addn : int -> 'a -> 'a list -> 'a list
-  (** [addn n x l] adds [n] times [x] on the left of [l]. *)
+  val drop_prefix : 'a eq -> 'a list -> 'a list -> 'a list
+  (** [drop_prefix eq l1 l] returns [l2] if [l=l1++l2] else return [l]. *)
+
+  val insert : 'a eq -> 'a -> 'a list -> 'a list
+  (** Insert at the (first) position so that if the list is ordered wrt to the
+      total order given as argument, the order is preserved *)
+
+  val share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list
+  (** [share_tails l1 l2] returns [(l1',l2',l)] such that [l1] is
+      [l1'\@l] and [l2] is [l2'\@l] and [l] is maximal amongst all such
+      decompositions *)
+
+  (** {6 Association lists} *)
+
+  val map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list
+  (** Applies a function on the codomain of an association list *)
+
+  val assoc_f : 'a eq -> 'a -> ('a * 'b) list -> 'b
+  (** Like [List.assoc] but using the equality given as argument *)
+
+  val remove_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> ('a * 'b) list
+  (** Remove first matching element; unchanged if no such element *)
+
+  val mem_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> bool
+  (** Like [List.mem_assoc] but using the equality given as argument *)
 
-  val prefix_of : 'a eq -> 'a list -> 'a list -> bool
-  (** [prefix_of l1 l2] returns [true] if [l1] is a prefix of [l2], [false]
+  val factorize_left : 'a eq -> ('a * 'b) list -> ('a * 'b list) list
+  (** Create a list of associations from a list of pairs *)
+
+  (** {6 Operations on lists of tuples} *)
+
+  val split : ('a * 'b) list -> 'a list * 'b list
+  (** Like OCaml's [List.split] but tail-recursive. *)
+
+  val combine : 'a list -> 'b list -> ('a * 'b) list
+  (** Like OCaml's [List.combine] but tail-recursive. *)
+
+  val split3 : ('a * 'b * 'c) list -> 'a list * 'b list * 'c list
+  (** Like [split] but for triples *)
+
+  val combine3 : 'a list -> 'b list -> 'c list -> ('a * 'b * 'c) list
+  (** Like [combine] but for triples *)
+
+  (** {6 Operations on lists seen as sets, preserving uniqueness of elements} *)
+
+  val add_set : 'a eq -> 'a -> 'a list -> 'a list
+  (** [add_set x l] adds [x] in [l] if it is not already there, or returns [l]
       otherwise. *)
 
-  val drop_prefix : 'a eq -> 'a list -> 'a list -> 'a list
-  (** [drop_prefix p l] returns [t] if [l=p++t] else return [l]. *)
+  val eq_set : 'a eq -> 'a list eq
+  (** Test equality up to permutation. It respects multiple occurrences
+      and thus works also on multisets. *)
 
-  val drop_last : 'a list -> 'a list
+  val subset : 'a list eq
+  (** Tell if a list is a subset of another up to permutation. It expects
+      each element to occur only once. *)
 
-  val map_append : ('a -> 'b list) -> 'a list -> 'b list
-  (** [map_append f [x1; ...; xn]] returns [(f x1)@(f x2)@...@(f xn)]. *)
+  val merge_set : 'a cmp -> 'a list -> 'a list -> 'a list
+  (** Merge two sorted lists and preserves the uniqueness property. *)
 
-  val map_append2 : ('a -> 'b -> 'c list) -> 'a list -> 'b list -> 'c list
-  (** As [map_append]. Raises [Invalid_argument _] if the two lists don't have 
-      the same length. *)
+  val intersect : 'a eq -> 'a list -> 'a list -> 'a list
+  (** Return the intersection of two lists, assuming and preserving
+      uniqueness of elements *)
 
-  val share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list
+  val union : 'a eq -> 'a list -> 'a list -> 'a list
+  (** Return the union of two lists, assuming and preserving
+      uniqueness of elements *)
 
-  val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
-  (** [fold_left_map f e_0 [l_1...l_n] = e_n,[k_1...k_n]]
-    where [(e_i,k_i)=f e_{i-1} l_i] *)
+  val unionq : 'a list -> 'a list -> 'a list
+  (** [union] specialized to physical equality *)
 
-  val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
-  (** Same, folding on the right *)
+  val subtract : 'a eq -> 'a list -> 'a list -> 'a list
+  (** Remove from the first list all elements from the second list. *)
 
-  val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b list -> 'c list -> 'a * 'd list
-  (** Same with two lists, folding on the left *)
+  val subtractq : 'a list -> 'a list -> 'a list
+  (** [subtract] specialized to physical equality *)
 
-  val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a
-  (** Same with two lists, folding on the right *)
+  val merge_uniq : 'a cmp -> 'a list -> 'a list -> 'a list
+  [@@ocaml.deprecated "Same as [merge_set]"]
 
-  val fold_left3_map : ('a -> 'b -> 'c -> 'd -> 'a * 'e) -> 'a -> 'b list -> 'c list -> 'd list -> 'a * 'e list
-  (** Same with three lists, folding on the left *)
+  (** {6 Uniqueness and duplication} *)
 
-  val fold_left4_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a * 'r list
-  (** Same with four lists, folding on the left *)
+  val distinct : 'a list -> bool
+  (** Return [true] if all elements of the list are distinct. *)
 
-  val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
-  [@@ocaml.deprecated "Same as [fold_left_map]"]
+  val distinct_f : 'a cmp -> 'a list -> bool
+  (** Like [distinct] but using the equality given as argument *)
 
-  val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
-  [@@ocaml.deprecated "Same as [fold_right_map]"]
+  val duplicates : 'a eq -> 'a list -> 'a list
+  (** Return the list of unique elements which appear at least twice. Elements
+      are kept in the order of their first appearance. *)
 
-  val map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list
-  val assoc_f : 'a eq -> 'a -> ('a * 'b) list -> 'b
-  val remove_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> ('a * 'b) list
-  val mem_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> bool
+  val uniquize : 'a list -> 'a list
+  (** Return the list of elements without duplicates.
+      This is the list unchanged if there was none. *)
+
+  val sort_uniquize : 'a cmp -> 'a list -> 'a list
+  (** Return a sorted version of a list without duplicates
+      according to some comparison function. *)
 
   val min : 'a cmp -> 'a list -> 'a
   (** Return minimum element according to some comparison function.
 
       @raise Not_found on an empty list. *)
 
+  (** {6 Cartesian product} *)
+
   val cartesian : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
-  (** A generic cartesian product: for any operator (**),
+  (** A generic binary cartesian product: for any operator (**),
     [cartesian (**) [x1;x2] [y1;y2] = [x1**y1; x1**y2; x2**y1; x2**y1]],
     and so on if there are more elements in the lists. *)
 
   val cartesians : ('a -> 'b -> 'b) -> 'b -> 'a list list -> 'b list
-  (** [cartesians] is an n-ary cartesian product: it iterates
-    [cartesian] over a list of lists.  *)
+  (** [cartesians op init l] is an n-ary cartesian product: it builds
+      the list of all [op a1 .. (op an init) ..] for [a1], ..., [an] in
+      the product of the elements of the lists *)
 
   val combinations : 'a list list -> 'a list list
-  (** combinations [[a;b];[c;d]] returns [[a;c];[a;d];[b;c];[b;d]] *)
-
-  val combine3 : 'a list -> 'b list -> 'c list -> ('a * 'b * 'c) list
+  (** [combinations l] returns the list of [n_1] * ... * [n_p] tuples
+      [[a11;...;ap1];...;[a1n_1;...;apn_pd]] whenever [l] is a list
+      [[a11;..;a1n_1];...;[ap1;apn_p]]; otherwise said, it is
+      [cartesians (::) [] l] *)
 
   val cartesians_filter :
     ('a -> 'b -> 'b option) -> 'b -> 'a list list -> 'b list
-  (** Keep only those products that do not return None *)
-
-  val factorize_left : 'a eq -> ('a * 'b) list -> ('a * 'b list) list
+  (** Like [cartesians op init l] but keep only the tuples for which
+      [op] returns [Some _] on all the elements of the tuple. *)
+
+  module Smart :
+  sig
+    val map : ('a -> 'a) -> 'a list -> 'a list
+    (** [Smart.map f [a1...an] = List.map f [a1...an]] but if for all i
+        [f ai == ai], then [Smart.map f l == l] *)
+  end
 
   module type MonoS = sig
     type elt
diff --git a/clib/cMap.ml b/clib/cMap.ml
index 373e3f8f..54a8b258 100644
--- a/clib/cMap.ml
+++ b/clib/cMap.ml
@@ -35,8 +35,15 @@ sig
   val fold_left : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
   val fold_right : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
   val smartmap : ('a -> 'a) -> 'a t -> 'a t
+  [@@ocaml.deprecated "Same as [Smart.map]"]
   val smartmapi : (key -> 'a -> 'a) -> 'a t -> 'a t
+  [@@ocaml.deprecated "Same as [Smart.mapi]"]
   val height : 'a t -> int
+  module Smart :
+  sig
+    val map : ('a -> 'a) -> 'a t -> 'a t
+    val mapi : (key -> 'a -> 'a) -> 'a t -> 'a t
+  end
   module Unsafe :
   sig
     val map : (key -> 'a -> key * 'b) -> 'a t -> 'b t
@@ -59,8 +66,15 @@ sig
   val fold_left : (M.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b
   val fold_right : (M.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b
   val smartmap : ('a -> 'a) -> 'a map -> 'a map
+  [@@ocaml.deprecated "Same as [Smart.map]"]
   val smartmapi : (M.t -> 'a -> 'a) -> 'a map -> 'a map
+  [@@ocaml.deprecated "Same as [Smart.mapi]"]
   val height : 'a map -> int
+  module Smart :
+  sig
+    val map : ('a -> 'a) -> 'a map -> 'a map
+    val mapi : (M.t -> 'a -> 'a) -> 'a map -> 'a map
+  end
   module Unsafe :
   sig
     val map : (M.t -> 'a -> M.t * 'b) -> 'a map -> 'b map
@@ -154,28 +168,36 @@ struct
     let accu = f k v (fold_right f r accu) in
     fold_right f l accu
 
-  let rec smartmap f (s : 'a map) = match map_prj s with
-  | MEmpty -> map_inj MEmpty
-  | MNode (l, k, v, r, h) ->
-    let l' = smartmap f l in
-    let r' = smartmap f r in
-    let v' = f v in
-    if l == l' && r == r' && v == v' then s
-    else map_inj (MNode (l', k, v', r', h))
-
-  let rec smartmapi f (s : 'a map) = match map_prj s with
-  | MEmpty -> map_inj MEmpty
-  | MNode (l, k, v, r, h) ->
-    let l' = smartmapi f l in
-    let r' = smartmapi f r in
-    let v' = f k v in
-    if l == l' && r == r' && v == v' then s
-    else map_inj (MNode (l', k, v', r', h))
-
   let height s = match map_prj s with
   | MEmpty -> 0
   | MNode (_, _, _, _, h) -> h
 
+  module Smart =
+  struct
+
+    let rec map f (s : 'a map) = match map_prj s with
+    | MEmpty -> map_inj MEmpty
+    | MNode (l, k, v, r, h) ->
+      let l' = map f l in
+      let r' = map f r in
+      let v' = f v in
+      if l == l' && r == r' && v == v' then s
+      else map_inj (MNode (l', k, v', r', h))
+
+    let rec mapi f (s : 'a map) = match map_prj s with
+    | MEmpty -> map_inj MEmpty
+    | MNode (l, k, v, r, h) ->
+      let l' = mapi f l in
+      let r' = mapi f r in
+      let v' = f k v in
+      if l == l' && r == r' && v == v' then s
+      else map_inj (MNode (l', k, v', r', h))
+
+  end
+
+  let smartmap = Smart.map
+  let smartmapi = Smart.mapi
+
   module Unsafe =
   struct
 
diff --git a/clib/cMap.mli b/clib/cMap.mli
index bb0019bb..127bf23a 100644
--- a/clib/cMap.mli
+++ b/clib/cMap.mli
@@ -58,14 +58,23 @@ sig
   (** Folding keys in decreasing order. *)
 
   val smartmap : ('a -> 'a) -> 'a t -> 'a t
-  (** As [map] but tries to preserve sharing. *)
+  [@@ocaml.deprecated "Same as [Smart.map]"]
 
   val smartmapi : (key -> 'a -> 'a) -> 'a t -> 'a t
-  (** As [mapi] but tries to preserve sharing. *)
+  [@@ocaml.deprecated "Same as [Smart.mapi]"]
 
   val height : 'a t -> int
   (** An indication of the logarithmic size of a map *)
 
+  module Smart :
+  sig
+    val map : ('a -> 'a) -> 'a t -> 'a t
+    (** As [map] but tries to preserve sharing. *)
+
+    val mapi : (key -> 'a -> 'a) -> 'a t -> 'a t
+    (** As [mapi] but tries to preserve sharing. *)
+  end
+
   module Unsafe :
   sig
     val map : (key -> 'a -> key * 'b) -> 'a t -> 'b t
diff --git a/clib/canary.ml b/clib/canary.ml
deleted file mode 100644
index b8b79ed7..00000000
--- a/clib/canary.ml
+++ /dev/null
@@ -1,28 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-type t = Obj.t
-
-let obj = Obj.new_block Obj.closure_tag 0
-  (** This is an empty closure block. In the current implementation, it is
-      sufficient to allow marshalling but forbid equality. Sadly still allows
-      hash. *)
-  (** FIXME : use custom blocks somehow. *)
-
-module type Obj = sig type t end
-
-module Make(M : Obj) =
-struct
-  type canary = t
-  type t = (canary * M.t)
-
-  let prj (_, x) = x
-  let inj x = (obj, x)
-end
diff --git a/clib/canary.mli b/clib/canary.mli
deleted file mode 100644
index d993eabc..00000000
--- a/clib/canary.mli
+++ /dev/null
@@ -1,27 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-type t
-(** Type of canaries. Canaries are used to ensure that an object does not use
-    generic operations. *)
-
-val obj : t
-(** Canary. In the current implementation, this object is marshallable,
-    forbids generic comparison but still allows generic hashes. *)
-
-module type Obj = sig type t end
-
-module Make(M : Obj) :
-sig
-  type t
-  val prj : t -> M.t
-  val inj : M.t -> t
-end
-(** Adds a canary to any type. *)
diff --git a/clib/clib.mllib b/clib/clib.mllib
index c9b4d72f..5a2c9a9c 100644
--- a/clib/clib.mllib
+++ b/clib/clib.mllib
@@ -1,4 +1,3 @@
-Canary
 CObj
 CEphemeron
 
@@ -38,3 +37,5 @@ Backtrace
 IStream
 Terminal
 Monad
+
+Diff2
diff --git a/clib/diff2.ml b/clib/diff2.ml
new file mode 100644
index 00000000..42c4733f
--- /dev/null
+++ b/clib/diff2.ml
@@ -0,0 +1,158 @@
+(* copied from https://github.com/leque/ocaml-diff.git and renamed from "diff.ml" *)
+
+(*
+ * Copyright (C) 2016 OOHASHI Daichi
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a copy
+ * of this software and associated documentation files (the "Software"), to deal
+ * in the Software without restriction, including without limitation the rights
+ * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+ * copies of the Software, and to permit persons to whom the Software is
+ * furnished to do so, subject to the following conditions:
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+ * THE SOFTWARE.
+ *)
+
+type 'a common =
+  [ `Common of int * int * 'a ]
+
+type 'a edit =
+  [ `Added of int * 'a
+  | `Removed of int * 'a
+  | 'a common
+  ]
+
+module type SeqType = sig
+  type t
+  type elem
+  val get : t -> int -> elem
+  val length : t -> int
+end
+
+module type S = sig
+  type t
+  type elem
+
+  val lcs :
+      ?equal:(elem -> elem -> bool) ->
+      t -> t -> elem common list
+
+  val diff :
+      ?equal:(elem -> elem -> bool) ->
+      t -> t -> elem edit list
+
+  val fold_left :
+      ?equal:(elem -> elem -> bool) ->
+      f:('a -> elem edit -> 'a) ->
+      init:'a ->
+      t -> t -> 'a
+
+  val iter :
+      ?equal:(elem -> elem -> bool) ->
+      f:(elem edit -> unit) ->
+      t -> t -> unit
+end
+
+module Make(M : SeqType) : (S with type t = M.t and type elem = M.elem) = struct
+  type t = M.t
+  type elem = M.elem
+
+  let lcs ?(equal = (=)) a b =
+    let n = M.length a in
+    let m = M.length b in
+    let mn = m + n in
+    let sz = 2 * mn + 1 in
+    let vd = Array.make sz 0 in
+    let vl = Array.make sz 0 in
+    let vr = Array.make sz [] in
+    let get v i = Array.get v (i + mn) in
+    let set v i x = Array.set v (i + mn) x in
+    let finish () =
+      let rec loop i maxl r =
+        if i > mn then
+          List.rev r
+        else if get vl i > maxl then
+          loop (i + 1) (get vl i) (get vr i)
+        else
+          loop (i + 1) maxl r
+      in loop (- mn) 0 []
+    in
+    if mn = 0 then
+      []
+    else
+      (* For d <- 0 to mn Do *)
+      let rec dloop d =
+        assert (d <= mn);
+        (* For k <- -d to d in steps of 2 Do *)
+        let rec kloop k =
+          if k > d then
+            dloop @@ d + 1
+          else
+            let x, l, r =
+              if k = -d || (k <> d && get vd (k - 1) < get vd (k + 1)) then
+                get vd (k + 1), get vl (k + 1), get vr (k + 1)
+              else
+                get vd (k - 1) + 1, get vl (k - 1), get vr (k - 1)
+            in
+            let x, y, l, r =
+              let rec xyloop x y l r =
+                if x < n && y < m && equal (M.get a x) (M.get b y) then
+                  xyloop (x + 1) (y + 1) (l + 1) (`Common(x, y, M.get a x) :: r)
+                else
+                  x, y, l, r
+              in xyloop x (x - k) l r
+            in
+            set vd k x;
+            set vl k l;
+            set vr k r;
+            if x >= n && y >= m then
+              (* Stop *)
+              finish ()
+            else
+              kloop @@ k + 2
+        in kloop @@ -d
+      in dloop 0
+
+  let fold_left ?(equal = (=)) ~f ~init a b =
+    let ff x y = f y x in
+    let fold_map f g x from to_ init =
+      let rec loop i init =
+        if i >= to_ then
+          init
+        else
+          loop (i + 1) (f (g i @@ M.get x i) init)
+      in loop from init
+    in
+    let added i x = `Added (i, x) in
+    let removed i x = `Removed (i, x) in
+    let rec loop cs apos bpos init =
+      match cs with
+      | [] ->
+          init
+          |> fold_map ff removed a apos (M.length a)
+          |> fold_map ff added b bpos (M.length b)
+      | `Common (aoff, boff, _) as e :: rest ->
+          init
+          |> fold_map ff removed a apos aoff
+          |> fold_map ff added b bpos boff
+          |> ff e
+          |> loop rest (aoff + 1) (boff + 1)
+    in loop (lcs ~equal a b) 0 0 init
+
+  let diff ?(equal = (=)) a b =
+    fold_left ~equal ~f:(fun xs x -> x::xs) ~init:[] a b
+
+  let iter ?(equal = (=)) ~f a b =
+    fold_left a b
+      ~equal
+      ~f:(fun () x -> f x)
+      ~init:()
+end
diff --git a/clib/diff2.mli b/clib/diff2.mli
new file mode 100644
index 00000000..a085f4ff
--- /dev/null
+++ b/clib/diff2.mli
@@ -0,0 +1,101 @@
+(* copied from https://github.com/leque/ocaml-diff.git and renamed from "diff.mli" *)
+(**
+   An implementation of Eugene Myers' O(ND) Difference Algorithm\[1\].
+   This implementation is a port of util.lcs module of
+   {{:http://practical-scheme.net/gauche} Gauche Scheme interpreter}.
+
+   - \[1\] Eugene Myers, An O(ND) Difference Algorithm and Its Variations, Algorithmica Vol. 1 No. 2, pp. 251-266, 1986.
+ *)
+
+type 'a common = [
+    `Common of int * int * 'a
+  ]
+(** an element of lcs of seq1 and seq2 *)
+
+type 'a edit =
+  [ `Removed of int * 'a
+  | `Added of int * 'a
+  | 'a common
+  ]
+(** an element of diff of seq1 and seq2. *)
+
+module type SeqType = sig
+  type t
+  (** The type of the sequence. *)
+
+  type elem
+  (** The type of the elements of the sequence. *)
+
+  val get : t -> int -> elem
+  (** [get t n] returns [n]-th element of the sequence [t]. *)
+
+  val length : t -> int
+  (** [length t] returns the length of the sequence [t]. *)
+end
+(** Input signature of {!Diff.Make}. *)
+
+module type S = sig
+  type t
+  (** The type of input sequence. *)
+
+  type elem
+  (** The type of the elements of result / input sequence. *)
+
+  val lcs :
+      ?equal:(elem -> elem -> bool) ->
+      t -> t -> elem common list
+  (**
+     [lcs ~equal seq1 seq2] computes the LCS (longest common sequence) of
+     [seq1] and [seq2].
+     Elements of [seq1] and [seq2] are compared with [equal].
+     [equal] defaults to [Pervasives.(=)].
+
+     Elements of lcs are [`Common (pos1, pos2, e)]
+     where [e] is an element, [pos1] is a position in [seq1],
+     and [pos2] is a position in [seq2].
+   *)
+
+  val diff :
+      ?equal:(elem -> elem -> bool) ->
+      t -> t -> elem edit list
+  (**
+     [diff ~equal seq1 seq2] computes the diff of [seq1] and [seq2].
+     Elements of [seq1] and [seq2] are compared with [equal].
+
+     Elements only in [seq1] are represented as [`Removed (pos, e)]
+     where [e] is an element, and [pos] is a position in [seq1];
+     those only in [seq2] are represented as [`Added (pos, e)]
+     where [e] is an element, and [pos] is a position in [seq2];
+     those common in [seq1] and [seq2] are represented as
+     [`Common (pos1, pos2, e)]
+     where [e] is an element, [pos1] is a position in [seq1],
+     and [pos2] is a position in [seq2].
+   *)
+
+  val fold_left :
+      ?equal:(elem -> elem -> bool) ->
+      f:('a -> elem edit -> 'a) ->
+      init:'a ->
+      t -> t -> 'a
+  (**
+     [fold_left ~equal ~f ~init seq1 seq2] is same as
+     [diff ~equal seq1 seq2 |> ListLabels.fold_left ~f ~init],
+     but does not create an intermediate list.
+   *)
+
+  val iter :
+      ?equal:(elem -> elem -> bool) ->
+      f:(elem edit -> unit) ->
+      t -> t -> unit
+  (**
+     [iter ~equal ~f seq1 seq2] is same as
+     [diff ~equal seq1 seq2 |> ListLabels.iter ~f],
+     but does not create an intermediate list.
+   *)
+end
+(** Output signature of {!Diff.Make}. *)
+
+module Make :
+  functor (M : SeqType) -> (S with type t = M.t and type elem = M.elem)
+(** Functor building an implementation of the diff structure
+    given a sequence type.  *)
diff --git a/clib/dyn.ml b/clib/dyn.ml
index e9b04198..6c457672 100644
--- a/clib/dyn.ml
+++ b/clib/dyn.ml
@@ -8,7 +8,7 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-module type TParam =
+module type ValueS =
 sig
   type 'a t
 end
@@ -16,40 +16,38 @@ end
 module type MapS =
 sig
   type t
-  type 'a obj
   type 'a key
+  type 'a value
   val empty : t
-  val add : 'a key -> 'a obj -> t -> t
+  val add : 'a key -> 'a value -> t -> t
   val remove : 'a key -> t -> t
-  val find : 'a key -> t -> 'a obj
+  val find : 'a key -> t -> 'a value
   val mem : 'a key -> t -> bool
 
-  type any = Any : 'a key * 'a obj -> any
-
-  type map = { map : 'a. 'a key -> 'a obj -> 'a obj }
+  type map = { map : 'a. 'a key -> 'a value -> 'a value }
   val map : map -> t -> t
 
+  type any = Any : 'a key * 'a value -> any
   val iter : (any -> unit) -> t -> unit
   val fold : (any -> 'r -> 'r) -> t -> 'r -> 'r
 end
 
 module type PreS =
 sig
-type 'a tag
-type t = Dyn : 'a tag * 'a -> t
-
-val create : string -> 'a tag
-val eq : 'a tag -> 'b tag -> ('a, 'b) CSig.eq option
-val repr : 'a tag -> string
+  type 'a tag
+  type t = Dyn : 'a tag * 'a -> t
 
-type any = Any : 'a tag -> any
+  val create : string -> 'a tag
+  val eq : 'a tag -> 'b tag -> ('a, 'b) CSig.eq option
+  val repr : 'a tag -> string
 
-val name : string -> any option
+  val dump : unit -> (int * string) list
 
-module Map(M : TParam) : MapS with type 'a obj = 'a M.t with type 'a key = 'a tag
-
-val dump : unit -> (int * string) list
+  type any = Any : 'a tag -> any
+  val name : string -> any option
 
+  module Map(Value : ValueS) :
+    MapS with type 'a key = 'a tag and type 'a value = 'a Value.t
 end
 
 module type S =
@@ -57,104 +55,100 @@ sig
   include PreS
 
   module Easy : sig
-
     val make_dyn_tag : string -> ('a -> t) * (t -> 'a) * 'a tag
     val make_dyn : string -> ('a -> t) * (t -> 'a)
     val inj : 'a -> 'a tag -> t
     val prj : t -> 'a tag -> 'a option
   end
-
 end
 
 module Make () = struct
-module Self : PreS = struct
-(* Dynamics, programmed with DANGER !!! *)
-
-type 'a tag = int
 
-type t = Dyn : 'a tag * 'a -> t
-
-type any = Any : 'a tag -> any
-
-let dyntab = ref (Int.Map.empty : string Int.Map.t)
-(** Instead of working with tags as strings, which are costly, we use their
-    hash. We ensure unicity of the hash in the [create] function. If ever a
-    collision occurs, which is unlikely, it is sufficient to tweak the offending
-    dynamic tag. *)
-
-let create (s : string) =
-  let hash = Hashtbl.hash s in
-  let () =
-    if Int.Map.mem hash !dyntab then
-      let old = Int.Map.find hash !dyntab in
-      let () = Printf.eprintf "Dynamic tag collision: %s vs. %s\n%!" s old in
+module Self : PreS = struct
+  (* Dynamics, programmed with DANGER !!! *)
+
+  type 'a tag = int
+
+  type t = Dyn : 'a tag * 'a -> t
+
+  type any = Any : 'a tag -> any
+
+  let dyntab = ref (Int.Map.empty : string Int.Map.t)
+  (** Instead of working with tags as strings, which are costly, we use their
+      hash. We ensure unicity of the hash in the [create] function. If ever a
+      collision occurs, which is unlikely, it is sufficient to tweak the offending
+      dynamic tag. *)
+
+  let create (s : string) =
+    let hash = Hashtbl.hash s in
+    let () =
+      if Int.Map.mem hash !dyntab then
+        let old = Int.Map.find hash !dyntab in
+        let () = Printf.eprintf "Dynamic tag collision: %s vs. %s\n%!" s old in
+        assert false
+    in
+    let () = dyntab := Int.Map.add hash s !dyntab in
+    hash
+
+  let eq : 'a 'b. 'a tag -> 'b tag -> ('a, 'b) CSig.eq option =
+    fun h1 h2 -> if Int.equal h1 h2 then Some (Obj.magic CSig.Refl) else None
+
+  let repr s =
+    try Int.Map.find s !dyntab
+    with Not_found ->
+      let () = Printf.eprintf "Unknown dynamic tag %i\n%!" s in
       assert false
-  in
-  let () = dyntab := Int.Map.add hash s !dyntab in
-  hash
-
-let eq : 'a 'b. 'a tag -> 'b tag -> ('a, 'b) CSig.eq option =
-  fun h1 h2 -> if Int.equal h1 h2 then Some (Obj.magic CSig.Refl) else None
-
-let repr s =
-  try Int.Map.find s !dyntab
-  with Not_found ->
-    let () = Printf.eprintf "Unknown dynamic tag %i\n%!" s in
-    assert false
-
-let name s =
-  let hash = Hashtbl.hash s in
-  if Int.Map.mem hash !dyntab then Some (Any hash) else None
-
-let dump () = Int.Map.bindings !dyntab
-
-module Map(M : TParam) =
-struct
-type t = Obj.t M.t Int.Map.t
-type 'a obj = 'a M.t
-type 'a key = 'a tag
-let cast : 'a M.t -> 'b M.t = Obj.magic
-let empty = Int.Map.empty
-let add tag v m = Int.Map.add tag (cast v) m
-let remove tag m = Int.Map.remove tag m
-let find tag m = cast (Int.Map.find tag m)
-let mem = Int.Map.mem
-
-type any = Any : 'a tag * 'a M.t -> any
-
-type map = { map : 'a. 'a tag -> 'a M.t -> 'a M.t }
-let map f m = Int.Map.mapi f.map m
-
-let iter f m = Int.Map.iter (fun k v -> f (Any (k, v))) m
-let fold f m accu = Int.Map.fold (fun k v accu -> f (Any (k, v)) accu) m accu
-end
 
+  let name s =
+    let hash = Hashtbl.hash s in
+    if Int.Map.mem hash !dyntab then Some (Any hash) else None
+
+  let dump () = Int.Map.bindings !dyntab
+
+  module Map(Value: ValueS) =
+  struct
+    type t = Obj.t Value.t Int.Map.t
+    type 'a key = 'a tag
+    type 'a value = 'a Value.t
+    let cast : 'a value -> 'b value = Obj.magic
+    let empty = Int.Map.empty
+    let add tag v m = Int.Map.add tag (cast v) m
+    let remove tag m = Int.Map.remove tag m
+    let find tag m = cast (Int.Map.find tag m)
+    let mem = Int.Map.mem
+
+    type map = { map : 'a. 'a tag -> 'a value -> 'a value }
+    let map f m = Int.Map.mapi f.map m
+
+    type any = Any : 'a tag * 'a value -> any
+    let iter f m = Int.Map.iter (fun k v -> f (Any (k, v))) m
+    let fold f m accu = Int.Map.fold (fun k v accu -> f (Any (k, v)) accu) m accu
+  end
 end
 include Self
 
 module Easy = struct
-
-(* now tags are opaque, we can do the trick *)
-let make_dyn_tag (s : string) =
- (fun (type a) (tag : a tag) ->
-  let infun : (a -> t) = fun x -> Dyn (tag, x) in
-  let outfun : (t -> a) = fun (Dyn (t, x)) ->
-    match eq tag t with
-    | None -> assert false
-    | Some CSig.Refl -> x
-  in
-  infun, outfun, tag)
- (create s)
-
-let make_dyn (s : string) =
-  let inf, outf, _ = make_dyn_tag s in inf, outf
-
-let inj x tag = Dyn(tag,x)
-let prj : type a. t -> a tag -> a option =
+  (* now tags are opaque, we can do the trick *)
+  let make_dyn_tag (s : string) =
+   (fun (type a) (tag : a tag) ->
+    let infun : (a -> t) = fun x -> Dyn (tag, x) in
+    let outfun : (t -> a) = fun (Dyn (t, x)) ->
+      match eq tag t with
+      | None -> assert false
+      | Some CSig.Refl -> x
+    in
+    infun, outfun, tag)
+   (create s)
+
+  let make_dyn (s : string) =
+    let inf, outf, _ = make_dyn_tag s in inf, outf
+
+  let inj x tag = Dyn(tag,x)
+  let prj : type a. t -> a tag -> a option =
     fun (Dyn(tag',x)) tag ->
-    match eq tag tag' with
-    | None -> None
-    | Some CSig.Refl -> Some x
+      match eq tag tag' with
+      | None -> None
+      | Some CSig.Refl -> Some x
 end
 
 end
diff --git a/clib/dyn.mli b/clib/dyn.mli
index 51d30914..ff9762bd 100644
--- a/clib/dyn.mli
+++ b/clib/dyn.mli
@@ -10,7 +10,7 @@
 
 (** Dynamically typed values *)
 
-module type TParam =
+module type ValueS =
 sig
   type 'a t
 end
@@ -18,51 +18,66 @@ end
 module type MapS =
 sig
   type t
-  type 'a obj
   type 'a key
+  type 'a value
   val empty : t
-  val add : 'a key -> 'a obj -> t -> t
+  val add : 'a key -> 'a value -> t -> t
   val remove : 'a key -> t -> t
-  val find : 'a key -> t -> 'a obj
+  val find : 'a key -> t -> 'a value
   val mem : 'a key -> t -> bool
 
-  type any = Any : 'a key * 'a obj -> any
-
-  type map = { map : 'a. 'a key -> 'a obj -> 'a obj }
+  type map = { map : 'a. 'a key -> 'a value -> 'a value }
   val map : map -> t -> t
 
+  type any = Any : 'a key * 'a value -> any
   val iter : (any -> unit) -> t -> unit
   val fold : (any -> 'r -> 'r) -> t -> 'r -> 'r
 end
 
 module type S =
 sig
-type 'a tag
-type t = Dyn : 'a tag * 'a -> t
+  type 'a tag
+  (** Type of dynamic tags *)
 
-val create : string -> 'a tag
-val eq : 'a tag -> 'b tag -> ('a, 'b) CSig.eq option
-val repr : 'a tag -> string
+  type t = Dyn : 'a tag * 'a -> t
+  (** Type of dynamic values *)
 
-type any = Any : 'a tag -> any
+  val create : string -> 'a tag
+  (** [create n] returns a tag describing a type called [n].
+      [create] raises an exception if [n] is already registered.
+      Type names are hashed, so [create] may raise even if no type with
+      the exact same name was registered due to a collision. *)
 
-val name : string -> any option
+  val eq : 'a tag -> 'b tag -> ('a, 'b) CSig.eq option
+  (** [eq t1 t2] returns [Some witness] if [t1] is the same as [t2], [None] otherwise. *)
 
-module Map(M : TParam) : MapS with type 'a obj = 'a M.t with type 'a key = 'a tag
+  val repr : 'a tag -> string
+  (** [repr tag] returns the name of the type represented by [tag]. *)
 
-val dump : unit -> (int * string) list
+  val dump : unit -> (int * string) list
+  (** [dump ()] returns a list of (tag, name) pairs for every type tag registered
+      in this [Dyn.Make] instance. *)
 
-module Easy : sig
+  type any = Any : 'a tag -> any
+  (** Type of boxed dynamic tags *)
 
-  (* To create a dynamic type on the fly *)
-  val make_dyn_tag : string -> ('a -> t) * (t -> 'a) * 'a tag
-  val make_dyn : string -> ('a -> t) * (t -> 'a)
+  val name : string -> any option
+  (** [name n] returns [Some t] where t is a boxed tag previously registered
+      with [create n], or [None] if there is no such tag. *)
 
-  (* For types declared with the [create] function above *)
-  val inj : 'a -> 'a tag -> t
-  val prj : t -> 'a tag -> 'a option
-end
+  module Map(Value : ValueS) :
+    MapS with type 'a key = 'a tag and type 'a value = 'a Value.t
+  (** Map from type tags to values parameterized by the tag type *)
+
+  module Easy : sig
+    (* To create a dynamic type on the fly *)
+    val make_dyn_tag : string -> ('a -> t) * (t -> 'a) * 'a tag
+    val make_dyn : string -> ('a -> t) * (t -> 'a)
 
+    (* For types declared with the [create] function above *)
+    val inj : 'a -> 'a tag -> t
+    val prj : t -> 'a tag -> 'a option
+  end
 end
 
 module Make () : S
diff --git a/clib/hMap.ml b/clib/hMap.ml
index 37f867c6..b2cf4743 100644
--- a/clib/hMap.ml
+++ b/clib/hMap.ml
@@ -383,13 +383,21 @@ struct
     let m = Map.set k x m in
     Int.Map.set h m s
 
-  let smartmap f s =
-    let fs m = Map.smartmap f m in
-    Int.Map.smartmap fs s
+  module Smart =
+  struct
+
+    let map f s =
+      let fs m = Map.Smart.map f m in
+      Int.Map.Smart.map fs s
+
+    let mapi f s =
+      let fs m = Map.Smart.mapi f m in
+      Int.Map.Smart.map fs s
+
+  end
 
-  let smartmapi f s =
-    let fs m = Map.smartmapi f m in
-    Int.Map.smartmap fs s
+  let smartmap = Smart.map
+  let smartmapi = Smart.mapi
 
   let height s = Int.Map.height s
 
diff --git a/clib/hashcons.ml b/clib/hashcons.ml
index ec73c6d9..39969ebf 100644
--- a/clib/hashcons.ml
+++ b/clib/hashcons.ml
@@ -10,8 +10,6 @@
 
 (* Hash consing of datastructures *)
 
-(* The generic hash-consing functions (does not use Obj) *)
-
 (* [t] is the type of object to hash-cons
  * [u] is the type of hash-cons functions for the sub-structures
  *   of objects of type t (u usually has the form (t1->t1)*(t2->t2)*...).
@@ -148,41 +146,3 @@ module Hstring = Make(
       let len = String.length s in
       hash len s 0 0
   end)
-
-(* Obj.t *)
-exception NotEq
-
-(* From CAMLLIB/caml/mlvalues.h *)
-let no_scan_tag = 251
-let tuple_p obj = Obj.is_block obj && (Obj.tag obj < no_scan_tag)
-
-let comp_obj o1 o2 =
-  if tuple_p o1 && tuple_p o2 then
-    let n1 = Obj.size o1 and n2 = Obj.size o2 in
-      if n1=n2 then
-        try
-          for i = 0 to pred n1 do
-            if not (Obj.field o1 i == Obj.field o2 i) then raise NotEq
-          done; true
-        with NotEq -> false
-      else false
-  else o1=o2
-
-let hash_obj hrec o =
-  begin
-    if tuple_p o then
-      let n = Obj.size o in
-        for i = 0 to pred n do
-          Obj.set_field o i (hrec (Obj.field o i))
-        done
-  end;
-  o
-
-module Hobj = Make(
-  struct
-    type t = Obj.t
-    type u = (Obj.t -> Obj.t) * unit
-    let hashcons (hrec,_) = hash_obj hrec
-    let eq = comp_obj
-    let hash = Hashtbl.hash
-  end)
diff --git a/clib/hashcons.mli b/clib/hashcons.mli
index 3e396ff2..223dd2a4 100644
--- a/clib/hashcons.mli
+++ b/clib/hashcons.mli
@@ -87,6 +87,3 @@ module Hstring : (S with type t = string and type u = unit)
 module Hlist (D:HashedType) :
   (S with type t = D.t list and type u = (D.t list -> D.t list)*(D.t->D.t))
 (** Hashconsing of lists.  *)
-
-module Hobj : (S with type t = Obj.t and type u = (Obj.t -> Obj.t) * unit)
-(** Hashconsing of OCaml values. *)
diff --git a/clib/option.ml b/clib/option.ml
index 32fe2fc5..7a3d5f93 100644
--- a/clib/option.ml
+++ b/clib/option.ml
@@ -100,12 +100,6 @@ let map f = function
   | Some y -> Some (f y)
   | _ -> None
 
-(** [smartmap f x] does the same as [map f x] except that it tries to share
-    some memory. *)
-let smartmap f = function
-  | Some y as x -> let y' = f y in if y' == y then x else Some y'
-  | _ -> None
-
 (** [fold_left f a x] is [f a y] if [x] is [Some y], and [a] otherwise. *)
 let fold_left f a = function
   | Some y -> f a y
@@ -176,6 +170,21 @@ let lift2 f x y =
   | _,_ -> None
 
 
+(** {6 Smart operations} *)
+
+module Smart =
+struct
+
+  (** [Smart.map f x] does the same as [map f x] except that it tries to share
+      some memory. *)
+  let map f = function
+    | Some y as x -> let y' = f y in if y' == y then x else Some y'
+    | _ -> None
+
+end
+
+let smartmap = Smart.map
+
 (** {6 Operations with Lists} *)
 
 module List =
diff --git a/clib/option.mli b/clib/option.mli
index 14fa9da3..8f82bf09 100644
--- a/clib/option.mli
+++ b/clib/option.mli
@@ -75,9 +75,8 @@ val iter2 : ('a -> 'b -> unit) -> 'a option -> 'b option -> unit
 (** [map f x] is [None] if [x] is [None] and [Some (f y)] if [x] is [Some y]. *)
 val map : ('a -> 'b) -> 'a option -> 'b option
 
-(** [smartmap f x] does the same as [map f x] except that it tries to share
-    some memory. *)
 val smartmap : ('a -> 'a) -> 'a option -> 'a option
+[@@ocaml.deprecated "Same as [Smart.map]"]
 
 (** [fold_left f a x] is [f a y] if [x] is [Some y], and [a] otherwise. *)
 val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a option -> 'b
@@ -123,6 +122,16 @@ val lift_left : ('a -> 'b -> 'c) -> 'a option -> 'b -> 'c option
     [Some w]. It is [None] otherwise. *)
 val lift2 : ('a -> 'b -> 'c) -> 'a option -> 'b option -> 'c option
 
+(** {6 Smart operations} *)
+
+module Smart :
+sig
+
+  (** [Smart.map f x] does the same as [map f x] except that it tries to share
+      some memory. *)
+  val map : ('a -> 'a) -> 'a option -> 'a option
+
+end
 
 (** {6 Operations with Lists} *)
 
diff --git a/clib/terminal.ml b/clib/terminal.ml
index 1d946813..d243d659 100644
--- a/clib/terminal.ml
+++ b/clib/terminal.ml
@@ -59,6 +59,19 @@ let default = {
   suffix = None;
 }
 
+let reset = "\027[0m"
+
+let reset_style = {
+  fg_color = Some `DEFAULT;
+  bg_color = Some `DEFAULT;
+  bold = Some false;
+  italic = Some false;
+  underline = Some false;
+  negative = Some false;
+  prefix = None;
+  suffix = None;
+}
+
 let make ?fg_color ?bg_color ?bold ?italic ?underline ?negative ?style ?prefix ?suffix () =
   let st = match style with
   | None -> default
@@ -87,6 +100,25 @@ let merge s1 s2 =
     suffix = set s1.suffix s2.suffix;
   }
 
+let diff s1 s2 =
+  let diff_op o1 o2 reset_val = match o1 with
+  | None -> o2
+  | Some _ ->
+    match o2 with
+    | None -> reset_val
+    | Some _ -> if o1 = o2 then None else o2 in
+
+  {
+    fg_color = diff_op s1.fg_color s2.fg_color reset_style.fg_color;
+    bg_color = diff_op s1.bg_color s2.bg_color reset_style.bg_color;
+    bold = diff_op s1.bold s2.bold reset_style.bold;
+    italic = diff_op s1.italic s2.italic reset_style.italic;
+    underline = diff_op s1.underline s2.underline reset_style.underline;
+    negative = diff_op s1.negative s2.negative reset_style.negative;
+    prefix = diff_op s1.prefix s2.prefix reset_style.prefix;
+    suffix = diff_op s1.suffix s2.suffix reset_style.suffix;
+  }
+
 let base_color = function
 | `DEFAULT -> 9
 | `BLACK -> 0
@@ -167,20 +199,8 @@ let repr st =
 let eval st =
   let tags = repr st in
   let tags = List.map string_of_int tags in
-  Printf.sprintf "\027[%sm" (String.concat ";" tags)
-
-let reset = "\027[0m"
-
-let reset_style = {
-  fg_color = Some `DEFAULT;
-  bg_color = Some `DEFAULT;
-  bold = Some false;
-  italic = Some false;
-  underline = Some false;
-  negative = Some false;
-  prefix = None;
-  suffix = None;
-}
+  if List.length tags = 0 then "" else
+    Printf.sprintf "\027[%sm" (String.concat ";" tags)
 
 let has_style t =
   Unix.isatty t && Sys.os_type = "Unix"
diff --git a/clib/terminal.mli b/clib/terminal.mli
index dbf8d464..bc30b001 100644
--- a/clib/terminal.mli
+++ b/clib/terminal.mli
@@ -51,6 +51,9 @@ val make : ?fg_color:color -> ?bg_color:color ->
 val merge : style -> style -> style
 (** [merge s1 s2] returns [s1] with all defined values of [s2] overwritten. *)
 
+val diff : style -> style -> style
+(** [diff s1 s2] returns the differences between [s1] and [s2]. *)
+
 val repr : style -> int list
 (** Generate the ANSI code representing the given style. *)
 
@@ -60,6 +63,9 @@ val eval : style -> string
 val reset : string
 (** This escape sequence resets all attributes. *)
 
+val reset_style : style
+(** The default style *)
+
 val has_style : Unix.file_descr -> bool
 (** Whether an output file descriptor handles styles. Very heuristic, only
     checks it is a terminal. *)
-- 
cgit v1.2.3