diff --git a/.merlin b/.merlin index 67556471..7ddc6d1f 100644 --- a/.merlin +++ b/.merlin @@ -32,4 +32,4 @@ PKG threads PKG threads.posix PKG lwt PKG bigarray -FLG -w +a -w -4 -w -44 +FLG -w +a -w -4 -w -44 -w -32 -w -34 diff --git a/CHANGELOG.md b/CHANGELOG.md index d55ea6b3..50fa1a62 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,32 @@ # Changelog +## 0.11 + +- add `CCList.{remove,is_empty}` +- add `CCOpt.is_none` +- remove packs for `containers_string` and `containers_advanced` +- add `Containers_string.Parse`, very simple monadic parser combinators +- remove warning from `.merlin` +- attempts of bugfix in PrintBox for unicode text (wip) +- add `CCList.{find_pred,find_pred_exn}` +- bugfix in `CCUnix.escape_str` +- add methods and accessors to `CCUnix` +- in `CCUnix`, use `Unix.environment` as the default environment +- add `CCList.partition_map` +- `RingBuffer.{of_array, to_array}` convenience functions +- `containers.misc.RAL`: more efficient in memory (unfold list) +- add `CCInt.pow` (thanks to bernardofpc) +- add `CCList.group_succ` +- `containers.data.CCMixset`, set of values indexed by poly keys +- disable warning 32 (unused val) in .merlin +- some infix operators for `CCUnix` +- add `CCUnix.async_call` for spawning and communicating with subprocess +- add `CCList.Set.{add,remove}` +- fix doc of `CCstring.Split.list_` + ## 0.10 -- add `containers_misc.Puf.iter` +- add `containers.misc.Puf.iter` - add `CCString.{lines,unlines,concat_gen}` - `CCUnix` (with a small subprocess API) - add `CCList.{sorted_merge_uniq, uniq_succ}` @@ -11,7 +35,7 @@ - `CCIntMap` (big-endian patricia trees) in containers.data - bugfix in `CCFQueue.add_seq_front` - add `CCFQueue.{rev, --}` -- add `App_parse` in `containers_string`, experimental applicative parser combinators +- add `App_parse` in `containers.string`, experimental applicative parser combinators - remove `containers.pervasives`, add the module `Containers` to core - bugfix in `CCFormat.to_file` diff --git a/README.md b/README.md index ef330830..6b8dab58 100644 --- a/README.md +++ b/README.md @@ -26,6 +26,10 @@ What is _containers_? be able to deal with your favorite unicode library). - A sub-library with complicated abstractions, `containers.advanced` (with a LINQ-like query module, batch operations using GADTs, and others). +- Utilities aroud the `unix` library in `containers.unix` (mainly to spawn + sub-processes) +- A bigstring module using `bigarray` in `containers.bigarray` +- A lightweight S-expression printer and streaming parser in `containers.sexp` - A library using [Lwt](https://github.com/ocsigen/lwt/), `containers.lwt`. Currently only contains experimental, unstable stuff. - Random stuff, with *NO* *GUARANTEE* of even being barely usable or tested, @@ -104,6 +108,7 @@ Documentation [here](http://cedeela.fr/~simon/software/containers). - `CCFQueue`, a purely functional double-ended queue structure - `CCBV`, mutable bitvectors - `CCPersistentHashtbl`, a semi-persistent hashtable (similar to [persistent arrays](https://www.lri.fr/~filliatr/ftp/ocaml/ds/parray.ml.html)) +- `CCMixmap`, `CCMixtbl`, `CCMixset`, containers of universal types (heterogenous containers) ### Containers.io diff --git a/_oasis b/_oasis index c5834652..983c8869 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.4 Name: containers -Version: 0.10 +Version: 0.11 Homepage: https://github.com/c-cube/ocaml-containers Authors: Simon Cruanes License: BSD-2-clause @@ -82,7 +82,8 @@ Library "containers_data" Path: src/data Modules: CCMultiMap, CCMultiSet, CCTrie, CCFlatHashtbl, CCCache, CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl, - CCMixmap, CCRingBuffer, CCIntMap, CCPersistentArray + CCMixmap, CCRingBuffer, CCIntMap, CCPersistentArray, + CCMixset BuildDepends: bytes FindlibParent: containers FindlibName: data @@ -95,16 +96,14 @@ Library "containers_iter" Library "containers_string" Path: src/string - Pack: true - Modules: KMP, Levenshtein, App_parse + Modules: Containers_string, CCKMP, CCLevenshtein, CCApp_parse, CCParse BuildDepends: bytes FindlibName: string FindlibParent: containers Library "containers_advanced" Path: src/advanced - Pack: true - Modules: CCLinq, CCBatch, CCCat, CCMonadIO + Modules: Containers_advanced, CCLinq, CCBatch, CCCat, CCMonadIO Build$: flag(advanced) Install$: flag(advanced) FindlibName: advanced diff --git a/_tags b/_tags index a20a5b46..2299aed8 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 2d4ff427096956a049556073cd9b4191) +# DO NOT EDIT (digest: 8abfb70ea9625c4528141fdd459e8114) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -34,16 +34,9 @@ true: annot, bin_annot "src/iter/containers_iter.cmxs": use_containers_iter # Library containers_string "src/string/containers_string.cmxs": use_containers_string -"src/string/KMP.cmx": for-pack(Containers_string) -"src/string/levenshtein.cmx": for-pack(Containers_string) -"src/string/app_parse.cmx": for-pack(Containers_string) : package(bytes) # Library containers_advanced "src/advanced/containers_advanced.cmxs": use_containers_advanced -"src/advanced/CCLinq.cmx": for-pack(Containers_advanced) -"src/advanced/CCBatch.cmx": for-pack(Containers_advanced) -"src/advanced/CCCat.cmx": for-pack(Containers_advanced) -"src/advanced/CCMonadIO.cmx": for-pack(Containers_advanced) : package(bytes) : package(sequence) : use_containers diff --git a/containers.odocl b/containers.odocl index a45bc47d..29bf76e6 100644 --- a/containers.odocl +++ b/containers.odocl @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 463813d3e54d45bc5b6a9d7d4eb17cd0) +# DO NOT EDIT (digest: 7f7259458c1636ee0279e4fb677f4e2b) src/core/CCVector src/core/CCPrint src/core/CCError @@ -53,10 +53,14 @@ src/data/CCMixmap src/data/CCRingBuffer src/data/CCIntMap src/data/CCPersistentArray -src/string/KMP -src/string/Levenshtein -src/string/App_parse +src/data/CCMixset +src/string/Containers_string +src/string/CCKMP +src/string/CCLevenshtein +src/string/CCApp_parse +src/string/CCParse src/bigarray/CCBigstring +src/advanced/Containers_advanced src/advanced/CCLinq src/advanced/CCBatch src/advanced/CCCat diff --git a/doc/intro.txt b/doc/intro.txt index 42f0f3c6..5b68eb1f 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -68,6 +68,7 @@ CCFQueue CCFlatHashtbl CCIntMap CCMixmap +CCMixset CCMixtbl CCMultiMap CCMultiSet diff --git a/setup.ml b/setup.ml index d83438c0..035ecf6f 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: bc1fcdeddb836af6942617417a65ae05) *) +(* DO NOT EDIT (digest: ee9a9724a7939bfbe9c154b61dba7eeb) *) (* Regenerated by OASIS v0.4.5 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6965,7 +6965,7 @@ let setup_t = alpha_features = ["ocamlbuild_more_args"]; beta_features = []; name = "containers"; - version = "0.10"; + version = "0.11"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -7294,7 +7294,8 @@ let setup_t = "CCMixmap"; "CCRingBuffer"; "CCIntMap"; - "CCPersistentArray" + "CCPersistentArray"; + "CCMixset" ]; lib_pack = false; lib_internal_modules = []; @@ -7355,8 +7356,15 @@ let setup_t = bs_nativeopt = [(OASISExpr.EBool true, [])] }, { - lib_modules = ["KMP"; "Levenshtein"; "App_parse"]; - lib_pack = true; + lib_modules = + [ + "Containers_string"; + "CCKMP"; + "CCLevenshtein"; + "CCApp_parse"; + "CCParse" + ]; + lib_pack = false; lib_internal_modules = []; lib_findlib_parent = Some "containers"; lib_findlib_name = Some "string"; @@ -7398,8 +7406,14 @@ let setup_t = }, { lib_modules = - ["CCLinq"; "CCBatch"; "CCCat"; "CCMonadIO"]; - lib_pack = true; + [ + "Containers_advanced"; + "CCLinq"; + "CCBatch"; + "CCCat"; + "CCMonadIO" + ]; + lib_pack = false; lib_internal_modules = []; lib_findlib_parent = Some "containers"; lib_findlib_name = Some "advanced"; @@ -8100,8 +8114,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.5"; - oasis_digest = - Some "Q\133\224\006'\239^\194\020\007 \247\168\220\142\188"; + oasis_digest = Some "\005\024\210\198~B\127\141$\2177\196Z573"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -8109,6 +8122,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 8113 "setup.ml" +# 8126 "setup.ml" (* OASIS_STOP *) let () = setup ();; diff --git a/src/advanced/containers_advanced.ml b/src/advanced/containers_advanced.ml new file mode 100644 index 00000000..fc460343 --- /dev/null +++ b/src/advanced/containers_advanced.ml @@ -0,0 +1,30 @@ + +(* +copyright (c) 2013-2015, 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. +*) + +module Batch = CCBatch +module Cat = CCCat +module Linq = CCLinq +module MonadIO = CCMonadIO diff --git a/src/advanced/containers_advanced.mldylib b/src/advanced/containers_advanced.mldylib index 0f1163e0..a5d214cf 100644 --- a/src/advanced/containers_advanced.mldylib +++ b/src/advanced/containers_advanced.mldylib @@ -1,4 +1,8 @@ # OASIS_START -# DO NOT EDIT (digest: 0f1ca0e2b031ae1710e26abf02cca256) +# DO NOT EDIT (digest: b0f5a3a0b7428f165d73d9e621998219) Containers_advanced +CCLinq +CCBatch +CCCat +CCMonadIO # OASIS_STOP diff --git a/src/advanced/containers_advanced.mllib b/src/advanced/containers_advanced.mllib index 0f1163e0..a5d214cf 100644 --- a/src/advanced/containers_advanced.mllib +++ b/src/advanced/containers_advanced.mllib @@ -1,4 +1,8 @@ # OASIS_START -# DO NOT EDIT (digest: 0f1ca0e2b031ae1710e26abf02cca256) +# DO NOT EDIT (digest: b0f5a3a0b7428f165d73d9e621998219) Containers_advanced +CCLinq +CCBatch +CCCat +CCMonadIO # OASIS_STOP diff --git a/src/advanced/containers_advanced.mlpack b/src/advanced/containers_advanced.mlpack deleted file mode 100644 index 7c96f38e..00000000 --- a/src/advanced/containers_advanced.mlpack +++ /dev/null @@ -1,7 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 5a399cd532edb84596f3034081578694) -CCLinq -CCBatch -CCCat -CCMonadIO -# OASIS_STOP diff --git a/src/core/CCInt.ml b/src/core/CCInt.ml index 4a7bbf1f..12a0d013 100644 --- a/src/core/CCInt.ml +++ b/src/core/CCInt.ml @@ -39,6 +39,27 @@ let sign i = let neg i = -i +let pow a b = + let rec aux acc = function + | 1 -> acc + | n -> + if n mod 2 = 0 + then aux (acc*acc) (n/2) + else acc * (aux (acc*acc) (n/2)) + in + match b with + | 0 -> if a = 0 then raise (Invalid_argument "Undefined value 0^0") else 1 + | b when b < 0 -> raise (Invalid_argument "pow: can't raise int to negative power") + | b -> aux a b + +(*$T + pow 2 10 = 1024 + pow 2 15 = 32768 + pow 10 5 = 100000 + pow 1 0 = 1 + pow 0 1 = 0 +*) + type 'a printer = Buffer.t -> 'a -> unit type 'a formatter = Format.formatter -> 'a -> unit type 'a random_gen = Random.State.t -> 'a diff --git a/src/core/CCInt.mli b/src/core/CCInt.mli index 12a9040c..9ad57969 100644 --- a/src/core/CCInt.mli +++ b/src/core/CCInt.mli @@ -41,6 +41,11 @@ val neg : t -> t (** [neg i = - i] @since 0.5 *) +val pow : t -> t -> t +(** [pow a b = a^b] for positive integers [a] and [b]. + raises [Invalid_argument] if [a = b = 0] or [b] < 0. + @since 0.11 *) + type 'a printer = Buffer.t -> 'a -> unit type 'a formatter = Format.formatter -> 'a -> unit type 'a random_gen = Random.State.t -> 'a diff --git a/src/core/CCList.ml b/src/core/CCList.ml index ea84429e..f8a82c3b 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -30,6 +30,10 @@ type 'a t = 'a list let empty = [] +let is_empty = function + | [] -> true + | _::_ -> false + (* max depth for direct recursion *) let direct_depth_default_ = 1000 @@ -206,6 +210,29 @@ let diagonal l = in gen [] l +let partition_map f l = + let rec iter f l1 l2 l = match l with + | [] -> List.rev l1, List.rev l2 + | x :: tl -> + match f x with + | `Left y -> iter f (y :: l1) l2 tl + | `Right y -> iter f l1 (y :: l2) tl + | `Drop -> iter f l1 l2 tl + in + iter f [] [] l + +(*$R + let l1, l2 = + partition_map (function + | n when n = 0 -> `Drop + | n when n mod 2 = 0 -> `Left n + | n -> `Right n + ) [0;1;2;3;4] + in + assert_equal [2;4] l1; + assert_equal [1;3] l2 +*) + let return x = [x] let (>>=) l f = flat_map f l @@ -266,6 +293,25 @@ let uniq_succ ?(eq=(=)) l = uniq_succ [1;1;2;3;1;6;6;4;6;1] = [1;2;3;1;6;4;6;1] *) +let group_succ ?(eq=(=)) l = + let rec f ~eq acc cur l = match cur, l with + | [], [] -> List.rev acc + | _::_, [] -> List.rev (List.rev cur :: acc) + | [], x::tl -> f ~eq acc [x] tl + | (y :: _), x :: tl when eq x y -> f ~eq acc (x::cur) tl + | _, x :: tl -> f ~eq (List.rev cur :: acc) [x] tl + in + f ~eq [] [] l + +(*$T + group_succ [1;2;3;1;1;2;4] = [[1]; [2]; [3]; [1;1]; [2]; [4]] + group_succ [] = [] + group_succ [1;1;1] = [[1;1;1]] + group_succ [1;2;2;2] = [[1]; [2;2;2]] + group_succ ~eq:(fun (x,_)(y,_)-> x=y) [1, 1; 1, 2; 1, 3; 2, 0] \ + = [[1, 1; 1, 2; 1, 3]; [2, 0]] +*) + let sorted_merge_uniq ?(cmp=Pervasives.compare) l1 l2 = let push ~cmp acc x = match acc with | [] -> [x] @@ -343,7 +389,23 @@ let last n l = let len = List.length l in if len < n then l else drop (len-n) l -let findi f l = +let rec find_pred p l = match l with + | [] -> None + | x :: _ when p x -> Some x + | _ :: tl -> find_pred p tl + +let find_pred_exn p l = match find_pred p l with + | None -> raise Not_found + | Some x -> x + +(*$T + find_pred ((=) 4) [1;2;5;4;3;0] = Some 4 + find_pred (fun _ -> true) [] = None + find_pred (fun _ -> false) (1 -- 10) = None + find_pred (fun x -> x < 10) (1 -- 9) = Some 1 +*) + +let find_mapi f l = let rec aux f i = function | [] -> None | x::l' -> @@ -352,15 +414,31 @@ let findi f l = | None -> aux f (i+1) l' in aux f 0 l -let find f l = findi (fun _ -> f) l +let find_map f l = find_mapi (fun _ -> f) l -let find_idx p l = findi (fun i x -> if p x then Some (i, x) else None) l +let find = find_map +let findi = find_mapi + +let find_idx p l = find_mapi (fun i x -> if p x then Some (i, x) else None) l (*$T find (fun x -> if x=3 then Some "a" else None) [1;2;3;4] = Some "a" find (fun x -> if x=3 then Some "a" else None) [1;2;4;5] = None *) +let remove ?(eq=(=)) ~x l = + let rec remove' eq x acc l = match l with + | [] -> List.rev acc + | y :: tail when eq x y -> remove' eq x acc tail + | y :: tail -> remove' eq x (y::acc) tail + in + remove' eq x [] l + +(*$T + remove ~x:1 [2;1;3;3;2;1] = [2;3;3;2] + remove ~x:10 [1;2;3] = [1;2;3] +*) + let filter_map f l = let rec recurse acc l = match l with | [] -> List.rev acc @@ -376,6 +454,26 @@ module Set = struct | y::l' -> eq x y || search eq x l' in search eq x l + let add ?(eq=(=)) x l = + if mem ~eq x l then l else x::l + + let remove ?(eq=(=)) x l = + let rec remove_one ~eq x acc l = match l with + | [] -> assert false + | y :: tl when eq x y -> List.rev_append acc tl + | y :: tl -> remove_one ~eq x (y::acc) tl + in + if mem ~eq x l then remove_one ~eq x [] l else l + + (*$Q + Q.(pair int (list int)) (fun (x,l) -> \ + Set.remove x (Set.add x l) = l) + Q.(pair int (list int)) (fun (x,l) -> \ + Set.mem x l || List.length (Set.add x l) = List.length l + 1) + Q.(pair int (list int)) (fun (x,l) -> \ + not (Set.mem x l) || List.length (Set.remove x l) = List.length l - 1) + *) + let subset ?(eq=(=)) l1 l2 = List.for_all (fun t -> mem ~eq t l2) diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 6021cf9d..201a2112 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -30,6 +30,10 @@ type 'a t = 'a list val empty : 'a t +val is_empty : _ t -> bool +(** [is_empty l] returns [true] iff [l = []] + @since 0.11 *) + val map : ('a -> 'b) -> 'a t -> 'b t (** Safe version of map *) @@ -54,7 +58,7 @@ val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a @since 0.8 *) val init : int -> (int -> 'a) -> 'a t -(** Same as [Array.init] +(** Similar to {!Array.init} @since 0.6 *) val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int @@ -77,6 +81,14 @@ 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 partition_map : ('a -> [<`Left of 'b | `Right of 'c | `Drop]) -> + 'a list -> 'b list * 'c list +(** [partition_map f l] maps [f] on [l] and gather results in lists: + - if [f x = `Left y], adds [y] to the first list + - if [f x = `Right z], adds [z] to the second list + - if [f x = `Drop], ignores [x] + @since 0.11 *) + val pure : 'a -> 'a t val (<*>) : ('a -> 'b) t -> 'a t -> 'b t @@ -101,19 +113,42 @@ val last : int -> 'a t -> 'a t (** [last n l] takes the last [n] elements of [l] (or less if [l] doesn't have that many elements *) -val find : ('a -> 'b option) -> 'a t -> 'b option +val find_pred : ('a -> bool) -> 'a t -> 'a option +(** [find_pred p l] finds the first element of [l] that satisfies [p], + or returns [None] if no element satisfies [p] + @since 0.11 *) + +val find_pred_exn : ('a -> bool) -> 'a t -> 'a +(** Unsafe version of {!find_pred} + @raise Not_found if no such element is found + @since 0.11 *) + +val find_map : ('a -> 'b option) -> 'a t -> 'b option (** [find f l] traverses [l], applying [f] to each element. If for some element [x], [f x = Some y], then [Some y] is returned. Otherwise - the call returns [None] *) + the call returns [None] + @since 0.11 *) + +val find : ('a -> 'b option) -> 'a list -> 'b option +(** @deprecated in favor of {!find_map}, for the name is too confusing *) + +val find_mapi : (int -> 'a -> 'b option) -> 'a t -> 'b option +(** Like {!find_map}, but also pass the index to the predicate function. + @since 0.11 *) val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option -(** Like {!find}, but also pass the index to the predicate function. +(** @deprecated in favor of {!find_mapi}, name is too confusing @since 0.3.4 *) val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option (** [find p x] returns [Some (i,x)] where [x] is the [i]-th element of [l], and [p x] holds. Otherwise returns [None] *) +val remove : ?eq:('a -> 'a -> bool) -> x:'a -> 'a t -> 'a t +(** [remove ~x l] removes every instance of [x] from [l]. Tailrec. + @param eq equality function + @since 0.11 *) + val filter_map : ('a -> 'b option) -> 'a t -> 'b t (** Map and remove elements at the same time *) @@ -135,6 +170,11 @@ val uniq_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list [uniq_succ [1;1;2] = [1;2]] @since 0.10 *) +val group_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list list +(** [group_succ ~eq l] groups together consecutive elements that are equal + according to [eq] + @since 0.11 *) + (** {2 Indices} *) module Idx : sig @@ -167,6 +207,14 @@ end (** {2 Set Operators} *) module Set : sig + val add : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t + (** [add x set] adds [x] to [set] if it was not already present + @since 0.11 *) + + val remove : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t + (** [remove x set] removes one occurrence of [x] from [set] + @since 0.11 *) + val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool (** membership to the list *) diff --git a/src/core/CCOpt.ml b/src/core/CCOpt.ml index 6f17e981..9a792fd0 100644 --- a/src/core/CCOpt.ml +++ b/src/core/CCOpt.ml @@ -40,6 +40,10 @@ let is_some = function | None -> false | Some _ -> true +let is_none = function + | None -> true + | Some _ -> false + let compare f o1 o2 = match o1, o2 with | None, None -> 0 | Some _, None -> 1 diff --git a/src/core/CCOpt.mli b/src/core/CCOpt.mli index f3214310..ed1f3778 100644 --- a/src/core/CCOpt.mli +++ b/src/core/CCOpt.mli @@ -36,6 +36,9 @@ val maybe : ('a -> 'b) -> 'b -> 'a t -> 'b val is_some : _ t -> bool +val is_none : _ t -> bool +(** @since 0.11 *) + val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool @@ -62,7 +65,6 @@ val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a val filter : ('a -> bool) -> 'a t -> 'a t (** Filter on 0 or 1 elements - @since 0.5 *) val get : 'a -> 'a t -> 'a diff --git a/src/core/CCString.mli b/src/core/CCString.mli index fcfc32db..bf03f5e0 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -146,9 +146,9 @@ module Split : sig (** split the given string along the given separator [by]. Should only be used with very small separators, otherwise use {!Containers_string.KMP}. - @return a list of (index,length) of substrings of [s] that are + @return a list of slices [(s,index,length)] that are separated by [by]. {!String.sub} can then be used to actually extract - the slice. + a string from the slice. @raise Failure if [by = ""] *) val gen : by:string -> string -> (string*int*int) gen diff --git a/src/core/META b/src/core/META index 800bab57..25c822ad 100644 --- a/src/core/META +++ b/src/core/META @@ -1,6 +1,6 @@ # OASIS_START -# DO NOT EDIT (digest: 09a66d8274446aebd1544537d064203d) -version = "0.10" +# DO NOT EDIT (digest: 21a795d293af857176fa2c97f6316578) +version = "0.11" description = "A modular standard library focused on data structures." requires = "bytes" archive(byte) = "containers.cma" @@ -9,7 +9,7 @@ archive(native) = "containers.cmxa" archive(native, plugin) = "containers.cmxs" exists_if = "containers.cma" package "unix" ( - version = "0.10" + version = "0.11" description = "A modular standard library focused on data structures." requires = "bytes unix" archive(byte) = "containers_unix.cma" @@ -20,7 +20,7 @@ package "unix" ( ) package "thread" ( - version = "0.10" + version = "0.11" description = "A modular standard library focused on data structures." requires = "containers threads" archive(byte) = "containers_thread.cma" @@ -31,7 +31,7 @@ package "thread" ( ) package "string" ( - version = "0.10" + version = "0.11" description = "A modular standard library focused on data structures." requires = "bytes" archive(byte) = "containers_string.cma" @@ -42,7 +42,7 @@ package "string" ( ) package "sexp" ( - version = "0.10" + version = "0.11" description = "A modular standard library focused on data structures." requires = "bytes" archive(byte) = "containers_sexp.cma" @@ -53,7 +53,7 @@ package "sexp" ( ) package "misc" ( - version = "0.10" + version = "0.11" description = "A modular standard library focused on data structures." requires = "containers containers.data" archive(byte) = "containers_misc.cma" @@ -64,7 +64,7 @@ package "misc" ( ) package "lwt" ( - version = "0.10" + version = "0.11" description = "A modular standard library focused on data structures." requires = "containers lwt containers.misc" archive(byte) = "containers_lwt.cma" @@ -75,7 +75,7 @@ package "lwt" ( ) package "iter" ( - version = "0.10" + version = "0.11" description = "A modular standard library focused on data structures." archive(byte) = "containers_iter.cma" archive(byte, plugin) = "containers_iter.cma" @@ -85,7 +85,7 @@ package "iter" ( ) package "io" ( - version = "0.10" + version = "0.11" description = "A modular standard library focused on data structures." requires = "bytes" archive(byte) = "containers_io.cma" @@ -96,7 +96,7 @@ package "io" ( ) package "data" ( - version = "0.10" + version = "0.11" description = "A modular standard library focused on data structures." requires = "bytes" archive(byte) = "containers_data.cma" @@ -107,7 +107,7 @@ package "data" ( ) package "bigarray" ( - version = "0.10" + version = "0.11" description = "A modular standard library focused on data structures." requires = "containers bigarray bytes" archive(byte) = "containers_bigarray.cma" @@ -118,7 +118,7 @@ package "bigarray" ( ) package "advanced" ( - version = "0.10" + version = "0.11" description = "A modular standard library focused on data structures." requires = "containers sequence" archive(byte) = "containers_advanced.cma" diff --git a/src/data/CCMixset.ml b/src/data/CCMixset.ml new file mode 100644 index 00000000..fcd5ddf6 --- /dev/null +++ b/src/data/CCMixset.ml @@ -0,0 +1,79 @@ + +(* +copyright (c) 2013-2015, 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 Set of Heterogeneous Values} *) + +module IMap = Map.Make(struct + type t = int + let compare : int -> int -> int = compare +end) + +(*$R + let k1 : int key = newkey () in + let k2 : int key = newkey () in + let k3 : string key = newkey () in + let set = + empty + |> set ~key:k1 1 + |> set ~key:k2 2 + |> set ~key:k3 "3" + in + assert (get ~key:k1 set = Some 1); + assert (get ~key:k2 set = Some 2); + assert (get ~key:k3 set = Some "3"); + () +*) + +type t = (unit -> unit) IMap.t +and 'a key = { + id: int; + mutable opt : 'a option; +};; + +let newkey_n_ = ref 0 + +let newkey () = + let id = !newkey_n_ in + incr newkey_n_; + { id; opt=None; } + +let empty = IMap.empty + +let get ~key set = + key.opt <- None; + try + (IMap.find key.id set) (); + key.opt + with Not_found -> None + +let get_exn ~key set = match get ~key set with + | None -> raise Not_found + | Some v -> v + +let set ~key v set = + IMap.add key.id (fun () -> key.opt <- Some v) set + +let cardinal set = IMap.cardinal set diff --git a/src/data/CCMixset.mli b/src/data/CCMixset.mli new file mode 100644 index 00000000..cde9b021 --- /dev/null +++ b/src/data/CCMixset.mli @@ -0,0 +1,77 @@ + +(* +copyright (c) 2013-2015, 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 Set of Heterogeneous Values} + + {[ + let k1 : int key = newkey () in + let k2 : int key = newkey () in + let k3 : string key = newkey () in + let set = + empty + |> set ~key:k1 1 + |> set ~key:k2 2 + |> set ~key:k3 "3" + in + assert (get ~key:k1 set = Some 1); + assert (get ~key:k2 set = Some 2); + assert (get ~key:k3 set = Some "3"); + () + ]} + + @since 0.11 *) + +type t +(** A set of values of heterogeneous types *) + +type 'a key +(** A unique "key" to access a value of type ['a] in a [set] *) + +val newkey : unit -> 'a key +(** [newkey ()] creates a new unique key that can be used to access + a ['a] value in a set. Each key created with [newkey] is distinct + from any other key, even if they have the same type. + + Not thread-safe. *) + +val empty : t +(** Empty set *) + +val set : key:'a key -> 'a -> t -> t +(** [set ~key v set] maps [key] to [v] in [set]. It means that + for every [set], [get ~key (set ~key v set) = Some v]. *) + +val get : key:'a key -> t -> 'a option +(** [get ~key set] obtains the value for [key] in [set], if any. *) + +val get_exn : key:'a key -> t -> 'a +(** Same as {!get}, but can fail + @raise Not_found if the key is not present *) + +val cardinal : t -> int +(** Number of mappings *) + + diff --git a/src/data/CCMixtbl.mli b/src/data/CCMixtbl.mli index a315b41a..5878624e 100644 --- a/src/data/CCMixtbl.mli +++ b/src/data/CCMixtbl.mli @@ -25,7 +25,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (** {1 Hash Table with Heterogeneous Keys} -From https://github.com/mjambon/mixtbl , thanks to him. +From https://github.com/mjambon/mixtbl (thanks to him). Example: {[ diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml index 714b78d3..fb8e820d 100644 --- a/src/data/CCRingBuffer.ml +++ b/src/data/CCRingBuffer.ml @@ -193,6 +193,14 @@ module type S = sig val take_front_exn : t -> Array.elt (** Take the first value from front of [t]. @raise Empty if buffer is already empty. *) + + val of_array : Array.t -> t + (** Create a buffer from an initial array, but doesn't take ownership + of it (stills allocates a new internal array) *) + + val to_array : t -> Array.t + (** Create an array from the elements, in order. + @since 0.11 *) end module MakeFromArray(Array:Array.S) = struct @@ -228,6 +236,13 @@ module MakeFromArray(Array:Array.S) = struct try Byte.iteri b (fun i c -> if Byte.get_front b' i <> c then raise Exit); true with Exit -> false) *) + (*$T + let b = Byte.of_array "abc" in \ + let b' = Byte.copy b in \ + Byte.clear b; \ + Byte.to_array b' = "abc" && Byte.to_array b = "" + *) + let capacity b = let len = Array.length b.buf in match len with 0 -> 0 | l -> l - 1 @@ -664,6 +679,26 @@ module MakeFromArray(Array:Array.S) = struct try let back = Byte.peek_back b in \ back = Bytes.get s (s_len - 1) with Byte.Empty -> s_len = 0) *) + + let of_array a = + let b = create (max (Array.length a) 16) in + blit_from b a 0 (Array.length a); + b + + let to_array b = + if is_empty b then Array.empty + else ( + let a = Array.make (length b) (peek_front b) in + let n = blit_into b a 0 (length b) in + assert (n = length b); + a + ) + + (*$Q + Q.printable_string (fun s -> \ + let b = Byte.of_array s in let s' = Byte.to_array b in \ + s = s') + *) end module Byte = MakeFromArray(Array.Byte) diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli index 4992c02b..2c7cdbb3 100644 --- a/src/data/CCRingBuffer.mli +++ b/src/data/CCRingBuffer.mli @@ -192,6 +192,14 @@ module type S = sig val take_front_exn : t -> Array.elt (** Take the first value from front of [t]. @raise Empty if buffer is already empty. *) + + val of_array : Array.t -> t + (** Create a buffer from an initial array, but doesn't take ownership + of it (stills allocates a new internal array) *) + + val to_array : t -> Array.t + (** Create an array from the elements, in order. + @since 0.11 *) end (** An efficient byte based ring buffer *) diff --git a/src/data/containers_data.mldylib b/src/data/containers_data.mldylib index ad8398b5..e45f6801 100644 --- a/src/data/containers_data.mldylib +++ b/src/data/containers_data.mldylib @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: b83e1a21d44ea00373b0dde5cda9eedd) +# DO NOT EDIT (digest: 423faeb80b3829590072ca8f5414955c) CCMultiMap CCMultiSet CCTrie @@ -14,4 +14,5 @@ CCMixmap CCRingBuffer CCIntMap CCPersistentArray +CCMixset # OASIS_STOP diff --git a/src/data/containers_data.mllib b/src/data/containers_data.mllib index ad8398b5..e45f6801 100644 --- a/src/data/containers_data.mllib +++ b/src/data/containers_data.mllib @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: b83e1a21d44ea00373b0dde5cda9eedd) +# DO NOT EDIT (digest: 423faeb80b3829590072ca8f5414955c) CCMultiMap CCMultiSet CCTrie @@ -14,4 +14,5 @@ CCMixmap CCRingBuffer CCIntMap CCPersistentArray +CCMixset # OASIS_STOP diff --git a/src/misc/RAL.ml b/src/misc/RAL.ml index f1b3f7ca..fb60a965 100644 --- a/src/misc/RAL.ml +++ b/src/misc/RAL.ml @@ -30,13 +30,11 @@ type +'a tree = | Leaf of 'a | Node of 'a * 'a tree * 'a tree -and +'a t = (int * 'a tree) list +and +'a t = + | Nil + | Cons of int * 'a tree * 'a t (** Functional array of complete trees *) -(* TODO: inline list's nodes - TODO: encode "complete binary tree" into types *) - - (** {2 Functions on trees} *) (* lookup [i]-th element in the tree [t], which has size [size] *) @@ -63,56 +61,67 @@ let rec tree_update size t i v =match t, i with (** {2 Functions on lists of trees} *) -let empty = [] +let empty = Nil -let return x = [1, Leaf x] +let return x = Cons (1, Leaf x, Nil) let is_empty = function - | [] -> true - | _ -> false + | Nil -> true + | Cons _ -> false let rec get l i = match l with - | [] -> raise (Invalid_argument "RAL.get: wrong index") - | (size,t) :: _ when i < size -> tree_lookup size t i - | (size,_) :: l' -> get l' (i - size) + | Nil -> raise (Invalid_argument "RAL.get: wrong index") + | Cons (size,t, _) when i < size -> tree_lookup size t i + | Cons (size,_, l') -> get l' (i - size) let rec set l i v = match l with - | [] -> raise (Invalid_argument "RAL.set: wrong index") - | (size,t) :: l' when i < size -> (size, tree_update size t i v) :: l' - | (size,t) :: l' -> (size, t) :: set l' (i - size) v + | Nil -> raise (Invalid_argument "RAL.set: wrong index") + | Cons (size,t, l') when i < size -> Cons (size, tree_update size t i v, l') + | Cons (size,t, l') -> Cons (size, t, set l' (i - size) v) + +(*$Q + Q.(pair (pair int int) (list int)) (fun ((i,v),l) -> \ + let ral = of_list l in let ral = set ral i v in \ + get ral i = v) +*) let cons x l = match l with - | (size1, t1) :: (size2, t2) :: l' -> + | Cons (size1, t1, Cons (size2, t2, l')) -> if size1 = size2 - then (1 + size1 + size2, Node (x, t1, t2)) :: l' - else (1, Leaf x) :: l - | _ -> (1, Leaf x) :: l + then Cons (1 + size1 + size2, Node (x, t1, t2), l') + else Cons (1, Leaf x, l) + | _ -> Cons (1, Leaf x, l) let hd l = match l with - | [] -> raise (Invalid_argument "RAL.hd: empty list") - | (_, Leaf x) :: _ -> x - | (_, Node (x, _, _)) :: _ -> x + | Nil -> raise (Invalid_argument "RAL.hd: empty list") + | Cons (_, Leaf x, _) -> x + | Cons (_, Node (x, _, _), _) -> x let tl l = match l with - | [] -> raise (Invalid_argument "RAL.tl: empty list") - | (_, Leaf _) :: l' -> l' - | (size, Node (_, t1, t2)) :: l' -> + | Nil -> raise (Invalid_argument "RAL.tl: empty list") + | Cons (_, Leaf _, l') -> l' + | Cons (size, Node (_, t1, t2), l') -> let size' = size / 2 in - (size', t1) :: (size', t2) :: l' + Cons (size', t1, Cons (size', t2, l')) + +(*$T + let l = of_list[1;2;3] in hd l = 1 + let l = of_list[1;2;3] in tl l |> to_list = [2;3] +*) let front l = match l with - | [] -> None - | (_, Leaf x) :: tl -> Some (x, tl) - | (size, Node (x, t1, t2)) :: l' -> + | Nil -> None + | Cons (_, Leaf x, tl) -> Some (x, tl) + | Cons (size, Node (x, t1, t2), l') -> let size' = size / 2 in - Some (x, (size', t1) :: (size', t2) :: l') + Some (x, Cons (size', t1, Cons (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' -> + | Nil -> raise (Invalid_argument "RAL.front") + | Cons (_, Leaf x, tl) -> x, tl + | Cons (size, Node (x, t1, t2), l') -> let size' = size / 2 in - x, (size', t1) :: (size', t2) :: l' + x, Cons (size', t1, Cons (size', t2, l')) let rec _remove prefix l i = let x, l' = front_exn l in @@ -126,24 +135,26 @@ 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 map f l = match l with + | Nil -> Nil + | Cons (i, t, tl) -> Cons (i, _map_tree f t, map f tl) let rec length l = match l with - | [] -> 0 - | (size,_) :: l' -> size + length l' + | Nil -> 0 + | Cons (size,_, l') -> size + length l' let rec iter f l = match l with - | [] -> () - | (_, Leaf x) :: l' -> f x; iter f l' - | (_, t) :: l' -> iter_tree t f; iter f l' + | Nil -> () + | Cons (_, Leaf x, l') -> f x; iter f l' + | Cons (_, 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 f acc l = match l with - | [] -> acc - | (_, Leaf x) :: l' -> fold f (f acc x) l' - | (_, t) :: l' -> + | Nil -> acc + | Cons (_, Leaf x, l') -> fold f (f acc x) l' + | Cons (_, t, l') -> let acc' = fold_tree t acc f in fold f acc' l' and fold_tree t acc f = match t with @@ -154,9 +165,9 @@ and fold_tree t acc f = match t with 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' -> + | Nil -> acc + | Cons (_, Leaf x, l') -> f (fold f acc l') x + | Cons (_, 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 diff --git a/src/misc/printBox.ml b/src/misc/printBox.ml index c25c92ea..5102d85f 100644 --- a/src/misc/printBox.ml +++ b/src/misc/printBox.ml @@ -76,7 +76,7 @@ module Output = struct ) let _ensure_line line i = - if i >= !_string_len line.bl_str + if i >= Bytes.length line.bl_str then ( let str' = Bytes.make (2 * i + 5) ' ' in Bytes.blit line.bl_str 0 str' 0 line.bl_len; @@ -100,7 +100,7 @@ module Output = struct line.bl_len <- max line.bl_len (pos.x+s_len) let _buf_put_string buf pos s = - _buf_put_sub_string buf pos s 0 (!_string_len (Bytes.unsafe_of_string s)) + _buf_put_sub_string buf pos s 0 (String.length s) (* create a new buffer *) let make_buffer () = @@ -119,7 +119,7 @@ module Output = struct let buf_to_lines ?(indent=0) buf = let buffer = Buffer.create (5 + buf.buf_len * 32) in for i = 0 to buf.buf_len - 1 do - for k = 1 to indent do Buffer.add_char buffer ' ' done; + for _k = 1 to indent do Buffer.add_char buffer ' ' done; let line = buf.buf_lines.(i) in Buffer.add_substring buffer (Bytes.unsafe_to_string line.bl_str) 0 line.bl_len; Buffer.add_char buffer '\n'; @@ -128,7 +128,7 @@ module Output = struct let buf_output ?(indent=0) oc buf = for i = 0 to buf.buf_len - 1 do - for k = 1 to indent do output_char oc ' '; done; + for _k = 1 to indent do output_char oc ' '; done; let line = buf.buf_lines.(i) in output oc line.bl_str 0 line.bl_len; output_char oc '\n'; @@ -141,6 +141,7 @@ let rec _find s c i = else if s.[i] = c then Some i else _find s c (i+1) +(* sequence of lines *) let rec _lines s i k = match _find s '\n' i with | None -> if i bool; (** End of input? *) + cur : unit -> char; (** Current char *) + next : unit -> char; (** if not {!is_done}, move to next char *) + pos : unit -> int; (** Current pos *) + backtrack : int -> unit; (** Restore to previous pos *) + sub : int -> int -> string; (** Extract slice from [pos] with [len] *) +} + +exception ParseError of int * string (** position * message *) + +let input_of_string s = + let i = ref 0 in + { is_done=(fun () -> !i = String.length s); + cur=(fun () -> s.[!i]); + next=(fun () -> + if !i = String.length s + then raise (ParseError (!i, "unexpected EOI")) + else ( + let c = s.[!i] in + incr i; + c + ) + ); + pos=(fun () -> !i); + backtrack=(fun j -> assert (0 <= j && j <= !i); i := j); + sub=(fun j len -> assert (j + len <= !i); String.sub s j len); + } + +type 'a t = input -> 'a + +let return x _ = x +let pure = return +let (>|=) p f st = f (p st) +let (>>=) p f st = + let x = p st in + f x st +let (<*>) x y st = + let f = x st in + let g = y st in + f g +let (<* ) x y st = + let res = x st in + let _ = y st in + res +let ( *>) x y st = + let _ = x st in + let res = y st in + res + +let junk_ st = ignore (st.next ()) +let fail_ st fmt = + Printf.ksprintf + (fun msg -> raise (ParseError (st.pos (), msg))) fmt + +let eoi st = if st.is_done() then () else fail_ st "expected EOI" +let fail msg st = fail_ st "%s" msg +let nop _ = () + +let char c st = + if st.next () = c then c else fail_ st "expected '%c'" c + +let char_if p st = + let c = st.next () in + if p c then c else fail_ st "unexpected char '%c'" c + +let chars_if p st = + let i = st.pos () in + let len = ref 0 in + while not (st.is_done ()) && p (st.cur ()) do junk_ st; incr len done; + st.sub i !len + +let chars1_if p st = + let s = chars_if p st in + if s = "" then fail_ st "unexpected sequence of chars"; + s + +let rec skip_chars p st = + if not (st.is_done ()) && p (st.cur ()) then ( + junk_ st; + skip_chars p st + ) + +let is_alpha = function + | 'a' .. 'z' | 'A' .. 'Z' -> true + | _ -> false +let is_num = function '0' .. '9' -> true | _ -> false +let is_alpha_num = function + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' -> true + | _ -> false +let is_space = function ' ' | '\t' -> true | _ -> false +let is_white = function ' ' | '\t' | '\n' -> true | _ -> false +let (~~~) p c = not (p c) +let (|||) p1 p2 c = p1 c || p2 c +let (&&&) p1 p2 c = p1 c && p2 c + +let endline = char '\n' +let space = char_if is_space +let white = char_if is_white + +let skip_space = skip_chars is_space +let skip_white = skip_chars is_white + +let (<|>) x y st = + let i = st.pos () in + try + x st + with ParseError _ -> + st.backtrack i; (* restore pos *) + y st + +let string s st = + let rec check i = + i = String.length s || + (s.[i] = st.next () && check (i+1)) + in + if check 0 then s else fail_ st "expected \"%s\"" s + +let rec many_rec p st acc = + if st.is_done () then List.rev acc + else + let i = st.pos () in + try + let x = p st in + many_rec p st (x :: acc) + with ParseError _ -> + st.backtrack i; + List.rev acc + +let many p st = many_rec p st [] + +let many1 p st = + let x = p st in + many_rec p st [x] + +let rec skip p st = + let i = st.pos () in + let matched = + try + let _ = p st in + true + with ParseError _ -> + false + in + if matched then skip p st else st.backtrack i + +let rec sep1 ~by p = + p >>= fun x -> + let cont = by *> sep ~by p >|= fun tl -> x :: tl in + cont <|> return [x] +and sep ~by p = + sep1 ~by p <|> return [] + +let fix f = + let rec p st = f p st in + p + +let parse_exn ~input p = p input + +let parse ~input p = + try `Ok (parse_exn ~input p) + with ParseError (i, msg) -> + `Error (Printf.sprintf "at position %d: error %s" i msg) + +let parse_string s p = parse ~input:(input_of_string s) p +let parse_string_exn s p = parse_exn ~input:(input_of_string s) p + +module U = struct + let sep_ = sep + + let list ?(start="[") ?(stop="]") ?(sep=";") p = + string start *> skip_space *> + sep_ ~by:(skip_space *> string sep *> skip_space) p <* + skip_space <* string stop + + let int = + chars1_if (is_num ||| (=) '-') + >>= fun s -> + try return (int_of_string s) + with Failure _ -> fail "expected an int" + + let map f x = x >|= f + let map2 f x y = pure f <*> x <*> y + let map3 f x y z = pure f <*> x <*> y <*> z + + let prepend_str c s = String.make 1 c ^ s + + let word = + map2 prepend_str (char_if is_alpha) (chars_if is_alpha_num) +end diff --git a/src/string/CCParse.mli b/src/string/CCParse.mli new file mode 100644 index 00000000..106abc73 --- /dev/null +++ b/src/string/CCParse.mli @@ -0,0 +1,149 @@ + +(* +copyright (c) 2013-2015, 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 Very Simple Parser Combinators} + +Examples: + +{6 parse recursive structures} + +{[ +open Containers_string.Parse;; + +type tree = L of int | N of tree * tree;; + +let mk_leaf x = L x +let mk_node x y = N(x,y) + +let ptree = fix @@ fun self -> + skip_space *> + ( (char '(' *> (pure mk_node <*> self <*> self) <* char ')') + <|> + (U.int >|= mk_leaf) ) +;; + +parse_string_exn "(1 (2 3))" ptree;; +parse_string_exn "((1 2) (3 (4 5)))" ptree;; + +]} + +{6 Parse a list of words} + +{[ +open Containers_string.Parse;; +let p = U.list ~sep:"," U.word;; +parse_string_exn "[abc , de, hello ,world ]" p;; +]} + +@since 0.11 +*) + +type 'a or_error = [`Ok of 'a | `Error of string] +exception ParseError of int * string (** position * message *) + +(** {2 Input} *) + +type input = { + is_done : unit -> bool; (** End of input? *) + cur : unit -> char; (** Current char *) + next : unit -> char; (** if not {!is_done}, move to next char *) + pos : unit -> int; (** Current pos *) + backtrack : int -> unit; (** Restore to previous pos *) + sub : int -> int -> string; (** [sub pos len] extracts slice from [pos] with [len] *) +} + +val input_of_string : string -> input + +(** {2 Combinators} *) + +type 'a t = input -> 'a (** @raise ParseError in case of failure *) + +val return : 'a -> 'a t +val pure : 'a -> 'a t (** synonym to {!return} *) +val (>|=) : 'a t -> ('a -> 'b) -> 'b t +val (>>=) : 'a t -> ('a -> 'b t) -> 'b t +val (<*>) : ('a -> 'b) t -> 'a t -> 'b t +val (<* ) : 'a t -> _ t -> 'a t +val ( *>) : _ t -> 'a t -> 'a t + +val fail : string -> 'a t +val eoi : unit t (** end of string *) +val nop : unit t (** do nothing *) + +val char : char -> char t +val char_if : (char -> bool) -> char t +val chars_if : (char -> bool) -> string t +val chars1_if : (char -> bool) -> string t (** non empty *) +val endline : char t +val space : char t (** tab or space *) +val white : char t (** tab or space or newline *) + +val skip_chars : (char -> bool) -> unit t (** Skip 0 or more chars *) +val skip_space : unit t +val skip_white : unit t + +val is_alpha : char -> bool +val is_num : char -> bool +val is_alpha_num : char -> bool +val is_space : char -> bool +val (~~~) : (char -> bool) -> char -> bool +val (|||) : (char -> bool) -> (char -> bool) -> char -> bool +val (&&&) : (char -> bool) -> (char -> bool) -> char -> bool + +val (<|>) : 'a t -> 'a t -> 'a t (* succeeds if either succeeds *) + +val string : string -> string t + +val many : 'a t -> 'a list t +val many1 : 'a t -> 'a list t (** non empty *) +val skip : _ t -> unit t + +val sep : by:_ t -> 'a t -> 'a list t +val sep1 : by:_ t -> 'a t -> 'a list t (** non empty *) + +val fix : ('a t -> 'a t) -> 'a t +(** Fixpoint combinator *) + +(** {2 Parse} *) + +val parse : input:input -> 'a t -> 'a or_error +val parse_exn : input:input -> 'a t -> 'a (** @raise ParseError if it fails *) + +val parse_string : string -> 'a t -> 'a or_error +val parse_string_exn : string -> 'a t -> 'a (** @raise ParseError if it fails *) + + +(** {2 Utils} *) + +module U : sig + val list : ?start:string -> ?stop:string -> ?sep:string -> 'a t -> 'a list t + val int : int t + val word : string t (** alpha num, start with alpha *) + val map : ('a -> 'b) -> 'a t -> 'b t + val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t + val map3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t +end diff --git a/src/string/containers_string.ml b/src/string/containers_string.ml new file mode 100644 index 00000000..8f138db5 --- /dev/null +++ b/src/string/containers_string.ml @@ -0,0 +1,31 @@ + +(* +copyright (c) 2013-2015, 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. +*) + +module App_parse = CCApp_parse +module Parse = CCParse +module KMP = CCKMP +module Levenshtein = CCLevenshtein + diff --git a/src/string/containers_string.mldylib b/src/string/containers_string.mldylib index 48464c54..ef101f6c 100644 --- a/src/string/containers_string.mldylib +++ b/src/string/containers_string.mldylib @@ -1,4 +1,8 @@ # OASIS_START -# DO NOT EDIT (digest: c89cc456e050edff914368d7fbea4eca) +# DO NOT EDIT (digest: b0d9848489c9eaabded92f7c9fec3073) Containers_string +CCKMP +CCLevenshtein +CCApp_parse +CCParse # OASIS_STOP diff --git a/src/string/containers_string.mllib b/src/string/containers_string.mllib index 48464c54..ef101f6c 100644 --- a/src/string/containers_string.mllib +++ b/src/string/containers_string.mllib @@ -1,4 +1,8 @@ # OASIS_START -# DO NOT EDIT (digest: c89cc456e050edff914368d7fbea4eca) +# DO NOT EDIT (digest: b0d9848489c9eaabded92f7c9fec3073) Containers_string +CCKMP +CCLevenshtein +CCApp_parse +CCParse # OASIS_STOP diff --git a/src/string/containers_string.mlpack b/src/string/containers_string.mlpack deleted file mode 100644 index 9bb5e104..00000000 --- a/src/string/containers_string.mlpack +++ /dev/null @@ -1,6 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 200ff8feb7cb7b8d5e2aea5b7c63241a) -KMP -Levenshtein -App_parse -# OASIS_STOP diff --git a/src/unix/CCUnix.ml b/src/unix/CCUnix.ml index ec739f0f..5743d636 100644 --- a/src/unix/CCUnix.ml +++ b/src/unix/CCUnix.ml @@ -55,7 +55,7 @@ let escape_str buf s = Buffer.add_char buf '\''; String.iter (function - | '\'' -> Buffer.add_string buf "''" + | '\'' -> Buffer.add_string buf "'\\''" | c -> Buffer.add_char buf c ) s; Buffer.add_char buf '\''; @@ -88,7 +88,7 @@ type call_result = let kbprintf' buf fmt k = Printf.kbprintf k buf fmt -let call ?(bufsize=2048) ?(stdin=`Str "") ?(env=[||]) cmd = +let call ?(bufsize=2048) ?(stdin=`Str "") ?(env=Unix.environment()) cmd = (* render the command *) let buf = Buffer.create 256 in kbprintf' buf cmd @@ -113,3 +113,53 @@ let call ?(bufsize=2048) ?(stdin=`Str "") ?(env=[||]) cmd = end ) +type line = string + +type async_call_result = + < stdout:line gen; + stderr:line gen; + stdin:line -> unit; (* send a line *) + close_in:unit; (* close stdin *) + close_err:unit; + close_out:unit; + close_all:unit; (* close all 3 channels *) + wait:Unix.process_status; (* block until the process ends *) + wait_errcode:int; (* block until the process ends, then extract errcode *) + > + +let async_call ?(env=Unix.environment()) cmd = + (* render the command *) + let buf = Buffer.create 256 in + kbprintf' buf cmd + (fun buf -> + let cmd = Buffer.contents buf in + let oc, ic, errc = Unix.open_process_full cmd env in + object (self) + method stdout () = + try Some (input_line oc) + with End_of_file -> None + method stderr () = + try Some (input_line errc) + with End_of_file -> None + method stdin l = output_string ic l; output_char ic '\n' + method close_in = close_out ic + method close_out = close_in oc + method close_err = close_in errc + method close_all = close_out ic; close_in oc; close_in errc; () + method wait = Unix.close_process_full (oc, ic, errc) + method wait_errcode = int_of_process_status self#wait + end + ) + +let stdout x = x#stdout +let stderr x = x#stderr +let status x = x#status +let errcode x = x#errcode + +module Infix = struct + let (?|) fmt = call fmt + + let (?|&) fmt = async_call fmt +end + +include Infix diff --git a/src/unix/CCUnix.mli b/src/unix/CCUnix.mli index e1e75ba7..5291244c 100644 --- a/src/unix/CCUnix.mli +++ b/src/unix/CCUnix.mli @@ -43,7 +43,7 @@ val escape_str : Buffer.t -> string -> unit (*$T CCPrint.sprintf "%a" escape_str "foo" = "foo" CCPrint.sprintf "%a" escape_str "foo bar" = "'foo bar'" - CCPrint.sprintf "%a" escape_str "fo'o b'ar" = "'fo''o b''ar'" + CCPrint.sprintf "%a" escape_str "fo'o b'ar" = "'fo'\\''o b'\\''ar'" *) type call_result = @@ -69,9 +69,57 @@ val call : ?bufsize:int -> (*$T (call ~stdin:(`Str "abc") "cat")#stdout = "abc" - (call "echo %a" escape_str "a'b'c")#stdout = "abc\n" + (call "echo %a" escape_str "a'b'c")#stdout = "a'b'c\n" (call "echo %s" "a'b'c")#stdout = "abc\n" *) +type line = string + +type async_call_result = + < stdout:line gen; + stderr:line gen; + stdin:line -> unit; (* send a line *) + close_in:unit; (* close stdin *) + close_err:unit; + close_out:unit; + close_all:unit; (* close all 3 channels *) (** @since 0.11 *) + wait:Unix.process_status; (* block until the process ends *) + wait_errcode:int; (* block until the process ends, then extract errcode *) + (** @since 0.11 *) + > +(** A subprocess for interactive usage (read/write channels line by line) + @since 0.11 *) + +val async_call : ?env:string array -> + ('a, Buffer.t, unit, async_call_result) format4 -> + 'a +(** Spawns a subprocess, like {!call}, but the subprocess's channels are + line generators and line sinks (for stdin). + if [p] is [async_call "cmd"], then [p#wait] waits for the subprocess + to die. Channels can be closed independently. + @since 0.11 *) + +(** {2 Accessors} + +@since 0.11 *) + +val stdout : < stdout : 'a; .. > -> 'a +val stderr : < stderr : 'a; .. > -> 'a +val status : < status : 'a; .. > -> 'a +val errcode : < errcode : 'a; .. > -> 'a + +(** {2 Infix Functions} *) + +module Infix : sig + val (?|) : ('a, Buffer.t, unit, call_result) format4 -> 'a + (** Infix version of {!call} + @since 0.11 *) + + val (?|&) : ('a, Buffer.t, unit, async_call_result) format4 -> 'a + (** Infix version of {!async_call} + @since 0.11 *) +end + +include module type of Infix