diff --git a/_oasis b/_oasis index 67bc4326..5f8052bd 100644 --- a/_oasis +++ b/_oasis @@ -40,7 +40,8 @@ Library "containers" Path: core Modules: CCVector, CCDeque, CCGen, CCSequence, CCFQueue, CCMultiMap, CCMultiSet, CCBV, CCPrint, CCPersistentHashtbl, - CCLeftistheap, CCList, CCOpt, CCPair, CCFun + CCLeftistheap, CCList, CCOpt, CCPair, CCFun, CCHash, + CCKList FindlibName: containers Library "containers_string" diff --git a/core/CCHash.ml b/core/CCHash.ml new file mode 100644 index 00000000..af0b9a3b --- /dev/null +++ b/core/CCHash.ml @@ -0,0 +1,76 @@ +(* +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 Hash combinators} *) + +type t = int +type 'a hash_fun = 'a -> t + +let combine hash i = + (hash * 65599 + i) land max_int + +let (<<>>) = combine + +let hash_int i = combine 0 i + +let hash_int2 i j = combine i j + +let hash_int3 i j k = combine (combine i j) k + +let hash_int4 i j k l = + combine (combine (combine i j) k) l + +let rec hash_list f h l = match l with + | [] -> h + | x::l' -> hash_list f (combine h (f x)) l' + +let hash_array f h a = + let h = ref h in + Array.iter (fun x -> h := combine !h (f x)) a; + !h + +let hash_string s = Hashtbl.hash s + +let hash_pair h1 h2 (x,y) = combine (h1 x) (h2 y) +let hash_triple h1 h2 h3 (x,y,z) = (h1 x) <<>> (h2 y) <<>> (h3 z) + +type 'a sequence = ('a -> unit) -> unit +type 'a gen = unit -> 'a option +type 'a klist = [`Nil | `Cons of 'a * (unit -> 'a klist)] + +let hash_seq f h seq = + let h = ref h in + seq (fun x -> h := !h <<>> f x); + !h + +let rec hash_gen f h g = match g () with + | None -> h + | Some x -> + hash_gen f (h <<>> f x) g + +let rec hash_klist f h l = match l with + | `Nil -> h + | `Cons (x,l') -> hash_klist f (h <<>> f x) (l' ()) + diff --git a/core/CCHash.mli b/core/CCHash.mli new file mode 100644 index 00000000..2233e240 --- /dev/null +++ b/core/CCHash.mli @@ -0,0 +1,64 @@ +(* +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 Hash combinators} + +Combination of hashes based on the +SDBM simple hash (see for instance +{{:http://www.cse.yorku.ca/~oz/hash.html} this page}) +*) + +type t = int + +type 'a hash_fun = 'a -> t + +val combine : t -> t -> t + (** Combine two hashes. Non-commutative. *) + +val (<<>>) : t -> t -> t + (** Infix version of {!combine} *) + +val hash_int : int -> t +val hash_int2 : int -> int -> t +val hash_int3 : int -> int -> int -> t +val hash_int4 : int -> int -> int -> int -> t + +val hash_string : string -> t + +val hash_list : 'a hash_fun -> t -> 'a list hash_fun +(** Hash a list. Each element is hashed using [f]. *) + +val hash_array : 'a hash_fun -> t -> 'a array hash_fun + +val hash_pair : 'a hash_fun -> 'b hash_fun -> ('a * 'b) hash_fun +val hash_triple : 'a hash_fun -> 'b hash_fun -> 'c hash_fun -> ('a * 'b * 'c) hash_fun + +type 'a sequence = ('a -> unit) -> unit +type 'a gen = unit -> 'a option +type 'a klist = [`Nil | `Cons of 'a * (unit -> 'a klist)] + +val hash_seq : 'a hash_fun -> t -> 'a sequence hash_fun +val hash_gen : 'a hash_fun -> t -> 'a gen hash_fun +val hash_klist : 'a hash_fun -> t -> 'a klist hash_fun diff --git a/core/CCKList.ml b/core/CCKList.ml new file mode 100644 index 00000000..72a9d60c --- /dev/null +++ b/core/CCKList.ml @@ -0,0 +1,106 @@ +(* +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 Continuation List} *) + + +type + 'a t = + [ `Nil + | `Cons of 'a * (unit -> 'a t) + ] + +let nil = `Nil +let cons a b = `Cons (a,b) + +let to_list l = + let rec direct i (l:'a t) = match l with + | `Nil -> [] + | _ when i=0 -> safe [] l + | `Cons (x, f) -> x :: direct (i-1) (f ()) + and safe acc l = match l with + | `Nil -> List.rev acc + | `Cons (x,l') -> safe (x::acc) (l' ()) + in + direct 200 l + +type 'a sequence = ('a -> unit) -> unit +type 'a gen = unit -> 'a option + +let rec to_seq res k = match res with + | `Nil -> () + | `Cons (s, f) -> k s; to_seq (f ()) k + +let to_gen l = + let l = ref l in + fun () -> + match !l with + | `Nil -> None + | `Cons (x,l') -> + l := l' (); + Some x + +let rec fold f acc res = match res with + | `Nil -> acc + | `Cons (s, cont) -> fold f (f acc s) (cont ()) + +let length l = fold (fun acc _ -> acc+1) 0 l + +let rec take n (l:'a t):'a t = match l with + | _ when n=0 -> `Nil + | `Nil -> `Nil + | `Cons (x,l') -> `Cons (x, fun () -> take (n-1) (l' ())) + +let rec drop n (l:'a t) = match l with + | _ when n=0 -> l + | `Nil -> `Nil + | `Cons (_,l') -> drop (n-1) (l'()) + +let rec map f l = match l with + | `Nil -> `Nil + | `Cons (x, l') -> `Cons (f x, fun () -> map f (l' ())) + +let rec fmap f (l:'a t):'b t = match l with + | `Nil -> `Nil + | `Cons (x, l') -> + begin match f x with + | None -> fmap f (l' ()) + | Some y -> `Cons (y, fun () -> fmap f (l' ())) + end + +let rec filter p l = match l with + | `Nil -> `Nil + | `Cons (x, l') -> + if p x + then `Cons (x, fun () -> filter p (l' ())) + else filter p (l' ()) + +let rec append l1 l2 = match l1 with + | `Nil -> l2 + | `Cons (x, l1') -> `Cons (x, fun () -> append (l1' ()) l2) + +let rec flat_map f l = match l with + | `Nil -> `Nil + | `Cons (x, l') -> + append (f x) (flat_map f (l' ())) diff --git a/core/CCKList.mli b/core/CCKList.mli new file mode 100644 index 00000000..7ed21cd2 --- /dev/null +++ b/core/CCKList.mli @@ -0,0 +1,63 @@ +(* +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 Continuation List} *) + +type + 'a t = + [ `Nil + | `Cons of 'a * (unit -> 'a t) + ] + +val nil : 'a t + +val cons : 'a -> (unit -> 'a t) -> 'a t + +val to_list : 'a t -> 'a list + (** Gather all values into a list *) + +type 'a sequence = ('a -> unit) -> unit +type 'a gen = unit -> 'a option + +val to_seq : 'a t -> 'a sequence +val to_gen : 'a t -> 'a gen + +val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a + (** Fold on values *) + +val length : 'a t -> int + +val take : int -> 'a t -> 'a t + +val drop : int -> 'a t -> 'a t + +val map : ('a -> 'b) -> 'a t -> 'b t + +val fmap : ('a -> 'b option) -> 'a t -> 'b t + +val filter : ('a -> bool) -> 'a t -> 'a t + +val append : 'a t -> 'a t -> 'a t + +val flat_map : ('a -> 'b t) -> 'a t -> 'b t diff --git a/core/CCList.ml b/core/CCList.ml index cad0c945..e368b280 100644 --- a/core/CCList.ml +++ b/core/CCList.ml @@ -379,6 +379,7 @@ end type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option +type 'a klist = [`Nil | `Cons of 'a * (unit -> 'a klist)] type 'a printer = Buffer.t -> 'a -> unit type 'a formatter = Format.formatter -> 'a -> unit @@ -408,6 +409,24 @@ let of_gen g = in direct _direct_depth g +let to_klist l = + let rec make l () = match l with + | [] -> `Nil + | x::l' -> `Cons (x, make l') + in make l () + +let of_klist l = + let rec direct i g = + if i = 0 then safe [] g + else match l with + | `Nil -> [] + | `Cons (x,l') -> x :: direct (i-1) (l' ()) + and safe acc l = match l with + | `Nil -> List.rev acc + | `Cons (x,l') -> safe (x::acc) (l' ()) + in + direct _direct_depth l + (** {2 IO} *) let pp ?(start="[") ?(stop="]") ?(sep=", ") pp_item buf l = diff --git a/core/CCList.mli b/core/CCList.mli index 0d84aac2..1691ed75 100644 --- a/core/CCList.mli +++ b/core/CCList.mli @@ -171,6 +171,7 @@ end type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option +type 'a klist = [`Nil | `Cons of 'a * (unit -> 'a klist)] type 'a printer = Buffer.t -> 'a -> unit type 'a formatter = Format.formatter -> 'a -> unit @@ -180,6 +181,9 @@ val of_seq : 'a sequence -> 'a t val to_gen : 'a t -> 'a gen val of_gen : 'a gen -> 'a t +val to_klist : 'a t -> 'a klist +val of_klist : 'a klist -> 'a t + (** {2 IO} *) val pp : ?start:string -> ?stop:string -> ?sep:string ->