diff --git a/.ocamlinit b/.ocamlinit index 7711334d..be85d342 100644 --- a/.ocamlinit +++ b/.ocamlinit @@ -3,11 +3,12 @@ #directory "_build/core";; #directory "_build/misc";; #directory "_build/string";; +#directory "_build/threads";; #directory "_build/tests/";; #load "containers.cma";; #load "containers_string.cma";; #load "containers_misc.cma";; -#require "threads";; +#thread;; #load "containers_thread.cma";; open Containers_misc;; #install_printer Bencode.pretty;; diff --git a/Makefile b/Makefile index d436e0ea..133eb6fc 100644 --- a/Makefile +++ b/Makefile @@ -93,4 +93,11 @@ test-all: run-test qtest tags: otags *.ml *.mli +VERSION=$(shell awk '/^Version:/ {print $$2}' _oasis) + +update_next_tag: + @echo "update version to $(VERSION)..." + sed -i "s/NEXT_VERSION/$(VERSION)/g" **/*.ml **/*.mli + sed -i "s/NEXT_RELEASE/$(VERSION)/g" **/*.ml **/*.mli + .PHONY: examples push_doc tags qtest push-stable clean-generated diff --git a/README.md b/README.md index 6083c7e0..a0ace7c7 100644 --- a/README.md +++ b/README.md @@ -20,6 +20,8 @@ ocaml-containers Some of the modules have been moved to their own repository (e.g. `sequence`, `gen`, `qcheck` and are on opam for great fun and profit (or not)). +[![Build Status](http://ci.cedeela.fr/buildStatus/icon?job=containers)](http://ci.cedeela.fr/job/containers/) + ## Use You can either build and install the library (see `Build`), or just copy diff --git a/_oasis b/_oasis index 6797f2e1..9e654950 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.4 Name: containers -Version: 0.3.1 +Version: 0.3.3 Homepage: https://github.com/c-cube/ocaml-containers Authors: Simon Cruanes License: BSD-2-clause @@ -45,8 +45,8 @@ Library "containers" Path: core Modules: CCVector, CCDeque, CCGen, CCSequence, CCFQueue, CCMultiMap, CCMultiSet, CCBV, CCPrint, CCPersistentHashtbl, CCError, - CCHeap, CCList, CCOpt, CCPair, CCFun, CCHash, - CCKList, CCInt, CCBool, CCArray, CCBatch, CCOrd, + CCHeap, CCList, CCOpt, CCPair, CCFun, CCHash, CCCat, + CCKList, CCInt, CCBool, CCArray, CCBatch, CCOrd, CCIO, CCRandom, CCLinq, CCKTree, CCTrie, CCString, CCHashtbl FindlibName: containers @@ -74,13 +74,13 @@ Library "containers_misc" Library "containers_thread" Path: threads/ - Modules: Future + Modules: CCFuture FindlibName: thread FindlibParent: containers Build$: flag(thread) Install$: flag(thread) BuildDepends: containers,threads - XMETARequires: containers,threads,lwt + XMETARequires: containers,threads Library "containers_lwt" Path: lwt diff --git a/containers.odocl b/containers.odocl index 25107e6e..c56c3c53 100644 --- a/containers.odocl +++ b/containers.odocl @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 003d658600739a79dc7efd8dee4190ce) +# DO NOT EDIT (digest: 3ce32ab9d93a14d03bdd4e7d7bc097f0) core/CCVector core/CCDeque core/CCGen @@ -17,12 +17,14 @@ core/CCOpt core/CCPair core/CCFun core/CCHash +core/CCCat core/CCKList core/CCInt core/CCBool core/CCArray core/CCBatch core/CCOrd +core/CCIO core/CCRandom core/CCLinq core/CCKTree diff --git a/core/CCCat.ml b/core/CCCat.ml new file mode 100644 index 00000000..cb9ab343 --- /dev/null +++ b/core/CCCat.ml @@ -0,0 +1,145 @@ + +(* +copyright (c) 2013-2014, 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 Categorical Constructs} *) + +(** {2 Signatures} *) + +module type MONOID = sig + type t + val empty : t + val append : t -> t -> t +end + +module type FUNCTOR = sig + type +'a t + val map : ('a -> 'b) -> 'a t -> 'b t +end + +module type APPLICATIVE = sig + type +'a t + include FUNCTOR with type 'a t := 'a t + val pure : 'a -> 'a t + val (<*>) : ('a -> 'b) t -> 'a t -> 'b t +end + +module type MONAD_BARE = sig + type +'a t + val return : 'a -> 'a t + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t +end + +module type MONAD = sig + include MONAD_BARE + include APPLICATIVE with type 'a t := 'a t +end + +module type MONAD_TRANSFORMER = sig + include MONAD + module M : MONAD + val lift : 'a M.t -> 'a t +end + +type 'a sequence = ('a -> unit) -> unit + +module type FOLDABLE = sig + type 'a t + val to_seq : 'a t -> 'a sequence +end + +module type TRAVERSE = functor(M : MONAD) -> sig + type +'a t + + val sequence_m : 'a M.t t -> 'a t M.t + + val fold_m : ('b -> 'a -> 'b M.t) -> 'b -> 'a t -> 'b M.t + + val map_m : ('a -> 'b M.t) -> 'a t -> 'b t M.t +end + +module type FREE_MONAD = sig + module F : FUNCTOR + + type +'a t = + | Return of 'a + | Roll of 'a t F.t + + include MONAD with type 'a t := 'a t + val inj : 'a F.t -> 'a t +end + +(** {2 Some Implementations} *) + +module WrapMonad(M : MONAD_BARE) = struct + include M + + let map f x = x >>= (fun x -> return (f x)) + + let pure = return + + let (<*>) f x = f >>= fun f -> x >>= fun x -> return (f x) +end + + +module MakeFree(F : FUNCTOR) = struct + module F = F + + type 'a t = Return of 'a | Roll of ('a t F.t) + + let return x = Return x + let pure = return + + let rec map : type a b. (a -> b) -> a t -> b t + = fun f x -> match x with + | Return x -> Return (f x) + | Roll xs -> Roll (F.map (map f) xs) + + let rec _bind : type a b. (a -> b t) -> a t -> b t + = fun f x -> match x with + | Return x -> f x + | Roll y -> Roll (F.map (_bind f) y) + + let (>>=) x f = _bind f x + + let rec _app : type a b. (a -> b) t -> a t -> b t + = fun f x -> match f, x with + | Return f, Return x -> Return (f x) + | Return f, Roll xs -> Roll (F.map (map f) xs) + | Roll fs, _ -> Roll (F.map (fun f -> _app f x) fs) + + let (<*>) = _app + + let inj x = Roll (F.map return x) +end + +module MakeFreeFold(FM : FREE_MONAD)(Fold : FOLDABLE with type 'a t = 'a FM.F.t) = struct + type 'a t = 'a FM.t + + let rec to_seq : type a. a FM.t -> a sequence + = fun x k -> match x with + | FM.Return x -> k x + | FM.Roll xs -> Fold.to_seq xs (fun x -> to_seq x k) +end diff --git a/core/CCCat.mli b/core/CCCat.mli new file mode 100644 index 00000000..1f136322 --- /dev/null +++ b/core/CCCat.mli @@ -0,0 +1,114 @@ +(* +copyright (c) 2013-2014, 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 Categorical Constructs} + +Attempt to copy some structures from Haskell and the likes. Disclaimer: +I don't know much about category theory, only about type signatures ;). *) + +(** {2 Signatures} *) + +module type MONOID = sig + type t + val empty : t + val append : t -> t -> t +end + +module type FUNCTOR = sig + type +'a t + val map : ('a -> 'b) -> 'a t -> 'b t +end + +module type APPLICATIVE = sig + type +'a t + include FUNCTOR with type 'a t := 'a t + val pure : 'a -> 'a t + val (<*>) : ('a -> 'b) t -> 'a t -> 'b t +end + +module type MONAD_BARE = sig + type +'a t + val return : 'a -> 'a t + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t +end + +module type MONAD = sig + include MONAD_BARE + include APPLICATIVE with type 'a t := 'a t +end + +module type MONAD_TRANSFORMER = sig + include MONAD + module M : MONAD + val lift : 'a M.t -> 'a t +end + +(** Cheating: use an equivalent of "to List" with a sequence *) +type 'a sequence = ('a -> unit) -> unit + +module type FOLDABLE = sig + type 'a t + val to_seq : 'a t -> 'a sequence +end + +module type TRAVERSE = functor(M : MONAD) -> sig + type +'a t + + val sequence_m : 'a M.t t -> 'a t M.t + + val fold_m : ('b -> 'a -> 'b M.t) -> 'b -> 'a t -> 'b M.t + + val map_m : ('a -> 'b M.t) -> 'a t -> 'b t M.t +end + +(** The free monad is built by nesting applications of a functor [F]. + +For instance, Lisp-like nested lists can be built and dealt with like this: +{[ + module Lisp = CCCat.FreeMonad(CCList);; + + let l = Lisp.(inj [1;2;3] >>= fun x -> inj [x; x*2; x+100]);; +]} *) +module type FREE_MONAD = sig + module F : FUNCTOR + + type +'a t = + | Return of 'a + | Roll of 'a t F.t + + include MONAD with type 'a t := 'a t + val inj : 'a F.t -> 'a t +end + +(** {2 Some Implementations} *) + +(** Implement the applicative and functor modules from only return and bind *) +module WrapMonad(M : MONAD_BARE) : MONAD with type 'a t = 'a M.t + +module MakeFree(F : FUNCTOR) : FREE_MONAD with module F = F + +module MakeFreeFold(FM : FREE_MONAD)(Fold : FOLDABLE with type 'a t = 'a FM.F.t) + : FOLDABLE with type 'a t = 'a FM.t + diff --git a/core/CCError.ml b/core/CCError.ml index fe1fdd86..851cd5c1 100644 --- a/core/CCError.ml +++ b/core/CCError.ml @@ -43,6 +43,12 @@ let return x = `Ok x let fail s = `Error s +let fail_printf format = + let buf = Buffer.create 16 in + Printf.kbprintf + (fun buf -> fail (Buffer.contents buf)) + buf format + let _printers = ref [] let register_printer p = _printers := p :: !_printers diff --git a/core/CCError.mli b/core/CCError.mli index ab850d9a..7a11f3db 100644 --- a/core/CCError.mli +++ b/core/CCError.mli @@ -45,6 +45,11 @@ val fail : string -> 'a t val of_exn : exn -> 'a t +val fail_printf : ('a, Buffer.t, unit, 'a t) format4 -> 'a +(** [fail_printf format] uses [format] to obtain an error message + and then returns [`Error msg] + @since 0.3.3 *) + val map : ('a -> 'b) -> 'a t -> 'b t val map2 : ('a -> 'b) -> (string -> string) -> 'a t -> 'b t diff --git a/core/CCHashtbl.ml b/core/CCHashtbl.ml index bc08e480..5de3a2a2 100644 --- a/core/CCHashtbl.ml +++ b/core/CCHashtbl.ml @@ -107,7 +107,8 @@ module Make(X : HASHABLE) = struct h mod Array.length tbl.arr let _succ tbl i = - if i = Array.length tbl.arr-1 then 0 else i+1 + let i' = i+1 in + if i' = Array.length tbl.arr then 0 else i' let _pred tbl i = if i = 0 then Array.length tbl.arr - 1 else i-1 @@ -198,7 +199,7 @@ module Make(X : HASHABLE) = struct | Empty -> raise Not_found | Key (k', v', _) when X.equal k k' -> v' | Key (_, _, h_k') -> - if (dib > 3 && _dib tbl h_k' i < dib) + if _dib tbl h_k' i < dib then raise Not_found (* [k] would be here otherwise *) else _get_exn tbl k h_k (_succ tbl i) (dib+1) @@ -206,9 +207,21 @@ module Make(X : HASHABLE) = struct let h_k = X.hash k in let i0 = _initial_idx tbl h_k in match tbl.arr.(i0) with - | Empty -> raise Not_found - | Key (k', v, _) when X.equal k k' -> v - | Key _ -> _get_exn tbl k h_k (_succ tbl i0) 1 + | Empty -> raise Not_found + | Key (k', v, _) -> + if X.equal k k' then v + else let i1 = _succ tbl i0 in + match tbl.arr.(i1) with + | Empty -> raise Not_found + | Key (k', v, _) -> + if X.equal k k' then v + else + let i2 = _succ tbl i1 in + match tbl.arr.(i2) with + | Empty -> raise Not_found + | Key (k', v, _) -> + if X.equal k k' then v + else _get_exn tbl k h_k (_succ tbl i2) 3 let get k tbl = try Some (get_exn k tbl) diff --git a/core/CCIO.ml b/core/CCIO.ml new file mode 100644 index 00000000..b0c27718 --- /dev/null +++ b/core/CCIO.ml @@ -0,0 +1,519 @@ + +(* +copyright (c) 2013-2014, 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 IO Monad} *) + +type _ t = + | Return : 'a -> 'a t + | Fail : string -> 'a t + | Map : ('a -> 'b) * 'a t -> 'b t + | Bind : ('a -> 'b t) * 'a t -> 'b t + | WithGuard: unit t * 'a t -> 'a t (* run guard in any case *) + | Star : ('a -> 'b) t * 'a t -> 'b t + | Repeat : int * 'a t -> 'a list t + | RepeatIgnore : int * 'a t -> unit t + | Wrap : (unit -> 'a) -> 'a t + | SequenceMap : ('a -> 'b t) * 'a list -> 'b list t + +type 'a io = 'a t +type 'a with_finalizer = ('a t * unit t) t +type 'a or_error = [ `Ok of 'a | `Error of string ] + +let (>>=) x f = Bind(f,x) + +let bind ?finalize f a = match finalize with + | None -> Bind(f,a) + | Some b -> WithGuard (b, Bind (f,a)) + +let map f x = Map(f, x) + +let (>|=) x f = Map(f, x) + +let return x = Return x +let pure = return + +let fail msg = Fail msg + +let (<*>) f a = Star (f, a) + +let lift = map + +let lift2 f a b = + a >>= fun x -> map (f x) b + +let lift3 f a b c = + a >>= fun x -> + b >>= fun y -> map (f x y) c + +let sequence_map f l = + SequenceMap (f,l) + +let sequence l = + let _id x = x in + SequenceMap(_id, l) + +let repeat i a = + if i <= 0 then Return [] else Repeat (i,a) + +let repeat' i a = + if i <= 0 then Return () else RepeatIgnore (i,a) + +(** {2 Finalizers} *) + +let (>>>=) a f = + a >>= function + | x, finalizer -> WithGuard (finalizer, x >>= f) + +(** {2 Running} *) + +exception IOFailure of string + +let rec _run : type a. a t -> a = function + | Return x -> x + | Fail msg -> raise (IOFailure msg) + | Map (f, a) -> f (_run a) + | Bind (f, a) -> _run (f (_run a)) + | WithGuard (g, a) -> + begin try + let res = _run a in + _run g; + res + with e -> + _run g; + raise e + end + | Star (f, a) -> _run f (_run a) + | Repeat (i,a) -> _repeat [] i a + | RepeatIgnore (i,a) -> _repeat_ignore i a + | Wrap f -> f() + | SequenceMap (f, l) -> _sequence_map f l [] +and _repeat : type a. a list -> int -> a t -> a list + = fun acc i a -> match i with + | 0 -> List.rev acc + | _ -> + let x = _run a in + _repeat (x::acc) (i-1) a +and _repeat_ignore : type a. int -> a t -> unit + = fun i a -> match i with + | 0 -> () + | _ -> + let _ = _run a in + _repeat_ignore (i-1) a +and _sequence_map : type a b. (a -> b t) -> a list -> b list -> b list + = fun f l acc -> match l with + | [] -> List.rev acc + | a::tail -> + let x = _run (f a) in + _sequence_map f tail (x::acc) + +let _printers = + ref [ + (* default printer *) + ( function IOFailure msg + | Sys_error msg -> Some msg + | Exit -> Some "exit" + | _ -> None + ) + ] + +exception PrinterResult of string + +let _print_exn e = + try + List.iter + (fun p -> match p e with + | None -> () + | Some msg -> raise (PrinterResult msg) + ) !_printers; + Printexc.to_string e + with PrinterResult s -> s + +let run x = + try `Ok (_run x) + with e -> `Error (_print_exn e) + +exception IO_error of string + +let run_exn x = + try _run x + with e -> raise (IO_error (_print_exn e)) + +let register_printer p = _printers := p :: !_printers + +(** {2 Standard Wrappers} *) + +let _open_in mode flags filename () = + open_in_gen flags mode filename +let _close_in ic () = close_in ic + +let with_in ?(mode=0o644) ?(flags=[]) filename = + Wrap (_open_in mode flags filename) + >>= fun ic -> + Return (Return ic, Wrap (_close_in ic)) + +let _read ic s i len () = input ic s i len +let read ic s i len = Wrap (_read ic s i len) + +let _read_line ic () = + try Some (Pervasives.input_line ic) + with End_of_file -> None +let read_line ic = Wrap(_read_line ic) + +let rec _read_lines ic acc = + read_line ic + >>= function + | None -> return (List.rev acc) + | Some l -> _read_lines ic (l::acc) + +let read_lines ic = _read_lines ic [] + +let _read_all ic () = + let buf = Buffer.create 128 in + try + while true do + Buffer.add_channel buf ic 1024 + done; + "" (* never returned *) + with End_of_file -> Buffer.contents buf + +let read_all ic = Wrap(_read_all ic) + +let _open_out mode flags filename () = + open_out_gen flags mode filename +let _close_out oc () = close_out oc + +let with_out ?(mode=0o644) ?(flags=[]) filename = + Wrap(_open_out mode (Open_wronly::flags) filename) + >>= fun oc -> + Return(Return oc, Wrap(_close_out oc)) + +let with_out_a ?mode ?(flags=[]) filename = + with_out ?mode ~flags:(Open_creat::Open_append::flags) filename + +let _write oc s i len () = output oc s i len +let write oc s i len = Wrap (_write oc s i len) + +let _write_str oc s () = output oc s 0 (String.length s) +let write_str oc s = Wrap (_write_str oc s) + +let _write_line oc l () = + output_string oc l; + output_char oc '\n' +let write_line oc l = Wrap (_write_line oc l) + +let _write_buf oc buf () = Buffer.output_buffer oc buf +let write_buf oc buf = Wrap (_write_buf oc buf) + +let flush oc = Wrap (fun () -> Pervasives.flush oc) + +(** {2 Seq} *) + +module Seq = struct + type 'a step_result = + | Yield of 'a + | Stop + + type 'a gen = unit -> 'a step_result io + + type 'a t = 'a gen + + let _stop () = return Stop + let _yield x = return (Yield x) + + let map_pure f gen () = + gen() >>= function + | Stop -> _stop () + | Yield x -> _yield (f x) + + let map f g () = + g() >>= function + | Stop -> _stop () + | Yield x -> f x >>= _yield + + let rec filter_map f g () = + g() >>= function + | Stop -> _stop() + | Yield x -> + match f x with + | None -> filter_map f g() + | Some y -> _yield y + + let rec filter f g () = + g() >>= function + | Stop -> _stop() + | Yield x -> + if f x then _yield x else filter f g() + + let rec flat_map f g () = + g() >>= function + | Stop -> _stop () + | Yield x -> + f x >>= fun g' -> _flat_map_aux f g g' () + and _flat_map_aux f g g' () = + g'() >>= function + | Stop -> flat_map f g () + | Yield x -> _yield x + + let general_iter f acc g = + let acc = ref acc in + let rec _next () = + g() >>= function + | Stop -> _stop() + | Yield x -> + f !acc x >>= function + | `Stop -> _stop() + | `Continue (acc', ret) -> + acc := acc'; + match ret with + | None -> _next() + | Some y -> _yield y + in + _next + + let take n seq = + general_iter + (fun n x -> if n<=0 + then return `Stop + else return (`Continue (n-1, Some x)) + ) n seq + + let drop n seq = + general_iter + (fun n x -> if n<=0 + then return (`Continue (n, Some x)) + else return (`Continue (n-1, None)) + ) n seq + + let take_while p seq = + general_iter + (fun () x -> + p x >|= function + | true -> `Continue ((), Some x) + | false -> `Stop + ) () seq + + let drop_while p seq = + general_iter + (fun dropping x -> + if dropping + then p x >|= function + | true -> `Continue (true, None) + | false -> `Continue (false, Some x) + else return (`Continue (false, Some x)) + ) true seq + + (* apply all actions from [l] to [x] *) + let rec _apply_all_to x l = match l with + | [] -> return () + | f::tail -> f x >>= fun () -> _apply_all_to x tail + + let _tee funs g () = + g() >>= function + | Stop -> _stop() + | Yield x -> + _apply_all_to x funs >>= fun () -> + _yield x + + let tee funs g = match funs with + | [] -> g + | _::_ -> _tee funs g + + (** {6 Consume} *) + + let rec fold_pure f acc g = + g() >>= function + | Stop -> return acc + | Yield x -> fold_pure f (f acc x) g + + let length g = fold_pure (fun acc _ -> acc+1) 0 g + + let rec fold f acc g = + g() >>= function + | Stop -> return acc + | Yield x -> + f acc x >>= fun acc' -> fold f acc' g + + let rec iter f g = + g() >>= function + | Stop -> return () + | Yield x -> f x >>= fun _ -> iter f g + + let of_fun g = g + + let empty () = _stop() + + let singleton x = + let first = ref true in + fun () -> + if !first then (first := false; _yield x) else _stop() + + let cons x g = + let first = ref true in + fun () -> + if !first then (first := false; _yield x) else g() + + let of_list l = + let l = ref l in + fun () -> match !l with + | [] -> _stop() + | x::tail -> l:= tail; _yield x + + let of_array a = + let i = ref 0 in + fun () -> + if !i = Array.length a + then _stop() + else ( + let x = a.(!i) in + incr i; + _yield x + ) + + (* TODO: wrapper around with_in? using bind ~finalize:... ? *) + + let chunks ~size ic = + let buf = Buffer.create size in + let eof = ref false in + let next() = + if !eof then _stop() + else try + Buffer.add_channel buf ic size; + let s = Buffer.contents buf in + Buffer.clear buf; + _yield s + with End_of_file -> + let s = Buffer.contents buf in + eof := true; + if s="" then _stop() else _yield s + in + next + + let lines ic () = + try _yield (input_line ic) + with End_of_file -> _stop() + + let words g = + failwith "words: not implemented yet" + (* TODO: state machine that goes: + - 0: read input chunk + - switch to "search for ' '", and yield word + - goto 0 if no ' ' found + - yield leftover when g returns Stop + let buf = Buffer.create 32 in + let next() = + g() >>= function + | Stop -> _stop + | Yield s -> + Buffer.add_string buf s; + search_ + in + next + *) + + let output ?sep oc seq = + let first = ref true in + iter + (fun s -> + (* print separator *) + ( if !first + then (first:=false; return ()) + else match sep with + | None -> return () + | Some sep -> write_str oc sep + ) >>= fun () -> + write_str oc s + ) seq + >>= fun () -> flush oc +end + +(** {6 File and file names} *) + +module File = struct + type t = string + + let to_string f = f + + let make f = + if Filename.is_relative f + then Filename.concat (Sys.getcwd()) f + else f + + let exists f = Wrap (fun () -> Sys.file_exists f) + + let is_directory f = Wrap (fun () -> Sys.is_directory f) + + let remove f = Wrap (fun () -> Sys.remove f) + + let _read_dir d () = + if Sys.is_directory d + then + let arr = Sys.readdir d in + Seq.of_array arr + |> Seq.map_pure make + else Seq.empty + + let rec _walk d () = + if Sys.is_directory d + then + let arr = Sys.readdir d in + let tail = Seq.of_array arr + |> Seq.flat_map + (fun s -> return (_walk (Filename.concat d s) ())) + in Seq.cons (`Dir,d) tail + else Seq.singleton (`File, d) + + let walk t = Wrap (_walk t) + + let read_dir ?(recurse=false) d = + if recurse + then walk d + >|= Seq.filter_map + (function + | `File, f -> Some f + | `Dir, _ -> None + ) + else Wrap (_read_dir d) + + let rec _read_dir_rec d () = + if Sys.is_directory d + then + let arr = Sys.readdir d in + Seq.of_array arr + |> Seq.map_pure (fun s -> Filename.concat d s) + |> Seq.flat_map + (fun s -> + if Sys.is_directory s + then return (_read_dir_rec s ()) + else return (Seq.singleton s) + ) + else Seq.empty +end + +(** {2 Raw} *) + +module Raw = struct + let wrap f = Wrap f +end diff --git a/core/CCIO.mli b/core/CCIO.mli new file mode 100644 index 00000000..d7950385 --- /dev/null +++ b/core/CCIO.mli @@ -0,0 +1,323 @@ + +(* +copyright (c) 2013-2014, 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 IO Monad} + +A simple abstraction over blocking IO, with strict evaluation. This is in +no way an alternative to Lwt/Async if you need concurrency. + +@since 0.3.3 +*) + +(** +Examples: + +- obtain the list of lines of a file: + +{[ +let l = CCIO.((with_in "/tmp/some_file" >>>= read_lines) |> run_exn);; +]} + +- transfer one file into another: + +{[ +# let a = CCIO.( + with_in "input" >>>= fun ic -> + with_out ~flags:[Open_creat] "output" >>>= fun oc -> + Seq.chunks 512 ic + |> Seq.output oc +) ;; + +# run a;; +]} +*) + +type 'a t +type 'a io = 'a t + +type 'a with_finalizer +(** A value of type ['a with_finalizer] is similar to a value ['a t] but + also contains a finalizer that must be run to cleanup. + See {!(>>>=)} to get rid of it. *) + +type 'a or_error = [ `Ok of 'a | `Error of string ] + +val (>>=) : 'a t -> ('a -> 'b t) -> 'b t +(** wait for the result of an action, then use a function to build a + new action and execute it *) + +val return : 'a -> 'a t +(** Just return a value *) + +val repeat : int -> 'a t -> 'a list t +(** Repeat an IO action as many times as required *) + +val repeat' : int -> 'a t -> unit t +(** Same as {!repeat}, but ignores the result *) + +val map : ('a -> 'b) -> 'a t -> 'b t +(** Map values *) + +val (>|=) : 'a t -> ('a -> 'b) -> 'b t + +val bind : ?finalize:(unit t) -> ('a -> 'b t) -> 'a t -> 'b t +(** [bind f a] runs the action [a] and applies [f] to its result + to obtain a new action. It then behaves exactly like this new + action. + @param finalize an optional action that is always run after evaluating + the whole action *) + +val pure : 'a -> 'a t +val (<*>) : ('a -> 'b) t -> 'a t -> 'b t + +val lift : ('a -> 'b) -> 'a t -> 'b t +(** Synonym to {!map} *) + +val lift2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t +val lift3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t + +val sequence : 'a t list -> 'a list t +(** Runs operations one by one and gather their results *) + +val sequence_map : ('a -> 'b t) -> 'a list -> 'b list t +(** Generalization of {!sequence} *) + +val fail : string -> 'a t +(** [fail msg] fails with the given message. Running the IO value will + return an [`Error] variant *) + +(** {2 Finalizers} *) + +val (>>>=) : 'a with_finalizer -> ('a -> 'b t) -> 'b t +(** Alternative to {!(>>=)} that also takes a [unit t] value, that is a + finalizer. This action will run in any case (even failure). + Other than the finalizer, this behaves like {!(>>=)} *) + +(** {2 Running} *) + +val run : 'a t -> 'a or_error +(** Run an IO action. + @return either [`Ok x] when [x] is the successful result of the + computation, or some [`Error "message"] *) + +exception IO_error of string + +val run_exn : 'a t -> 'a +(** Unsafe version of {!run}. It assumes non-failure. + @raise IO_error if the execution didn't go well *) + +val register_printer : (exn -> string option) -> unit +(** [register_printer p] register [p] as a possible failure printer. + If [run a] raises an exception [e], [p e] is evaluated. If [p e = Some msg] + then the error message will be [msg], otherwise other printers will + be tried *) + +(** {2 Standard Wrappers} *) + +(** {6 Input} *) + +val with_in : ?mode:int -> ?flags:open_flag list -> + string -> in_channel with_finalizer +(** Open an input file with the given optional flag list. + It yields a [in_channel] with a finalizer attached. See {!(>>>=)} to + use it. *) + +val read : in_channel -> string -> int -> int -> int t +(** Read a chunk into the given string *) + +val read_line : in_channel -> string option t +(** Read a line from the channel. Returns [None] if the input is terminated. *) + +val read_lines : in_channel -> string list t +(** Read all lines eagerly *) + +val read_all : in_channel -> string t +(** Read the whole channel into a buffer, then converted into a string *) + +(** {6 Output} *) + +val with_out : ?mode:int -> ?flags:open_flag list -> + string -> out_channel with_finalizer +(** Same as {!with_in} but for an output channel *) + +val with_out_a : ?mode:int -> ?flags:open_flag list -> + string -> out_channel with_finalizer +(** Similar to {!with_out} but with the [Open_append] and [Open_creat] + flags activated *) + +val write : out_channel -> string -> int -> int -> unit t + +val write_str : out_channel -> string -> unit t + +val write_buf : out_channel -> Buffer.t -> unit t + +val write_line : out_channel -> string -> unit t + +val flush : out_channel -> unit t + +(* TODO: printf/fprintf wrappers *) + +(** {2 Streams} + +Iterators on chunks of bytes, or lines, or any other value using combinators. +Those iterators are usable only once, because their source might +be usable only once (think of a socket) *) + +module Seq : sig + type 'a t + (** An IO stream of values of type 'a, consumable (iterable only once) *) + + val map : ('a -> 'b io) -> 'a t -> 'b t + (** Map values with actions *) + + val map_pure : ('a -> 'b) -> 'a t -> 'b t + (** Map values with a pure function *) + + val filter_map : ('a -> 'b option) -> 'a t -> 'b t + + val filter : ('a -> bool) -> 'a t -> 'a t + + val flat_map : ('a -> 'b t io) -> 'a t -> 'b t + (** Map each value to a sub sequence of values *) + + val take : int -> 'a t -> 'a t + + val drop : int -> 'a t -> 'a t + + val take_while : ('a -> bool io) -> 'a t -> 'a t + + val drop_while : ('a -> bool io) -> 'a t -> 'a t + + val general_iter : ('b -> 'a -> [`Stop | `Continue of ('b * 'c option)] io) -> + 'b -> 'a t -> 'c t + (** [general_iter f acc seq] performs a [filter_map] over [seq], + using [f]. [f] is given a state and the current value, and + can either return [`Stop] to indicate it stops traversing, + or [`Continue (st, c)] where [st] is the new state and + [c] an optional output value. + The result is the stream of values output by [f] *) + + val tee : ('a -> unit io) list -> 'a t -> 'a t + (** [tee funs seq] behaves like [seq], but each element is given to + every function [f] in [funs]. This function [f] returns an action that + is eagerly executed. *) + + (** {6 Consume} *) + + val iter : ('a -> _ io) -> 'a t -> unit io + (** Iterate on the stream, with an action for each element *) + + val length : _ t -> int io + (** Length of the stream *) + + val fold : ('b -> 'a -> 'b io) -> 'b -> 'a t -> 'b io + (** [fold f acc seq] folds over [seq], consuming it. Every call to [f] + has the right to return an IO value. *) + + val fold_pure : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b io + (** [fold f acc seq] folds over [seq], consuming it. [f] is pure. *) + + (** {6 Standard Wrappers} *) + + type 'a step_result = + | Yield of 'a + | Stop + + type 'a gen = unit -> 'a step_result io + + val of_fun : 'a gen -> 'a t + (** Create a stream from a function that yields an element or stops *) + + val empty : 'a t + val singleton : 'a -> 'a t + val cons : 'a -> 'a t -> 'a t + val of_list : 'a list -> 'a t + val of_array : 'a array -> 'a t + + val chunks : size:int -> in_channel -> string t + (** Read the channel's content into chunks of size [size] *) + + val lines : in_channel -> string t + (** Lines of an input channel *) + + val words : string t -> string t + (** Split strings into words at " " boundaries. + {b NOT IMPLEMENTED} *) + + val output : ?sep:string -> out_channel -> string t -> unit io + (** [output oc seq] outputs every value of [seq] into [oc], separated + with the optional argument [sep] (default: None). + It blocks until all values of [seq] are produced and written to [oc]. *) +end + +(** {6 File and file names} + +How to list recursively files in a directory: +{[ + CCIO.( + File.read_dir ~recurse:true (File.make "/tmp") + >>= Seq.output ~sep:"\n" stdout + ) |> CCIO.run_exn ;; + + ]} + +See {!File.walk} if you also need to list directories. +*) + +module File : sig + type t = string + (** A file is always represented by its absolute path *) + + val to_string : t -> string + + val make : string -> t + (** Build a file representation from a path (absolute or relative) *) + + val exists : t -> bool io + + val is_directory : t -> bool io + + val remove : t -> unit io + + val read_dir : ?recurse:bool -> t -> t Seq.t io + (** [read_dir d] returns a sequence of files and directory contained + in the directory [d] (or an empty stream if [d] is not a directory) + @param recurse if true (default [false]), sub-directories are also + explored *) + + val walk : t -> ([`File | `Dir] * t) Seq.t io + (** similar to {!read_dir} (with [recurse=true]), this function walks + a directory recursively and yields either files or directories. + Is a file anything that doesn't satisfy {!is_directory} (including + symlinks, etc.) *) +end + +(** {2 Low level access} *) +module Raw : sig + val wrap : (unit -> 'a) -> 'a t + (** [wrap f] is the IO action that, when executed, returns [f ()]. + [f] should be callable as many times as required *) +end diff --git a/core/CCKList.ml b/core/CCKList.ml index 9dd606e6..2b22e399 100644 --- a/core/CCKList.ml +++ b/core/CCKList.ml @@ -43,6 +43,21 @@ let empty = nil let singleton x () = `Cons (x, nil) +let rec _forever x () = `Cons (x, _forever x) + +let rec _repeat n x () = + if n<=0 then `Nil else `Cons (x, _repeat (n-1) x) + +let repeat ?n x = match n with + | None -> _forever x + | Some n -> _repeat n x + +(*$T + repeat ~n:4 0 |> to_list = [0;0;0;0] + repeat ~n:0 1 |> to_list = [] + repeat 1 |> take 20 |> to_list = (repeat ~n:20 1 |> to_list) +*) + let is_empty l = match l () with | `Nil -> true | `Cons _ -> false @@ -130,6 +145,12 @@ let rec append l1 l2 () = match l1 () with | `Nil -> l2 () | `Cons (x, l1') -> `Cons (x, append l1' l2) +let rec cycle l () = append l (cycle l) () + +(*$T + cycle (of_list [1;2]) |> take 5 |> to_list = [1;2;1;2;1] +*) + let rec flat_map f l () = match l () with | `Nil -> `Nil | `Cons (x, l') -> @@ -139,6 +160,50 @@ and _flat_map_app f l l' () = match l () with | `Cons (x, tl) -> `Cons (x, _flat_map_app f tl l') +let product_with f l1 l2 = + let rec _next_left h1 tl1 h2 tl2 () = + match tl1() with + | `Nil -> _next_right ~die:true h1 tl1 h2 tl2 () + | `Cons (x, tl1') -> + _map_list_left x h2 + (_next_right ~die:false (x::h1) tl1' h2 tl2) + () + and _next_right ~die h1 tl1 h2 tl2 () = + match tl2() with + | `Nil when die -> `Nil + | `Nil -> _next_left h1 tl1 h2 tl2 () + | `Cons (y, tl2') -> + _map_list_right h1 y + (_next_left h1 tl1 (y::h2) tl2') + () + and _map_list_left x l kont () = match l with + | [] -> kont() + | y::l' -> `Cons (f x y, _map_list_left x l' kont) + and _map_list_right l y kont () = match l with + | [] -> kont() + | x::l' -> `Cons (f x y, _map_list_right l' y kont) + in + _next_left [] l1 [] l2 + +let product l1 l2 = + product_with (fun x y -> x,y) l1 l2 + +let rec group eq l () = match l() with + | `Nil -> `Nil + | `Cons (x, l') -> + `Cons (cons x (take_while (eq x) l'), group eq (drop_while (eq x) l')) + +let rec _uniq eq prev l () = match prev, l() with + | _, `Nil -> `Nil + | None, `Cons (x, l') -> + `Cons (x, _uniq eq (Some x) l') + | Some y, `Cons (x, l') -> + if eq x y + then _uniq eq prev l' () + else `Cons (x, _uniq eq (Some x) l') + +let uniq eq l = _uniq eq None l + let rec filter_map f l () = match l() with | `Nil -> `Nil | `Cons (x, l') -> @@ -202,6 +267,15 @@ let rec merge cmp l1 l2 () = match l1(), l2() with then `Cons (x1, merge cmp l1' l2) else `Cons (x2, merge cmp l1 l2') +(** {2 Implementations} *) + +let return x () = `Cons (x, nil) +let pure = return +let (>>=) xs f = flat_map f xs +let (>|=) xs f = map f xs + +let (<*>) fs xs = product_with (fun f x -> f x) fs xs + (** {2 Conversions} *) let rec _to_rev_list acc l = match l() with @@ -237,6 +311,15 @@ let to_gen l = l := l'; Some x +let sort ?(cmp=Pervasives.compare) l = + let l = to_list l in + of_list (List.sort cmp l) + +let sort_uniq ?(cmp=Pervasives.compare) l = + let l = to_list l in + uniq (fun x y -> cmp x y = 0) (of_list (List.sort cmp l)) + + (** {2 Monadic Operations} *) module type MONAD = sig type 'a t diff --git a/core/CCKList.mli b/core/CCKList.mli index 0997a7f2..2a268103 100644 --- a/core/CCKList.mli +++ b/core/CCKList.mli @@ -47,6 +47,16 @@ val cons : 'a -> 'a t -> 'a t val singleton : 'a -> 'a t +val repeat : ?n:int -> 'a -> 'a t +(** [repeat ~n x] repeats [x] [n] times then stops. If [n] is omitted, + then [x] is repeated forever. + @since 0.3.3 *) + +val cycle : 'a t -> 'a t +(** Cycle through the iterator infinitely. The iterator shouldn't be empty. + @since 0.3.3 *) + + val is_empty : 'a t -> bool val equal : 'a equal -> 'a t equal @@ -78,6 +88,27 @@ val filter : ('a -> bool) -> 'a t -> 'a t val append : 'a t -> 'a t -> 'a t +val product_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t +(** Fair product of two (possibly infinite) lists into a new list. Lazy. + The first parameter is used to combine each pair of elements + @since 0.3.3 *) + +val product : 'a t -> 'b t -> ('a * 'b) t +(** Specialization of {!product_with} producing tuples + @since 0.3.3 *) + +val group : 'a equal -> 'a t -> 'a t t +(** [group eq l] groups together consecutive elements that satisfy [eq]. Lazy. + For instance [group (=) [1;1;1;2;2;3;3;1]] yields + [[1;1;1]; [2;2]; [3;3]; [1]] + @since 0.3.3 *) + +val uniq : 'a equal -> 'a t -> 'a t +(** [uniq eq l] returns [l] but removes consecutive duplicates. Lazy. + In other words, if several values that are equal follow one another, + only the first of them is kept. + @since 0.3.3 *) + val flat_map : ('a -> 'b t) -> 'a t -> 'b t val filter_map : ('a -> 'b option) -> 'a t -> 'b t @@ -106,6 +137,25 @@ val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool val merge : 'a ord -> 'a t -> 'a t -> 'a t (** Merge two sorted iterators into a sorted iterator *) +val sort : ?cmp:'a ord -> 'a t -> 'a t +(** Eager sort. Requires the iterator to be finite. O(n ln(n)) time + and space. + @since 0.3.3 *) + +val sort_uniq : ?cmp:'a ord -> 'a t -> 'a t +(** Eager sort that removes duplicate values. Requires the iterator to be + finite. O(n ln(n)) time and space. + @since 0.3.3 *) + +(** {2 Implementations} + @since 0.3.3 *) + +val return : 'a -> 'a t +val pure : 'a -> 'a t +val (>>=) : 'a t -> ('a -> 'b t) -> 'b t +val (>|=) : 'a t -> ('a -> 'b) -> 'b t +val (<*>) : ('a -> 'b) t -> 'a t -> 'b t + (** {2 Monadic Operations} *) module type MONAD = sig type 'a t diff --git a/core/CCList.ml b/core/CCList.ml index 2fca2327..ddb0fa5c 100644 --- a/core/CCList.ml +++ b/core/CCList.ml @@ -160,6 +160,8 @@ let (>>=) l f = flat_map f l let (<$>) = map +let pure f = [f] + let (<*>) funs l = product (fun f x -> f x) funs l let sorted_merge ?(cmp=Pervasives.compare) l1 l2 = @@ -508,6 +510,39 @@ module Zipper = struct | _, [] -> raise Not_found end +(** {2 References on Lists} *) + +module Ref = struct + type 'a t = 'a list ref + + let push l x = l := x :: !l + + let pop l = match !l with + | [] -> None + | x::tail -> + l := tail; + Some x + + let pop_exn l = match !l with + | [] -> failwith "CCList.Ref.pop_exn" + | x::tail -> + l := tail; + x + + let create() = ref [] + + let clear l = l := [] + + let lift f l = f !l + + let push_list r l = + r := List.rev_append l !r + + (*$T + let l = Ref.create() in Ref.push l 1; Ref.push_list l [2;3]; !l = [3;2;1] + *) +end + (** {2 Monadic Operations} *) module type MONAD = sig type 'a t diff --git a/core/CCList.mli b/core/CCList.mli index 6a72b547..bd3c0ad7 100644 --- a/core/CCList.mli +++ b/core/CCList.mli @@ -64,6 +64,8 @@ val diagonal : 'a t -> ('a * 'a) t (** All pairs of distinct positions of the list. [list_diagonal l] will return the list of [List.nth i l, List.nth j l] if [i < j]. *) +val pure : 'a -> 'a t + val (<*>) : ('a -> 'b) t -> 'a t -> 'b t val (<$>) : ('a -> 'b) -> 'a t -> 'b t @@ -223,6 +225,34 @@ module Zipper : sig @raise Not_found if the zipper is at an end *) end +(** {2 References on Lists} +@since 0.3.3 *) + +module Ref : sig + type 'a t = 'a list ref + + val push : 'a t -> 'a -> unit + + val pop : 'a t -> 'a option + + val pop_exn : 'a t -> 'a + (** Unsafe version of {!pop}. + @raise Failure if the list is empty *) + + val create : unit -> 'a t + (** Create a new list reference *) + + val clear : _ t -> unit + (** Remove all elements *) + + val lift : ('a list -> 'b) -> 'a t -> 'b + (** Apply a list function to the content *) + + val push_list : 'a t -> 'a list -> unit + (** Add elements of the list at the beginning of the list ref. Elements + at the end of the list will be at the beginning of the list ref *) +end + (** {2 Monadic Operations} *) module type MONAD = sig type 'a t diff --git a/core/CCMultiMap.ml b/core/CCMultiMap.ml index 3eedb5f7..29be19a8 100644 --- a/core/CCMultiMap.ml +++ b/core/CCMultiMap.ml @@ -225,3 +225,136 @@ module Make(K : OrderedType)(V : OrderedType) = struct let values m k = iter m (fun _ v -> k v) end + +module type BIDIR = sig + type t + type left + type right + + val empty : t + + val is_empty : t -> bool + + val add : t -> left -> right -> t + (** Add a binding (left,right) *) + + val remove : t -> left -> right -> t + (** Remove a specific binding *) + + val cardinal_left : t -> int + (** number of distinct left keys *) + + val cardinal_right : t -> int + (** number of distinct right keys *) + + val remove_left : t -> left -> t + (** Remove all bindings for the left key *) + + val remove_right : t -> right -> t + (** Remove all bindings for the right key *) + + val mem_left : t -> left -> bool + (** Is the left key present in at least one pair? *) + + val mem_right : t -> right -> bool + (** Is the right key present in at least one pair? *) + + val find_left : t -> left -> right sequence + (** Find all bindings for this given left-key *) + + val find_right : t -> right -> left sequence + (** Find all bindings for this given right-key *) + + val find1_left : t -> left -> right option + (** like {!find_left} but returns at most one value *) + + val find1_right : t -> right -> left option + (** like {!find_right} but returns at most one value *) + + val fold : ('a -> left -> right -> 'a) -> 'a -> t -> 'a + (** Fold on pairs *) + + val pairs : t -> (left * right) sequence + (** Iterate on pairs *) + + val add_pairs : t -> (left * right) sequence -> t + (** Add pairs *) + + val seq_left : t -> left sequence + val seq_right : t -> right sequence +end + +let _fold_seq f acc seq = + let acc = ref acc in + seq (fun x -> acc := f !acc x); + !acc + +let _head_seq seq = + let r = ref None in + begin try seq (fun x -> r := Some x; raise Exit) + with Exit -> (); + end; + !r + +module MakeBidir(L : OrderedType)(R : OrderedType) = struct + type left = L.t + type right = R.t + + module MapL = Make(L)(R) + module MapR = Make(R)(L) + + type t = { + left : MapL.t; + right : MapR.t; + } + + let empty = { + left = MapL.empty; + right = MapR.empty; + } + + let is_empty m = MapL.is_empty m.left + + let add m a b = { + left = MapL.add m.left a b; + right = MapR.add m.right b a; + } + + let remove m a b = { + left = MapL.remove m.left a b; + right = MapR.remove m.right b a; + } + + let cardinal_left m = MapL.size m.left + let cardinal_right m = MapR.size m.right + + let find_left m a = MapL.find_iter m.left a + let find_right m b = MapR.find_iter m.right b + + let remove_left m a = + _fold_seq + (fun m b -> remove m a b) + m (find_left m a) + + let remove_right m b = + _fold_seq + (fun m a -> remove m a b) + m (find_right m b) + + let mem_left m a = MapL.mem m.left a + let mem_right m b = MapR.mem m.right b + + let find1_left m a = _head_seq (find_left m a) + let find1_right m b = _head_seq (find_right m b) + + let fold f acc m = + MapL.fold m.left acc f + + let pairs m = MapL.to_seq m.left + + let add_pairs m seq = _fold_seq (fun m (a,b) -> add m a b) m seq + + let seq_left m = MapL.keys m.left + + let seq_right m = MapR.keys m.right +end diff --git a/core/CCMultiMap.mli b/core/CCMultiMap.mli index 8d6e9e71..bf6e8d4b 100644 --- a/core/CCMultiMap.mli +++ b/core/CCMultiMap.mli @@ -104,3 +104,70 @@ module type OrderedType = sig end module Make(K : OrderedType)(V : OrderedType) : S with type key = K.t and type value = V.t + +(** {2 Two-Way Multimap} +Represents n-to-n mappings between two types. Each element from the "left" +is mapped to several right values, and conversely. + +@since 0.3.3 *) + +module type BIDIR = sig + type t + type left + type right + + val empty : t + + val is_empty : t -> bool + + val add : t -> left -> right -> t + (** Add a binding (left,right) *) + + val remove : t -> left -> right -> t + (** Remove a specific binding *) + + val cardinal_left : t -> int + (** number of distinct left keys *) + + val cardinal_right : t -> int + (** number of distinct right keys *) + + val remove_left : t -> left -> t + (** Remove all bindings for the left key *) + + val remove_right : t -> right -> t + (** Remove all bindings for the right key *) + + val mem_left : t -> left -> bool + (** Is the left key present in at least one pair? *) + + val mem_right : t -> right -> bool + (** Is the right key present in at least one pair? *) + + val find_left : t -> left -> right sequence + (** Find all bindings for this given left-key *) + + val find_right : t -> right -> left sequence + (** Find all bindings for this given right-key *) + + val find1_left : t -> left -> right option + (** like {!find_left} but returns at most one value *) + + val find1_right : t -> right -> left option + (** like {!find_right} but returns at most one value *) + + val fold : ('a -> left -> right -> 'a) -> 'a -> t -> 'a + (** Fold on pairs *) + + val pairs : t -> (left * right) sequence + (** Iterate on pairs *) + + val add_pairs : t -> (left * right) sequence -> t + (** Add pairs *) + + val seq_left : t -> left sequence + val seq_right : t -> right sequence +end + +module MakeBidir(L : OrderedType)(R : OrderedType) : BIDIR + with type left = L.t and type right = R.t diff --git a/core/CCMultiSet.ml b/core/CCMultiSet.ml index 41d147f8..60640411 100644 --- a/core/CCMultiSet.ml +++ b/core/CCMultiSet.ml @@ -25,6 +25,8 @@ for any direct, indirect, incidental, special, exemplary, or consequential (** {1 Multiset} *) +type 'a sequence = ('a -> unit) -> unit + module type S = sig type elt type t @@ -69,6 +71,10 @@ module type S = sig val of_list : elt list -> t val to_list : t -> elt list + + val to_seq : t -> elt sequence + + val of_seq : elt sequence -> t end module Make(O : Set.OrderedType) = struct @@ -172,4 +178,12 @@ module Make(O : Set.OrderedType) = struct | _ -> n_cons (n-1) x (x::l) in fold m [] (fun acc n x -> n_cons n x acc) + + let to_seq m k = + M.iter (fun x n -> for _i = 1 to n do k x done) m + + let of_seq seq = + let m = ref empty in + seq (fun x -> m := add !m x); + !m end diff --git a/core/CCMultiSet.mli b/core/CCMultiSet.mli index 99e0521f..4c994901 100644 --- a/core/CCMultiSet.mli +++ b/core/CCMultiSet.mli @@ -25,6 +25,8 @@ for any direct, indirect, incidental, special, exemplary, or consequential (** {1 Multiset} *) +type 'a sequence = ('a -> unit) -> unit + module type S = sig type elt type t @@ -69,6 +71,10 @@ module type S = sig val of_list : elt list -> t val to_list : t -> elt list + + val to_seq : t -> elt sequence + + val of_seq : elt sequence -> t end module Make(O : Set.OrderedType) : S with type elt = O.t diff --git a/core/CCPair.ml b/core/CCPair.ml index 136bc567..fa15d4c9 100644 --- a/core/CCPair.ml +++ b/core/CCPair.ml @@ -36,6 +36,11 @@ let map f g (x,y) = f x, g y let map_same f (x,y) = f x, f y +let map_fst f (x,_) = f x +let map_snd f (_,x) = f x + +let iter f (x,y) = f x y + let swap (x,y) = y, x let (<<<) = map1 @@ -47,6 +52,10 @@ let ( *** ) = map let ( &&& ) f g x = f x, g x let merge f (x,y) = f x y +let fold = merge + +let dup x = x,x +let dup_map f x = x, f x let equal f g (x1,y1) (x2,y2) = f x1 x2 && g y1 y2 diff --git a/core/CCPair.mli b/core/CCPair.mli index 45748dab..1e6ddaf3 100644 --- a/core/CCPair.mli +++ b/core/CCPair.mli @@ -36,6 +36,16 @@ val map : ('a -> 'c) -> ('b -> 'd) -> ('a * 'b) -> ('c * 'd) val map_same : ('a -> 'b) -> ('a*'a) -> ('b*'b) +val map_fst : ('a -> 'b) -> ('a * _) -> 'b +(** Compose the given function with [fst]. + @since 0.3.3 *) + +val map_snd : ('a -> 'b) -> (_ * 'a) -> 'b +(** Compose the given function with [snd]. + @since 0.3.3 *) + +val iter : ('a -> 'b -> unit) -> ('a * 'b) -> unit + val swap : ('a * 'b) -> ('b * 'a) (** Swap the components of the tuple *) @@ -55,6 +65,19 @@ val ( &&& ) : ('a -> 'b) -> ('a -> 'c) -> 'a -> ('b * 'c) val merge : ('a -> 'b -> 'c) -> ('a * 'b) -> 'c (** Uncurrying (merges the two components of a tuple) *) +val fold : ('a -> 'b -> 'c) -> ('a * 'b) -> 'c +(** Synonym to {!merge} + @since 0.3.3 *) + +val dup : 'a -> ('a * 'a) +(** [dup x = (x,x)] (duplicate the value) + @since 0.3.3 *) + +val dup_map : ('a -> 'b) -> 'a -> ('a * 'b) +(** [dup_map f x = (x, f x)]. Duplicates the value and applies the function + to the second copy. + @since 0.3.3 *) + val equal : ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> ('a * 'b) -> ('a * 'b) -> bool val compare : ('a -> 'a -> int) -> ('b -> 'b -> int) -> ('a * 'b) -> ('a * 'b) -> int diff --git a/core/CCString.ml b/core/CCString.ml index 9c46b93c..1128093a 100644 --- a/core/CCString.ml +++ b/core/CCString.ml @@ -56,6 +56,11 @@ let compare = String.compare let hash s = Hashtbl.hash s +let init n f = + let s = String.make n ' ' in + for i = 0 to n-1 do s.[i] <- f i done; + s + let length = String.length let rec _to_list s acc i len = diff --git a/core/CCString.mli b/core/CCString.mli index 19fbe9fc..f003b908 100644 --- a/core/CCString.mli +++ b/core/CCString.mli @@ -62,6 +62,10 @@ val compare : t -> t -> int val hash : t -> int +val init : int -> (int -> char) -> t +(** Analog to [Array.init]. + @since 0.3.3 *) + val of_gen : char gen -> t val of_seq : char sequence -> t val of_klist : char klist -> t diff --git a/core/CCTrie.ml b/core/CCTrie.ml index 00926bce..47b4b9ce 100644 --- a/core/CCTrie.ml +++ b/core/CCTrie.ml @@ -104,6 +104,14 @@ module type S = sig val to_seq_values : 'a t -> 'a sequence val to_tree : 'a t -> [`Char of char_ | `Val of 'a | `Switch] ktree + + (** {6 Ranges} *) + + val above : key -> 'a t -> (key * 'a) sequence + (** All bindings whose key is bigger than (or equal to) the given key *) + + val below : key -> 'a t -> (key * 'a) sequence + (** All bindings whose key is smaller or equal to the given key *) end module Make(W : WORD) = struct @@ -143,6 +151,19 @@ module Make(W : WORD) = struct seq (fun x -> acc := f !acc x); finish !acc + let _filter_map_seq f seq k = + seq (fun x -> match f x with + | None -> () + | Some y -> k y) + + let _seq_append_list l seq = + let l = ref l in + seq (fun x -> l := x :: !l); + !l + + let _seq_map map k = + M.iter (fun key v -> k (key,v)) map + let _is_path = function | Path _ -> true | _ -> false @@ -293,24 +314,39 @@ module Make(W : WORD) = struct let _difflist_append f l = fun l' -> f (l @ l') let _difflist_add f x = fun l' -> f (x :: l') - let fold f acc t = - (* also keep the path from the root, so as to provide the list - of chars that lead to a value. The path is a difference list, ie - a function that prepends a list to some suffix *) - let rec aux path t acc = match t with - | Empty -> acc - | Path (l, t') -> aux (_difflist_append path l) t' acc - | Node (v, map) -> - let acc = match v with - | None -> acc - | Some v -> f acc (W.of_list (path [])) v - in - M.fold - (fun c t' acc -> aux (_difflist_add path c) t' acc) - map acc - in aux _id t acc + (* fold that also keeps the path from the root, so as to provide the list + of chars that lead to a value. The path is a difference list, ie + a function that prepends a list to some suffix *) + let rec _fold f path t acc = match t with + | Empty -> acc + | Path (l, t') -> _fold f (_difflist_append path l) t' acc + | Node (v, map) -> + let acc = match v with + | None -> acc + | Some v -> f acc path v + in + M.fold + (fun c t' acc -> _fold f (_difflist_add path c) t' acc) + map acc - let iter f t = fold (fun _ x y -> f x y) () t + let fold f acc t = + _fold + (fun acc path v -> + let key = W.of_list (path []) in + f acc key v + ) _id t acc + + let iter f t = + _fold + (fun () path y -> f (W.of_list (path [])) y) + _id t () + + let _iter_prefix ~prefix f t = + _fold + (fun () path y -> + let key = W.of_list (prefix (path [])) in + f key y) + _id t () let rec fold_values f acc t = match t with | Empty -> acc @@ -415,8 +451,83 @@ module Make(W : WORD) = struct in let l = M.bindings map in `Node(x, List.map (fun (c,t') -> _tree_node (`Char c) [to_tree t']) l) + + (** {6 Ranges} *) + + (* range above or below a threshold. + [p c c'] must return [true] if [c'], in the tree, meets some criterion + w.r.t [c] which is a part of the key. *) + let _half_range ~p key t k = + (* at subtree [cur = Some (t,trail)] or [None], alternatives above + [alternatives], and char [c] in [key]. *) + let on_char (cur, alternatives) c = + match cur with + | None -> (None, alternatives) + | Some (Empty,_) -> (None, alternatives) + | Some (Path ([], _),_) -> assert false + | Some (Path (c'::l, t'), trail) -> + if W.compare c c' = 0 + then Some (_mk_path l t', _difflist_add trail c), alternatives + else None, alternatives + | Some (Node (_, map), trail) -> + let alternatives = + _seq_map map + |> _filter_map_seq + (fun (c', t') -> if p c c' + then Some (t', _difflist_add trail c') + else None + ) + |> _seq_append_list alternatives + in + begin try + let t' = M.find c map in + Some (t', _difflist_add trail c), alternatives + with Not_found -> + None, alternatives + end + + (* run through the current path (if any) and alternatives *) + and finish (cur,alternatives) = + begin match cur with + | Some (t, prefix) -> + _iter_prefix ~prefix (fun key' v -> k (key', v)) t + | None -> () + end; + List.iter + (fun (t,prefix) -> _iter_prefix ~prefix (fun key' v -> k (key', v)) t) + alternatives + in + let word = W.to_seq key in + _fold_seq on_char ~finish (Some(t,_id), []) word + + let above key t = + _half_range ~p:(fun c c' -> W.compare c c' < 0) key t + + let below key t = + _half_range ~p:(fun c c' -> W.compare c c' > 0) key t end +module type ORDERED = sig + type t + val compare : t -> t -> int +end + +module MakeArray(X : ORDERED) = Make(struct + type t = X.t array + type char_ = X.t + let compare = X.compare + let to_seq a k = Array.iter k a + let of_list = Array.of_list +end) + +module MakeList(X : ORDERED) = Make(struct + type t = X.t list + type char_ = X.t + let compare = X.compare + let to_seq a k = List.iter k a + let of_list l = l +end) + module String = Make(struct type t = string type char_ = char diff --git a/core/CCTrie.mli b/core/CCTrie.mli index 38c4a479..b7afccd7 100644 --- a/core/CCTrie.mli +++ b/core/CCTrie.mli @@ -104,10 +104,27 @@ module type S = sig val to_seq_values : 'a t -> 'a sequence val to_tree : 'a t -> [`Char of char_ | `Val of 'a | `Switch] ktree + + (** {6 Ranges} *) + + val above : key -> 'a t -> (key * 'a) sequence + (** All bindings whose key is bigger than (or equal to) the given key *) + + val below : key -> 'a t -> (key * 'a) sequence + (** All bindings whose key is smaller or equal to the given key *) end (** {2 Implementation} *) module Make(W : WORD) : S with type key = W.t and type char_ = W.char_ +module type ORDERED = sig + type t + val compare : t -> t -> int +end + +module MakeArray(X : ORDERED) : S with type key = X.t array and type char_ = X.t + +module MakeList(X : ORDERED) : S with type key = X.t list and type char_ = X.t + module String : S with type key = string and type char_ = char diff --git a/core/META b/core/META index 5c45af6a..f58f611d 100644 --- a/core/META +++ b/core/META @@ -1,6 +1,6 @@ # OASIS_START -# DO NOT EDIT (digest: c45a958aaa0c31769f4e67935c863279) -version = "0.3.1" +# DO NOT EDIT (digest: eb8b3792deb258b784b1c656f2fcb136) +version = "0.3.3" description = "A modular standard library focused on data structures." archive(byte) = "containers.cma" archive(byte, plugin) = "containers.cma" @@ -8,9 +8,9 @@ archive(native) = "containers.cmxa" archive(native, plugin) = "containers.cmxs" exists_if = "containers.cma" package "thread" ( - version = "0.3.1" + version = "0.3.3" description = "A modular standard library focused on data structures." - requires = "containers threads lwt" + requires = "containers threads" archive(byte) = "containers_thread.cma" archive(byte, plugin) = "containers_thread.cma" archive(native) = "containers_thread.cmxa" @@ -19,7 +19,7 @@ package "thread" ( ) package "string" ( - version = "0.3.1" + version = "0.3.3" description = "A modular standard library focused on data structures." archive(byte) = "containers_string.cma" archive(byte, plugin) = "containers_string.cma" @@ -29,7 +29,7 @@ package "string" ( ) package "misc" ( - version = "0.3.1" + version = "0.3.3" description = "A modular standard library focused on data structures." requires = "unix containers" archive(byte) = "containers_misc.cma" @@ -40,7 +40,7 @@ package "misc" ( ) package "lwt" ( - version = "0.3.1" + version = "0.3.3" description = "A modular standard library focused on data structures." requires = "containers lwt lwt.unix containers.misc" archive(byte) = "containers_lwt.cma" @@ -51,7 +51,7 @@ package "lwt" ( ) package "cgi" ( - version = "0.3.1" + version = "0.3.3" description = "A modular standard library focused on data structures." requires = "containers CamlGI" archive(byte) = "containers_cgi.cma" diff --git a/core/containers.mldylib b/core/containers.mldylib index a6a3ed73..32db4c97 100644 --- a/core/containers.mldylib +++ b/core/containers.mldylib @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 97cab0e7fe53378041eec3783d519d27) +# DO NOT EDIT (digest: 5702460a7b213be45526616207085458) CCVector CCDeque CCGen @@ -17,12 +17,14 @@ CCOpt CCPair CCFun CCHash +CCCat CCKList CCInt CCBool CCArray CCBatch CCOrd +CCIO CCRandom CCLinq CCKTree diff --git a/core/containers.mllib b/core/containers.mllib index a6a3ed73..32db4c97 100644 --- a/core/containers.mllib +++ b/core/containers.mllib @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 97cab0e7fe53378041eec3783d519d27) +# DO NOT EDIT (digest: 5702460a7b213be45526616207085458) CCVector CCDeque CCGen @@ -17,12 +17,14 @@ CCOpt CCPair CCFun CCHash +CCCat CCKList CCInt CCBool CCArray CCBatch CCOrd +CCIO CCRandom CCLinq CCKTree diff --git a/misc/RAL.ml b/misc/RAL.ml index dcb57e93..f1b3f7ca 100644 --- a/misc/RAL.ml +++ b/misc/RAL.ml @@ -33,6 +33,9 @@ type +'a tree = and +'a t = (int * 'a tree) list (** Functional array of complete trees *) +(* TODO: inline list's nodes + TODO: encode "complete binary tree" into types *) + (** {2 Functions on trees} *) @@ -62,6 +65,8 @@ let rec tree_update size t i v =match t, i with let empty = [] +let return x = [1, Leaf x] + let is_empty = function | [] -> true | _ -> false @@ -95,24 +100,52 @@ let tl l = match l with let size' = size / 2 in (size', t1) :: (size', t2) :: l' +let front l = match l with + | [] -> None + | (_, Leaf x) :: tl -> Some (x, tl) + | (size, Node (x, t1, t2)) :: l' -> + let size' = size / 2 in + Some (x, (size', t1) :: (size', t2) :: l') + +let front_exn l = match l with + | [] -> raise (Invalid_argument "RAL.front") + | (_, Leaf x) :: tl -> x, tl + | (size, Node (x, t1, t2)) :: l' -> + let size' = size / 2 in + x, (size', t1) :: (size', t2) :: l' + +let rec _remove prefix l i = + let x, l' = front_exn l in + if i=0 + then List.fold_left (fun l x -> cons x l) l prefix + else _remove (x::prefix) l' (i-1) + +let remove l i = _remove [] l i + +let rec _map_tree f t = match t with + | Leaf x -> Leaf (f x) + | Node (x, l, r) -> Node (f x, _map_tree f l, _map_tree f r) + +let map f l = List.map (fun (i,t) -> i, _map_tree f t) l + let rec length l = match l with | [] -> 0 | (size,_) :: l' -> size + length l' -let rec iter l f = match l with +let rec iter f l = match l with | [] -> () - | (_, Leaf x) :: l' -> f x; iter l' f - | (_, t) :: l' -> iter_tree t f; iter l' f + | (_, Leaf x) :: l' -> f x; iter f l' + | (_, t) :: l' -> iter_tree t f; iter f l' and iter_tree t f = match t with | Leaf x -> f x | Node (x, t1, t2) -> f x; iter_tree t1 f; iter_tree t2 f -let rec fold l acc f = match l with +let rec fold f acc l = match l with | [] -> acc - | (_, Leaf x) :: l' -> fold l' (f acc x) f + | (_, Leaf x) :: l' -> fold f (f acc x) l' | (_, t) :: l' -> let acc' = fold_tree t acc f in - fold l' acc' f + fold f acc' l' and fold_tree t acc f = match t with | Leaf x -> f acc x | Node (x, t1, t2) -> @@ -120,6 +153,27 @@ and fold_tree t acc f = match t with let acc = fold_tree t1 acc f in fold_tree t2 acc f +let rec fold_rev f acc l = match l with + | [] -> acc + | (_, Leaf x) :: l' -> f (fold f acc l') x + | (_, t) :: l' -> + let acc = fold_rev f acc l' in + fold_tree_rev t acc f +and fold_tree_rev t acc f = match t with + | Leaf x -> f acc x + | Node (x, t1, t2) -> + let acc = fold_tree_rev t2 acc f in + let acc = fold_tree_rev t1 acc f in + f acc x + +let append l1 l2 = fold_rev (fun l2 x -> cons x l2) l2 l1 + let of_list l = List.fold_right cons l empty -let to_list l = List.rev (fold l [] (fun l x -> x :: l)) +let rec of_list_map f l = match l with + | [] -> empty + | x::l' -> + let y = f x in + cons y (of_list_map f l') + +let to_list l = List.rev (fold (fun l x -> x :: l) [] l) diff --git a/misc/RAL.mli b/misc/RAL.mli index 31dc223e..daca6d0b 100644 --- a/misc/RAL.mli +++ b/misc/RAL.mli @@ -43,13 +43,26 @@ val is_empty : _ t -> bool val cons : 'a -> 'a t -> 'a t (** Add an element at the front of the list *) +val return : 'a -> 'a t + +val map : ('a -> 'b) -> 'a t -> 'b t + (** Map on elements *) + val hd : 'a t -> 'a - (** First element of the list, or @raise Invalid_argument if the list is empty *) + (** First element of the list, or + @raise Invalid_argument if the list is empty *) val tl : 'a t -> 'a t (** Remove the first element from the list, or @raise Invalid_argument if the list is empty *) +val front : 'a t -> ('a * 'a t) option + (** Remove and return the first element of the list *) + +val front_exn : 'a t -> 'a * 'a t + (** Unsafe version of {!front}. + @raise Invalid_argument if the list is empty *) + val length : 'a t -> int (** Number of elements *) @@ -61,13 +74,22 @@ val set : 'a t -> int -> 'a -> 'a t (** [set l i v] sets the [i]-th element of the list to [v]. O(log(n)). @raise Invalid_argument if the list has less than [i+1] elements. *) -val iter : 'a t -> ('a -> unit) -> unit +val remove : 'a t -> int -> 'a t + (** [remove l i] removes the [i]-th element of [v]. + @raise Invalid_argument if the list has less than [i+1] elements. *) + +val append : 'a t -> 'a t -> 'a t + +val iter : ('a -> unit) -> 'a t -> unit (** Iterate on the list's elements *) -val fold : 'a t -> 'b -> ('b -> 'a -> 'b) -> 'b +val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b (** Fold on the list's elements *) val of_list : 'a list -> 'a t (** Convert a list to a RAL. {b Caution}: non tail-rec *) +val of_list_map : ('a -> 'b) -> 'a list -> 'b t + (** Combination of {!of_list} and {!map} *) + val to_list : 'a t -> 'a list diff --git a/setup.ml b/setup.ml index 6d47f3cb..728adc55 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.4.4 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 467cad461ef31a16415d6790bdfffaea) *) +(* DO NOT EDIT (digest: baa9973b38a97689412be8397df50548) *) (* Regenerated by OASIS v0.4.4 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6856,7 +6856,7 @@ let setup_t = alpha_features = []; beta_features = []; name = "containers"; - version = "0.3.1"; + version = "0.3.3"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -7012,12 +7012,14 @@ let setup_t = "CCPair"; "CCFun"; "CCHash"; + "CCCat"; "CCKList"; "CCInt"; "CCBool"; "CCArray"; "CCBatch"; "CCOrd"; + "CCIO"; "CCRandom"; "CCLinq"; "CCKTree"; @@ -7170,7 +7172,7 @@ let setup_t = bs_nativeopt = [(OASISExpr.EBool true, [])] }, { - lib_modules = ["Future"]; + lib_modules = ["CCFuture"]; lib_pack = false; lib_internal_modules = []; lib_findlib_parent = Some "containers"; @@ -7739,7 +7741,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.4"; - oasis_digest = Some "r\029\246\250i\231\180\245`&\163\247h!\251b"; + oasis_digest = Some ">\"\nZ{\234\192R\1690\0047v\140\218\145"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7747,6 +7749,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7751 "setup.ml" +# 7753 "setup.ml" (* OASIS_STOP *) let () = setup ();; diff --git a/tests/benchs.ml b/tests/benchs.ml index 93f48fd2..a6553124 100644 --- a/tests/benchs.ml +++ b/tests/benchs.ml @@ -281,7 +281,7 @@ let imap_find m = let icchashtbl_find m = fun n -> for i = 0 to n-1 do - ignore (ICCHashtbl.find_exn m i); + ignore (ICCHashtbl.get_exn i m); done let bench_maps3 () = diff --git a/tests/test_graph.ml b/tests/test_graph.ml index bbedd709..2899b232 100644 --- a/tests/test_graph.ml +++ b/tests/test_graph.ml @@ -65,7 +65,6 @@ let test_bfs () = () let rec pp_path p = - let buf = Buffer.create 10 in CCPrint.to_string (CCList.pp ~sep:"; " pp_edge) p and pp_edge b (v1,e,v2) = Printf.bprintf b "%d -> %d" v1 v2 diff --git a/threads/future.ml b/threads/CCFuture.ml similarity index 100% rename from threads/future.ml rename to threads/CCFuture.ml diff --git a/threads/future.mli b/threads/CCFuture.mli similarity index 100% rename from threads/future.mli rename to threads/CCFuture.mli diff --git a/threads/containers_thread.mldylib b/threads/containers_thread.mldylib index b10f0345..420c8b75 100644 --- a/threads/containers_thread.mldylib +++ b/threads/containers_thread.mldylib @@ -1,4 +1,4 @@ # OASIS_START -# DO NOT EDIT (digest: adff855173c9b92b5478129af7d39e03) -Future +# DO NOT EDIT (digest: ede75f11c3857d71e591f7b889f4d09d) +CCFuture # OASIS_STOP diff --git a/threads/containers_thread.mllib b/threads/containers_thread.mllib index b10f0345..420c8b75 100644 --- a/threads/containers_thread.mllib +++ b/threads/containers_thread.mllib @@ -1,4 +1,4 @@ # OASIS_START -# DO NOT EDIT (digest: adff855173c9b92b5478129af7d39e03) -Future +# DO NOT EDIT (digest: ede75f11c3857d71e591f7b889f4d09d) +CCFuture # OASIS_STOP