From ac1cd31f0a8eaed13200964cb364ea4d1d76d4f0 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 8 Nov 2013 00:20:29 +0100 Subject: [PATCH] type declarations for the TTree associative structure --- _oasis | 2 +- _tags | 3 +- containers.mlpack | 3 +- containers.odocl | 3 +- setup.ml | 9 +-- tTree.ml | 161 ++++++++++++++++++++++++++++++++++++++++++++++ tTree.mli | 65 +++++++++++++++++++ 7 files changed, 238 insertions(+), 8 deletions(-) create mode 100644 tTree.ml create mode 100644 tTree.mli diff --git a/_oasis b/_oasis index 895da459..0b3bbe4a 100644 --- a/_oasis +++ b/_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" diff --git a/_tags b/_tags index f60e6e2f..3f96a872 100644 --- a/_tags +++ b/_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 diff --git a/containers.mlpack b/containers.mlpack index bcefd059..abdffeed 100644 --- a/containers.mlpack +++ b/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 diff --git a/containers.odocl b/containers.odocl index bf83cba3..4fd566d3 100644 --- a/containers.odocl +++ b/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 diff --git a/setup.ml b/setup.ml index c826a7e2..5a4551f2 100644 --- a/setup.ml +++ b/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 ();; diff --git a/tTree.ml b/tTree.ml new file mode 100644 index 00000000..538432c0 --- /dev/null +++ b/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 diff --git a/tTree.mli b/tTree.mli new file mode 100644 index 00000000..2357c5be --- /dev/null +++ b/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