From 070467672414ca87d26b52ccf9c6d3e53d76527e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Suzanne=20Dup=C3=A9ron?= <ligo@suzanne.soy>
Date: Thu, 9 Apr 2020 14:02:06 +0200
Subject: [PATCH] Imported Christian Rinderknecht's polymorphic Red-Black_Trees
 library from commit
 https://github.com/rinderknecht/Red-Black_Trees/commit/98b11312810d979ee1b0dacee6900228574e41e7

---
 vendors/Red-Black_Trees/.PolyMapMain.tag  |  0
 vendors/Red-Black_Trees/.PolySetMain.tag  |  0
 vendors/Red-Black_Trees/.RedBlackMain.tag |  0
 vendors/Red-Black_Trees/.links            |  1 +
 vendors/Red-Black_Trees/LICENSE           | 21 ++++++
 vendors/Red-Black_Trees/Makefile.cfg      |  4 ++
 vendors/Red-Black_Trees/PolyMap.ml        | 37 ++++++++++
 vendors/Red-Black_Trees/PolyMap.mli       | 70 ++++++++++++++++++
 vendors/Red-Black_Trees/PolyMapMain.ml    | 59 +++++++++++++++
 vendors/Red-Black_Trees/PolySet.ml        | 32 +++++++++
 vendors/Red-Black_Trees/PolySet.mli       | 70 ++++++++++++++++++
 vendors/Red-Black_Trees/PolySetMain.ml    | 34 +++++++++
 vendors/Red-Black_Trees/README.md         |  5 ++
 vendors/Red-Black_Trees/RedBlack.ml       | 86 ++++++++++++++++++++++
 vendors/Red-Black_Trees/RedBlack.mli      | 66 +++++++++++++++++
 vendors/Red-Black_Trees/RedBlackMain.ml   | 88 +++++++++++++++++++++++
 vendors/Red-Black_Trees/URL               |  1 +
 vendors/Red-Black_Trees/build.sh          | 17 +++++
 vendors/Red-Black_Trees/clean.sh          |  3 +
 19 files changed, 594 insertions(+)
 create mode 100644 vendors/Red-Black_Trees/.PolyMapMain.tag
 create mode 100644 vendors/Red-Black_Trees/.PolySetMain.tag
 create mode 100644 vendors/Red-Black_Trees/.RedBlackMain.tag
 create mode 100644 vendors/Red-Black_Trees/.links
 create mode 100644 vendors/Red-Black_Trees/LICENSE
 create mode 100644 vendors/Red-Black_Trees/Makefile.cfg
 create mode 100644 vendors/Red-Black_Trees/PolyMap.ml
 create mode 100644 vendors/Red-Black_Trees/PolyMap.mli
 create mode 100644 vendors/Red-Black_Trees/PolyMapMain.ml
 create mode 100644 vendors/Red-Black_Trees/PolySet.ml
 create mode 100644 vendors/Red-Black_Trees/PolySet.mli
 create mode 100644 vendors/Red-Black_Trees/PolySetMain.ml
 create mode 100644 vendors/Red-Black_Trees/README.md
 create mode 100644 vendors/Red-Black_Trees/RedBlack.ml
 create mode 100644 vendors/Red-Black_Trees/RedBlack.mli
 create mode 100644 vendors/Red-Black_Trees/RedBlackMain.ml
 create mode 100644 vendors/Red-Black_Trees/URL
 create mode 100755 vendors/Red-Black_Trees/build.sh
 create mode 100755 vendors/Red-Black_Trees/clean.sh

diff --git a/vendors/Red-Black_Trees/.PolyMapMain.tag b/vendors/Red-Black_Trees/.PolyMapMain.tag
new file mode 100644
index 000000000..e69de29bb
diff --git a/vendors/Red-Black_Trees/.PolySetMain.tag b/vendors/Red-Black_Trees/.PolySetMain.tag
new file mode 100644
index 000000000..e69de29bb
diff --git a/vendors/Red-Black_Trees/.RedBlackMain.tag b/vendors/Red-Black_Trees/.RedBlackMain.tag
new file mode 100644
index 000000000..e69de29bb
diff --git a/vendors/Red-Black_Trees/.links b/vendors/Red-Black_Trees/.links
new file mode 100644
index 000000000..b79d096bc
--- /dev/null
+++ b/vendors/Red-Black_Trees/.links
@@ -0,0 +1 @@
+../OCaml-build/Makefile
diff --git a/vendors/Red-Black_Trees/LICENSE b/vendors/Red-Black_Trees/LICENSE
new file mode 100644
index 000000000..33a225af0
--- /dev/null
+++ b/vendors/Red-Black_Trees/LICENSE
@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2018 Christian Rinderknecht
+
+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.
diff --git a/vendors/Red-Black_Trees/Makefile.cfg b/vendors/Red-Black_Trees/Makefile.cfg
new file mode 100644
index 000000000..13c016eb6
--- /dev/null
+++ b/vendors/Red-Black_Trees/Makefile.cfg
@@ -0,0 +1,4 @@
+SHELL := dash
+BFLAGS := -strict-sequence -w +A-48-4
+#OCAMLC := ocamlcp
+#OCAMLOPT := ocamloptp
diff --git a/vendors/Red-Black_Trees/PolyMap.ml b/vendors/Red-Black_Trees/PolyMap.ml
new file mode 100644
index 000000000..ee485ec40
--- /dev/null
+++ b/vendors/Red-Black_Trees/PolyMap.ml
@@ -0,0 +1,37 @@
+(* Polymorphic maps *)
+
+module RB = RedBlack
+
+type ('key, 'value) t = {
+  tree : ('key * 'value) RB.t;
+  cmp  : 'key -> 'key -> int
+}
+
+type ('key, 'value) map = ('key, 'value) t
+
+let create ~cmp = {tree = RB.empty; cmp}
+
+let empty = {tree = RB.empty; cmp=Pervasives.compare}
+
+let is_empty map = RB.is_empty map.tree
+
+let add key value map =
+  let cmp (k1,_) (k2,_) = map.cmp k1 k2 in
+  {map with tree = RB.add ~cmp RB.New (key, value) map.tree}
+
+exception Not_found
+
+let find key map =
+  let cmp k1 (k2,_) = map.cmp k1 k2 in
+  try snd (RB.find ~cmp key map.tree) with
+    RB.Not_found -> raise Not_found
+
+let find_opt key map =
+  try Some (find key map) with Not_found -> None
+
+let bindings map =
+  RB.fold_dec (fun ~elt ~acc -> elt::acc) ~init:[] map.tree
+
+let iter f map = RB.iter (fun (k,v) -> f k v) map.tree
+
+let fold_inc f map = RB.fold_inc (fun ~elt:(k,v) -> f k v) map.tree
diff --git a/vendors/Red-Black_Trees/PolyMap.mli b/vendors/Red-Black_Trees/PolyMap.mli
new file mode 100644
index 000000000..7aafb8ae0
--- /dev/null
+++ b/vendors/Red-Black_Trees/PolyMap.mli
@@ -0,0 +1,70 @@
+(* Polymorphic maps
+
+   This module does not provide a function to merge polymorphic
+   maps. Use the functorial interface of the module [Map] of the OCaml
+   standard library instead, at the cost of the polymorphism on the
+   keys.
+
+   No deletion is provided.
+*)
+
+type ('key, 'value) t
+type ('key, 'value) map = ('key, 'value) t
+
+(* The value of the call [create ~cmp] is an empty map with [cmp]
+   being the comparison over the (future) keys.
+
+   The value [empty] is identical to the value of the call [create
+   ~cmp:Pervasives.compare].
+*)
+
+val create : cmp:('key -> 'key -> int) -> ('key, 'value) t
+
+val empty : ('key, 'value) t
+
+(* Emptiness *)
+
+val is_empty : ('key, 'value) t -> bool
+
+(* The value of the call [add key value map] is a map containing all
+   the bindings of the map [map], extended by the binding of [key] to
+   [value]. If there is a binding for [key] in [map], its value is
+   lost (and replaced by [value]). *)
+
+val add : 'key -> 'value -> ('key, 'value) t -> ('key, 'value) t
+
+(* The value of the call [find key map] is the value associated to the
+   [key] in the map [map]. If [key] is not bound in [map], the
+   exception [Not_found] is raised. *)
+
+exception Not_found
+
+val find : 'key -> ('key, 'value) t -> 'value
+
+(* The value of the call [find_opt key map] is [Some value] if the key
+   [key] is bound to [value] in the map [map], and [None]
+   otherwise. *)
+
+val find_opt : 'key -> ('key, 'value) t -> 'value option
+
+(* The value of the call [bindings map] is the association list
+   containing the bindings of the map [map], sorted by increasing keys
+   (with respect to the total comparison function used to create the
+   map). *)
+
+val bindings : ('key, 'value) t -> ('key * 'value) list
+
+(* The side-effect of evaluating the call [iter f map] is the
+   successive side-effects of the calls [f key value], for all
+   bindings [(key, value)] belonging to the map [map], sorted in
+   increasing order of the keys (with respect to the total comparison
+   function used to create the map). *)
+
+val iter : ('key -> 'value -> unit) -> ('key, 'value) t -> unit
+
+(* The call [fold_inc f map ~init] computes [(f k_n v_n ~acc:(... (f
+   k_1 v_1 ~acc:init)...)], where [k_1], ..., [k_n] are the keys of
+   all bindings in the map [map] in increasing order, and [v_1], ...,
+   [v_n] are the associated values. *)
+
+val fold_inc : ('key -> 'value -> acc:'a -> 'a) -> ('key, 'value) t -> init:'a -> 'a
diff --git a/vendors/Red-Black_Trees/PolyMapMain.ml b/vendors/Red-Black_Trees/PolyMapMain.ml
new file mode 100644
index 000000000..929e3193d
--- /dev/null
+++ b/vendors/Red-Black_Trees/PolyMapMain.ml
@@ -0,0 +1,59 @@
+(* Unit testing of module [PolyMap] *)
+
+let () = Printf.printf "Testing polymorphic maps... "
+
+let cmp = Pervasives.compare
+
+let in_assoc =
+  ["c", 2;
+   "g", -1;
+   "a", 0;
+   "e", 4;
+   "f", 5;
+   "g", -1;
+   "b", -1;
+   "b", 1;
+   "d", 3;
+   "j", 9;
+   "g", 6;
+   "h", 7;
+   "i", 8]
+
+(* Insertion sort which keeps the last duplicate of any item.
+   WARNING: Quadratic cost! *)
+
+let rec ins cmp x = function
+         [] -> [x]
+| y::s as l ->
+    let diff = cmp x y in
+    if diff = 0 then l else if diff > 0 then y :: ins cmp x s else x::l
+
+let rec isort cmp = function
+    [] -> []
+| x::s -> ins cmp x (isort cmp s)
+
+
+let sorted_in_assoc = isort (fun (k1,_) (k2,_) -> cmp k1 k2) in_assoc
+
+(*
+let () = Printf.printf "\nInput map:\n"
+let () = List.iter (fun (k,v) -> Printf.printf "%s -> %d\n" k v) in_assoc
+let () = Printf.printf "\nSorted map:\n"
+let () = List.iter (fun (k,v) -> Printf.printf "%s -> %d\n" k v) sorted_in_assoc
+*)
+
+let empty_map = PolyMap.create ~cmp
+let out_map =
+  List.fold_left (fun m (k,v) -> PolyMap.add k v m) empty_map in_assoc
+
+let out_bindings = PolyMap.bindings out_map
+
+(*
+let () = Printf.printf "\nOutput map:\n"
+let () = List.iter (fun (k,v) -> Printf.printf "%s -> %d\n" k v) out_bindings
+*)
+
+let () =
+  if sorted_in_assoc = out_bindings then
+    Printf.printf "PASS.\n%!"
+  else Printf.printf "FAILED.\n%!"
diff --git a/vendors/Red-Black_Trees/PolySet.ml b/vendors/Red-Black_Trees/PolySet.ml
new file mode 100644
index 000000000..7e60fc3bd
--- /dev/null
+++ b/vendors/Red-Black_Trees/PolySet.ml
@@ -0,0 +1,32 @@
+(* Polymorphic sets *)
+
+module RB = RedBlack
+
+type 'elt t = {
+  tree : 'elt RB.t;
+  cmp  : 'elt -> 'elt -> int
+}
+
+type 'elt set = 'elt t
+
+let create ~cmp = {tree = RB.empty; cmp}
+
+let empty = {tree = RB.empty; cmp=Pervasives.compare}
+
+let is_empty set = RB.is_empty set.tree
+
+let add elt set = {set with tree = RB.add ~cmp:set.cmp RB.New elt set.tree}
+
+exception Not_found
+
+let find elt set =
+  try RB.find ~cmp:set.cmp elt set.tree with
+    RB.Not_found -> raise Not_found
+
+let find_opt elt set = RB.find_opt ~cmp:set.cmp elt set.tree
+
+let elements set = RB.elements set.tree
+
+let iter f set = RB.iter f set.tree
+
+let fold_inc f set = RB.fold_inc (fun ~elt -> f elt) set.tree
diff --git a/vendors/Red-Black_Trees/PolySet.mli b/vendors/Red-Black_Trees/PolySet.mli
new file mode 100644
index 000000000..42f85a529
--- /dev/null
+++ b/vendors/Red-Black_Trees/PolySet.mli
@@ -0,0 +1,70 @@
+(* Polymorphic ordered sets
+
+   This module does not provide a function to merge polymorphic
+   sets. Use the functorial interface of the module [Set] of the OCaml
+   standard library instead.
+
+   No deletion is provided.
+*)
+
+type 'elt t
+type 'elt set = 'elt t
+
+(* The value of the call [create ~cmp] is an empty set with [cmp]
+   being the comparison over the (future) keys.
+
+   The value [empty] is identical to the value of the call [create
+   ~cmp:Pervasives.compare].
+ *)
+
+val create : cmp:('elt -> 'elt -> int) -> 'elt t
+
+val empty : 'elt t
+
+(* Emptiness *)
+
+val is_empty : 'elt t -> bool
+
+(* The value of the call [add elt set] is the union of the set [set]
+   and the singleton set containing [elt]. If there is an element [y]
+   in [set] such that [cmp y elt = true], where [cmp] is the
+   comparison function of the set [set] (see [create]), then [y] is
+   replaced by [elt]. *)
+
+val add : 'elt -> 'elt t -> 'elt t
+
+(* The value of the call [find elt set] is the element [y] of set
+   [set] such that [cmp y elt = true], where [cmp] is the comparison
+   function of [set] (see [create]). If [elt] is not in [set], then
+   the exception [Not_found] is raised. *)
+
+exception Not_found
+
+val find : 'elt -> 'elt t -> 'elt
+
+(* The call [find_opt elt set] is similar to [find elt set], except
+   that [None] is returned instead of the [Not_found] exception being
+   raised, otherwise it is an optional element. *)
+
+val find_opt : 'elt -> 'elt t -> 'elt option
+
+(* The value of the call [element set] is the list of elements of the
+   set [set] in increasing order (with respect to the total comparison
+   function used to create the set). *)
+
+val elements : 'elt t -> 'elt list
+
+(* The side-effect of evaluating the call [iter f set] is the
+   successive side-effects of the calls [f elt], for all the elements
+   [elt] of the set [set], sorted in increasing order (with respect to
+   the total comparison function used to create the set). *)
+
+val iter : ('elt -> unit) -> 'elt t -> unit
+
+(* The value of the call [fold_inc f set ~init] is the result of
+   iterating the function [f] on all the elements of the set [set] in
+   increasing order (with respect to the total comparison function
+   used to create the set), accumulating partial results from the
+   initial value [init]. *)
+
+val fold_inc : ('elt -> acc:'a -> 'a) -> 'elt t -> init:'a -> 'a
diff --git a/vendors/Red-Black_Trees/PolySetMain.ml b/vendors/Red-Black_Trees/PolySetMain.ml
new file mode 100644
index 000000000..ade43d1d6
--- /dev/null
+++ b/vendors/Red-Black_Trees/PolySetMain.ml
@@ -0,0 +1,34 @@
+(* Unit testing of module [PolySet] *)
+
+open PolySet;;
+
+let () = Printf.printf "Testing polymorphic sets... "
+
+let cmp = Pervasives.compare
+
+let in_items = [6;7;9;1;0;3;6;1;8;5;4;2]
+let sorted_in_items = List.sort_uniq cmp in_items
+
+(*
+let () = Printf.printf "\nInput items:  "
+let () = List.iter (fun x -> Printf.printf "%d " x) in_items
+let () = Printf.printf "\nSorted input: "
+let () = List.iter (fun x -> Printf.printf "%d " x) sorted_in_items
+*)
+
+let empty_set = create ~cmp
+
+let set = List.fold_right add in_items empty_set
+let out_items = elements set
+
+(*
+let () = Printf.printf "\nOutput items: "
+let () = List.iter (fun x -> Printf.printf "%d " x) out_items
+let () = Printf.printf "\n%!"
+*)
+
+let () =
+  if sorted_in_items = out_items then
+    Printf.printf "PASS.\n%!"
+  else Printf.printf "FAILED.\n%!"
+
diff --git a/vendors/Red-Black_Trees/README.md b/vendors/Red-Black_Trees/README.md
new file mode 100644
index 000000000..c12ebace6
--- /dev/null
+++ b/vendors/Red-Black_Trees/README.md
@@ -0,0 +1,5 @@
+# Read-Black trees a la Okasaki and polymorphic sets and maps based on them
+
+This implementation is based on the classic paper by Chris Okasaki,
+*Red-Black Trees in a Functional Setting*. J. Funct. Program. 9(4):
+471-477 (1999).
diff --git a/vendors/Red-Black_Trees/RedBlack.ml b/vendors/Red-Black_Trees/RedBlack.ml
new file mode 100644
index 000000000..50bb9659f
--- /dev/null
+++ b/vendors/Red-Black_Trees/RedBlack.ml
@@ -0,0 +1,86 @@
+(* Red-black trees according to the following classic paper:
+
+   Chris Okasaki, Red-Black Trees in a Functional
+   Setting. J. Funct. Program. 9(4): 471-477 (1999)
+*)
+
+type colour = Red | Black
+
+type 'a t =
+  Ext
+| Int of colour * 'a t * 'a * 'a t
+
+let empty = Ext
+
+let is_empty m = (m = empty)
+
+let blacken = function
+                         Ext -> Ext
+| Int (_, left, root, right) -> Int (Black, left, root, right)
+
+let balance colour left root right =
+  match colour, left, root, right with
+    Black, Int (Red, Int (Red, a, x, b), y, c), z, d
+  | Black, Int (Red, a, x, Int (Red, b, y, c)), z, d
+  | Black, a, x, Int (Red, Int (Red, b, y, c), z, d)
+  | Black, a, x, Int (Red, b, y, Int (Red, c, z, d)) ->
+      Int (Red, Int (Black, a, x, b), y, Int (Black, c, z, d))
+  | _ -> Int (colour, left, root, right)
+
+type choice = Old | New
+
+let choose ~old ~new' = function
+  Old -> old
+| New -> new'
+
+exception Physical_equality
+
+let add ~cmp choice elt tree =
+  let rec insert = function
+    Ext -> Int (Red, Ext, elt, Ext)  (* A leaf *)
+  | Int (colour, left, root, right) ->
+      let diff = cmp elt root in
+      if diff = 0 then
+        let root' = choose ~new':elt ~old:root choice
+        in if root == root' then raise Physical_equality
+           else Int (colour, left, root', right)
+      else if diff < 0 then
+             balance colour (insert left) root right
+           else balance colour left root (insert right)
+  in try blacken (insert tree) with
+       Physical_equality -> tree
+
+exception Not_found
+
+let rec find ~cmp elt = function
+  Ext -> raise Not_found
+| Int (_, left, root, right) ->
+    let diff = cmp elt root in
+    if diff = 0 then root
+    else if diff < 0 then find ~cmp elt left
+         else find ~cmp elt right
+
+let find_opt ~cmp elt tree =
+  try Some (find ~cmp elt tree) with Not_found -> None
+
+(* Inorder iterators *)
+
+let rec iter f = function
+                         Ext -> ()
+| Int (_, left, root, right) -> iter f left; f root; iter f right
+
+let rec inorder acc = function
+                         Ext -> acc
+| Int (_, left, root, right) -> inorder (root :: inorder acc right) left
+
+let elements t = inorder [] t
+
+let rec fold_inc f ~init = function
+                         Ext -> init
+| Int (_, left, root, right) ->
+    fold_inc f ~init:(f ~elt:root ~acc:(fold_inc f ~init left)) right
+
+let rec fold_dec f ~init = function
+                         Ext -> init
+| Int (_, left, root, right) ->
+    fold_dec f ~init:(f ~elt:root ~acc:(fold_dec f ~init right)) left
diff --git a/vendors/Red-Black_Trees/RedBlack.mli b/vendors/Red-Black_Trees/RedBlack.mli
new file mode 100644
index 000000000..65a45230c
--- /dev/null
+++ b/vendors/Red-Black_Trees/RedBlack.mli
@@ -0,0 +1,66 @@
+(* Red-black trees according to the following classic paper:
+
+   Chris Okasaki, Red-Black Trees in a Functional
+   Setting. J. Funct. Program. 9(4): 471-477 (1999)
+*)
+
+type colour = Red | Black
+
+type 'a t = private
+  Ext
+| Int of colour * 'a t * 'a * 'a t
+
+val empty: 'a t
+
+val is_empty: 'a t -> bool
+
+(* The value of the call [add ~cmp choice x t] is a red-black tree
+   augmenting the tree [t] with a node containing the element [x],
+   using the comparison function [cmp] (following the same convention
+   as [Pervasives.compare]) and, if a value [y] such that [x = y] is
+   already present in a node of [t], then the value [choice] denotes
+   whether [x] ([New]) or [y] ([Old]) remains in the value of the
+   call. Moreover, if [x == y], then [add ~cmp choice x t == t]. *)
+
+type choice = Old | New
+
+val add: cmp:('a -> 'a -> int) -> choice -> 'a -> 'a t -> 'a t
+
+(* The value of the call [find ~cmp x t] is the element [y] belonging
+   to a node of the tree [t], such that [cmp x y = true]. If none, the
+   exception [Not_found] is raised. *)
+
+exception Not_found
+
+val find: cmp:('a -> 'b -> int) -> 'a -> 'b t -> 'b
+
+(* The value of call [find_opt ~cmp x t] is [Some y] if there is an
+   element [y] in a node of the tree [t] such that [cmp x y = true],
+   and [None] otherwise. *)
+
+val find_opt: cmp:('a -> 'b -> int) -> 'a -> 'b t -> 'b option
+
+(* The value of the call [elements t] is the list of elements in the
+   nodes of the tree [t], sorted by increasing order. *)
+
+val elements: 'a t -> 'a list
+
+(* The side-effect of evaluating the call [iter f t] is the successive
+   side-effects of the calls [f x], for all elements [x] belonging to
+   the nodes of [t], visited in increasing order. *)
+
+val iter: ('a -> unit) -> 'a t -> unit
+
+(* The value of the call [fold_inc f ~init t] is the iteration of the
+   function [f] on increasing elements of the nodes of tree [t],
+   accumulating the partial results from the initial value of
+   [init]. *)
+
+val fold_inc: (elt:'a -> acc:'b -> 'b) -> init:'b -> 'a t -> 'b
+
+(* The value of the call [fold_dec f ~init t] is the iteration of the
+   function [f] on decreasing elements of the nodes of tree [t],
+   accumulating the partial results from the initial value of
+   [init]. *)
+
+val fold_dec: (elt:'a -> acc:'b -> 'b) -> init:'b -> 'a t -> 'b
diff --git a/vendors/Red-Black_Trees/RedBlackMain.ml b/vendors/Red-Black_Trees/RedBlackMain.ml
new file mode 100644
index 000000000..9f607e71f
--- /dev/null
+++ b/vendors/Red-Black_Trees/RedBlackMain.ml
@@ -0,0 +1,88 @@
+(* Unit testing of module [RedBlack] *)
+
+open RedBlack;;
+
+let () = Printf.printf "Testing Red-black trees... "
+
+let cmp = Pervasives.compare
+
+let in_items = [6;7;9;1;0;3;6;1;8;5;4;2]
+let sorted_in_items = List.sort_uniq cmp in_items
+
+let () = Printf.printf "\nInput items:  "
+let () = List.iter (fun x -> Printf.printf "%d " x) in_items
+let () = Printf.printf "\nSorted input: "
+let () = List.iter (fun x -> Printf.printf "%d " x) sorted_in_items
+
+let t = List.fold_right (add ~cmp Old) in_items empty
+let out_items = elements t
+
+let () = Printf.printf "\nOutput items: "
+let () = List.iter (fun x -> Printf.printf "%d " x) out_items
+let () = Printf.printf "\n%!"
+
+let () =
+  if sorted_in_items = out_items then
+    Printf.printf "PASS.\n%!"
+  else Printf.printf "FAILED.\n%!"
+
+let rec draw ~pad:(pd,pc) = function
+  Ext -> ()
+| Int (colour, left, root, right) ->
+    let app i sub =
+      let pad =
+        (pc ^ (if i = 1 then "`-- " else "|-- "),
+         pc ^ (if i = 1 then "    " else "|   "))
+      in draw ~pad sub in
+    begin
+      Printf.printf "%s%s(%d)\n" pd (if colour = Red then "R" else "B") root;
+      List.iteri app [left; right]
+    end
+
+let () = draw ~pad:("","") t
+
+let rec to_string buffer ~pad:(pd,pc) = function
+  Ext -> ()
+| Int (colour, left, root, right) ->
+    let root_str =
+      Printf.sprintf "%s%s(%d)\n" pd
+        (if colour = Red then "R" else "B") root in
+    let app rank sub =
+      let pad =
+        (pc ^ (if rank = 1 then "`-- " else "|-- "),
+         pc ^ (if rank = 1 then "    " else "|   "))
+      in to_string buffer ~pad sub in
+    begin
+      Buffer.add_string buffer root_str;
+      List.iteri app [left; right]
+    end
+
+let to_string tree =
+  let buffer = Buffer.create 131 in
+  let     () = to_string buffer ~pad:("","") tree
+  in Buffer.contents buffer
+
+let () = to_string t |> print_string |> print_newline
+
+let rec pretty buffer ~pad:(pd,pc) = function
+  Ext -> Buffer.add_string buffer (pd ^ "Ext\n")
+| Int (colour, left, root, right) ->
+    let root_str =
+      Printf.sprintf "%sInt (%s,%d)\n" pd
+        (if colour = Red then "Red" else "Black") root in
+    let app rank sub =
+      let pad =
+        pc ^ (if rank = 0 then "|-- " else "`-- "),
+        pc ^ (if rank = 0 then "|   " else "    ")
+      in pretty buffer ~pad sub in
+    begin
+      Buffer.add_string buffer root_str;
+      List.iteri app [left; right]
+    end
+
+let pretty tree =
+  let buffer = Buffer.create 131 in
+  let     () = pretty buffer ~pad:("","") tree
+  in Buffer.contents buffer
+
+let () = pretty t |> print_string |> print_newline
diff --git a/vendors/Red-Black_Trees/URL b/vendors/Red-Black_Trees/URL
new file mode 100644
index 000000000..f782590d9
--- /dev/null
+++ b/vendors/Red-Black_Trees/URL
@@ -0,0 +1 @@
+https://github.com/rinderknecht/Red-Black_Trees/commit/98b11312810d979ee1b0dacee6900228574e41e7
diff --git a/vendors/Red-Black_Trees/build.sh b/vendors/Red-Black_Trees/build.sh
new file mode 100755
index 000000000..925ff7626
--- /dev/null
+++ b/vendors/Red-Black_Trees/build.sh
@@ -0,0 +1,17 @@
+#!/bin/sh
+set -x
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -c RedBlack.mli
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -c PolyMap.mli
+ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c RedBlack.ml
+ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c PolyMapMain.ml
+ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c PolyMap.ml
+ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c PolyMapMain.ml
+ocamlfind ocamlopt -o PolyMapMain.opt RedBlack.cmx PolyMap.cmx PolyMapMain.cmx
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -c PolySet.mli
+ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c PolySet.ml
+ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c PolySetMain.ml
+ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c PolySetMain.ml
+ocamlfind ocamlopt -o PolySetMain.opt RedBlack.cmx PolySet.cmx PolySetMain.cmx
+ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c RedBlackMain.ml
+ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c RedBlackMain.ml
+ocamlfind ocamlopt -o RedBlackMain.opt RedBlack.cmx RedBlackMain.cmx
diff --git a/vendors/Red-Black_Trees/clean.sh b/vendors/Red-Black_Trees/clean.sh
new file mode 100755
index 000000000..6373ab745
--- /dev/null
+++ b/vendors/Red-Black_Trees/clean.sh
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+\rm -f *.cm* *.o *.byte *.opt