simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2026-01-23 17:46:40 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge branch 'master' into stable; oasis setup; 0.11

Browse source
This commit is contained in:
Simon Cruanes 2015-05-24 21:45:54 +02:00
commit 7bacac2c98
43 changed files with 1089 additions and 128 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.merlin
View file

@ -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

28
CHANGELOG.md
View file

@ -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`

5
README.md
View file

@ -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

11
_oasis
View file

@ -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

9
_tags
View file

@ -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)
<src/string/*.ml{,i,y}>: 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)
<src/advanced/*.ml{,i,y}>: package(bytes)
<src/advanced/*.ml{,i,y}>: package(sequence)
<src/advanced/*.ml{,i,y}>: use_containers

12
containers.odocl
View file

@ -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

1
doc/intro.txt
View file

@ -68,6 +68,7 @@ CCFQueue
CCFlatHashtbl
CCIntMap
CCMixmap
CCMixset
CCMixtbl
CCMultiMap
CCMultiSet

33
setup.ml
View file

@ -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 ();;

30
src/advanced/containers_advanced.ml Normal file
View file

@ -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

6
src/advanced/containers_advanced.mldylib
View file

@ -1,4 +1,8 @@
# OASIS_START
# DO NOT EDIT (digest: 0f1ca0e2b031ae1710e26abf02cca256)
# DO NOT EDIT (digest: b0f5a3a0b7428f165d73d9e621998219)
Containers_advanced
CCLinq
CCBatch
CCCat
CCMonadIO
# OASIS_STOP

6
src/advanced/containers_advanced.mllib
View file

@ -1,4 +1,8 @@
# OASIS_START
# DO NOT EDIT (digest: 0f1ca0e2b031ae1710e26abf02cca256)
# DO NOT EDIT (digest: b0f5a3a0b7428f165d73d9e621998219)
Containers_advanced
CCLinq
CCBatch
CCCat
CCMonadIO
# OASIS_STOP

7
src/advanced/containers_advanced.mlpack
View file

@ -1,7 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: 5a399cd532edb84596f3034081578694)
CCLinq
CCBatch
CCCat
CCMonadIO
# OASIS_STOP

21
src/core/CCInt.ml
View file

@ -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

5
src/core/CCInt.mli
View file

@ -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

104
src/core/CCList.ml
View file

@ -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)

56
src/core/CCList.mli
View file

@ -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 *)

4
src/core/CCOpt.ml
View file

@ -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

4
src/core/CCOpt.mli
View file

@ -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

4
src/core/CCString.mli
View file

@ -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

26
src/core/META
View file

@ -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"

79
src/data/CCMixset.ml Normal file
View file

@ -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

77
src/data/CCMixset.mli Normal file
View file

@ -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 *)

2
src/data/CCMixtbl.mli
View file

@ -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:
{[

35
src/data/CCRingBuffer.ml
View file

@ -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)

8
src/data/CCRingBuffer.mli
View file

@ -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 *)

3
src/data/containers_data.mldylib
View file

@ -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

3
src/data/containers_data.mllib
View file

@ -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

103
src/misc/RAL.ml
View file

@ -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

9
src/misc/printBox.ml
View file

@ -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<String.length s then k (String.sub s i (String.length s-i))

0
src/string/app_parse.ml → src/string/CCApp_parse.ml
View file

0
src/string/app_parse.mli → src/string/CCApp_parse.mli
View file

0
src/string/KMP.ml → src/string/CCKMP.ml
View file

0
src/string/KMP.mli → src/string/CCKMP.mli
View file

0
src/string/levenshtein.ml → src/string/CCLevenshtein.ml
View file

0
src/string/levenshtein.mli → src/string/CCLevenshtein.mli
View file

220
src/string/CCParse.ml Normal file
View file

@ -0,0 +1,220 @@
(*
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} *)
type 'a or_error = [`Ok of 'a | `Error of string]
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; (** 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

149
src/string/CCParse.mli Normal file
View file

@ -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

31
src/string/containers_string.ml Normal file
View file

@ -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

6
src/string/containers_string.mldylib
View file

@ -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

6
src/string/containers_string.mllib
View file

@ -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

6
src/string/containers_string.mlpack
View file

@ -1,6 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: 200ff8feb7cb7b8d5e2aea5b7c63241a)
KMP
Levenshtein
App_parse
# OASIS_STOP

54
src/unix/CCUnix.ml
View file

@ -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

52
src/unix/CCUnix.mli
View file

@ -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