mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 19:25:28 -05:00
merge from master
This commit is contained in:
commit
d3224e6b4d
38 changed files with 1865 additions and 60 deletions
|
|
@ -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;;
|
||||
|
|
|
|||
7
Makefile
7
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
|
||||
|
|
|
|||
|
|
@ -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)).
|
||||
|
||||
[](http://ci.cedeela.fr/job/containers/)
|
||||
|
||||
## Use
|
||||
|
||||
You can either build and install the library (see `Build`), or just copy
|
||||
|
|
|
|||
10
_oasis
10
_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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
145
core/CCCat.ml
Normal file
145
core/CCCat.ml
Normal file
|
|
@ -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
|
||||
114
core/CCCat.mli
Normal file
114
core/CCCat.mli
Normal file
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
519
core/CCIO.ml
Normal file
519
core/CCIO.ml
Normal file
|
|
@ -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
|
||||
323
core/CCIO.mli
Normal file
323
core/CCIO.mli
Normal file
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
145
core/CCTrie.ml
145
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
16
core/META
16
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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
68
misc/RAL.ml
68
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)
|
||||
|
|
|
|||
28
misc/RAL.mli
28
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
|
||||
|
|
|
|||
12
setup.ml
12
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 ();;
|
||||
|
|
|
|||
|
|
@ -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 () =
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
# OASIS_START
|
||||
# DO NOT EDIT (digest: adff855173c9b92b5478129af7d39e03)
|
||||
Future
|
||||
# DO NOT EDIT (digest: ede75f11c3857d71e591f7b889f4d09d)
|
||||
CCFuture
|
||||
# OASIS_STOP
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
# OASIS_START
|
||||
# DO NOT EDIT (digest: adff855173c9b92b5478129af7d39e03)
|
||||
Future
|
||||
# DO NOT EDIT (digest: ede75f11c3857d71e591f7b889f4d09d)
|
||||
CCFuture
|
||||
# OASIS_STOP
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue