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

Merge branch 'master' into stable

Browse source
This commit is contained in:
Simon Cruanes 2014-12-08 10:38:37 +01:00
commit b91d42912a
60 changed files with 11021 additions and 9551 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
AUTHORS.md
View file

@ -1,7 +1,9 @@
# Authors and contributors
- Simon Cruanes
- Simon Cruanes (companion_cube)
- Drup (Gabriel Radanne)
- Jacques-Pascal Deplaix
- Nicolas Braud-Santoni
- Whitequark (Peter Zotov)
- hcarty (Hezekiah M. Carty)
- struktured (Carmelo Piccione)

23
CHANGELOG.md
View file

@ -1,26 +1,33 @@
# Changelog
## 0.6.1
- use subtree `gen/` for `CCGen` (symlink) rather than a copy.
- Add benchmarks for the function `iter` of iterators.
- `CCKTree`: more printers (to files), `Format` printer
- `CCOpt.get_lazy` convenience function
- introduce `CCFloat`, add float functions to `CCRandom` (thanks to @struktured)
## 0.6
### breaking changes
#### breaking changes
- new `CCIO` module, much simpler, but incompatible interface
- renamed `CCIO` to `advanced.CCMonadIO`
- `CCError.t` now has two type arguments
### other changes
#### other changes
- `CCMultiSet.{add_mult,remove_mult,update}`
- `CCVector.{top,top_exn}`
- `CCFun.compose_binop` (binary composition)
- `CCList.init`
- `CCError.map2` has a more general type (thanks to @hcarty)
- new module `CCCache`
* moved from `misc`
* add `CCache`.{size,iter}
* incompatible interface (functor -> values), much simpler to use
- `lwt/Lwt_actor` stub, for erlang-style concurrency (albeit much much more naive)
- `misc/Mixtbl`
- `misc/Mixtbl` added from its old repository
- more benchmarks, with a more general system to select/run them
- more efficient versions of `CCList.{flatten,append,flat_map}`, some functions
are now tailrec
@ -28,16 +35,16 @@
## 0.5
### breaking changes
#### breaking changes
- dependency on `cppo` (thanks to @whitequark, see AUHORS.md) and `bytes`
- dependency on `cppo` (thanks to @whitequark, see `AUTHORS.md`) and `bytes`
- `CCError`:
* now polymorphic on the error type
* some retro-incompatibilies (wrap,guard)
- `CCPervasives.Opt` -> `CCPervasives.Option`
- `Levenshtein.Index.remove` changed signature (useless param removed)
### other changes
#### other changes
- stronger inlining for `CCVector` (so that e.g. push is inline)
- more tests for `CCVector`

21
HOWTO.md
View file

@ -3,10 +3,19 @@
1. `make test-all`
2. update version in `_oasis`
3. `make update_next_tag` (to update `@since` comments)
4. `git checkout stable`
5. `git merge master`
6. update `CHANGELOG.md` (see its end to find the right git command)
7. commit, tag, and push both to github
8. new opam package
3. `make update_next_tag` (to update `@since` comments; be careful not to change symlinks)
4. update `CHANGELOG.md` (see its end to find the right git command)
5. commit the changes
6. `git checkout stable`
7. `git merge master`
8. tag, and push both to github
9. new opam package
## List Authors
`git log --format='%aN' | sort -u`
## Subtree
If gen is [this remote](https://github.com/c-cube/gen.git):
`git subtree pull --prefix gen gen master --squash`

1
Makefile
View file

@ -52,6 +52,7 @@ push_doc: doc
scp -r containers_string.docdir/* cedeela.fr:~/simon/root/software/containers/string/
scp -r containers_advanced.docdir/* cedeela.fr:~/simon/root/software/containers/advanced
scp -r containers_misc.docdir/* cedeela.fr:~/simon/root/software/containers/misc/
scp -r containers_lwt.docdir/* cedeela.fr:~/simon/root/software/containers/lwt/
DONTTEST=myocamlbuild.ml setup.ml $(wildcard **/*.cppo*)
QTESTABLE=$(filter-out $(DONTTEST), \

33
README.md
View file

@ -17,7 +17,9 @@ ocaml-containers
modules of the stdlib.
4. A sub-library with complicated abstractions, `containers.advanced` (with
a LINQ-like query module, batch operations using GADTs, and others)
5. Random stuff, with *NO* *GUARANTEE* of even being barely usable or tested,
5. A library using [Lwt](https://github.com/ocsigen/lwt/), `containers.lwt`.
Currently only contains experimental, unstable stuff.
6. Random stuff, with *NO* *GUARANTEE* of even being barely usable or tested,
in other dirs (mostly `misc` but also `lwt` and `threads`). It's where I
tend to write code when I want to test some idea, so half the modules (at
least) are unfinished or don't really work.
@ -27,6 +29,10 @@ Some of the modules have been moved to their own repository (e.g. `sequence`,
[![Build Status](http://ci.cedeela.fr/buildStatus/icon?job=containers)](http://ci.cedeela.fr/job/containers/)
## Change Log
See [this file](https://github.com/c-cube/ocaml-containers/blob/master/CHANGELOG.md).
## Finding help
- the [github wiki](https://github.com/c-cube/ocaml-containers/wiki)
@ -46,11 +52,6 @@ If you have comments, requests, or bugfixes, please share them! :-)
This code is free, under the BSD license.
## Documentation
The API documentation can be
found [here](http://cedeela.fr/~simon/software/containers).
## Contents
The design is mostly centered around polymorphism rather than functors. Such
@ -58,19 +59,26 @@ structures comprise (some modules in `misc/`, some other in `core/`):
### Core Structures
the core library, `containers`, now depends on
[cppo](https://github.com/mjambon/cppo) and `base-bytes` (provided
by ocamlfind).
Documentation [here](http://cedeela.fr/~simon/software/containers).
- `CCHeap`, a purely functional heap structure.
- `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))
- `CCVector`, a growable array (pure OCaml, no C) with mutability annotations
- `CCGen` and `CCSequence`, generic iterators structures (with structural types so they can be defined in several places). Now also in their own repository and opam packages (`gen` and `sequence`).
- `CCGen` and `CCSequence`, generic iterators structures (with structural types so they can be defined in several places). They are also available in their own repository and opam packages (`gen` and `sequence`). Note that the `@since` annotations may not be accurate because of the use of `git subtree`.
- `CCKList`, a persistent iterator structure (akin to a lazy list)
- `CCList`, functions on lists, including tail-recursive implementations of `map` and `append` and many other things
- `CCArray`, utilities on arrays and slices
- `CCMultimap` and `CCMultiset`, functors defining persistent structures
- `CCHashtbl`, an extension of the standard hashtbl module
- `CCHashtbl`, `CCMap` extensions of the standard modules `Hashtbl` and `Map`
- `CCFlatHashtbl`, a flat (open-addressing) hashtable functorial implementation
- `CCKTree`, an abstract lazy tree structure (similar to what `CCKlist` is to lists)
- `CCTrie`, a prefix tree
- small modules (basic types, utilities):
- `CCInt`
- `CCString` (basic string operations)
@ -78,11 +86,15 @@ structures comprise (some modules in `misc/`, some other in `core/`):
- `CCOpt` (options, very useful)
- `CCFun` (function combinators)
- `CCBool`
- `CCFloat`
- `CCOrd` (combinators for total orderings)
- `CCRandom` (combinators for random generators)
- `CCPrint` (printing combinators)
- `CCHash` (hashing combinators)
- `CCError` (monadic error handling, very useful)
- `CCSexp`, a small S-expression library
- `CCIO`, basic utilities for IO
- `CCCache`, memoization caches, LRU, etc.
### String
@ -103,7 +115,8 @@ In the module `Containers_advanced`:
### Misc
See [doc](http://cedeela.fr/~simon/software/containers/misc).
See [doc](http://cedeela.fr/~simon/software/containers/misc). This list
is not necessarily up-to-date.
- `PHashtbl`, a polymorphic hashtable (with open addressing)
- `SplayTree`, a polymorphic splay heap implementation (not quite finished)
@ -121,8 +134,6 @@ access to elements by their index.
- `SmallSet`, a sorted list implementation behaving like a set.
- `AbsSet`, an abstract Set data structure, a bit like `LazyGraph`.
- `Univ`, a universal type encoding with affectation
- `Cache`, a low level memoization cache for unary and binary functions
- `Deque`, an imperative double ended FIFO (double-linked list)
- `FlatHashtbl`, a (deprecated) open addressing hashtable with
a functorial interface (replaced by PHashtbl)
- `UnionFind`, a functorial imperative Union-Find structure.

14
_oasis
View file

@ -1,6 +1,6 @@
OASISFormat: 0.4
Name: containers
Version: 0.6
Version: 0.6.1
Homepage: https://github.com/c-cube/ocaml-containers
Authors: Simon Cruanes
License: BSD-2-clause
@ -42,10 +42,10 @@ Flag "bench"
Library "containers"
Path: core
Modules: CCVector, CCDeque, CCGen, CCSequence, CCFQueue, CCMultiMap,
Modules: CCVector, CCDeque, CCGen, Gen_intf, CCSequence, CCFQueue, CCMultiMap,
CCMultiSet, CCBV, CCPrint, CCPersistentHashtbl, CCError,
CCHeap, CCList, CCOpt, CCPair, CCFun, CCHash,
CCKList, CCInt, CCBool, CCArray, CCOrd, CCIO,
CCKList, CCInt, CCBool, CCFloat, CCArray, CCOrd, CCIO,
CCRandom, CCKTree, CCTrie, CCString, CCHashtbl,
CCFlatHashtbl, CCSexp, CCMap, CCCache
BuildDepends: bytes
@ -147,6 +147,14 @@ Document containers_advanced
XOCamlbuildPath: .
XOCamlbuildLibraries: containers.advanced
Document containers_lwt
Title: Containers_lwt docs
Type: ocamlbuild (0.3)
BuildTools+: ocamldoc
Install: true
XOCamlbuildPath: .
XOCamlbuildLibraries: containers.lwt
Executable run_benchs
Path: benchs/
Install: false

1
_tags
View file

@ -203,5 +203,6 @@ true: annot, bin_annot
<tests/*.ml{,i}>: thread
<threads/*.ml{,i}>: thread
<sequence>: -traverse
<gen>: -traverse
<core/CCVector.cmx>: inline(25)
<{string,core}/**/*.ml>: warn_A, warn(-4), warn(-44)

26
benchs/run_benchs.ml
View file

@ -506,10 +506,34 @@ module Iter = struct
"klist.flat_map", klist, ();
]
let bench_iter n =
let seq () =
let i = ref 2 in
CCSequence.(
1 -- n |> iter (fun x -> i := !i * x)
)
and gen () =
let i = ref 2 in
CCGen.(
1 -- n |> iter (fun x -> i := !i * x)
)
and klist () =
let i = ref 2 in
CCKList.(
1 -- n |> iter (fun x -> i := !i * x)
)
in
CCBench.throughputN 3
[ "sequence.iter", seq, ();
"gen.iter", gen, ();
"klist.iter", klist, ();
]
let () = CCBench.register CCBench.(
"iter" >:::
[ "fold" >:: with_int bench_fold [100; 1_000; 10_000; 1_000_000]
; "flat_map" >:: with_int bench_flat_map [1_000; 10_000]
; "iter" >:: with_int bench_iter [1_000; 10_000]
])
end
@ -608,5 +632,3 @@ end
let () =
CCBench.run_main ()

4
containers.odocl
View file

@ -1,8 +1,9 @@
# OASIS_START
# DO NOT EDIT (digest: 06463ded0a7c83efb61e8ab83df42fcb)
# DO NOT EDIT (digest: ce652946b9e4e3d4bbad78e220466df8)
core/CCVector
core/CCDeque
core/CCGen
core/Gen_intf
core/CCSequence
core/CCFQueue
core/CCMultiMap
@ -20,6 +21,7 @@ core/CCHash
core/CCKList
core/CCInt
core/CCBool
core/CCFloat
core/CCArray
core/CCOrd
core/CCIO

93
core/CCFloat.ml Normal file
View file

@ -0,0 +1,93 @@
(*
copyright (c) 2014, Carmelo Piccione
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.
*)
type t = float
type fpclass = Pervasives.fpclass =
| FP_normal
| FP_subnormal
| FP_zero
| FP_infinite
| FP_nan
let nan = Pervasives.nan
let infinity = Pervasives.infinity
let neg_infinity = Pervasives.neg_infinity
let max_value = infinity
let min_value = neg_infinity
let max_finite_value = Pervasives.max_float
let epsilon = Pervasives.epsilon_float
let is_nan x = (x : t) <> x
let add = (+.)
let sub = (-.)
let neg = (~-.)
let abs = Pervasives.abs_float
let scale = ( *. )
let min (x : t) y =
if is_nan x || is_nan y then nan
else if x < y then x else y
let max (x : t) y =
if is_nan x || is_nan y then nan
else if x > y then x else y
let equal (a:float) b = a=b
let hash = Hashtbl.hash
let compare (a:float) b = Pervasives.compare a b
type 'a printer = Buffer.t -> 'a -> unit
type 'a formatter = Format.formatter -> 'a -> unit
type 'a random_gen = Random.State.t -> 'a
let pp buf = Printf.bprintf buf "%f"
let print fmt = Format.pp_print_float fmt
let sign (a:float) =
if a < 0.0 then -1
else if a > 0.0 then 1
else 0
let to_int (a:float) = Pervasives.int_of_float a
let of_int (a:int) = Pervasives.float_of_int a
let to_string (a:float) = Pervasives.string_of_float a
let of_string (a:string) = Pervasives.float_of_string a
let random n st = Random.State.float st n
let random_small = random 100.0
let random_range i j st = i +. random (j-.i) st
let equal_precision ~epsilon a b = abs_float (a-.b) < epsilon
let classify = Pervasives.classify_float

92
core/CCFloat.mli Normal file
View file

@ -0,0 +1,92 @@
(*
copyright (c) 2014, Carmelo Piccione
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 Basic Float functions}
@since 0.6.1 *)
type t = float
type fpclass = Pervasives.fpclass =
| FP_normal
| FP_subnormal
| FP_zero
| FP_infinite
| FP_nan
val nan : t
val max_value : t
val min_value : t
val max_finite_value : t
val epsilon : float
val is_nan : t -> bool
val add : t -> t -> t
val sub : t -> t -> t
val neg : t -> t
val abs : t -> t
val scale : t -> t -> t
val min : t -> t -> t
val max : t -> t -> t
val equal : t -> t -> bool
val compare : float -> float -> int
type 'a printer = Buffer.t -> 'a -> unit
type 'a formatter = Format.formatter -> 'a -> unit
type 'a random_gen = Random.State.t -> 'a
val pp : t printer
val print : t formatter
val hash : t -> int
val random : t -> t random_gen
val random_small : t random_gen
val random_range : t -> t -> t random_gen
val sign : t -> int
(** [sign t] is one of [-1, 0, 1] *)
val to_int : t -> int
val of_int : int -> t
val to_string : t -> string
val of_string : string -> t
val equal_precision : epsilon:t -> t -> t -> bool
(** Equality with allowed error up to a non negative epsilon value *)
val classify : float -> fpclass

1716
core/CCGen.ml
View file

File diff suppressed because it is too large Load diff

1
core/CCGen.ml Symbolic link
View file

@ -0,0 +1 @@
../gen/gen.ml

293
core/CCGen.mli
View file

@ -43,289 +43,10 @@ type 'a t = unit -> 'a option
type 'a gen = 'a t
(** {2 Common signature for transient and restartable generators}
The signature {!S} abstracts on a type ['a t], where the [t] can be
the type of transient or restartable generators. Some functions specify
explicitely that they use ['a gen] (transient generators). *)
module type S = sig
type 'a t
val empty : 'a t
(** Empty generator, with no elements *)
val singleton : 'a -> 'a t
(** One-element generator *)
val repeat : 'a -> 'a t
(** Repeat same element endlessly *)
val iterate : 'a -> ('a -> 'a) -> 'a t
(** [iterate x f] is [[x; f x; f (f x); f (f (f x)); ...]] *)
val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t
(** Dual of {!fold}, with a deconstructing operation. It keeps on
unfolding the ['b] value into a new ['b], and a ['a] which is yielded,
until [None] is returned. *)
val init : ?limit:int -> (int -> 'a) -> 'a t
(** Calls the function, starting from 0, on increasing indices.
If [limit] is provided and is a positive int, iteration will
stop at the limit (excluded).
For instance [init ~limit:4 id] will yield 0, 1, 2, and 3. *)
(** {2 Basic combinators} *)
val is_empty : _ t -> bool
(** Check whether the genertor is empty. Consumes one element if the
generator isn't empty. *)
val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** Fold on the generator, tail-recursively; consumes it *)
val reduce : ('a -> 'a -> 'a) -> 'a t -> 'a
(** Fold on non-empty sequences
@raise Invalid_argument if the generator is empty *)
val scan : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t
(** Like {!fold}, but keeping successive values of the accumulator *)
val iter : ('a -> unit) -> 'a t -> unit
(** Iterate on the generator, consuming it *)
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** Iterate on elements with their index in the enum, from 0. Consumes it. *)
val length : _ t -> int
(** Length of a generator (linear time, consumes its input) *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** Lazy map. No iteration is performed now, the function will be called
when the result is traversed. *)
val append : 'a t -> 'a t -> 'a t
(** Append the two enums; the result contains the elements of the first,
then the elements of the second enum. *)
val flatten : 'a gen t -> 'a t
(** Flatten the enumeration of generators *)
val flat_map : ('a -> 'b gen) -> 'a t -> 'b t
(** Monadic bind; each element is transformed to a sub-enum
which is then iterated on, before the next element is processed,
and so on. *)
val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
(** Is the given element, member of the enum? *)
val take : int -> 'a t -> 'a t
(** Take at most n elements *)
val drop : int -> 'a t -> 'a t
(** Drop n elements *)
val nth : int -> 'a t -> 'a
(** n-th element, or Not_found
@raise Not_found if the generator contains less than [n] arguments *)
val take_nth : int -> 'a t -> 'a t
(** [take_nth n g] returns every element of [g] whose index
is a multiple of [n]. For instance [take_nth 2 (1--10) |> to_list]
will return [1;3;5;7;9] *)
val filter : ('a -> bool) -> 'a t -> 'a t
(** Filter out elements that do not satisfy the predicate. *)
val take_while : ('a -> bool) -> 'a t -> 'a t
(** Take elements while they satisfy the predicate *)
val drop_while : ('a -> bool) -> 'a t -> 'a t
(** Drop elements while they satisfy the predicate *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
(** Maps some elements to 'b, drop the other ones *)
val zip_index : 'a t -> (int * 'a) t
(** Zip elements with their index in the enum *)
val unzip : ('a * 'b) t -> 'a t * 'b t
(** Unzip into two sequences, splitting each pair *)
val partition : ('a -> bool) -> 'a t -> 'a t * 'a t
(** [partition p l] returns the elements that satisfy [p],
and the elements that do not satisfy [p] *)
val for_all : ('a -> bool) -> 'a t -> bool
(** Is the predicate true for all elements? *)
val exists : ('a -> bool) -> 'a t -> bool
(** Is the predicate true for at least one element? *)
val min : ?lt:('a -> 'a -> bool) -> 'a t -> 'a
(** Minimum element, according to the given comparison function.
@raise Invalid_argument if the generator is empty *)
val max : ?lt:('a -> 'a -> bool) -> 'a t -> 'a
(** Maximum element, see {!min}
@raise Invalid_argument if the generator is empty *)
val eq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** Equality of generators. *)
val lexico : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
(** Lexicographic comparison of generators. If a generator is a prefix
of the other one, it is considered smaller. *)
val compare : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
(** Synonym for {! lexico} *)
val find : ('a -> bool) -> 'a t -> 'a option
(** [find p e] returns the first element of [e] to satisfy [p],
or None. *)
val sum : int t -> int
(** Sum of all elements *)
(** {2 Multiple iterators} *)
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Map on the two sequences. Stops once one of them is exhausted.*)
val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** Iterate on the two sequences. Stops once one of them is exhausted.*)
val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
(** Fold the common prefix of the two iterators *)
val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
(** Succeeds if all pairs of elements satisfy the predicate.
Ignores elements of an iterator if the other runs dry. *)
val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
(** Succeeds if some pair of elements satisfy the predicate.
Ignores elements of an iterator if the other runs dry. *)
val zip_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Combine common part of the enums (stops when one is exhausted) *)
val zip : 'a t -> 'b t -> ('a * 'b) t
(** Zip together the common part of the enums *)
(** {2 Complex combinators} *)
val merge : 'a gen t -> 'a t
(** Pick elements fairly in each sub-generator. The merge of enums
[e1, e2, ... ] picks elements in [e1], [e2],
in [e3], [e1], [e2] .... Once a generator is empty, it is skipped;
when they are all empty, and none remains in the input,
their merge is also empty.
For instance, [merge [1;3;5] [2;4;6]] will be, in disorder, [1;2;3;4;5;6]. *)
val intersection : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t
(** Intersection of two sorted sequences. Only elements that occur in both
inputs appear in the output *)
val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t
(** Merge two sorted sequences into a sorted sequence *)
val sorted_merge_n : ?cmp:('a -> 'a -> int) -> 'a t list -> 'a t
(** Sorted merge of multiple sorted sequences *)
val tee : ?n:int -> 'a t -> 'a gen list
(** Duplicate the enum into [n] generators (default 2). The generators
share the same underlying instance of the enum, so the optimal case is
when they are consumed evenly *)
val round_robin : ?n:int -> 'a t -> 'a gen list
(** Split the enum into [n] generators in a fair way. Elements with
[index = k mod n] with go to the k-th enum. [n] default value
is 2. *)
val interleave : 'a t -> 'a t -> 'a t
(** [interleave a b] yields an element of [a], then an element of [b],
and so on. When a generator is exhausted, this behaves like the
other generator. *)
val intersperse : 'a -> 'a t -> 'a t
(** Put the separator element between all elements of the given enum *)
val product : 'a t -> 'b t -> ('a * 'b) t
(** Cartesian product, in no predictable order. Works even if some of the
arguments are infinite. *)
val group : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t
(** Group equal consecutive elements together. *)
val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t
(** Remove consecutive duplicate elements. Basically this is
like [fun e -> map List.hd (group e)]. *)
val sort : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
(** Sort according to the given comparison function. The enum must be finite. *)
val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
(** Sort and remove duplicates. The enum must be finite. *)
val chunks : int -> 'a t -> 'a array t
(** [chunks n e] returns a generator of arrays of length [n], composed
of successive elements of [e]. The last array may be smaller
than [n] *)
(* TODO later
val permutations : 'a t -> 'a gen t
(** Permutations of the enum. Each permutation becomes unavailable once
the next one is produced. *)
val combinations : int -> 'a t -> 'a t t
(** Combinations of given length. *)
val powerSet : 'a t -> 'a t t
(** All subsets of the enum (in no particular order) *)
*)
(** {2 Basic conversion functions} *)
val of_list : 'a list -> 'a t
(** Enumerate elements of the list *)
val to_list : 'a t -> 'a list
(** non tail-call trasnformation to list, in the same order *)
val to_rev_list : 'a t -> 'a list
(** Tail call conversion to list, in reverse order (more efficient) *)
val to_array : 'a t -> 'a array
(** Convert the enum to an array (not very efficient) *)
val of_array : ?start:int -> ?len:int -> 'a array -> 'a t
(** Iterate on (a slice of) the given array *)
val rand_int : int -> int t
(** Random ints in the given range. *)
val int_range : int -> int -> int t
(** [int_range a b] enumerates integers between [a] and [b], included. [a]
is assumed to be smaller than [b]. *)
module Infix : sig
val (--) : int -> int -> int t
(** Synonym for {! int_range} *)
val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t
(** Monadic bind operator *)
end
val (--) : int -> int -> int t
(** Synonym for {! int_range} *)
val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t
(** Monadic bind operator *)
val pp : ?start:string -> ?stop:string -> ?sep:string -> ?horizontal:bool ->
(Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
(** Pretty print the content of the generator on a formatter. *)
end
(** {b NOTE}: version informations ("@since" annotations) in CCGen_intf
will not be reliable, for they will represent versions of Gen
rather than containers. *)
module type S = Gen_intf.S
(** {2 Transient generators} *)
@ -373,6 +94,12 @@ val persistent : 'a t -> 'a Restart.t
on it several times later. If possible, consider using combinators
from {!Restart} directly instead. *)
val persistent_lazy : 'a t -> 'a Restart.t
(** Same as {!persistent}, but consumes the generator on demand (by chunks).
This allows to make a restartable generator out of an ephemeral one,
without paying a big cost upfront (nor even consuming it fully).
@since 0.6.1 *)
val start : 'a Restart.t -> 'a t
(** Create a new transient generator.
[start gen] is the same as [gen ()] but is included for readability. *)

57
core/CCKTree.ml
View file

@ -33,6 +33,7 @@ type 'a sequence = ('a -> unit) -> unit
type 'a gen = unit -> 'a option
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
type 'a printer = Buffer.t -> 'a -> unit
type 'a formatter = Format.formatter -> 'a -> unit
type +'a t = unit -> [`Nil | `Node of 'a * 'a t list]
@ -132,7 +133,7 @@ module FQ = struct
hd : 'a list;
tl : 'a list;
}
exception Empty
(* invariant: if hd=[], then tl=[] *)
@ -220,24 +221,24 @@ module Dot = struct
| `Id n :: l' -> n, List.rev_append acc l'
| x :: l' -> _find_id (x::acc) l'
let _pp_attr buf attr = match attr with
| `Color c -> Printf.bprintf buf "color=%s" c
| `Shape s -> Printf.bprintf buf "shape=%s" s
| `Weight w -> Printf.bprintf buf "weight=%d" w
| `Style s -> Printf.bprintf buf "style=%s" s
| `Label l -> Printf.bprintf buf "label=\"%s\"" l
| `Other (name, value) -> Printf.bprintf buf "%s=\"%s\"" name value
let _pp_attr fmt attr = match attr with
| `Color c -> Format.fprintf fmt "color=%s" c
| `Shape s -> Format.fprintf fmt "shape=%s" s
| `Weight w -> Format.fprintf fmt "weight=%d" w
| `Style s -> Format.fprintf fmt "style=%s" s
| `Label l -> Format.fprintf fmt "label=\"%s\"" l
| `Other (name, value) -> Format.fprintf fmt "%s=\"%s\"" name value
| `Id _ -> () (* should not be here *)
let rec _pp_attrs buf l = match l with
let rec _pp_attrs fmt l = match l with
| [] -> ()
| [x] -> _pp_attr buf x
| [x] -> _pp_attr fmt x
| x::l' ->
_pp_attr buf x;
Buffer.add_char buf ',';
_pp_attrs buf l'
_pp_attr fmt x;
Format.pp_print_char fmt ',';
_pp_attrs fmt l'
let pp buf (name,l) =
let print fmt (name,l) =
(* nodes already printed *)
let tbl = Hashtbl.create 32 in
(* fresh name generator *)
@ -267,11 +268,11 @@ module Dot = struct
let name, attrs = get_name x in
begin match parent with
| None -> ()
| Some n -> Printf.bprintf buf " %s -> %s;\n" n name
| Some n -> Format.fprintf fmt " %s -> %s;@," n name
end;
if not (Hashtbl.mem tbl name) then (
Hashtbl.add tbl name ();
Printf.bprintf buf " %s [%a];\n" name _pp_attrs attrs;
Format.fprintf fmt "@[%s [%a];@]@," name _pp_attrs attrs;
List.fold_left
(fun q y -> FQ.push q (Some name, y)) q l
) else q
@ -282,11 +283,31 @@ module Dot = struct
FQ.empty l
in
(* preamble *)
Printf.bprintf buf "digraph %s {\n" name;
Format.fprintf fmt "@[<hv 2>digraph \"%s\" {@," name;
aux q;
Printf.bprintf buf "}\n";
Format.fprintf fmt "}@]@.";
()
let pp buf t =
let fmt = Format.formatter_of_buffer buf in
print fmt t;
Format.pp_print_flush fmt ()
let pp_single name buf t = pp buf (singleton ~name t)
let print_to_file filename g =
let oc = open_out filename in
let fmt = Format.formatter_of_out_channel oc in
try
print fmt g;
Format.pp_print_flush fmt ();
close_out oc
with e ->
close_out oc;
raise e
let to_file ?(name="graph") filename trees =
let g = make ~name trees in
print_to_file filename g
end

16
core/CCKTree.mli
View file

@ -33,6 +33,7 @@ type 'a sequence = ('a -> unit) -> unit
type 'a gen = unit -> 'a option
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
type 'a printer = Buffer.t -> 'a -> unit
type 'a formatter = Format.formatter -> 'a -> unit
(** {2 Basics} *)
@ -123,5 +124,20 @@ module Dot : sig
(** Print the graph in DOT *)
val pp_single : string -> attribute list t printer
val print : graph formatter
(** Printer with indentation, etc.
@since 0.6.1 *)
val print_to_file : string -> graph -> unit
(** [print_to_file filename g] prints [g] into a file whose name
is [filename].
@since 0.6.1 *)
val to_file : ?name:string -> string -> attribute list t list -> unit
(** [to_file filename trees] makes a graph out of the trees, opens the
file [filename] and prints the graph into the file.
@param name name of the graph
@since 0.6.1 *)
end

4
core/CCOpt.ml
View file

@ -104,6 +104,10 @@ let get_exn = function
| Some x -> x
| None -> invalid_arg "CCOpt.get_exn"
let get_lazy default_fn x = match x with
| None -> default_fn ()
| Some y -> y
let sequence_l l =
let rec aux acc l = match l with
| [] -> Some (List.rev acc)

4
core/CCOpt.mli
View file

@ -73,6 +73,10 @@ val get_exn : 'a t -> 'a
(** Open the option, possibly failing if it is [None]
@raise Invalid_argument if the option is [None] *)
val get_lazy : (unit -> 'a) -> 'a t -> 'a
(** [get_lazy default_fn x] unwraps [x], but if [x = None] it returns [default_fn ()] instead.
@since 0.6.1 *)
val sequence_l : 'a t list -> 'a list t
(** [sequence_l [x1; x2; ...; xn]] returns [Some [y1;y2;...;yn]] if
every [xi] is [Some yi]. Otherwise, if the list contains at least

7
core/CCRandom.ml
View file

@ -66,6 +66,13 @@ let small_int = int 100
let int_range i j st = i + Random.State.int st (j-i+1)
let float f st = Random.State.float st f
let small_float = float 100.0
let float_range i j st = i +. Random.State.float st (j-.i+.1.)
let replicate n g st =
let rec aux acc n =
if n = 0 then acc else aux (g st :: acc) (n-1)

14
core/CCRandom.mli
View file

@ -88,6 +88,19 @@ val int : int -> int t
val int_range : int -> int -> int t
(** Inclusive range *)
val small_float : float t
(** A reasonably small float.
@since 0.6.1 *)
val float : float -> float t
(** Random float within the given range
@since 0.6.1 *)
val float_range : float -> float -> float t
(** Inclusive range
@since 0.6.1 *)
val split : int -> (int * int) option t
(** Split a positive value [n] into [n1,n2] where [n = n1 + n2].
@return [None] if the value is too small *)
@ -135,3 +148,4 @@ val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
val run : ?st:state -> 'a t -> 'a
(** Using a random state (possibly the one in argument) run a generator *)

6
core/CCSequence.mli
View file

@ -576,6 +576,12 @@ By chunks of [4096] bytes:
Sequence.IO.(chunks_of ~size:4096 "a" |> write_to "b");;
]}
Read the lines of a file into a list:
{[
Sequence.IO.lines "a" |> Sequence.to_list
]}
@since 0.3.4 *)
module IO : sig

1
core/Gen_intf.ml Symbolic link
View file

@ -0,0 +1 @@
../gen/gen_intf.ml

18
core/META
View file

@ -1,6 +1,6 @@
# OASIS_START
# DO NOT EDIT (digest: 34ddfea96490dfa42580c0446eef8db6)
version = "0.6"
# DO NOT EDIT (digest: 29eba35d8937ec2340c27a97da9180a6)
version = "0.6.1"
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 "thread" (
version = "0.6"
version = "0.6.1"
description = "A modular standard library focused on data structures."
requires = "containers threads"
archive(byte) = "containers_thread.cma"
@ -20,7 +20,7 @@ package "thread" (
)
package "string" (
version = "0.6"
version = "0.6.1"
description = "A modular standard library focused on data structures."
archive(byte) = "containers_string.cma"
archive(byte, plugin) = "containers_string.cma"
@ -30,7 +30,7 @@ package "string" (
)
package "pervasives" (
version = "0.6"
version = "0.6.1"
description = "A modular standard library focused on data structures."
requires = "containers"
archive(byte) = "containers_pervasives.cma"
@ -41,7 +41,7 @@ package "pervasives" (
)
package "misc" (
version = "0.6"
version = "0.6.1"
description = "A modular standard library focused on data structures."
requires = "unix containers"
archive(byte) = "containers_misc.cma"
@ -52,7 +52,7 @@ package "misc" (
)
package "lwt" (
version = "0.6"
version = "0.6.1"
description = "A modular standard library focused on data structures."
requires = "containers lwt lwt.unix containers.misc"
archive(byte) = "containers_lwt.cma"
@ -63,7 +63,7 @@ package "lwt" (
)
package "cgi" (
version = "0.6"
version = "0.6.1"
description = "A modular standard library focused on data structures."
requires = "containers CamlGI"
archive(byte) = "containers_cgi.cma"
@ -74,7 +74,7 @@ package "cgi" (
)
package "advanced" (
version = "0.6"
version = "0.6.1"
description = "A modular standard library focused on data structures."
requires = "containers"
archive(byte) = "containers_advanced.cma"

4
core/containers.mldylib
View file

@ -1,8 +1,9 @@
# OASIS_START
# DO NOT EDIT (digest: 3c18f9fa7222954b0235c41f44fd620a)
# DO NOT EDIT (digest: 8d84707fdc7358bdadca9b7202118243)
CCVector
CCDeque
CCGen
Gen_intf
CCSequence
CCFQueue
CCMultiMap
@ -20,6 +21,7 @@ CCHash
CCKList
CCInt
CCBool
CCFloat
CCArray
CCOrd
CCIO

4
core/containers.mllib
View file

@ -1,8 +1,9 @@
# OASIS_START
# DO NOT EDIT (digest: 3c18f9fa7222954b0235c41f44fd620a)
# DO NOT EDIT (digest: 8d84707fdc7358bdadca9b7202118243)
CCVector
CCDeque
CCGen
Gen_intf
CCSequence
CCFQueue
CCMultiMap
@ -20,6 +21,7 @@ CCHash
CCKList
CCInt
CCBool
CCFloat
CCArray
CCOrd
CCIO

11
gen/.gitignore vendored Normal file
View file

@ -0,0 +1,11 @@
.*.swp
.*.swo
_build
*.native
*.byte
.session
TAGS
*.docdir
setup.log
setup.data
qtest

5
gen/.merlin Normal file
View file

@ -0,0 +1,5 @@
S .
B _build
S tests
B _build/tests
PKG oUnit

11
gen/META Normal file
View file

@ -0,0 +1,11 @@
# OASIS_START
# DO NOT EDIT (digest: c6b7b0973d898c3e8b7f565b701ee0d0)
version = "0.2.2"
description = "Simple, efficient iterators for OCaml"
archive(byte) = "gen.cma"
archive(byte, plugin) = "gen.cma"
archive(native) = "gen.cmxa"
archive(native, plugin) = "gen.cmxs"
exists_if = "gen.cma"
# OASIS_STOP

59
gen/Makefile Normal file
View file

@ -0,0 +1,59 @@
# OASIS_START
# DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954)
SETUP = ocaml setup.ml
build: setup.data
$(SETUP) -build $(BUILDFLAGS)
doc: setup.data build
$(SETUP) -doc $(DOCFLAGS)
test: setup.data build
$(SETUP) -test $(TESTFLAGS)
all:
$(SETUP) -all $(ALLFLAGS)
install: setup.data
$(SETUP) -install $(INSTALLFLAGS)
uninstall: setup.data
$(SETUP) -uninstall $(UNINSTALLFLAGS)
reinstall: setup.data
$(SETUP) -reinstall $(REINSTALLFLAGS)
clean:
$(SETUP) -clean $(CLEANFLAGS)
distclean:
$(SETUP) -distclean $(DISTCLEANFLAGS)
setup.data:
$(SETUP) -configure $(CONFIGUREFLAGS)
configure:
$(SETUP) -configure $(CONFIGUREFLAGS)
.PHONY: build doc test all install uninstall reinstall clean distclean configure
# OASIS_STOP
push_doc: all doc
scp -r gen.docdir/* cedeela.fr:~/simon/root/software/gen/
qtest-gen:
mkdir -p qtest
qtest extract gen.ml > qtest/run_qtest.ml
test-all:
./run_tests.native
./run_qtest.native
VERSION=$(shell awk '/^Version:/ {print $$2}' _oasis)
update_next_tag:
@echo "update version to $(VERSION)..."
sed -i "s/NEXT_VERSION/$(VERSION)/g" *.ml *.mli
sed -i "s/NEXT_RELEASE/$(VERSION)/g" *.ml *.mli

32
gen/README.md Normal file
View file

@ -0,0 +1,32 @@
Gen
===
Iterators for OCaml, both restartable and consumable. Performances should
be good, yet the code is simple and straightforward.
The documentation can be found [here](http://cedeela.fr/~simon/software/gen)
## Use
You can either build and install the library (see `Build`), or just copy
files to your own project. The last solution has the benefits that you
don't have additional dependencies nor build complications (and it may enable
more inlining). I therefore recommand it for its simplicity.
If you have comments, requests, or bugfixes, please share them! :-)
## Build
There are no dependencies. This should work with OCaml>=3.12.
$ make
To build and run tests (requires `oUnit`):
$ opam install oUnit
$ make tests
$ ./tests.native
## License
This code is free, under the BSD license.

65
gen/_oasis Normal file
View file

@ -0,0 +1,65 @@
OASISFormat: 0.3
Name: gen
Version: 0.2.2
Homepage: https://github.com/c-cube/gen
Authors: Simon Cruanes
License: BSD3
LicenseFile: LICENSE
Plugins: META (0.3), DevFiles (0.3)
BuildTools: ocamlbuild
Synopsis: Simple, efficient iterators for OCaml
Flag "bench"
Description: build benchmark
Default: false
Library "gen"
Path: .
Pack: false
Modules: Gen, Gen_intf
Document gen
Title: Containers docs
Type: ocamlbuild (0.3)
BuildTools+: ocamldoc
Install: true
XOCamlbuildPath: .
XOCamlbuildLibraries: gen
PreBuildCommand: make qtest-gen
Executable run_tests
Path: tests/
Install: false
CompiledObject: native
MainIs: run_tests.ml
Build$: flag(tests)
BuildDepends: gen,oUnit
Executable run_qtest
Path: qtest/
Install: false
CompiledObject: native
MainIs: run_qtest.ml
Build$: flag(tests)
BuildDepends: containers, containers.misc, containers.string,
oUnit, QTest2Lib
Test all
Command: make test-all
TestTools: run_tests, run_qtest
Run$: flag(tests)
Executable bench_persistent
Path: bench/
Install: false
CompiledObject: native
MainIs: bench_persistent.ml
Build$: flag(bench)
BuildDepends: gen,benchmark
SourceRepository head
Type: git
Location: https://github.com/c-cube/gen
Browser: https://github.com/c-cube/gen/tree/master/src

43
gen/_tags Normal file
View file

@ -0,0 +1,43 @@
# OASIS_START
# DO NOT EDIT (digest: a9f4ed4316e4221c9e3cad121ae7a8a9)
# 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
true: annot, bin_annot
<**/.svn>: -traverse
<**/.svn>: not_hygienic
".bzr": -traverse
".bzr": not_hygienic
".hg": -traverse
".hg": not_hygienic
".git": -traverse
".git": not_hygienic
"_darcs": -traverse
"_darcs": not_hygienic
# Library gen
"gen.cmxs": use_gen
# Executable run_tests
"tests/run_tests.native": pkg_oUnit
"tests/run_tests.native": use_gen
<tests/*.ml{,i,y}>: pkg_oUnit
<tests/*.ml{,i,y}>: use_gen
# Executable run_qtest
"qtest/run_qtest.native": pkg_QTest2Lib
"qtest/run_qtest.native": pkg_containers
"qtest/run_qtest.native": pkg_containers.misc
"qtest/run_qtest.native": pkg_containers.string
"qtest/run_qtest.native": pkg_oUnit
<qtest/*.ml{,i,y}>: pkg_QTest2Lib
<qtest/*.ml{,i,y}>: pkg_containers
<qtest/*.ml{,i,y}>: pkg_containers.misc
<qtest/*.ml{,i,y}>: pkg_containers.string
<qtest/*.ml{,i,y}>: pkg_oUnit
# Executable bench_persistent
"bench/bench_persistent.native": pkg_benchmark
"bench/bench_persistent.native": use_gen
<bench/*.ml{,i,y}>: pkg_benchmark
<bench/*.ml{,i,y}>: use_gen
# OASIS_STOP
"qtest": include
<**/*.ml>: warn_A, warn(-4), warn(-44)

4
gen/bench/.merlin Normal file
View file

@ -0,0 +1,4 @@
S .
B ../_build/bench/
REC
PKG benchmark

161
gen/bench/bench_persistent.ml Normal file
View file

@ -0,0 +1,161 @@
let _sum g =
Gen.Restart.fold (+) 0 g
module MList = struct
type 'a t = 'a node option ref
and 'a node = {
content : 'a;
mutable prev : 'a node;
mutable next : 'a node;
}
let create () = ref None
let is_empty d =
match !d with
| None -> true
| Some _ -> false
let push_back d x =
match !d with
| None ->
let rec elt = {
content = x; prev = elt; next = elt; } in
d := Some elt
| Some first ->
let elt = { content = x; next=first; prev=first.prev; } in
first.prev.next <- elt;
first.prev <- elt
(* conversion to gen *)
let to_gen d =
fun () ->
match !d with
| None -> (fun () -> None)
| Some first ->
let cur = ref first in (* current element of the list *)
let stop = ref false in (* are we done yet? *)
fun () ->
if !stop then None
else begin
let x = (!cur).content in
cur := (!cur).next;
(if !cur == first then stop := true); (* EOG, we made a full cycle *)
Some x
end
end
(** Store content of the generator in an enum *)
let persistent_mlist gen =
let l = MList.create () in
Gen.iter (MList.push_back l) gen;
MList.to_gen l
let bench_mlist n =
for _i = 0 to 100 do
let g = persistent_mlist Gen.(1 -- n) in
ignore (_sum g)
done
(** {6 Unrolled mutable list} *)
module UnrolledList = struct
type 'a node =
| Nil
| Partial of 'a array * int
| Cons of 'a array * 'a node ref
let of_gen gen =
let start = ref Nil in
let chunk_size = ref 16 in
let rec fill prev cur =
match cur, gen() with
| Partial (a,n), None ->
prev := Cons (Array.sub a 0 n, ref Nil); () (* done *)
| _, None -> prev := cur; () (* done *)
| Nil, Some x ->
let n = !chunk_size in
if n < 4096 then chunk_size := 2 * !chunk_size;
fill prev (Partial (Array.make n x, 1))
| Partial (a, n), Some x ->
assert (n < Array.length a);
a.(n) <- x;
if n+1 = Array.length a
then begin
let r = ref Nil in
prev := Cons(a, r);
fill r Nil
end else fill prev (Partial (a, n+1))
| Cons _, _ -> assert false
in
fill start !start ;
!start
let to_gen l () =
let cur = ref l in
let i = ref 0 in
let rec next() = match !cur with
| Nil -> None
| Cons (a,l') ->
if !i = Array.length a
then begin
cur := !l';
i := 0;
next()
end else begin
let y = a.(!i) in
incr i;
Some y
end
| Partial _ -> assert false
in
next
end
(** Store content of the generator in an enum *)
let persistent_unrolled gen =
let l = UnrolledList.of_gen gen in
UnrolledList.to_gen l
let bench_unrolled n =
for _i = 0 to 100 do
let g = persistent_unrolled Gen.(1 -- n) in
ignore (_sum g)
done
let bench_naive n =
for _i = 0 to 100 do
let l = Gen.to_rev_list Gen.(1 -- n) in
let g = Gen.Restart.of_list (List.rev l) in
ignore (_sum g)
done
let bench_current n =
for _i = 0 to 100 do
let g = Gen.persistent Gen.(1 -- n) in
ignore (_sum g)
done
let bench_current_lazy n =
for _i = 0 to 100 do
let g = Gen.persistent_lazy Gen.(1 -- n) in
ignore (_sum g)
done
let () =
let bench_n n =
Printf.printf "BENCH for %d\n" n;
let res = Benchmark.throughputN 5
[ "mlist", bench_mlist, n
; "naive", bench_naive, n
; "unrolled", bench_unrolled, n
; "current", bench_current, n
; "current_lazy", bench_current_lazy, n
]
in Benchmark.tabulate res
in
bench_n 100;
bench_n 100_000;
()

27
gen/configure vendored Executable file
View file

@ -0,0 +1,27 @@
#!/bin/sh
# OASIS_START
# DO NOT EDIT (digest: dc86c2ad450f91ca10c931b6045d0499)
set -e
FST=true
for i in "$@"; do
if $FST; then
set --
FST=false
fi
case $i in
--*=*)
ARG=${i%%=*}
VAL=${i##*=}
set -- "$@" "$ARG" "$VAL"
;;
*)
set -- "$@" "$i"
;;
esac
done
ocaml setup.ml -configure "$@"
# OASIS_STOP

1669
gen/gen.ml Normal file
View file

File diff suppressed because it is too large Load diff

5
gen/gen.mldylib Normal file
View file

@ -0,0 +1,5 @@
# OASIS_START
# DO NOT EDIT (digest: f69818d114f140be18d72c90abdc60e8)
Gen
Gen_intf
# OASIS_STOP

102
gen/gen.mli Normal file
View file

@ -0,0 +1,102 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(** {1 Generators}
Values of type ['a Gen.t] represent a possibly infinite sequence of values
of type 'a. One can only iterate once on the sequence, as it is consumed
by iteration/deconstruction/access. [None] is returned when the generator
is exhausted.
The submodule {!Restart} provides utilities to work with
{b restartable generators}, that is, functions [unit -> 'a Gen.t] that
allow to build as many generators from the same source as needed.
*)
(** {2 Global type declarations} *)
type 'a t = unit -> 'a option
(** A generator may be called several times, yielding the next value
each time. It returns [None] when no elements remain *)
type 'a gen = 'a t
module type S = Gen_intf.S
(** {2 Transient generators} *)
val get : 'a t -> 'a option
(** Get the next value *)
val next : 'a t -> 'a option
(** Synonym for {!get} *)
val get_exn : 'a t -> 'a
(** Get the next value, or fails
@raise Invalid_argument if no element remains *)
val junk : 'a t -> unit
(** Drop the next value, discarding it. *)
val repeatedly : (unit -> 'a) -> 'a t
(** Call the same function an infinite number of times (useful for instance
if the function is a random generator). *)
include S with type 'a t := 'a gen
(** Operations on {b transient} generators *)
(** {2 Restartable generators} *)
module Restart : sig
type 'a t = unit -> 'a gen
type 'a restartable = 'a t
include S with type 'a t := 'a restartable
val cycle : 'a t -> 'a t
(** Cycle through the enum, endlessly. The enum must not be empty. *)
val lift : ('a gen -> 'b) -> 'a t -> 'b
val lift2 : ('a gen -> 'b gen -> 'c) -> 'a t -> 'b t -> 'c
end
(** {2 Utils} *)
val persistent : 'a t -> 'a Restart.t
(** Store content of the transient generator in memory, to be able to iterate
on it several times later. If possible, consider using combinators
from {!Restart} directly instead. *)
val persistent_lazy : 'a t -> 'a Restart.t
(** Same as {!persistent}, but consumes the generator on demand (by chunks).
This allows to make a restartable generator out of an ephemeral one,
without paying a big cost upfront (nor even consuming it fully).
@since 0.2.2 *)
val start : 'a Restart.t -> 'a t
(** Create a new transient generator.
[start gen] is the same as [gen ()] but is included for readability. *)

5
gen/gen.mllib Normal file
View file

@ -0,0 +1,5 @@
# OASIS_START
# DO NOT EDIT (digest: f69818d114f140be18d72c90abdc60e8)
Gen
Gen_intf
# OASIS_STOP

5
gen/gen.odocl Normal file
View file

@ -0,0 +1,5 @@
# OASIS_START
# DO NOT EDIT (digest: f69818d114f140be18d72c90abdc60e8)
Gen
Gen_intf
# OASIS_STOP

321
gen/gen_intf.ml Normal file
View file

@ -0,0 +1,321 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(** {1 Common signature for transient and restartable generators}
The signature {!S} abstracts on a type ['a t], where the [t] can be
the type of transient or restartable generators. Some functions specify
explicitely that they use ['a gen] (transient generators). *)
type 'a gen = unit -> 'a option
module type S = sig
type 'a t
val empty : 'a t
(** Empty generator, with no elements *)
val singleton : 'a -> 'a t
(** One-element generator *)
val repeat : 'a -> 'a t
(** Repeat same element endlessly *)
val iterate : 'a -> ('a -> 'a) -> 'a t
(** [iterate x f] is [[x; f x; f (f x); f (f (f x)); ...]] *)
val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t
(** Dual of {!fold}, with a deconstructing operation. It keeps on
unfolding the ['b] value into a new ['b], and a ['a] which is yielded,
until [None] is returned. *)
val init : ?limit:int -> (int -> 'a) -> 'a t
(** Calls the function, starting from 0, on increasing indices.
If [limit] is provided and is a positive int, iteration will
stop at the limit (excluded).
For instance [init ~limit:4 id] will yield 0, 1, 2, and 3. *)
(** {2 Basic combinators} *)
val is_empty : _ t -> bool
(** Check whether the enum is empty. Pops an element, if any *)
val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** Fold on the generator, tail-recursively. Consumes the generator. *)
val reduce : ('a -> 'a -> 'a) -> 'a t -> 'a
(** Fold on non-empty sequences. Consumes the generator.
@raise Invalid_argument on an empty gen *)
val scan : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t
(** Like {!fold}, but keeping successive values of the accumulator.
Consumes the generator. *)
val unfold_scan : ('b -> 'a -> 'b * 'c) -> 'b -> 'a t -> 'c t
(** A mix of {!unfold} and {!scan}. The current state is combined with
the current element to produce a new state, and an output value
of type 'c.
@since 0.2.2 *)
val iter : ('a -> unit) -> 'a t -> unit
(** Iterate on the enum, consumes it. *)
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** Iterate on elements with their index in the enum, from 0, consuming it. *)
val length : _ t -> int
(** Length of an enum (linear time), consuming it *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** Lazy map. No iteration is performed now, the function will be called
when the result is traversed. *)
val append : 'a t -> 'a t -> 'a t
(** Append the two enums; the result contains the elements of the first,
then the elements of the second enum. *)
val flatten : 'a gen t -> 'a t
(** Flatten the enumeration of generators *)
val flat_map : ('a -> 'b gen) -> 'a t -> 'b t
(** Monadic bind; each element is transformed to a sub-enum
which is then iterated on, before the next element is processed,
and so on. *)
val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
(** Is the given element, member of the enum? *)
val take : int -> 'a t -> 'a t
(** Take at most n elements *)
val drop : int -> 'a t -> 'a t
(** Drop n elements *)
val nth : int -> 'a t -> 'a
(** n-th element, or Not_found
@raise Not_found if the generator contains less than [n] arguments *)
val take_nth : int -> 'a t -> 'a t
(** [take_nth n g] returns every element of [g] whose index
is a multiple of [n]. For instance [take_nth 2 (1--10) |> to_list]
will return [1;3;5;7;9] *)
val filter : ('a -> bool) -> 'a t -> 'a t
(** Filter out elements that do not satisfy the predicate. *)
val take_while : ('a -> bool) -> 'a t -> 'a t
(** Take elements while they satisfy the predicate *)
val drop_while : ('a -> bool) -> 'a t -> 'a t
(** Drop elements while they satisfy the predicate *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
(** Maps some elements to 'b, drop the other ones *)
val zip_index : 'a t -> (int * 'a) t
(** Zip elements with their index in the enum *)
val unzip : ('a * 'b) t -> 'a t * 'b t
(** Unzip into two sequences, splitting each pair *)
val partition : ('a -> bool) -> 'a t -> 'a t * 'a t
(** [partition p l] returns the elements that satisfy [p],
and the elements that do not satisfy [p] *)
val for_all : ('a -> bool) -> 'a t -> bool
(** Is the predicate true for all elements? *)
val exists : ('a -> bool) -> 'a t -> bool
(** Is the predicate true for at least one element? *)
val min : ?lt:('a -> 'a -> bool) -> 'a t -> 'a
(** Minimum element, according to the given comparison function.
@raise Invalid_argument if the generator is empty *)
val max : ?lt:('a -> 'a -> bool) -> 'a t -> 'a
(** Maximum element, see {!min}
@raise Invalid_argument if the generator is empty *)
val eq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** Equality of generators. *)
val lexico : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
(** Lexicographic comparison of generators. If a generator is a prefix
of the other one, it is considered smaller. *)
val compare : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
(** Synonym for {! lexico} *)
val find : ('a -> bool) -> 'a t -> 'a option
(** [find p e] returns the first element of [e] to satisfy [p],
or None. *)
val sum : int t -> int
(** Sum of all elements *)
(** {2 Multiple iterators} *)
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Map on the two sequences. Stops once one of them is exhausted.*)
val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** Iterate on the two sequences. Stops once one of them is exhausted.*)
val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
(** Fold the common prefix of the two iterators *)
val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
(** Succeeds if all pairs of elements satisfy the predicate.
Ignores elements of an iterator if the other runs dry. *)
val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
(** Succeeds if some pair of elements satisfy the predicate.
Ignores elements of an iterator if the other runs dry. *)
val zip_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Combine common part of the enums (stops when one is exhausted) *)
val zip : 'a t -> 'b t -> ('a * 'b) t
(** Zip together the common part of the enums *)
(** {2 Complex combinators} *)
val merge : 'a gen t -> 'a t
(** Pick elements fairly in each sub-generator. The merge of enums
[e1, e2, ... ] picks elements in [e1], [e2],
in [e3], [e1], [e2] .... Once a generator is empty, it is skipped;
when they are all empty, and none remains in the input,
their merge is also empty.
For instance, [merge [1;3;5] [2;4;6]] will be, in disorder, [1;2;3;4;5;6]. *)
val intersection : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t
(** Intersection of two sorted sequences. Only elements that occur in both
inputs appear in the output *)
val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t
(** Merge two sorted sequences into a sorted sequence *)
val sorted_merge_n : ?cmp:('a -> 'a -> int) -> 'a t list -> 'a t
(** Sorted merge of multiple sorted sequences *)
val tee : ?n:int -> 'a t -> 'a gen list
(** Duplicate the enum into [n] generators (default 2). The generators
share the same underlying instance of the enum, so the optimal case is
when they are consumed evenly *)
val round_robin : ?n:int -> 'a t -> 'a gen list
(** Split the enum into [n] generators in a fair way. Elements with
[index = k mod n] with go to the k-th enum. [n] default value
is 2. *)
val interleave : 'a t -> 'a t -> 'a t
(** [interleave a b] yields an element of [a], then an element of [b],
and so on. When a generator is exhausted, this behaves like the
other generator. *)
val intersperse : 'a -> 'a t -> 'a t
(** Put the separator element between all elements of the given enum *)
val product : 'a t -> 'b t -> ('a * 'b) t
(** Cartesian product, in no predictable order. Works even if some of the
arguments are infinite. *)
val group : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t
(** Group equal consecutive elements together. *)
val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t
(** Remove consecutive duplicate elements. Basically this is
like [fun e -> map List.hd (group e)]. *)
val sort : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
(** Sort according to the given comparison function. The enum must be finite. *)
val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
(** Sort and remove duplicates. The enum must be finite. *)
val chunks : int -> 'a t -> 'a array t
(** [chunks n e] returns a generator of arrays of length [n], composed
of successive elements of [e]. The last array may be smaller
than [n] *)
val permutations : 'a t -> 'a list t
(** Permutations of the enum.
@since 0.2.2 *)
val combinations : int -> 'a t -> 'a list t
(** Combinations of given length. The ordering of the elements within
each combination is unspecified.
Example (ignoring ordering):
[combinations 2 (1--3) |> to_list = [[1;2]; [1;3]; [2;3]]]
@since 0.2.2 *)
val power_set : 'a t -> 'a list t
(** All subsets of the enum (in no particular order). The ordering of
the elements within each subset is unspecified.
@since 0.2.2 *)
(** {2 Basic conversion functions} *)
val of_list : 'a list -> 'a t
(** Enumerate elements of the list *)
val to_list : 'a t -> 'a list
(** non tail-call trasnformation to list, in the same order *)
val to_rev_list : 'a t -> 'a list
(** Tail call conversion to list, in reverse order (more efficient) *)
val to_array : 'a t -> 'a array
(** Convert the enum to an array (not very efficient) *)
val of_array : ?start:int -> ?len:int -> 'a array -> 'a t
(** Iterate on (a slice of) the given array *)
val rand_int : int -> int t
(** Random ints in the given range. *)
val int_range : int -> int -> int t
(** [int_range a b] enumerates integers between [a] and [b], included. [a]
is assumed to be smaller than [b]. *)
module Infix : sig
val (--) : int -> int -> int t
(** Synonym for {! int_range} *)
val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t
(** Monadic bind operator *)
end
val (--) : int -> int -> int t
(** Synonym for {! int_range} *)
val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t
(** Monadic bind operator *)
val pp : ?start:string -> ?stop:string -> ?sep:string -> ?horizontal:bool ->
(Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
(** Pretty print the content of the generator on a formatter. *)
end

623
gen/myocamlbuild.ml Normal file
View file

@ -0,0 +1,623 @@
(* OASIS_START *)
(* DO NOT EDIT (digest: 8b03085ed54d5ff9a8cbd756150607bd) *)
module OASISGettext = struct
(* # 22 "src/oasis/OASISGettext.ml" *)
let ns_ str =
str
let s_ str =
str
let f_ (str: ('a, 'b, 'c, 'd) format4) =
str
let fn_ fmt1 fmt2 n =
if n = 1 then
fmt1^^""
else
fmt2^^""
let init =
[]
end
module OASISExpr = struct
(* # 22 "src/oasis/OASISExpr.ml" *)
open OASISGettext
type test = string
type flag = string
type t =
| EBool of bool
| ENot of t
| EAnd of t * t
| EOr of t * t
| EFlag of flag
| ETest of test * string
type 'a choices = (t * 'a) list
let eval var_get t =
let rec eval' =
function
| EBool b ->
b
| ENot e ->
not (eval' e)
| EAnd (e1, e2) ->
(eval' e1) && (eval' e2)
| EOr (e1, e2) ->
(eval' e1) || (eval' e2)
| EFlag nm ->
let v =
var_get nm
in
assert(v = "true" || v = "false");
(v = "true")
| ETest (nm, vl) ->
let v =
var_get nm
in
(v = vl)
in
eval' t
let choose ?printer ?name var_get lst =
let rec choose_aux =
function
| (cond, vl) :: tl ->
if eval var_get cond then
vl
else
choose_aux tl
| [] ->
let str_lst =
if lst = [] then
s_ "<empty>"
else
String.concat
(s_ ", ")
(List.map
(fun (cond, vl) ->
match printer with
| Some p -> p vl
| None -> s_ "<no printer>")
lst)
in
match name with
| Some nm ->
failwith
(Printf.sprintf
(f_ "No result for the choice list '%s': %s")
nm str_lst)
| None ->
failwith
(Printf.sprintf
(f_ "No result for a choice list: %s")
str_lst)
in
choose_aux (List.rev lst)
end
# 132 "myocamlbuild.ml"
module BaseEnvLight = struct
(* # 22 "src/base/BaseEnvLight.ml" *)
module MapString = Map.Make(String)
type t = string MapString.t
let default_filename =
Filename.concat
(Sys.getcwd ())
"setup.data"
let load ?(allow_empty=false) ?(filename=default_filename) () =
if Sys.file_exists filename then
begin
let chn =
open_in_bin filename
in
let st =
Stream.of_channel chn
in
let line =
ref 1
in
let st_line =
Stream.from
(fun _ ->
try
match Stream.next st with
| '\n' -> incr line; Some '\n'
| c -> Some c
with Stream.Failure -> None)
in
let lexer =
Genlex.make_lexer ["="] st_line
in
let rec read_file mp =
match Stream.npeek 3 lexer with
| [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
Stream.junk lexer;
Stream.junk lexer;
Stream.junk lexer;
read_file (MapString.add nm value mp)
| [] ->
mp
| _ ->
failwith
(Printf.sprintf
"Malformed data file '%s' line %d"
filename !line)
in
let mp =
read_file MapString.empty
in
close_in chn;
mp
end
else if allow_empty then
begin
MapString.empty
end
else
begin
failwith
(Printf.sprintf
"Unable to load environment, the file '%s' doesn't exist."
filename)
end
let rec var_expand str env =
let buff =
Buffer.create ((String.length str) * 2)
in
Buffer.add_substitute
buff
(fun var ->
try
var_expand (MapString.find var env) env
with Not_found ->
failwith
(Printf.sprintf
"No variable %s defined when trying to expand %S."
var
str))
str;
Buffer.contents buff
let var_get name env =
var_expand (MapString.find name env) env
let var_choose lst env =
OASISExpr.choose
(fun nm -> var_get nm env)
lst
end
# 237 "myocamlbuild.ml"
module MyOCamlbuildFindlib = struct
(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
(** OCamlbuild extension, copied from
* http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
* by N. Pouillard and others
*
* Updated on 2009/02/28
*
* Modified by Sylvain Le Gall
*)
open Ocamlbuild_plugin
type conf =
{ no_automatic_syntax: bool;
}
(* these functions are not really officially exported *)
let run_and_read =
Ocamlbuild_pack.My_unix.run_and_read
let blank_sep_strings =
Ocamlbuild_pack.Lexers.blank_sep_strings
let exec_from_conf exec =
let exec =
let env_filename = Pathname.basename BaseEnvLight.default_filename in
let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in
try
BaseEnvLight.var_get exec env
with Not_found ->
Printf.eprintf "W: Cannot get variable %s\n" exec;
exec
in
let fix_win32 str =
if Sys.os_type = "Win32" then begin
let buff = Buffer.create (String.length str) in
(* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'.
*)
String.iter
(fun c -> Buffer.add_char buff (if c = '\\' then '/' else c))
str;
Buffer.contents buff
end else begin
str
end
in
fix_win32 exec
let split s ch =
let buf = Buffer.create 13 in
let x = ref [] in
let flush () =
x := (Buffer.contents buf) :: !x;
Buffer.clear buf
in
String.iter
(fun c ->
if c = ch then
flush ()
else
Buffer.add_char buf c)
s;
flush ();
List.rev !x
let split_nl s = split s '\n'
let before_space s =
try
String.before s (String.index s ' ')
with Not_found -> s
(* ocamlfind command *)
let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x]
(* This lists all supported packages. *)
let find_packages () =
List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list"))
(* Mock to list available syntaxes. *)
let find_syntaxes () = ["camlp4o"; "camlp4r"]
let well_known_syntax = [
"camlp4.quotations.o";
"camlp4.quotations.r";
"camlp4.exceptiontracer";
"camlp4.extend";
"camlp4.foldgenerator";
"camlp4.listcomprehension";
"camlp4.locationstripper";
"camlp4.macro";
"camlp4.mapgenerator";
"camlp4.metagenerator";
"camlp4.profiler";
"camlp4.tracer"
]
let dispatch conf =
function
| After_options ->
(* By using Before_options one let command line options have an higher
* priority on the contrary using After_options will guarantee to have
* the higher priority override default commands by ocamlfind ones *)
Options.ocamlc := ocamlfind & A"ocamlc";
Options.ocamlopt := ocamlfind & A"ocamlopt";
Options.ocamldep := ocamlfind & A"ocamldep";
Options.ocamldoc := ocamlfind & A"ocamldoc";
Options.ocamlmktop := ocamlfind & A"ocamlmktop";
Options.ocamlmklib := ocamlfind & A"ocamlmklib"
| After_rules ->
(* When one link an OCaml library/binary/package, one should use
* -linkpkg *)
flag ["ocaml"; "link"; "program"] & A"-linkpkg";
if not (conf.no_automatic_syntax) then begin
(* For each ocamlfind package one inject the -package option when
* compiling, computing dependencies, generating documentation and
* linking. *)
List.iter
begin fun pkg ->
let base_args = [A"-package"; A pkg] in
(* TODO: consider how to really choose camlp4o or camlp4r. *)
let syn_args = [A"-syntax"; A "camlp4o"] in
let (args, pargs) =
(* Heuristic to identify syntax extensions: whether they end in
".syntax"; some might not.
*)
if Filename.check_suffix pkg "syntax" ||
List.mem pkg well_known_syntax then
(syn_args @ base_args, syn_args)
else
(base_args, [])
in
flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
(* TODO: Check if this is allowed for OCaml < 3.12.1 *)
flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs;
end
(find_packages ());
end;
(* Like -package but for extensions syntax. Morover -syntax is useless
* when linking. *)
List.iter begin fun syntax ->
flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "infer_interface"; "syntax_"^syntax] &
S[A"-syntax"; A syntax];
end (find_syntaxes ());
(* The default "thread" tag is not compatible with ocamlfind.
* Indeed, the default rules add the "threads.cma" or "threads.cmxa"
* options when using this tag. When using the "-linkpkg" option with
* ocamlfind, this module will then be added twice on the command line.
*
* To solve this, one approach is to add the "-thread" option when using
* the "threads" package using the previous plugin.
*)
flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]);
| _ ->
()
end
module MyOCamlbuildBase = struct
(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
(** Base functions for writing myocamlbuild.ml
@author Sylvain Le Gall
*)
open Ocamlbuild_plugin
module OC = Ocamlbuild_pack.Ocaml_compiler
type dir = string
type file = string
type name = string
type tag = string
(* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
type t =
{
lib_ocaml: (name * dir list * string list) list;
lib_c: (name * dir * file list) list;
flags: (tag list * (spec OASISExpr.choices)) list;
(* Replace the 'dir: include' from _tags by a precise interdepends in
* directory.
*)
includes: (dir * dir list) list;
}
let env_filename =
Pathname.basename
BaseEnvLight.default_filename
let dispatch_combine lst =
fun e ->
List.iter
(fun dispatch -> dispatch e)
lst
let tag_libstubs nm =
"use_lib"^nm^"_stubs"
let nm_libstubs nm =
nm^"_stubs"
let dispatch t e =
let env =
BaseEnvLight.load
~filename:env_filename
~allow_empty:true
()
in
match e with
| Before_options ->
let no_trailing_dot s =
if String.length s >= 1 && s.[0] = '.' then
String.sub s 1 ((String.length s) - 1)
else
s
in
List.iter
(fun (opt, var) ->
try
opt := no_trailing_dot (BaseEnvLight.var_get var env)
with Not_found ->
Printf.eprintf "W: Cannot get variable %s\n" var)
[
Options.ext_obj, "ext_obj";
Options.ext_lib, "ext_lib";
Options.ext_dll, "ext_dll";
]
| After_rules ->
(* Declare OCaml libraries *)
List.iter
(function
| nm, [], intf_modules ->
ocaml_lib nm;
let cmis =
List.map (fun m -> (String.uncapitalize m) ^ ".cmi")
intf_modules in
dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis
| nm, dir :: tl, intf_modules ->
ocaml_lib ~dir:dir (dir^"/"^nm);
List.iter
(fun dir ->
List.iter
(fun str ->
flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir]))
["compile"; "infer_interface"; "doc"])
tl;
let cmis =
List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi")
intf_modules in
dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"]
cmis)
t.lib_ocaml;
(* Declare directories dependencies, replace "include" in _tags. *)
List.iter
(fun (dir, include_dirs) ->
Pathname.define_context dir include_dirs)
t.includes;
(* Declare C libraries *)
List.iter
(fun (lib, dir, headers) ->
(* Handle C part of library *)
flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib]
(S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib";
A("-l"^(nm_libstubs lib))]);
flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib]
(S[A"-cclib"; A("-l"^(nm_libstubs lib))]);
flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
(S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
(* When ocaml link something that use the C library, then one
need that file to be up to date.
This holds both for programs and for libraries.
*)
dep ["link"; "ocaml"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
dep ["compile"; "ocaml"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
(* TODO: be more specific about what depends on headers *)
(* Depends on .h files *)
dep ["compile"; "c"]
headers;
(* Setup search path for lib *)
flag ["link"; "ocaml"; "use_"^lib]
(S[A"-I"; P(dir)]);
)
t.lib_c;
(* Add flags *)
List.iter
(fun (tags, cond_specs) ->
let spec = BaseEnvLight.var_choose cond_specs env in
let rec eval_specs =
function
| S lst -> S (List.map eval_specs lst)
| A str -> A (BaseEnvLight.var_expand str env)
| spec -> spec
in
flag tags & (eval_specs spec))
t.flags
| _ ->
()
let dispatch_default conf t =
dispatch_combine
[
dispatch t;
MyOCamlbuildFindlib.dispatch conf;
]
end
# 606 "myocamlbuild.ml"
open Ocamlbuild_plugin;;
let package_default =
{
MyOCamlbuildBase.lib_ocaml = [("gen", [], [])];
lib_c = [];
flags = [];
includes = []
}
;;
let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
# 622 "myocamlbuild.ml"
(* OASIS_STOP *)
Ocamlbuild_plugin.dispatch dispatch_default;;

7150
gen/setup.ml Normal file
View file

File diff suppressed because it is too large Load diff

4
gen/tests/run_tests.ml Normal file
View file

@ -0,0 +1,4 @@
let () =
let _ = OUnit.run_test_tt_main Test_gen.suite in
()

146
gen/tests/test_gen.ml Normal file
View file

@ -0,0 +1,146 @@
open OUnit
open Gen.Infix
module GR = Gen.Restart
let pint i = string_of_int i
let pilist l =
let b = Buffer.create 15 in
let fmt = Format.formatter_of_buffer b in
Format.fprintf fmt "%a@?"
(Gen.pp Format.pp_print_int) (Gen.of_list l);
Buffer.contents b
let pi2list l =
let b = Buffer.create 15 in
let fmt = Format.formatter_of_buffer b in
Format.fprintf fmt "%a@?"
(Gen.pp (fun fmt (a,b) -> Format.fprintf fmt "%d,%d" a b))
(Gen.of_list l);
Buffer.contents b
let pstrlist l =
let b = Buffer.create 15 in
let fmt = Format.formatter_of_buffer b in
Format.fprintf fmt "%a@?"
(Gen.pp Format.pp_print_string) (Gen.of_list l);
Buffer.contents b
let test_singleton () =
let gen = Gen.singleton 42 in
OUnit.assert_equal (Some 42) (Gen.get gen);
OUnit.assert_equal None (Gen.get gen);
let gen = Gen.singleton 42 in
OUnit.assert_equal 1 (Gen.length gen);
()
let test_iter () =
let e = GR.(1 -- 10) in
OUnit.assert_equal ~printer:pint 10 (GR.length e);
OUnit.assert_equal [1;2] GR.(to_list (1 -- 2));
OUnit.assert_equal [1;2;3;4;5] (GR.to_list (GR.take 5 e));
()
let test_map () =
let e = 1 -- 10 in
let e' = Gen.map string_of_int e in
OUnit.assert_equal ~printer:pstrlist ["9"; "10"] (Gen.to_list (Gen.drop 8 e'));
()
let test_append () =
let e = Gen.append (1 -- 5) (6 -- 10) in
OUnit.assert_equal [10;9;8;7;6;5;4;3;2;1] (Gen.to_rev_list e);
()
let test_flat_map () =
let e = 1 -- 3 in
let e' = e >>= (fun x -> x -- (x+1)) in
OUnit.assert_equal [1;2;2;3;3;4] (Gen.to_list e');
()
let test_zip () =
let e = Gen.zip_with (+) (Gen.repeat 1) (4--7) in
OUnit.assert_equal [5;6;7;8] (Gen.to_list e);
()
let test_filter_map () =
let f x = if x mod 2 = 0 then Some (string_of_int x) else None in
let e = Gen.filter_map f (1 -- 10) in
OUnit.assert_equal ["2"; "4"; "6"; "8"; "10"] (Gen.to_list e);
()
let test_merge () =
let e = Gen.of_list [1--3; 4--6; 7--9] in
let e' = Gen.merge e in
OUnit.assert_equal [1;2;3;4;5;6;7;8;9] (Gen.to_list e' |> List.sort compare);
()
let test_persistent () =
let i = ref 0 in
let gen () =
let j = !i in
if j > 5 then None else (incr i; Some j)
in
let e = Gen.persistent gen in
OUnit.assert_equal [0;1;2;3;4;5] (GR.to_list e);
OUnit.assert_equal [0;1;2;3;4;5] (GR.to_list e);
OUnit.assert_equal [0;1;2;3;4;5] (GR.to_list e);
()
let test_round_robin () =
let e = GR.round_robin ~n:2 GR.(1--10) in
match e with
| [a;b] ->
OUnit.assert_equal [1;3;5;7;9] (Gen.to_list a);
OUnit.assert_equal [2;4;6;8;10] (Gen.to_list b)
| _ -> OUnit.assert_failure "wrong list lenght"
let test_big_rr () =
let e = GR.round_robin ~n:3 GR.(1 -- 999) in
let l = List.map Gen.length e in
OUnit.assert_equal [333;333;333] l;
()
let test_merge_sorted () =
[Gen.of_list [1;3;5]; Gen.of_list [0;1;1;3;4;6;10]; Gen.of_list [2;2;11]]
|> Gen.sorted_merge_n ?cmp:None
|> Gen.to_list
|> OUnit.assert_equal ~printer:pilist [0;1;1;1;2;2;3;3;4;5;6;10;11]
let test_interleave () =
let e1 = Gen.of_list [1;3;5;7;9] in
let e2 = Gen.of_list [2;4;6;8;10] in
let e = Gen.interleave e1 e2 in
OUnit.assert_equal [1;2;3;4;5;6;7;8;9;10] (Gen.to_list e);
()
let test_intersperse () =
let e = 1 -- 5 in
let e' = Gen.intersperse 0 e in
OUnit.assert_equal [1;0;2;0;3;0;4;0;5] (Gen.to_list e');
()
let test_product () =
let printer = pi2list in
let e = Gen.product (1--3) (4--5) in
OUnit.assert_equal ~printer [1,4; 1,5; 2,4; 2,5; 3,4; 3,5]
(List.sort compare (Gen.to_list e));
()
let suite =
"test_gen" >:::
[ "test_singleton" >:: test_singleton;
"test_iter" >:: test_iter;
"test_map" >:: test_map;
"test_append" >:: test_append;
"test_flat_map" >:: test_flat_map;
"test_zip" >:: test_zip;
"test_filter_map" >:: test_filter_map;
"test_merge" >:: test_merge;
"test_persistent" >:: test_persistent;
"test_round_robin" >:: test_round_robin;
"test_big_rr" >:: test_big_rr;
"test_merge_sorted" >:: test_merge_sorted;
"test_interleave" >:: test_interleave;
"test_intersperse" >:: test_intersperse;
"test_product" >:: test_product;
]

4
lwt/lwt_actor.mli
View file

@ -26,7 +26,9 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 Small Actor system for Lwt}
Let's draw inspiration from Erlang. Just a tiny bit.
Let's draw inspiration from Erlang. Just a tiny bit. Currently
this module is unstable and experimental.
{b NOTE}: this module is not thread-safe at all.
*)

2
misc/printBox.mli
View file

@ -147,6 +147,8 @@ val vpad : int -> Box.t -> Box.t
val hpad : int -> Box.t -> Box.t
(** Pad horizontally *)
(* TODO: right-align/left-align *)
val grid : ?pad:(Box.t -> Box.t) -> ?bars:bool ->
Box.t array array -> Box.t
(** Grid of boxes (no frame between boxes). The matrix is indexed

22
sequence/CHANGELOG.md
View file

@ -1,25 +1,5 @@
# Changelog
## 0.5.4
- depend on `bytes`
- compliance with `-safe-string`
- `sequence.bigarray`
## 0.5.3
- bugfix: interaction between `take` and `is_empty`
## 0.5.2
- bugfix in `take`
- `on_list` for mapping lists through sequences
## 0.5.1
- `Sequence.IO` module, a very very simple way to read/write files
- options: `to_opt/of_opt/head/head_exn`
## 0.5
- conversion with `klist`
@ -82,4 +62,4 @@
- `zip`, `unzip` and `zip_i` to convert between `t` and `t2`
- added `scan` combinator
note: git log --no-merges --pretty=%s previous_version..HEAD
note: git log --no-merges previous_version..HEAD --pretty=%s

26
sequence/META
View file

@ -1,33 +1,11 @@
# OASIS_START
# DO NOT EDIT (digest: 0c501104bbf1dfc40db58200fdbfdd57)
version = "0.5.4"
# DO NOT EDIT (digest: 1e28d93f3671e8db9acf63b73cdbca82)
version = "0.4.1"
description = "Simple sequence (iterator) datatype and combinators"
requires = "bytes"
archive(byte) = "sequence.cma"
archive(byte, plugin) = "sequence.cma"
archive(native) = "sequence.cmxa"
archive(native, plugin) = "sequence.cmxs"
exists_if = "sequence.cma"
package "invert" (
version = "0.5.4"
description = "Simple sequence (iterator) datatype and combinators"
requires = "sequence delimcc"
archive(byte) = "invert.cma"
archive(byte, plugin) = "invert.cma"
archive(native) = "invert.cmxa"
archive(native, plugin) = "invert.cmxs"
exists_if = "invert.cma"
)
package "bigarray" (
version = "0.5.4"
description = "Simple sequence (iterator) datatype and combinators"
requires = "sequence bigarray"
archive(byte) = "bigarray.cma"
archive(byte, plugin) = "bigarray.cma"
archive(native) = "bigarray.cmxa"
archive(native, plugin) = "bigarray.cmxs"
exists_if = "bigarray.cma"
)
# OASIS_STOP

8
sequence/Makefile
View file

@ -57,13 +57,11 @@ push_stable: all
git push origin
git checkout master
VERSION=$(shell awk '/^Version:/ {print $$2}' _oasis)
SOURCE=*.ml *.mli invert/*.ml invert/*.mli bigarray/*.ml bigarray/*.mli
VERSION=$(shell awk '^/Version:/ {print $$2}' _oasis)
update_next_tag:
@echo "update version to $(VERSION)..."
sed -i "s/NEXT_VERSION/$(VERSION)/g" $(SOURCE)
sed -i "s/NEXT_RELEASE/$(VERSION)/g" $(SOURCE)
sed -i "s/NEXT_VERSION/$(VERSION)/g" *.ml *.mli
sed -i "s/NEXT_RELEASE/$(VERSION)/g" *.ml *.mli
.PHONY: benchs tests examples update_next_tag push_doc push_stable

4
sequence/_oasis
View file

@ -1,6 +1,6 @@
OASISFormat: 0.4
Name: sequence
Version: 0.5.4
Version: dev
Homepage: https://github.com/c-cube/sequence
Authors: Simon Cruanes
License: BSD-2-clause
@ -59,7 +59,7 @@ Document sequence
XOCamlbuildLibraries: sequence
Test all
Type: custom (0.4)
Type: custom
Command: make run-tests
TestTools: run_tests
Run$: flag(tests)

30
sequence/_tags
View file

@ -1,9 +1,8 @@
# OASIS_START
# DO NOT EDIT (digest: 29e0c9fc65daf16caa16466d6ff32bac)
# DO NOT EDIT (digest: ffd3fbaf00b431777fea1b8279203bf9)
# 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
true: annot, bin_annot
<**/.svn>: -traverse
<**/.svn>: not_hygienic
".bzr": -traverse
@ -16,38 +15,17 @@ true: annot, bin_annot
"_darcs": not_hygienic
# Library sequence
"sequence.cmxs": use_sequence
<*.ml{,i,y}>: pkg_bytes
# Library invert
"invert/invert.cmxs": use_invert
<invert/*.ml{,i,y}>: pkg_bytes
<invert/*.ml{,i,y}>: pkg_delimcc
<invert/*.ml{,i,y}>: use_sequence
# Library bigarray
"bigarray/bigarray.cmxs": use_bigarray
<bigarray/*.ml{,i,y}>: pkg_bigarray
<bigarray/*.ml{,i,y}>: pkg_bytes
<bigarray/*.ml{,i,y}>: use_sequence
# Executable run_tests
"tests/run_tests.native": pkg_bytes
"tests/run_tests.native": pkg_oUnit
"tests/run_tests.native": use_sequence
<tests/*.ml{,i,y}>: pkg_bytes
<tests/*.ml{,i,y}>: pkg_oUnit
<tests/*.ml{,i,y}>: use_sequence
# Executable benchs
"bench/benchs.native": pkg_benchmark
"bench/benchs.native": pkg_bytes
"bench/benchs.native": use_sequence
# Executable bench_persistent
"bench/bench_persistent.native": pkg_benchmark
"bench/bench_persistent.native": pkg_bytes
"bench/bench_persistent.native": use_sequence
# Executable bench_persistent_read
"bench/bench_persistent_read.native": pkg_benchmark
"bench/bench_persistent_read.native": pkg_bytes
"bench/bench_persistent_read.native": use_sequence
<bench/*.ml{,i,y}>: pkg_benchmark
<bench/*.ml{,i,y}>: pkg_bytes
<bench/*.ml{,i,y}>: use_sequence
<bench/*.ml{,i}>: pkg_benchmark
<bench/*.ml{,i}>: use_sequence
# OASIS_STOP
true: bin_annot
<**/*.ml>: warn_A, warn(-4)

4
sequence/bigarray/bigarray.mldylib
View file

@ -1,4 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: dca476c3b57e859aa3b1c75ec0959ed9)
SequenceBigarray
# OASIS_STOP

4
sequence/bigarray/bigarray.mllib
View file

@ -1,4 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: dca476c3b57e859aa3b1c75ec0959ed9)
SequenceBigarray
# OASIS_STOP

4
sequence/invert/invert.mldylib
View file

@ -1,4 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: d74492d261fcc87665b60e0331c04236)
SequenceInvert
# OASIS_STOP

4
sequence/invert/invert.mllib
View file

@ -1,4 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: d74492d261fcc87665b60e0331c04236)
SequenceInvert
# OASIS_STOP

113
sequence/myocamlbuild.ml
View file

@ -1,5 +1,5 @@
(* OASIS_START *)
(* DO NOT EDIT (digest: 2ea21bad023bcdcb9626e204d039d0d2) *)
(* DO NOT EDIT (digest: 958ece46307b808952e439e1cc47a739) *)
module OASISGettext = struct
(* # 22 "src/oasis/OASISGettext.ml" *)
@ -39,10 +39,10 @@ module OASISExpr = struct
open OASISGettext
type test = string
type test = string
type flag = string
type flag = string
type t =
@ -52,10 +52,10 @@ module OASISExpr = struct
| EOr of t * t
| EFlag of flag
| ETest of test * string
type 'a choices = (t * 'a) list
type 'a choices = (t * 'a) list
let eval var_get t =
@ -249,9 +249,6 @@ module MyOCamlbuildFindlib = struct
*)
open Ocamlbuild_plugin
type conf =
{ no_automatic_syntax: bool;
}
(* these functions are not really officially exported *)
let run_and_read =
@ -318,7 +315,7 @@ module MyOCamlbuildFindlib = struct
(* This lists all supported packages. *)
let find_packages () =
List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list"))
List.map before_space (split_nl & run_and_read "ocamlfind list")
(* Mock to list available syntaxes. *)
@ -341,7 +338,7 @@ module MyOCamlbuildFindlib = struct
]
let dispatch conf =
let dispatch =
function
| After_options ->
(* By using Before_options one let command line options have an higher
@ -360,39 +357,31 @@ module MyOCamlbuildFindlib = struct
* -linkpkg *)
flag ["ocaml"; "link"; "program"] & A"-linkpkg";
if not (conf.no_automatic_syntax) then begin
(* For each ocamlfind package one inject the -package option when
* compiling, computing dependencies, generating documentation and
* linking. *)
List.iter
begin fun pkg ->
let base_args = [A"-package"; A pkg] in
(* TODO: consider how to really choose camlp4o or camlp4r. *)
let syn_args = [A"-syntax"; A "camlp4o"] in
let (args, pargs) =
(* Heuristic to identify syntax extensions: whether they end in
".syntax"; some might not.
*)
if Filename.check_suffix pkg "syntax" ||
List.mem pkg well_known_syntax then
(syn_args @ base_args, syn_args)
else
(base_args, [])
in
flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
(* TODO: Check if this is allowed for OCaml < 3.12.1 *)
flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs;
end
(find_packages ());
end;
(* For each ocamlfind package one inject the -package option when
* compiling, computing dependencies, generating documentation and
* linking. *)
List.iter
begin fun pkg ->
let base_args = [A"-package"; A pkg] in
(* TODO: consider how to really choose camlp4o or camlp4r. *)
let syn_args = [A"-syntax"; A "camlp4o"] in
let args =
(* Heuristic to identify syntax extensions: whether they end in
".syntax"; some might not.
*)
if Filename.check_suffix pkg "syntax" ||
List.mem pkg well_known_syntax then
syn_args @ base_args
else
base_args
in
flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
end
(find_packages ());
(* Like -package but for extensions syntax. Morover -syntax is useless
* when linking. *)
@ -441,10 +430,10 @@ module MyOCamlbuildBase = struct
module OC = Ocamlbuild_pack.Ocaml_compiler
type dir = string
type file = string
type name = string
type tag = string
type dir = string
type file = string
type name = string
type tag = string
(* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
@ -459,7 +448,7 @@ module MyOCamlbuildBase = struct
* directory.
*)
includes: (dir * dir list) list;
}
}
let env_filename =
@ -557,13 +546,12 @@ module MyOCamlbuildBase = struct
(* When ocaml link something that use the C library, then one
need that file to be up to date.
This holds both for programs and for libraries.
*)
dep ["link"; "ocaml"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
dep ["link"; "ocaml"; "program"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
dep ["compile"; "ocaml"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
dep ["compile"; "ocaml"; "program"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
(* TODO: be more specific about what depends on headers *)
(* Depends on .h files *)
@ -592,37 +580,30 @@ module MyOCamlbuildBase = struct
()
let dispatch_default conf t =
let dispatch_default t =
dispatch_combine
[
dispatch t;
MyOCamlbuildFindlib.dispatch conf;
MyOCamlbuildFindlib.dispatch;
]
end
# 606 "myocamlbuild.ml"
# 594 "myocamlbuild.ml"
open Ocamlbuild_plugin;;
let package_default =
{
MyOCamlbuildBase.lib_ocaml =
[
("sequence", [], []);
("invert", ["invert"], []);
("bigarray", ["bigarray"], [])
];
MyOCamlbuildBase.lib_ocaml = [("sequence", [], [])];
lib_c = [];
flags = [];
includes = []
}
;;
let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;;
let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
# 627 "myocamlbuild.ml"
# 608 "myocamlbuild.ml"
(* OASIS_STOP *)
Ocamlbuild_plugin.dispatch dispatch_default;;

22
sequence/sequence.ml
View file

@ -40,7 +40,7 @@ let rec from_fun f k = match f () with
| None -> ()
| Some x -> k x; from_fun f k
let empty k = ()
let empty _ = ()
let singleton x k = k x
let return x k = k x
@ -152,10 +152,6 @@ module MList = struct
let of_seq seq =
of_seq_with seq (fun _ -> ())
let is_empty = function
| Nil -> true
| Cons _ -> false
let rec iter f l = match l with
| Nil -> ()
| Cons (a, n, tl) ->
@ -199,7 +195,7 @@ module MList = struct
cur := !tl;
i := 0;
get_next arg
| Cons (a, n, _) ->
| Cons (a, _, _) ->
let x = a.(!i) in
incr i;
Some x
@ -214,7 +210,7 @@ module MList = struct
let rec make (l,i) () = match l with
| Nil -> `Nil
| Cons (_, n, tl) when i = !n -> make (!tl,0) ()
| Cons (a, n, _) -> `Cons (a.(i), make (l,i+1))
| Cons (a, _, _) -> `Cons (a.(i), make (l,i+1))
in make (l,0)
end
@ -411,7 +407,7 @@ let is_empty seq =
(** {2 Transform a sequence} *)
let empty2 k = ()
let empty2 _ = ()
let is_empty2 seq2 =
try ignore (seq2 (fun _ _ -> raise ExitIsEmpty)); true
@ -525,9 +521,9 @@ let of_hashtbl h k = Hashtbl.iter (fun a b -> k (a, b)) h
let of_hashtbl2 h k = Hashtbl.iter k h
let hashtbl_keys h k = Hashtbl.iter (fun a b -> k a) h
let hashtbl_keys h k = Hashtbl.iter (fun a _ -> k a) h
let hashtbl_values h k = Hashtbl.iter (fun a b -> k b) h
let hashtbl_values h k = Hashtbl.iter (fun _ b -> k b) h
let of_str s k = String.iter k s
@ -613,16 +609,16 @@ module Set = struct
end
(** Create an enriched Set module from the given one *)
module Adapt(X : Set.S) = struct
module Adapt(X : Set.S) : S with type elt = X.elt and type t = X.t = struct
let to_seq set k = X.iter k set
let of_seq seq = fold (fun set x -> X.add x set) X.empty seq
let of_list l = of_seq (of_list l)
let to_list set = to_list (to_seq set)
include X
let of_list l = List.fold_left (fun set x -> add x set) empty l
end
(** Functor to build an extended Set module from an ordered type *)

7318
sequence/setup.ml
View file

File diff suppressed because it is too large Load diff

52
sequence/tests/test_sequence.ml
View file

@ -2,7 +2,6 @@
open OUnit
module S = Sequence
open Sequence.Infix
let pp_ilist l =
let b = Buffer.create 15 in
@ -24,14 +23,14 @@ let test_repeat () =
()
let test_concat () =
let s1 = (1 -- 5) in
let s2 = (6 -- 10) in
let s1 = S.(1 -- 5) in
let s2 = S.(6 -- 10) in
let l = [1;2;3;4;5;6;7;8;9;10] in
OUnit.assert_equal l (S.to_list (S.append s1 s2));
()
let test_fold () =
let n = (1 -- 10)
let n = S.(1 -- 10)
|> S.fold (+) 0 in
OUnit.assert_equal 55 n;
()
@ -44,33 +43,33 @@ let test_foldi () =
()
let test_exists () =
(1 -- 100)
S.(1 -- 100)
|> S.exists (fun x -> x = 59)
|> OUnit.assert_bool "exists";
(1 -- 100)
S.(1 -- 100)
|> S.exists (fun x -> x < 0)
|> (fun x -> not x)
|> OUnit.assert_bool "not exists";
()
let test_length () =
(1 -- 1000) |> S.length |> OUnit.assert_equal 1000
S.(1 -- 1000) |> S.length |> OUnit.assert_equal 1000
let test_concat () =
1 -- 1000
|> S.map (fun i -> (i -- (i+1)))
let test_concat2 () =
S.(1 -- 1000)
|> S.map (fun i -> S.(i -- (i+1)))
|> S.concat
|> S.length
|> OUnit.assert_equal 2000
let test_flatMap () =
1 -- 1000
|> S.flatMap (fun i -> (i -- (i+1)))
S.(1 -- 1000)
|> S.flatMap (fun i -> S.(i -- (i+1)))
|> S.length
|> OUnit.assert_equal 2000
let test_intersperse () =
1 -- 100
S.(1 -- 100)
|> (fun seq -> S.intersperse 0 seq)
|> S.take 10
|> S.to_list
@ -98,7 +97,7 @@ let test_persistent () =
let test_big_persistent () =
let printer = pp_ilist in
let seq = 0 -- 10_000 in
let seq = S.(0 -- 10_000) in
let seq' = S.persistent seq in
OUnit.assert_equal 10_001 (S.length seq');
OUnit.assert_equal 10_001 (S.length seq');
@ -106,7 +105,7 @@ let test_big_persistent () =
()
let test_sort () =
1 -- 100
S.(1 -- 100)
|> S.sort ~cmp:(fun i j -> j - i)
|> S.take 4
|> S.to_list
@ -115,18 +114,18 @@ let test_sort () =
let test_sort_uniq () =
[42;1;2;3;4;5;4;3;2;1]
|> S.of_list
|> S.sort_uniq
|> S.sort_uniq ?cmp:None
|> S.to_list
|> OUnit.assert_equal [1;2;3;4;5;42]
let test_group () =
[1;2;3;3;2;2;3;4]
|> S.of_list |> S.group |> S.to_list
|> S.of_list |> S.group ?eq:None |> S.to_list
|> OUnit.assert_equal [[1];[2];[3;3];[2;2];[3];[4]]
let test_uniq () =
[1;2;2;3;4;4;4;3;3]
|> S.of_list |> S.uniq |> S.to_list
|> S.of_list |> S.uniq ?eq:None |> S.to_list
|> OUnit.assert_equal [1;2;3;4;3]
let test_product () =
@ -140,7 +139,7 @@ let test_product () =
"c",0; "c", 1; "c", 2;] s
let test_join () =
let s1 = (1 -- 3) in
let s1 = S.(1 -- 3) in
let s2 = S.of_list ["1"; "2"] in
let join_row i j =
if string_of_int i = j then Some (string_of_int i ^ " = " ^ j) else None
@ -150,16 +149,16 @@ let test_join () =
()
let test_scan () =
1 -- 5
S.(1 -- 5)
|> S.scan (+) 0
|> S.to_list
|> OUnit.assert_equal ~printer:pp_ilist [0;1;3;6;10;15]
let test_drop () =
1 -- 5 |> S.drop 2 |> S.to_list |> OUnit.assert_equal [3;4;5]
S.(1 -- 5) |> S.drop 2 |> S.to_list |> OUnit.assert_equal [3;4;5]
let test_rev () =
1 -- 5 |> S.rev |> S.to_list |> OUnit.assert_equal [5;4;3;2;1]
S.(1 -- 5) |> S.rev |> S.to_list |> OUnit.assert_equal [5;4;3;2;1]
let test_unfoldr () =
let f x = if x < 5 then Some (string_of_int x,x+1) else None in
@ -168,12 +167,12 @@ let test_unfoldr () =
|> OUnit.assert_equal ["0"; "1"; "2"; "3"; "4"]
let test_hashtbl () =
let h = 1 -- 5
let h = S.(1 -- 5)
|> S.zip_i
|> S.to_hashtbl2 in
0 -- 4
S.(0 -- 4)
|> S.iter (fun i -> OUnit.assert_equal (i+1) (Hashtbl.find h i));
OUnit.assert_equal [0;1;2;3;4] (S.hashtbl_keys h |> S.sort |> S.to_list);
OUnit.assert_equal [0;1;2;3;4] (S.hashtbl_keys h |> S.sort ?cmp:None |> S.to_list);
()
let test_buff () =
@ -208,6 +207,7 @@ let suite =
[ "test_empty" >:: test_empty;
"test_repeat" >:: test_repeat;
"test_concat" >:: test_concat;
"test_concat2" >:: test_concat2;
"test_fold" >:: test_fold;
"test_foldi" >:: test_foldi;
"test_exists" >:: test_exists;
@ -231,5 +231,5 @@ let suite =
"test_hashtbl" >:: test_hashtbl;
"test_int_range" >:: test_int_range;
"test_take" >:: test_take;
"test_regression1" >:: test_regression1
"test_regression1" >:: test_regression1;
]

50
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: 4d75ed6ab1fc0101ea43731be9fc6381) *)
(* DO NOT EDIT (digest: 4828f89967677c4737a4a949042a8d4c) *)
(*
Regenerated by OASIS v0.4.5
Visit http://oasis.forge.ocamlcore.org for more information and
@ -6835,6 +6835,12 @@ let setup_t =
run_path = "."
});
("containers_advanced",
OCamlbuildDocPlugin.doc_build
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
run_path = "."
});
("containers_lwt",
OCamlbuildDocPlugin.doc_build
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
@ -6876,6 +6882,12 @@ let setup_t =
run_path = "."
});
("containers_advanced",
OCamlbuildDocPlugin.doc_clean
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
run_path = "."
});
("containers_lwt",
OCamlbuildDocPlugin.doc_clean
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
@ -6903,7 +6915,7 @@ let setup_t =
alpha_features = [];
beta_features = [];
name = "containers";
version = "0.6";
version = "0.6.1";
license =
OASISLicense.DEP5License
(OASISLicense.DEP5Unit
@ -7046,6 +7058,7 @@ let setup_t =
"CCVector";
"CCDeque";
"CCGen";
"Gen_intf";
"CCSequence";
"CCFQueue";
"CCMultiMap";
@ -7063,6 +7076,7 @@ let setup_t =
"CCKList";
"CCInt";
"CCBool";
"CCFloat";
"CCArray";
"CCOrd";
"CCIO";
@ -7484,6 +7498,34 @@ let setup_t =
doc_build_tools =
[ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]
});
Doc
({
cs_name = "containers_lwt";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
doc_type = (`Doc, "ocamlbuild", Some "0.3");
doc_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command = [(OASISExpr.EBool true, None)]
};
doc_build =
[
(OASISExpr.ENot (OASISExpr.EFlag "docs"), false);
(OASISExpr.EFlag "docs", true)
];
doc_install = [(OASISExpr.EBool true, true)];
doc_install_dir = "$docdir";
doc_title = "Containers_lwt docs";
doc_authors = [];
doc_abstract = None;
doc_format = OtherDoc;
doc_data_files = [];
doc_build_tools =
[ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]
});
Executable
({
cs_name = "run_benchs";
@ -7914,7 +7956,7 @@ let setup_t =
};
oasis_fn = Some "_oasis";
oasis_version = "0.4.5";
oasis_digest = Some "\151b\2136\171\237[\223\221\025\166\157\127)\016-";
oasis_digest = Some "\224Im\201\235\195\005\221\244\022\209\165\168XI>";
oasis_exec = None;
oasis_setup_args = [];
setup_update = false
@ -7922,6 +7964,6 @@ let setup_t =
let setup () = BaseSetup.setup setup_t;;
# 7926 "setup.ml"
# 7968 "setup.ml"
(* OASIS_STOP *)
let () = setup ();;