Module Quickcheck.Generator

type +'a t = 'a Base_quickcheck.Generator.t
val create : (size:Base.Int.t -> random:Splittable_random.State.t -> 'a) -> 'a t
val generate : 'a t -> size:Base.Int.t -> random:Splittable_random.State.t -> 'a

Generators form a monad. t1 >>= fun x -> t2 replaces each value x in t1 with the values in t2; each value's probability is the product of its probability in t1 and t2.

include Base.Monad.S with type 'a t := 'a t
val (>>=) : 'a t -> ('a -> 'a t) -> 'a t

t >>= f returns a computation that sequences the computations represented by two monad elements. The resulting computation first does t to yield a value v, and then runs the computation returned by f v.

val (>>|) : 'a t -> ('a -> 'b) -> 'a t

t >>| f is t >>= (fun a -> return (f a)).

module Monad_infix : sig ... end
val bind : 'a t -> f:('a -> 'a t) -> 'a t

bind t ~f = t >>= f

val return : 'a -> 'a t

return v returns the (trivial) computation that returns v.

val map : 'a t -> f:('a -> 'b) -> 'a t

map t ~f is t >>| f.

val join : 'a t -> 'a t

join t is t >>= (fun t' -> t').

val ignore_m : 'a t -> 'a t

ignore_m t is map t ~f:(fun _ -> ()). ignore_m used to be called ignore, but we decided that was a bad name, because it shadowed the widely used Caml.ignore. Some monads still do let ignore = ignore_m for historical reasons.

val all : 'a t list -> 'a t
val all_unit : 'a t list -> 'a t

Like all, but ensures that every monadic value in the list produces a unit value, all of which are discarded rather than being collected into a list.

module Let_syntax : sig ... end
include Base.Applicative.S with type 'a t := 'a t
val return : 'a -> 'a t
val map : 'a t -> f:('a -> 'b) -> 'a t
val both : 'a t -> 'a t -> 'a t
val (<*>) : 'a t -> 'a t -> 'a t

same as apply

val (<*) : 'a t -> 'a t -> 'a t
val (*>) : 'a t -> 'a t -> 'a t
val (>>|) : 'a t -> ('a -> 'b) -> 'a t
val apply : 'a t -> 'a t -> 'a t
val map2 : 'a t -> 'a t -> f:('a -> 'b -> 'c) -> 'a t
val map3 : 'a t -> 'a t -> 'a t -> f:('a -> 'b -> 'c -> 'd) -> 'a t
val all : 'a t list -> 'a t
val all_unit : 'a t list -> 'a t
module Applicative_infix : sig ... end
val size : Base.Int.t t

size = create (fun ~size _ -> size)

val with_size : 'a t -> size:Base.Int.t -> 'a t

with_size t ~size = create (fun ~size:_ random -> generate t ~size random)

val bool : Base.Bool.t t
val char : Base.Char.t t
val char_digit : Base.Char.t t
val char_lowercase : Base.Char.t t
val char_uppercase : Base.Char.t t
val char_alpha : Base.Char.t t
val char_alphanum : Base.Char.t t
val char_print : Base.Char.t t
val char_whitespace : Base.Char.t t
val singleton : 'a -> 'a t
val doubleton : 'a -> 'a -> 'a t
val of_list : 'a Base.List.t -> 'a t

Produce any of the given values, weighted equally.

of_list [ v1 ; ... ; vN ] = union [ singleton v1 ; ... ; singleton vN ]

val union : 'a t Base.List.t -> 'a t

Combine arbitary generators, weighted equally.

union [ g1 ; ... ; gN ] = weighted_union [ (1.0, g1) ; ... ; (1.0, gN) ]

val of_sequence : p:Base.Float.t -> 'a Sequence.t -> 'a t

Generator for the values from a potentially infinite sequence. Chooses each value with probability p, or continues with probability 1-p. Must satisfy 0. < p && p <= 1..

val tuple2 : 'a t -> 'b t -> ('a * 'b) t
val tuple3 : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
val tuple4 : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
val tuple5 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> ('a * 'b * 'c * 'd * 'e) t
val tuple6 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> ('a * 'b * 'c * 'd * 'e * 'f) t
val variant2 : 'a t -> 'b t -> [ `A of 'a | `B of 'b ] t
val variant3 : 'a t -> 'b t -> 'c t -> [ `A of 'a | `B of 'b | `C of 'c ] t
val variant4 : 'a t -> 'b t -> 'c t -> 'd t -> [ `A of 'a | `B of 'b | `C of 'c | `D of 'd ] t
val variant5 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> [ `A of 'a | `B of 'b | `C of 'c | `D of 'd | `E of 'e ] t
val variant6 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> [ `A of 'a | `B of 'b | `C of 'c | `D of 'd | `E of 'e | `F of 'f ] t
val geometric : p:Base.Float.t -> Base.Int.t -> Base.Int.t t

geometric ~p init produces a geometric distribution (think "radioactive decay") that produces init with probability p, and otherwise recursively chooses from geometric ~p (init+1). Must satisfy 0. < p && p <= 1..

val small_non_negative_int : Base.Int.t t

small_non_negative_int produces a non-negative int of a tractable size, e.g. allocating a value of this size should not run out of memory.

val small_positive_int : Base.Int.t t

small_positive_int produces a positive int of a tractable size, e.g. allocating a value of this size should not run out of memory.

val fn : 'a Base_quickcheck.Observer.t -> 'b t -> ('a -> 'b) t

Generators for functions; take observers for inputs and a generator for outputs.

val fn2 : 'a Base_quickcheck.Observer.t -> 'b Base_quickcheck.Observer.t -> 'c t -> ('a -> 'b -> 'c) t
val fn3 : 'a Base_quickcheck.Observer.t -> 'b Base_quickcheck.Observer.t -> 'c Base_quickcheck.Observer.t -> 'd t -> ('a -> 'b -> 'c -> 'd) t
val fn4 : 'a Base_quickcheck.Observer.t -> 'b Base_quickcheck.Observer.t -> 'c Base_quickcheck.Observer.t -> 'd Base_quickcheck.Observer.t -> 'e t -> ('a -> 'b -> 'c -> 'd -> 'e) t
val fn5 : 'a Base_quickcheck.Observer.t -> 'b Base_quickcheck.Observer.t -> 'c Base_quickcheck.Observer.t -> 'd Base_quickcheck.Observer.t -> 'e Base_quickcheck.Observer.t -> 'f t -> ('a -> 'b -> 'c -> 'd -> 'e -> 'f) t
val fn6 : 'a Base_quickcheck.Observer.t -> 'b Base_quickcheck.Observer.t -> 'c Base_quickcheck.Observer.t -> 'd Base_quickcheck.Observer.t -> 'e Base_quickcheck.Observer.t -> 'f Base_quickcheck.Observer.t -> 'g t -> ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g) t
val compare_fn : 'a Base_quickcheck.Observer.t -> ('a -> 'a -> Base.Int.t) t

Generator for comparison functions; result is guaranteed to be a partial order.

val equal_fn : 'a Base_quickcheck.Observer.t -> ('a -> 'a -> Base.Bool.t) t

Generator for equality functions; result is guaranteed to be an equivalence relation.

val filter_map : 'a t -> f:('a -> 'b Base.Option.t) -> 'b t

filter_map t ~f produces y for every x in t such that f x = Some y.

val filter : 'a t -> f:('a -> Base.Bool.t) -> 'a t

filter t ~f produces every x in t such that f x = true.

val recursive_union : 'a t Base.List.t -> f:('a t -> 'a t Base.List.t) -> 'a t

Generator for recursive data type with multiple clauses. At size 0, chooses only among the non-recursive cases; at sizes greater than 0, chooses among non-recursive and recursive cases, calling the recursive cases with decremented size.

type tree = Leaf | Node of tree * int * tree;;
recursive_union [return Leaf] ~f:(fun self ->
  [let%map left = self
   and int = Int.gen
   and right = self
   in Node (left, int, right)])
val weighted_recursive_union : (Base.Float.t * 'a t) Base.List.t -> f:('a t -> (Base.Float.t * 'a t) Base.List.t) -> 'a t

Like recursive_union, with the addition of non-uniform weights for each clause.

val fixed_point : ('a t -> 'a t) -> 'a t

Fixed-point generator. Use size to bound the size of the value and the depth of the recursion. There is no prescribed semantics for size except that it must be non-negative. For example, the following produces a naive generator for natural numbers:

fixed_point (fun self ->
  match%bind size with
  | 0 -> singleton 0
  | n -> with_size self ~size:(n-1) >>| Int.succ)
val weighted_union : (Base.Float.t * 'a t) Base.List.t -> 'a t

weighted_union alist produces a generator that combines the distributions of each t in alist with the associated weights, which must be finite positive floating point values.

val of_fun : (Base.Unit.t -> 'a t) -> 'a t

of_fun f produces a generator that lazily applies f.

It is recommended that f not be memoized. Instead, spread out the work of generating a whole distribution over many of_fun calls combined with weighted_union. This allows lazily generated generators to be garbage collected after each test and the relevant portions cheaply recomputed in subsequent tests, rather than accumulating without bound over time.

val list : 'a t -> 'a Base.List.t t

Generators for lists, choosing each element independently from the given element generator. list and list_non_empty distribute size among the list length and the sizes of each element. list_non_empty never generates the empty list. list_with_length generates lists of the given length, and distributes size among the sizes of the elements.

val list_non_empty : 'a t -> 'a Base.List.t t
val list_with_length : Base.Int.t -> 'a t -> 'a Base.List.t t