From 90a246c9c0bd93c442ae74b4c3f0f3519ce7f306 Mon Sep 17 00:00:00 2001
From: Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>
Date: Sun, 21 Aug 2016 03:04:24 +0200
Subject: Adding skewed lists.

This is a purely functional datastructure isomorphic to usual lists, except
that it features a O(log n) lookup while preserving the O(1) cons operation.
---
 clib/clib.mllib |  1 +
 clib/range.ml   | 91 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 clib/range.mli  | 37 +++++++++++++++++++++++
 3 files changed, 129 insertions(+)
 create mode 100644 clib/range.ml
 create mode 100644 clib/range.mli

(limited to 'clib')

diff --git a/clib/clib.mllib b/clib/clib.mllib
index bd5ddb152..0b5d9826f 100644
--- a/clib/clib.mllib
+++ b/clib/clib.mllib
@@ -12,6 +12,7 @@ CString
 CStack
 
 Int
+Range
 HMap
 Bigint
 
diff --git a/clib/range.ml b/clib/range.ml
new file mode 100644
index 000000000..86a078633
--- /dev/null
+++ b/clib/range.ml
@@ -0,0 +1,91 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+type 'a tree =
+| Leaf of 'a
+| Node of 'a * 'a tree * 'a tree
+
+type 'a t = Nil | Cons of int * 'a tree * 'a t
+
+let oob () = invalid_arg "index out of bounds"
+
+let empty = Nil
+
+let cons x l = match l with
+| Cons (h1, t1, Cons (h2, t2, rem)) ->
+  if Int.equal h1 h2 then Cons (1 + h1 + h2, Node (x, t1, t2), rem)
+  else Cons (1, Leaf x, l)
+| _ -> Cons (1, Leaf x, l)
+
+let is_empty = function
+| Nil -> true
+| _ -> false
+
+let rec tree_get h t i = match t with
+| Leaf x ->
+  if i = 0 then x else oob ()
+| Node (x, t1, t2) ->
+  if i = 0 then x
+  else
+    let h = h / 2 in
+    if i <= h then tree_get h t1 (i - 1) else tree_get h t2 (i - h - 1)
+
+let rec get l i = match l with
+| Nil -> oob ()
+| Cons (h, t, rem) ->
+  if i < h then tree_get h t i else get rem (i - h)
+
+let length l =
+  let rec length accu = function
+  | Nil -> accu
+  | Cons (h, _, l) -> length (h + accu) l
+  in
+  length 0 l
+
+let rec tree_map f = function
+| Leaf x -> Leaf (f x)
+| Node (x, t1, t2) -> Node (f x, tree_map f t1, tree_map f t2)
+
+let rec map f = function
+| Nil -> Nil
+| Cons (h, t, l) -> Cons (h, tree_map f t, map f l)
+
+let rec tree_fold_left f accu = function
+| Leaf x -> f accu x
+| Node (x, t1, t2) ->
+  tree_fold_left f (tree_fold_left f (f accu x) t1) t2
+
+let rec fold_left f accu = function
+| Nil -> accu
+| Cons (_, t, l) -> fold_left f (tree_fold_left f accu t) l
+
+let rec tree_fold_right f t accu = match t with
+| Leaf x -> f x accu
+| Node (x, t1, t2) ->
+  f x (tree_fold_right f t1 (tree_fold_right f t2 accu))
+
+let rec fold_right f l accu = match l with
+| Nil -> accu
+| Cons (_, t, l) -> tree_fold_right f t (fold_right f l accu)
+
+let hd = function
+| Nil -> failwith "hd"
+| Cons (_, Leaf x, _) -> x
+| Cons (_, Node (x, _, _), _) -> x
+
+let tl = function
+| Nil -> failwith "tl"
+| Cons (_, Leaf _, l) -> l
+| Cons (h, Node (_, t1, t2), l) ->
+  let h = h / 2 in
+  Cons (h, t1, Cons (h, t2, l))
+
+let rec skipn n l =
+  if n = 0 then l
+  else if is_empty l then failwith "List.skipn"
+  else skipn (pred n) (tl l)
diff --git a/clib/range.mli b/clib/range.mli
new file mode 100644
index 000000000..ae7684ffa
--- /dev/null
+++ b/clib/range.mli
@@ -0,0 +1,37 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Skewed lists
+
+    This is a purely functional datastructure isomorphic to usual lists, except
+    that it features a O(log n) lookup while preserving the O(1) cons operation.
+
+*)
+
+(** {5 Constructors} *)
+
+type +'a t
+
+val empty : 'a t
+val cons : 'a -> 'a t -> 'a t
+
+(** {5 List operations} *)
+
+val is_empty : 'a t -> bool
+val length : 'a t -> int
+val map : ('a -> 'b) -> 'a t -> 'b t
+val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
+val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+val hd : 'a t -> 'a
+val tl : 'a t -> 'a t
+
+val skipn : int -> 'a t -> 'a t
+
+(** {5 Indexing operations} *)
+
+val get : 'a t -> int -> 'a
-- 
cgit v1.2.3