Module Core_kernel__Quickcheck.Generator

type +'a t = 'a Base_quickcheck.Generator.t
val create : (size:Core_kernel__.Import.int -> random:Splittable_random.State.t -> 'a) -> 'a t
val generate : 'a t -> size:Core_kernel__.Import.int -> 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.

This can be used to form distributions of related values. For instance, the following expression creates a distribution of pairs x,y where x <= y:

Int.gen
>>= fun x ->
Int.gen_incl x Int.max_value
>>| fun y ->
x, y
include Core_kernel__.Import.Monad.S with type 'a t := 'a t
type 'a t
include Base__.Monad_intf.S_without_syntax with type 'a t := 'a t
type 'a t
include Base__.Monad_intf.Infix with type 'a t := 'a t
type 'a t
val (>>=) : 'a t -> ('a -> 'b t) -> 'b 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) -> 'b t

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

module Monad_infix : Base__.Monad_intf.Infix with type 'a t := 'a t
val bind : 'a t -> f:('a -> 'b t) -> 'b 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) -> 'b t

map t ~f is t >>| f.

val join : 'a t t -> 'a t

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

val ignore_m : 'a t -> unit 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 list t
val all_unit : unit t list -> unit 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.

include Base__.Monad_intf.Syntax with type 'a t := 'a t
type 'a t
module Let_syntax : sig ... end
include Core_kernel__.Import.Applicative.S with type 'a t := 'a t
include Base__.Applicative_intf.For_let_syntax
type 'a t
val return : 'a -> 'a t
val map : 'a t -> f:('a -> 'b) -> 'b t
val both : 'a t -> 'b t -> ('a * 'b) t
include Base__.Applicative_intf.Applicative_infix with type 'a t := 'a t
type 'a t
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t

same as apply

val (<*) : 'a t -> unit t -> 'a t
val (*>) : unit t -> 'a t -> 'a t
val (>>|) : 'a t -> ('a -> 'b) -> 'b t
val apply : ('a -> 'b) t -> 'a t -> 'b t
val map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t
val map3 : 'a t -> 'b t -> 'c t -> f:('a -> 'b -> 'c -> 'd) -> 'd t
val all : 'a t list -> 'a list t
val all_unit : unit t list -> unit t
val size : Core_kernel__.Import.int t

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

val with_size : 'a t -> size:Core_kernel__.Import.int -> 'a t

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

val bool : Core_kernel__.Import.bool t
val char : Core_kernel__.Import.char t
val char_digit : Core_kernel__.Import.char t
val char_lowercase : Core_kernel__.Import.char t
val char_uppercase : Core_kernel__.Import.char t
val char_alpha : Core_kernel__.Import.char t
val char_alphanum : Core_kernel__.Import.char t
val char_print : Core_kernel__.Import.char t
val char_whitespace : Core_kernel__.Import.char t
val singleton : 'a -> 'a t
val doubleton : 'a -> 'a -> 'a t
val of_list : 'a Core_kernel__.Import.list -> 'a t

Produce any of the given values, weighted equally.

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

val union : 'a t Core_kernel__.Import.list -> 'a t

Combine arbitary generators, weighted equally.

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

val of_sequence : p:Core_kernel__.Import.float -> 'a Core_kernel.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:Core_kernel__.Import.float -> Core_kernel__.Import.int -> Core_kernel__.Import.int 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 : Core_kernel__.Import.int 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 : Core_kernel__.Import.int 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 -> Core_kernel__.Import.int) t

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

val equal_fn : 'a Base_quickcheck.Observer.t -> ('a -> 'a -> Core_kernel__.Import.bool) t

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

val filter_map : 'a t -> f:('a -> 'b Core_kernel__.Import.option) -> '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 -> Core_kernel__.Import.bool) -> 'a t

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

val recursive_union : 'a t Core_kernel__.Import.list -> f:('a t -> 'a t Core_kernel__.Import.list) -> '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 : (Core_kernel__.Import.float * 'a t) Core_kernel__.Import.list -> f:('a t -> (Core_kernel__.Import.float * 'a t) Core_kernel__.Import.list) -> '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 : (Core_kernel__.Import.float * 'a t) Core_kernel__.Import.list -> '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 : (Core_kernel__.Import.unit -> '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 Core_kernel__.Import.list 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 Core_kernel__.Import.list t
val list_with_length : Core_kernel__.Import.int -> 'a t -> 'a Core_kernel__.Import.list t