diff --git a/.ocamlformat b/.ocamlformat
index df32741..093e76f 100644
--- a/.ocamlformat
+++ b/.ocamlformat
@@ -1,2 +1,2 @@
-version=0.26.1
-profile=ocamlformat
\ No newline at end of file
+version=0.26.2
+profile=ocamlformat
diff --git a/example/1-simple/dune b/example/1-simple/dune
index 9962cca..de06cb1 100644
--- a/example/1-simple/dune
+++ b/example/1-simple/dune
@@ -1,3 +1,3 @@
 (library
-  (name simple)
-  (libraries tezt-bam))
\ No newline at end of file
+ (name simple)
+ (libraries tezt-bam))
diff --git a/example/2-simple-failure/dune b/example/2-simple-failure/dune
index 674cbcc..6256cbc 100644
--- a/example/2-simple-failure/dune
+++ b/example/2-simple-failure/dune
@@ -1,3 +1,3 @@
 (library
-  (name simple_failure)
-  (libraries tezt-bam))
\ No newline at end of file
+ (name simple_failure)
+ (libraries tezt-bam))
diff --git a/example/3-writing-generators/dune b/example/3-writing-generators/dune
index 4fd0788..5d55759 100644
--- a/example/3-writing-generators/dune
+++ b/example/3-writing-generators/dune
@@ -1,3 +1,3 @@
 (library
-  (name writing_generators)
-  (libraries tezt-bam))
\ No newline at end of file
+ (name writing_generators)
+ (libraries tezt-bam))
diff --git a/example/6-debugging/dune b/example/6-debugging/dune
index 9e02f92..45275c0 100644
--- a/example/6-debugging/dune
+++ b/example/6-debugging/dune
@@ -1,3 +1,3 @@
 (library
-  (name debugging)
-  (libraries tezt-bam))
\ No newline at end of file
+ (name debugging)
+ (libraries tezt-bam))
diff --git a/lib_bam/dune b/lib_bam/dune
index 0c09ccb..016e9c9 100644
--- a/lib_bam/dune
+++ b/lib_bam/dune
@@ -4,4 +4,4 @@
  (libraries pringo zarith))
 
 (documentation
- (package bam))
\ No newline at end of file
+ (package bam))
diff --git a/lib_bam/gen.ml b/lib_bam/gen.ml
index f08b862..4a96157 100644
--- a/lib_bam/gen.ml
+++ b/lib_bam/gen.ml
@@ -72,7 +72,7 @@ let root (gen : 'a t) f rs =
      to the function [f] is indeed the one that would be produced with
      a bind. *)
   let rs_left, _ = Random.split rs in
-  Forest.first (gen rs_left) |> Tree.root |> Fun.flip f rs
+  Forest.uncons (gen rs_left) |> fst |> Tree.root |> Fun.flip f rs
 
 module Syntax = struct
   let ( let* ) x f = bind x f
@@ -120,8 +120,8 @@ let with_merge : 'a Merge.t -> 'a t -> 'a t =
  fun merge gen rs ->
   Forest.map_tree (fun tree -> Tree.with_merge ~merge tree) (gen rs)
 
-let z_range : ?origin:Z.t -> min:Z.t -> max:Z.t -> unit -> Z.t t =
- fun ?origin ~min ~max () rs ->
+let z_range : ?root:Z.t -> ?origin:Z.t -> min:Z.t -> max:Z.t -> unit -> Z.t t =
+ fun ?root ?origin ~min ~max () rs ->
   let open Z.Compare in
   if max <= min then Forest.return min
   else
@@ -132,7 +132,7 @@ let z_range : ?origin:Z.t -> min:Z.t -> max:Z.t -> unit -> Z.t t =
         ~fill:(fun bytes pos len -> PRNG.Splitmix.State.bytes rs bytes pos len)
         upper_bound
     in
-    let initial = Z.add min start in
+    let initial = match root with None -> Z.add min start | Some v -> v in
     let origin =
       Option.value origin
         ~default:(if min <= Z.zero && Z.zero <= max then Z.zero else min)
@@ -140,20 +140,27 @@ let z_range : ?origin:Z.t -> min:Z.t -> max:Z.t -> unit -> Z.t t =
     Tree.binary_search ~initial ~origin () |> Forest.lift
 
 let float_range :
-       ?exhaustive_search_digits:int
+       ?root:float
+    -> ?exhaustive_search_digits:int
     -> ?precision_digits:int
     -> ?origin:float
     -> min:float
     -> max:float
     -> unit
     -> float t =
- fun ?exhaustive_search_digits ?precision_digits ?origin ~min ~max () rs ->
+ fun ?root ?exhaustive_search_digits ?precision_digits ?origin ~min ~max () rs ->
   let origin =
     Option.value origin ~default:(if min <= 0. && 0. <= max then 0. else min)
   in
   if min >= max then return min rs
   else if max -. min <= 1. then
-    let initial, _ = Random.float (max -. min) rs in
+    let initial =
+      match root with
+      | None ->
+          Random.float (max -. min) rs |> fst
+      | Some float ->
+          float
+    in
     Tree.fractional_search ?exhaustive_search_digits ?precision_digits ~initial
       ~origin ()
     |> Forest.lift
@@ -171,7 +178,9 @@ let float_range :
         ~max:(Z.sub (Z.of_float maxi) shift)
         () rs
     in
-    let fractional = Random.float 1. rs' |> fst in
+    let fractional =
+      match root with None -> Random.float 1. rs' |> fst | Some float -> float
+    in
     let ff, fi = Float.modf fractional in
     let fractional_forest =
       Tree.fractional_search ?exhaustive_search_digits ?precision_digits
@@ -185,6 +194,10 @@ let float_range :
             Float.max min (value +. fractional +. min) |> Float.min max )
           fractional_forest )
 
+let of_seq roots =
+  let roots = Seq.to_dispenser roots in
+  fun rs -> return (roots ()) rs
+
 let crunch i (gen : 'a t) : 'a t =
  fun rs ->
   let forest = gen rs in
@@ -205,4 +218,5 @@ let run ?(on_failure = failwith) gen state =
      [on_failure] argument to [Gen.run]."
   in
   let forest = gen state in
-  if Forest.is_singleton forest then Forest.first forest else on_failure message
+  let first, remaining_trees = forest |> Forest.uncons in
+  if Seq.is_empty remaining_trees then first else on_failure message
diff --git a/lib_bam/gen.mli b/lib_bam/gen.mli
index dea4f52..27da6b4 100644
--- a/lib_bam/gen.mli
+++ b/lib_bam/gen.mli
@@ -36,29 +36,36 @@ val make : 'a -> ('a -> 'a Seq.t) -> 'a t
     build an infinite tree if the function [f] never returns an empty
     sequence. *)
 
-val z_range : ?origin:Z.t -> min:Z.t -> max:Z.t -> unit -> Z.t t
-(** [range ?shrink min max] returns a generator producing a uniform
-    value between [min] (inclusive) and [max] (exclusive). It shrinks
-    towards the value [origin] using a binary search (see
+val z_range : ?root:Z.t -> ?origin:Z.t -> min:Z.t -> max:Z.t -> unit -> Z.t t
+(** [z_range ?root ?shrink min max] returns a generator producing a
+    uniform value between [min] (inclusive) and [max] (exclusive). It
+    shrinks towards the value [origin] using a binary search (see
     [Tree.binary_search]. By default [origin] is [0] if [0] is in the
-    interval [min;max]. Otherwise [origin] is set to [min].     
+    interval [min;max]. Otherwise [origin] is set to [min].
+
+    If [root] is specified, the value returned is [root] with the same
+    shrinking tree as if the random generator had produce this value.
 *)
 
 val float_range :
-     ?exhaustive_search_digits:int
+     ?root:float
+  -> ?exhaustive_search_digits:int
   -> ?precision_digits:int
   -> ?origin:float
   -> min:float
   -> max:float
   -> unit
   -> float t
-(** [range ?shrink min max] returns a generator producing a value
-    between [min] (inclusive) and [max] (exclusive). It shrinks
-    towards the value [min] using a binary search (see
+(** [float_range ?root ?shrink min max] returns a generator producing
+    a value between [min] (inclusive) and [max] (exclusive). It
+    shrinks towards the value [min] using a binary search (see
     [Tree.binary_search]. The generator is not uniform. In particular
     when the fractional part of [min] and [max] are getting closer to
     [0.5], the generator may tend to create more values equal to [min]
     or [max]. If the fractional part is [0.], it should be uniform.
+
+    If [root] is specified, the value returned is [root] with the same
+    shrinking tree as if the random generator had produce this value.
 *)
 
 val run : ?on_failure:(string -> 'a Tree.t) -> 'a t -> Random.t -> 'a Tree.t
@@ -90,6 +97,10 @@ val root : 'a t -> ('a -> 'b t) -> 'b t
     As a result, this new generator forgets completely the other
     values of [gen]. It acts as if it contains only the root. *)
 
+val of_seq : 'a Seq.t -> 'a option t
+(** [of_seq seq] returns a generator that will produce successively
+    the values of the sequence until the sequence is empty. *)
+
 module Syntax : sig
   val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
   (** Alias for {!bind}. *)
diff --git a/lib_bam/std.ml b/lib_bam/std.ml
index 5cffe4c..2378d65 100644
--- a/lib_bam/std.ml
+++ b/lib_bam/std.ml
@@ -36,10 +36,14 @@ let root = Gen.root
 
 let crunch = Gen.crunch
 
-let int ?(shrinker = Shrinker.Default) ?(min = 0) ?(max = Int.max_int) () =
+let of_seq = Gen.of_seq
+
+let int ?root ?(shrinker = Shrinker.Default) ?(min = 0) ?(max = Int.max_int) ()
+    =
   let range ?origin ~min ~max () =
     let origin = Option.map Z.of_int origin in
-    Gen.z_range ?origin ~min:(Z.of_int min) ~max:(Z.of_int max) ()
+    let root = Option.map Z.of_int root in
+    Gen.z_range ?root ?origin ~min:(Z.of_int min) ~max:(Z.of_int max) ()
     |> Gen.map Z.to_int
   in
   match shrinker with
@@ -51,11 +55,12 @@ let int ?(shrinker = Shrinker.Default) ?(min = 0) ?(max = Int.max_int) () =
   | Int n ->
       range ~origin:n ~min ~max ()
 
-let int32 ?(shrinker = Shrinker.Default) ?(min = Int32.zero)
+let int32 ?root ?(shrinker = Shrinker.Default) ?(min = Int32.zero)
     ?(max = Int32.max_int) () =
   let range ?origin ~min ~max () =
     let origin = Option.map Z.of_int32 origin in
-    Gen.z_range ?origin ~min:(Z.of_int32 min) ~max:(Z.of_int32 max) ()
+    let root = Option.map Z.of_int32 root in
+    Gen.z_range ?root ?origin ~min:(Z.of_int32 min) ~max:(Z.of_int32 max) ()
     |> Gen.map Z.to_int32
   in
   match shrinker with
@@ -67,11 +72,12 @@ let int32 ?(shrinker = Shrinker.Default) ?(min = Int32.zero)
   | Int32 n ->
       range ~origin:n ~min ~max ()
 
-let int64 ?(shrinker = Shrinker.Default) ?(min = Int64.zero)
+let int64 ?root ?(shrinker = Shrinker.Default) ?(min = Int64.zero)
     ?(max = Int64.max_int) () =
   let range ?origin ~min ~max () =
     let origin = Option.map Z.of_int64 origin in
-    Gen.z_range ?origin ~min:(Z.of_int64 min) ~max:(Z.of_int64 max) ()
+    let root = Option.map Z.of_int64 root in
+    Gen.z_range ?root ?origin ~min:(Z.of_int64 min) ~max:(Z.of_int64 max) ()
     |> Gen.map Z.to_int64
   in
   match shrinker with
@@ -83,19 +89,19 @@ let int64 ?(shrinker = Shrinker.Default) ?(min = Int64.zero)
   | Int64 n ->
       range ~origin:n ~min ~max ()
 
-let float ?(shrinker = Shrinker.Default) ?(min = 0.) ?(max = Float.max_float) ()
-    =
+let float ?root ?(shrinker = Shrinker.Default) ?(min = 0.)
+    ?(max = Float.max_float) () =
   match shrinker with
   | Manual shrinker ->
-      let*! root = Gen.float_range ~min ~max () in
+      let*! root = Gen.float_range ?root ~min ~max () in
       Gen.make root shrinker
   | Default ->
-      Gen.float_range ~min ~max ()
+      Gen.float_range ?root ~min ~max ()
   | Float f ->
-      Gen.float_range ~origin:f ~min ~max ()
+      Gen.float_range ?root ~origin:f ~min ~max ()
   | Float_precision {exhaustive_search_digits; precision_digits; target} ->
-      Gen.float_range ~exhaustive_search_digits ~precision_digits ~origin:target
-        ~min ~max ()
+      Gen.float_range ?root ~exhaustive_search_digits ~precision_digits
+        ~origin:target ~min ~max ()
 
 let pair ?(shrinker = Shrinker.Default) left right =
   match shrinker with
@@ -128,19 +134,20 @@ let bool ?(shrinker = Shrinker.Default) () =
       let* x = int ~min:0 ~max:2 () in
       if x = 0 = b then return true else return false
 
-let char ?(shrinker = Shrinker.Default) ?(printable = true) () =
+let char ?root ?(shrinker = Shrinker.Default) ?(printable = true) () =
   let base = if printable then Char.code 'a' else 0 in
   let max = if printable then 26 else 256 in
+  let root = root |> Option.map (fun root -> Char.code root - Char.code 'a') in
   match shrinker with
   | Manual shrinker ->
-      let*! root = int ~min:0 ~max () in
+      let*! root = int ?root ~min:0 ~max () in
       Gen.make (Char.chr (base + root)) shrinker
   | Default ->
-      let* offset = int ~min:0 ~max () in
+      let* offset = int ?root ~min:0 ~max () in
       return (Char.chr (base + offset))
   | Char c ->
       let origin = Char.code c - base in
-      let* offset = int ~shrinker:(Int origin) ~min:0 ~max () in
+      let* offset = int ?root ~shrinker:(Int origin) ~min:0 ~max () in
       return (Char.chr (base + offset))
 
 module Gen_list = struct
diff --git a/lib_bam/std.mli b/lib_bam/std.mli
index 372f4ea..aa6e280 100644
--- a/lib_bam/std.mli
+++ b/lib_bam/std.mli
@@ -119,32 +119,53 @@ val crunch : int -> 'a t -> 'a t
     shrinking. It increases the number of values that will be used
     during the shrinking. More details in {!page-shrinking}. *)
 
-val int : ?shrinker:int Shrinker.t -> ?min:int -> ?max:int -> unit -> int t
-(** [int ?shrinker ?(min=0) ?(max=Int.max_int) ()] is a generator for
+val of_seq : 'a Seq.t -> 'a option t
+(** [of_seq seq] returns a generator that will produce successively
+    the values of the sequence until the sequence is empty. Those
+    values are intended to be used as the root argument of other generators. *)
+
+val int :
+  ?root:int -> ?shrinker:int Shrinker.t -> ?min:int -> ?max:int -> unit -> int t
+(** [int ?root ?shrinker ?(min=0) ?(max=Int.max_int) ()] is a generator for
     integers. Bounds are inclusive.
 
     Default strategy is {!constructor:Shrinker.Int}[0].
  *)
 
 val int32 :
-  ?shrinker:int32 Shrinker.t -> ?min:int32 -> ?max:int32 -> unit -> int32 t
-(** [int ?shrinker ?(min=0) ?(max=Int.max_int) ()] is a generator for
+     ?root:int32
+  -> ?shrinker:int32 Shrinker.t
+  -> ?min:int32
+  -> ?max:int32
+  -> unit
+  -> int32 t
+(** [int ?root ?shrinker ?(min=0) ?(max=Int.max_int) ()] is a generator for
     integers. Bounds are inclusive.
 
     Default strategy is {!constructor:Shrinker.Int}[0].
  *)
 
 val int64 :
-  ?shrinker:int64 Shrinker.t -> ?min:int64 -> ?max:int64 -> unit -> int64 t
-(** [int ?shrinker ?(min=0) ?(max=Int.max_int) ()] is a generator for
+     ?root:int64
+  -> ?shrinker:int64 Shrinker.t
+  -> ?min:int64
+  -> ?max:int64
+  -> unit
+  -> int64 t
+(** [int ?root ?shrinker ?(min=0) ?(max=Int.max_int) ()] is a generator for
     integers. Bounds are inclusive.
 
     Default strategy is {!constructor:Shrinker.Int}[0].
  *)
 
 val float :
-  ?shrinker:float Shrinker.t -> ?min:float -> ?max:float -> unit -> float t
-(** [float ?shrinker ?(min=0.) ?(max=Float.max_float) ()] generates
+     ?root:float
+  -> ?shrinker:float Shrinker.t
+  -> ?min:float
+  -> ?max:float
+  -> unit
+  -> float t
+(** [float ?root ?shrinker ?(min=0.) ?(max=Float.max_float) ()] generates
     integers. Bounds are inclusive.
 
     Default strategy is {!constructor:Shrinker.Float}[0.].
@@ -163,8 +184,9 @@ val bool : ?shrinker:bool Shrinker.t -> unit -> bool t
     Default strategy is {!constructor:Shrinker.Bool}[false].
  *)
 
-val char : ?shrinker:Char.t Shrinker.t -> ?printable:bool -> unit -> char t
-(** [char ?shrinker ?(printable=true) ()] generates a char.
+val char :
+  ?root:char -> ?shrinker:Char.t Shrinker.t -> ?printable:bool -> unit -> char t
+(** [char ?root ?shrinker ?(printable=true) ()] generates a char.
 
     Default strategy is {!constructor:Shrinker.Char}['a].    
  *)
diff --git a/lib_bam/tree.ml b/lib_bam/tree.ml
index f533a6e..37d2910 100644
--- a/lib_bam/tree.ml
+++ b/lib_bam/tree.ml
@@ -123,20 +123,13 @@ module Forest = struct
 
   let map f = Seq.map (map f)
 
-  let first seq =
+  let uncons seq =
     match Seq.uncons seq with
     | None ->
         (* This invariant is ensured by the module itself. *)
         assert false
-    | Some (x, _) ->
-        x
-
-  let is_singleton seq =
-    match Seq.uncons seq with
-    | None ->
-        false
-    | Some (_x, seq) ->
-        Seq.is_empty seq
+    | Some (x, seq) ->
+        (x, seq)
 
   let crunch i seq = Seq.map (crunch i) seq
 
diff --git a/lib_bam/tree.mli b/lib_bam/tree.mli
index ab75f61..14a2506 100644
--- a/lib_bam/tree.mli
+++ b/lib_bam/tree.mli
@@ -140,14 +140,9 @@ module Forest : sig
   val make : 'a -> ('a -> 'a Seq.t) -> 'a t
   (** [make root ] produces a forest with a single tree by using {!make} *)
 
-  val first : 'a t -> 'a tree
-  (** [first forest] returns the first tree of the forest. This
-      function is total since the module guarantees the forest is
-      never empty. *)
-
-  val is_singleton : 'a t -> bool
-  (** [is_singleton forest] returns [true] if there is a single tree
-      in the forest. [false] otherwise. *)
+  val uncons : 'a t -> 'a tree * 'a tree Seq.t
+  (** [uncons forest] splits the forest into a tree and a sequence of
+      trees. *)
 
   val sequence : 'a t -> 'a t Seq.t -> 'a t
   (** [seqnece tree forest] returns a new forest made of a sequence of
diff --git a/lib_ppx/runtime.ml b/lib_ppx/runtime.ml
index efbb042..0456690 100644
--- a/lib_ppx/runtime.ml
+++ b/lib_ppx/runtime.ml
@@ -5,7 +5,7 @@ let loc = !Ast_helper.default_loc
 module Default = struct
   let unit = [%expr Bam.Std.return ()]
 
-  let bool ~shrinker =
+  let bool ~shrinker : expression =
     match shrinker with
     | None ->
         [%expr Bam.Std.bool ()]
diff --git a/lib_ppx/runtime.mli b/lib_ppx/runtime.mli
index 115a536..f826e86 100644
--- a/lib_ppx/runtime.mli
+++ b/lib_ppx/runtime.mli
@@ -5,12 +5,9 @@ type t =
   ; override: expression Ty.Map.t
   ; gen: expression option
   ; weight: int option
-  ; shrinker: expression option 
+  ; shrinker: expression option
   ; use_monadic_syntax: bool ref }
 
-
-
-
 val default : t
 
 val get : t -> 'continuation Ty.t -> 'continuation
diff --git a/lib_tezt_bam/runner.ml b/lib_tezt_bam/runner.ml
index fdc02b4..987a78a 100644
--- a/lib_tezt_bam/runner.ml
+++ b/lib_tezt_bam/runner.ml
@@ -2,31 +2,87 @@ open Tezt
 open Bam
 module Set = Set.Make (Int)
 
-let default_minimum_sampling_ratio = 0.10
+let log ?(level = Cli.Logs.Info) ?(color = Log.Color.FG.magenta) text =
+  Log.log ~level ~prefix:"pbt" ~color text
 
-let default_minimum_number_of_samples = 50
+module Cli = struct
+  include Cli
 
-let default_stop_after =
-  match Cli.Options.loop_mode with
-  | Infinite ->
-      `Loop
-  | Count 1 ->
-      `Timeout 0.100
-  | Count n ->
-      `Count n
+  let section =
+    Clap.section
+      ~description:"Options that can be used for PBT tests using Bam." "Bam"
 
-let log ?(level = Cli.Logs.Info) ?(color = Log.Color.FG.magenta) text =
-  Log.log ~level ~prefix:"pbt" ~color text
+  let shrink =
+    Clap.flag ~section ~set_long:"shrink"
+      ~description:"Use for PBT test to find a smaller counter-example." false
+
+  let capture =
+    Clap.flag ~section ~unset_long:"no-capture"
+      ~description:
+        "While running examples, do not capture any output from stdout or \
+         stderr."
+      (Cli.Options.loop_mode <> Infinite)
+
+  let aggressive =
+    Clap.default_int ~section ~long:"aggressive"
+      ~description:
+        "Make the shrinking heuristic more aggressive (should be >= 1)." 0
+
+  let statistics =
+    Clap.flag ~section ~description:"Compute execution statistics"
+      ~set_long:"stats" ~set_long_synonyms:["statistics"]
+      (shrink || Cli.Options.loop_mode <> Infinite)
+
+  let log_statistics_frequnecy =
+    Clap.optional_int ~section
+      ~description:
+        "Frequency when execution statistics are logged (in seconds). A \
+         negative value can be used for not showing any statistics."
+      ~long:"log-statistics-frequency" ~long_synonyms:["log-stats-frequency"] ()
+end
+
+module Default = struct
+  let default_timeout = 0.1
+
+  let stop_after =
+    match Cli.Options.loop_mode with
+    | Infinite ->
+        `Loop
+    | Count 1 ->
+        `Timeout default_timeout
+    | Count n ->
+        `Count n
+
+  (* This is low enough so that it should not be an issue in practice
+     and detect obvious problems. *)
+  let minimum_number_of_samples = 50
 
-module Stats = struct
+  (* This is low enough so that it should not be an issue in practice
+     and detect obvious problems. *)
+  let expected_sampling_ratio = 0.1
+
+  (* This may slow down a bit the test. It is activated by default,
+     but the user can opt-out. When shrinking (i.e. we are finding a
+     counter-example) or when looping, it may not be necessary to get
+     execution statistics, hence we deactivate this option to speed up
+     the number of samples tested. *)
+  let compute_execution_statistics = Cli.statistics
+
+  (* By default a log will be issued every 2 seconds. *)
+  let log_statistics_frequency =
+    let v = Option.value ~default:2 Cli.log_statistics_frequnecy in
+    Mtime.Span.(v * s)
+end
+
+module Execution_statistics = struct
   type t =
-    { start: Mtime_clock.counter
-    ; min: Mtime.span
-    ; max: Mtime.span
-    ; avg: Mtime.span
-    ; count: int
-    ; total: Mtime.span
-    ; distinct_values: Set.t }
+    { start: Mtime_clock.counter (* When the test started. *)
+    ; min: Mtime.span (* Minimum execution time on a sample. *)
+    ; max: Mtime.span (* Maximum execution time on a sample. *)
+    ; avg: Mtime.span (* Average execution time. *)
+    ; count: int (* Number of samples tested. *)
+    ; total: Mtime.span (* Total execution time since the test has started. *)
+    ; distinct_values: Set.t (* Distinct number of samples tested. *) }
 
   let empty () =
     { start= Mtime_clock.counter ()
@@ -80,12 +136,16 @@ module Stats = struct
     | `Loop ->
         false
     | `Count n ->
-        stats.count > n
+        stats.count >= n
     | `Timeout t ->
         t *. 1_000_000_000. < Mtime.Span.to_float_ns stats.total
 
   let samples stats = Set.cardinal stats.distinct_values
 
+  let pp_short fmt {count; total; _} =
+    Format.fprintf fmt "Execution time: %a@.Number of executions: %d"
+      Mtime.Span.pp total count
+
   let pp fmt ({start= _; min; max; avg; count; total; distinct_values} as stats)
       =
     Format.fprintf fmt
@@ -99,11 +159,21 @@ module Stats = struct
       (sampling_ratio stats)
 end
 
-let run ~aggressive ~expected_sampling_ratio ~minimum_number_of_samples ~hash
-    ~pp ~regression ~capture ~shrink ~stop_after ~on_sample gen f =
-  let update stats value =
-    on_sample value ;
-    Stats.update stats (hash value)
+let run ~aggressive ~expected_sampling_ratio ~minimum_number_of_samples
+    ~compute_execution_statistics ~log_statistics_frequency ~hash ~pp
+    ~regression ~capture ~shrink ~stop_after ~on_sample gen f =
+  let update (stats : Execution_statistics.t) value =
+    if not compute_execution_statistics then
+      if Mtime.Span.compare log_statistics_frequency Mtime.Span.zero >= 0 then
+        (* We only update the number of samples tested. This is used to
+           print a log when we run the test in loop. *)
+        { stats with
+          Execution_statistics.count= stats.count + 1
+        ; total= Mtime_clock.count stats.start }
+      else stats
+    else (
+      on_sample value ;
+      Execution_statistics.update stats (hash value) )
   in
   (* Tezt uses [Random] for initializing the seed. For compatibility
      with OCaml 4.14, the library uses a different module.
@@ -152,6 +222,8 @@ let run ~aggressive ~expected_sampling_ratio ~minimum_number_of_samples ~hash
       let finally () =
         Unix.dup2 ~cloexec:true stdout Unix.stdout ;
         Unix.dup2 ~cloexec:true stderr Unix.stderr ;
+        Unix.close stdout ;
+        Unix.close stderr ;
         Unix.close dump_stdout ;
         Unix.close dump_stderr
       in
@@ -178,9 +250,30 @@ let run ~aggressive ~expected_sampling_ratio ~minimum_number_of_samples ~hash
         | Error (`Fail message) ->
             Error (Tree.return x, message, stats) )
   in
+  let initial_logging =
+    let now = Mtime_clock.now () in
+    if Mtime.Span.compare log_statistics_frequency Mtime.Span.zero > 0 then
+      Mtime.add_span now log_statistics_frequency |> Option.get
+    else
+      (* Assuming we won't run the test for a whole year, nothing will be printed. *)
+      Mtime.add_span now Mtime.Span.year |> Option.get
+  in
+  let next_logging = ref initial_logging in
+  (* This requires to be in no capture mode. *)
+  let show_statistics stats =
+    if Mtime.is_later (Mtime_clock.now ()) ~than:!next_logging then (
+      next_logging :=
+        Mtime.add_span !next_logging log_statistics_frequency |> Option.get ;
+      if compute_execution_statistics then
+        log ~level:Report "%a" Execution_statistics.pp stats
+      else log ~level:Report "%a" Execution_statistics.pp_short stats )
+  in
   (* Repeat the function [f] [count] times with random inputs. *)
   let rec loop stats =
-    if Stats.should_stop stop_after stats then Ok stats
+    (* When using loop, it can be useful to print a text to ensure
+       liveness. *)
+    show_statistics stats ;
+    if Execution_statistics.should_stop stop_after stats then Ok stats
     else
       let tree = Gen.run gen (get_state ()) in
       let result = f (Tree.root tree) in
@@ -189,12 +282,12 @@ let run ~aggressive ~expected_sampling_ratio ~minimum_number_of_samples ~hash
       | Ok _x ->
           loop stats
       | Error `Bad_value ->
-          (* We remove this sampling. *)
-          loop (Stats.uncount stats (hash (Tree.root tree)))
+          (* We remove this sampling since it should not count. *)
+          loop (Execution_statistics.uncount stats (hash (Tree.root tree)))
       | Error (`Fail message) ->
           Error (tree, message, stats)
   in
-  let stats = Stats.empty () in
+  let stats = Execution_statistics.empty () in
   let result =
     with_capture (fun () ->
         match regressions stats regression with
@@ -206,11 +299,11 @@ let run ~aggressive ~expected_sampling_ratio ~minimum_number_of_samples ~hash
   match result with
   | Ok stats ->
       log "No counter-example found" ;
-      log ~level:Debug "Runtime statistics:@.%a" Stats.pp stats ;
+      log ~level:Debug "Runtime statistics:@.%a" Execution_statistics.pp stats ;
       (* We consider the test fails if it did not run with enough
          distinct samples. This is because this is probably an error
          that should be notified and is hard to catch otherwise. *)
-      let sampling_ratio = Stats.sampling_ratio stats in
+      let sampling_ratio = Execution_statistics.sampling_ratio stats in
       if sampling_ratio < expected_sampling_ratio then
         let msg =
           Format.asprintf
@@ -220,10 +313,11 @@ let run ~aggressive ~expected_sampling_ratio ~minimum_number_of_samples ~hash
              sampling ratio (default: %f). Otherwise, it may be possible there \
              is an issue with the generator used by the test."
             sampling_ratio expected_sampling_ratio
-            default_minimum_sampling_ratio
+            Default.expected_sampling_ratio
         in
         `Not_enough_samples msg
-      else if Stats.samples stats < minimum_number_of_samples then
+      else if Execution_statistics.samples stats < minimum_number_of_samples
+      then
         let msg =
           Format.asprintf
             "No counter example was found. However, the property was run with \
@@ -231,15 +325,15 @@ let run ~aggressive ~expected_sampling_ratio ~minimum_number_of_samples ~hash
              with at least %d. If this is expected, consier decreasing the \
              expected number of samples (default: %d). Otherwise, it may be \
              possible there is an issue the property or the generator."
-            (Stats.samples stats) minimum_number_of_samples
-            default_minimum_number_of_samples
+            (Execution_statistics.samples stats)
+            minimum_number_of_samples Default.minimum_number_of_samples
         in
         `Not_enough_samples msg
       else `Ok
   | Error (tree, message, stats) -> (
       log "First counter example found: %a@.With error:@.%s@." pp
         (Tree.root tree) message ;
-      log ~level:Debug "Runtime statistics:@.%a@." Stats.pp stats ;
+      log ~level:Debug "Runtime statistics:@.%a@." Execution_statistics.pp stats ;
       let counter_example =
         if shrink then (
           log "Start shrinking..." ;
@@ -274,34 +368,31 @@ let run ~aggressive ~expected_sampling_ratio ~minimum_number_of_samples ~hash
       | Error (`Fail err) ->
           `Failed err )
 
-let shrink =
-  Clap.flag ~set_long:"shrink"
-    ~description:"Use for PBT test to find a smaller counter-example" false
-
-let capture =
-  Clap.flag ~unset_long:"no-capture"
-    ~description:
-      "While running examples, do not capture any output from stdout or stderr"
-    true
-
-let aggressive =
-  Clap.default_int ~long:"aggressive"
-    ~description:"Make the shrinking heuristic more aggressive (should be >= 1)"
-    0
-
 let register ?(hash = Hashtbl.hash)
     ?(pp =
       fun fmt _s ->
         Format.fprintf fmt "<Unable to print the value: no printer given>")
-    ?(expected_sampling_ratio = default_minimum_sampling_ratio)
-    ?(minimum_number_of_samples = default_minimum_number_of_samples)
-    ?(regression = []) ?(stop_after = default_stop_after)
-    ?(on_sample = fun _ -> ()) ~__FILE__ ~title ~tags ~gen ~property () =
+    ?(compute_execution_statistics = Default.compute_execution_statistics)
+    ?(expected_sampling_ratio =
+      if compute_execution_statistics then Default.expected_sampling_ratio
+      else 0.0)
+    ?(minimum_number_of_samples =
+      if compute_execution_statistics then Default.minimum_number_of_samples
+      else 0) ?log_statistics_frequency ?(regression = [])
+    ?(stop_after = Default.stop_after) ?(on_sample = fun _ -> ()) ~__FILE__
+    ~title ~tags ~gen ~property () =
   Test.register ~seed:Random ~__FILE__ ~title ~tags
   @@ fun () ->
+  let log_statistics_frequency =
+    Option.fold ~none:Default.log_statistics_frequency
+      ~some:(fun n -> Mtime.Span.(n * s))
+      log_statistics_frequency
+  in
+  let open Cli in
   match
-    run ~aggressive ~expected_sampling_ratio ~minimum_number_of_samples ~hash
-      ~pp ~regression ~capture ~shrink ~stop_after ~on_sample gen property
+    run ~aggressive ~expected_sampling_ratio ~minimum_number_of_samples
+      ~compute_execution_statistics ~log_statistics_frequency ~hash ~pp
+      ~regression ~capture ~shrink ~stop_after ~on_sample gen property
   with
   | `Ok ->
       Lwt.return_unit
diff --git a/lib_tezt_bam/runner.mli b/lib_tezt_bam/runner.mli
index 6ea868c..f83eb28 100644
--- a/lib_tezt_bam/runner.mli
+++ b/lib_tezt_bam/runner.mli
@@ -1,8 +1,10 @@
 val register :
      ?hash:('a -> int)
   -> ?pp:(Format.formatter -> 'a -> unit)
+  -> ?compute_execution_statistics:bool
   -> ?expected_sampling_ratio:float
   -> ?minimum_number_of_samples:int
+  -> ?log_statistics_frequency:int
   -> ?regression:'a list
   -> ?stop_after:[`Timeout of float | `Count of int | `Loop]
   -> ?on_sample:('a -> unit)
diff --git a/lib_tezt_bam/tezt_bam.mli b/lib_tezt_bam/tezt_bam.mli
index 549720e..c9c47b2 100644
--- a/lib_tezt_bam/tezt_bam.mli
+++ b/lib_tezt_bam/tezt_bam.mli
@@ -94,8 +94,10 @@ module Pbt : sig
   val register :
        ?hash:('a -> int)
     -> ?pp:(Format.formatter -> 'a -> unit)
+    -> ?compute_execution_statistics:bool
     -> ?expected_sampling_ratio:float
     -> ?minimum_number_of_samples:int
+    -> ?log_statistics_frequency:int
     -> ?regression:'a list
     -> ?stop_after:[`Timeout of float | `Count of int | `Loop]
     -> ?on_sample:('a -> unit)
@@ -140,21 +142,39 @@ module Pbt : sig
     this is to ensure the property is run on many samples as detailed
     below.
 
-    One issue with proerty-based testing is that it is not easy to
+    One issue with property-based testing is that it is not easy to
     ensure that the generator and the property are run an a large
     range of values. The default behaviour of this register function
     is to prevent such a case to occur. To do so, two parameters are
     used: [expected_sampling_ratio] and[minimum_number_of_samples].
 
-    [expected_sampling_ratio] (by default 0.10) ensures that the
-    generator generates in general different sample.
-
-    [minimum_number_of_samples] (by default 50) ensures that the
-    property is run at least that numbero f times.
-
-    Those default values should ensure that it is not a constraint
-    most of the times, while at the same time should capture
-    erronenous cases.
+    [compute_execution_statistics] enables to compute statistics on
+    the test. It will compute the number of distinct values generated,
+    or statistics about the execution time of each sample. Its default
+    value is [true] unless shrinking is activated or [stop_after] is
+    [`Loop]. The reason is that this may slow down the execution of
+    the test which is superfluous when we shrink or we try to find a
+    counter-example.
+ 
+    [expected_sampling_ratio] ensures that the generator generates in
+    general different sample. Its default value is [0.10] if
+    [compute_execution_statistics] is [true], [0.0] otherwise.
+
+    [minimum_number_of_samples] ensures that the property is run at
+    least that numbero f times. Its default value is [50] if
+    [compute_execution-statistics] is [true], [0] otherwise.
+
+    [log_statistics_frequency] controls the frequency (in seconds) at
+    which a log shows some execution statistics. Don't forget to use
+    [--no-capture] if you want to see the log on [stdout], see the
+    corresponding documentation for this option. A negative value for
+    this parameter combined with [compute_execution_statistics] sets
+    to [false] ensures no statistics are computed for this test. Its
+    default value is [2].
+
+    The default values should ensure that we can capture obvious
+    erroneous cases where the test is not executed on enough samples
+    without being too restrictive.
 
     [stop_after] allows to determine how many samples should be drawn
     to run the property on. By default it is set to [`Timeout 0.10],
@@ -172,7 +192,10 @@ module Pbt : sig
     found.
 
     If [hash] is provided, it will be used to [hash] values. This
-    function is used to count the number of distinct samples.
+    function is used to count the number of distinct samples. Default
+    value is [Stdlib.Hashtbl.hash]. This function may generate a lot
+    of collisions on complex values. You can redefine a better [hash]
+    function via [ppx-hash] for example.
 
     [regression] can be instantiated to be sure that some fixed
     deterministic examples is always run.
@@ -183,6 +206,6 @@ module Pbt : sig
     counter-example. An explanation about shrinking can be found in
     the documentation of the package [Bam].
 
-    - [--no-capture] so that output is not captured
- *)
+    - [--no-capture] so that output is not captured. Its default value
+    is [true] unless [stop_after] is set to [`Loop]. *)
 end
diff --git a/test/expected/std.ml/std oneof.out b/test/expected/std.ml/std oneof.out
index 3d64d84..063f573 100644
--- a/test/expected/std.ml/std oneof.out	
+++ b/test/expected/std.ml/std oneof.out	
@@ -1 +1 @@
-1 1 2 4 5 5 5 6 7 7 8 9 9 10 103 124 124 134 135 135 160 161 161 175 1461 1913 4545 4684 4968 9349
+0 0 1 1 2 2 4 4 6 6 6 6 9 10 101 104 110 132 146 152 159 170 193 200 1793 4358 6898 7817 8240 8895
diff --git a/test/gen.ml b/test/gen.ml
index 5108c1f..64e697c 100644
--- a/test/gen.ml
+++ b/test/gen.ml
@@ -167,10 +167,27 @@ let root () =
   Tezt_bam.Pbt.register ~__FILE__ ~title:"Gen.root" ~tags:["gen"; "root"] ~gen
     ~property ()
 
+let hard_coded_values () =
+  let gen =
+    let int_gen =
+      let gen = [0; 1; 2; 3; 4] |> List.to_seq |> Seq.cycle |> Gen.of_seq in
+      Gen.bind gen (fun root -> Std.int ?root ~min:0 ~max:10 ())
+    in
+    Std.list ~size:(Std.return 5) int_gen
+  in
+  Tezt_bam.Pbt.register ~__FILE__ ~title:"self"
+    ~compute_execution_statistics:false ~stop_after:(`Count 1) ~tags:["self"]
+    ~gen
+    ~property:(fun l ->
+      if l = [0; 1; 2; 3; 4] then Ok ()
+      else Error (`Fail "The generated list should be [0;1;2;3;4]") )
+    ()
+
 let register () =
   z_range_regression () ;
   float_range () ;
   float_in_bounds () ;
   crunch () ;
   map_bind_return () ;
-  root ()
+  root () ;
+  hard_coded_values ()