type declarations for the TTree associative structure

_oasis

@@ -39,7 +39,7 @@ Library "containers"
                     PHashtbl, Sequence, SkipList, SplayTree, SplayMap, Univ,
                     Vector, Bij, PiCalculus, Bencode, Sexp, RAL, MultiSet,
                     UnionFind, SmallSet, Leftistheap, AbsSet, CSM, MultiMap,
-                    ActionMan, BV, QCheck, BencodeOnDisk, Show
+                    ActionMan, BV, QCheck, BencodeOnDisk, Show, TTree
   BuildDepends:     unix
 
 Library "containers_thread"

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: d71835b977f65228c00aa3a47e880688)
+# DO NOT EDIT (digest: 727237717e19643a155e5e70e3495f8e)
 # Ignore VCS directories, you can use the same kind of rule outside 
 # OASIS_START/STOP if you want to exclude directories that contains 
 # useless stuff for the build process
@@ -50,6 +50,7 @@
 "qCheck.cmx": for-pack(Containers)
 "bencodeOnDisk.cmx": for-pack(Containers)
 "show.cmx": for-pack(Containers)
+"tTree.cmx": for-pack(Containers)
 # Library containers_thread
 "containers_thread.cmxs": use_containers_thread
 <*.ml{,i}>: pkg_threads

containers.mlpack

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: c71ccfdbd010237adfeae06ed09c46ad)
+# DO NOT EDIT (digest: 5c1e80992f9515200585f739a64d9771)
 Cache
 Deque
 Gen
@@ -35,4 +35,5 @@ BV
 QCheck
 BencodeOnDisk
 Show
+TTree
 # OASIS_STOP

containers.odocl

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 3b0c2006d9fcd3955eb8118014479a19)
+# DO NOT EDIT (digest: ca2e7fd09ab7b0d8b4525454fa277f3c)
 Cache
 Deque
 Gen
@@ -35,5 +35,6 @@ BV
 QCheck
 BencodeOnDisk
 Show
+TTree
 Behavior
 # OASIS_STOP

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.3.0 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: c9341580de424a256871dd6b43247845) *)
+(* DO NOT EDIT (digest: 1ff8886120b2512ffd368de480850fcc) *)
 (*
    Regenerated by OASIS v0.3.0
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -5902,7 +5902,8 @@ let setup_t =
                            "BV";
                            "QCheck";
                            "BencodeOnDisk";
-                           "Show"
+                           "Show";
+                           "TTree"
                         ];
                       lib_pack = true;
                       lib_internal_modules = [];
@@ -6223,7 +6224,7 @@ let setup_t =
           };
      oasis_fn = Some "_oasis";
      oasis_version = "0.3.0";
-     oasis_digest = Some "H\2095\254\2336\164\1606\140\2459^6o\218";
+     oasis_digest = Some "!l\025\004\144\144\255le\222F\177Z\202S\216";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false;
@@ -6231,6 +6232,6 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 6235 "setup.ml"
+# 6236 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

tTree.ml

@@ -0,0 +1,161 @@
+
+(*
+copyright (c) 2013, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(** {1 T-Trees} *)
+
+(** {2 Persistent array}
+
+The nodes of the tree are arrays, but to expose a persistent interface we
+use persistent arrays. *)
+
+module PArray = struct
+  type 'a t = 'a zipper ref
+  and 'a zipper =
+    | Array of 'a array
+    | Diff of int * 'a * 'a zipper ref
+
+  (* XXX maybe having a snapshot of the array from point to point may help? *)
+
+  let make size elt =
+    let a = Array.create size elt in
+    ref (Array a)
+
+  (** Recover the given version of the shared array. Returns the array
+      itself. *)
+  let rec reroot t =
+    match !t with
+    | Array a -> a
+    | Diff (i, v, t') ->
+      begin
+        let a = reroot t' in
+        let v' = a.(i) in
+        t' := Diff (i, v', t);
+        a.(i) <- v;
+        t := Array a;
+        a
+      end
+
+  let get t i =
+    match !t with
+    | Array a -> a.(i)
+    | Diff _ -> 
+      let a = reroot t in
+      a.(i)
+
+  let set t i v =
+    let a =
+      match !t with
+      | Array a -> a
+      | Diff _ -> reroot t in
+    let v' = a.(i) in
+    if v == v'
+      then t (* no change *)
+      else begin
+        let t' = ref (Array a) in
+        a.(i) <- v;
+        t := Diff (i, v', t');
+        t' (* create new array *)
+      end
+
+  let fold_left f acc t =
+    let a = reroot t in
+    Array.fold_left f acc a
+
+  let rec length t =
+    match !t with
+    | Array a -> Array.length a
+    | Diff (_, _, t') -> length t'
+end
+
+(** {2 signature} *)
+
+module type S = sig
+  type key
+
+  type 'a t
+
+  val empty : 'a t
+    (** Empty tree *)
+
+  val add : 'a t -> key -> 'a -> 'a t
+    (** Add a binding key/value. If the key already was bound to some
+        value, the old binding is erased. *)
+
+  val remove : 'a t -> key -> 'a t
+    (** Remove the key *)
+
+  val find : 'a t -> key -> 'a
+    (** Find the element associated with this key.
+        @raise Not_found if the key is not present *)
+
+  val length : 'a t -> int
+    (** Number of bindings *)
+
+  val fold : 'a t -> 'b -> ('b -> key -> 'a -> 'b) -> 'b
+    (** Fold on bindings *)
+end
+
+(** {2 Functor} *)
+
+module Make(X : Set.OrderedType) = struct
+  type key = X.t
+
+  (* bucket that maps a key to a value *)
+  type 'a bucket =
+    | B_none
+    | B_some of key * 'a
+
+  (* recursive tree type *)
+  type 'a node = {
+    left : 'a node option;
+    right : 'a node option;
+    depth : int;
+    buckets : 'a bucket PArray.t;
+  }
+
+  (* to avoid the value restriction, we need to make a special case for
+      the empty tree *)
+  type 'a t =
+    | E
+    | N of 'a node
+
+  let empty = E
+
+  let add tree k v = assert false
+
+  let remove tree k = assert false
+
+  let find tree k =
+    let rec find node k = assert false (* TODO *)
+    in
+    match tree with
+    | E -> raise Not_found
+    | N node -> find node k
+
+  let length tree = assert false
+
+  let fold tree acc f = assert false
+end

tTree.mli

@@ -0,0 +1,65 @@
+
+(*
+copyright (c) 2013, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(** {1 T-Trees}
+
+Shallow, cache-friendly associative data structure.
+See {{:http://en.wikipedia.org/wiki/T-tree} wikipedia}.
+
+Not thread-safe.
+*)
+
+(** {2 signature} *)
+
+module type S = sig
+  type key
+
+  type 'a t
+
+  val empty : 'a t
+    (** Empty tree *)
+
+  val add : 'a t -> key -> 'a -> 'a t
+    (** Add a binding key/value. If the key already was bound to some
+        value, the old binding is erased. *)
+
+  val remove : 'a t -> key -> 'a t
+    (** Remove the key *)
+
+  val find : 'a t -> key -> 'a
+    (** Find the element associated with this key.
+        @raise Not_found if the key is not present *)
+
+  val length : 'a t -> int
+    (** Number of bindings *)
+
+  val fold : 'a t -> 'b -> ('b -> key -> 'a -> 'b) -> 'b
+    (** Fold on bindings *)
+end
+
+(** {2 Functor that builds T trees for comparable keys} *)
+
+module Make(X : Set.OrderedType) : S with type key = X.t