Add QCheck2.Gen.recursive

CHANGELOG.md

@@ -58,6 +58,10 @@
 - Add a documentation warning about the precedence of `==>` to `QCheck` and `QCheck2`
 - Remove 32-bit support from QCheck's internal test suite. The libraries
   themselves are expected to continue running on 32-bit platforms.
+- Add `QCheck2.Gen.recursive`, a combinator for building generators of
+  recursive types from their base and recursive cases. It scales the size by
+  the reciprocal of the golden ratio (~0.618) at each level rather than
+  halving, and takes an optional `?scale` to override that schedule.
 
 
 ## 0.91 (2025-12-21)

src/core/QCheck2.ml

@@ -889,6 +889,27 @@ module Gen = struct
     let rec f' n st = f f' n st in
     f'
 
+  (* The reciprocal of the golden ratio, the default per-level size scaling
+     factor of [recursive]. *)
+  let golden_ratio_scale (n : int) : int =
+    int_of_float (Float.round (float_of_int n *. 0.618033988749895))
+
+  let recursive ?(scale = golden_ratio_scale)
+      (combine : 'a t list -> 'a t)
+      (base : 'a t list)
+      (rec_cases : ('a t -> 'a t) list) : 'a t =
+    match base with
+    | [] -> failwith "QCheck2.Gen.recursive called with an empty list of base cases"
+    | _ ->
+      sized (fix (fun self n ->
+          if n <= 1
+          then combine base
+          else
+            (* Clamping to [n - 1] keeps the recursion well-founded whatever
+               [scale] returns. *)
+            let smaller = delay (fun () -> self (max 0 (min (n - 1) (scale n)))) in
+            combine (base @ List.map (fun rec_case -> rec_case smaller) rec_cases)))
+
   let generate ?(rand=RS.make_self_init()) ~(n : int) (gen : 'a t) : 'a list =
     list_repeat n gen rand |> Tree.root
 

src/core/QCheck2.mli

@@ -856,6 +856,50 @@ module Gen : sig
       in a generator.
       @since 0.17 *)
 
+  val recursive :
+    ?scale:(int -> int) ->
+    ('a t list -> 'a t) ->
+    'a t list ->
+    ('a t -> 'a t) list ->
+    'a t
+  (** [recursive combine base rec_cases] builds a generator for a recursive
+      type out of its non-recursive cases [base] and its recursive cases
+      [rec_cases], combined with [combine] - typically {!oneof}, or
+      {!oneof_weighted} composed with a weighting function.
+
+      A size is drawn with {!val:sized}, and every generator in [rec_cases] is
+      handed a generator for the same type at a smaller size. The size is
+      multiplied by the reciprocal of the golden ratio (approximately [0.618])
+      at each level, so the expected depth grows with the drawn size instead of
+      being bounded by a fixed division schedule. Once the size reaches [1] only
+      [base] is used, which is what terminates the recursion.
+
+      Compared to writing the recursion by hand with {!val:sized} and {!fix}, this
+      combinator picks the size schedule for you and makes the base cases
+      syntactically distinct from the recursive ones, so a generator cannot
+      accidentally be written without a terminating case.
+
+      Example:
+      {[
+        type tree = Leaf of int | Node of tree * tree
+
+        let tree_gen =
+          QCheck2.Gen.(recursive oneof
+                         [ map (fun i -> Leaf i) nat ]
+                         [ (fun self -> map2 (fun l r -> Node (l, r)) self self) ])
+      ]}
+
+      Shrinks on the size first, then on the selected cases.
+
+      @param scale how the size is reduced at each level, [0.618] times the
+      size by default. Its result is clamped to the range [\[0, n - 1\]], so a
+      [scale] that fails to decrease cannot make generation diverge.
+
+      @raise Failure if [base] is empty, since the recursion could then never
+      stop.
+
+      @since 0.92 *)
+
   (** {2:composing_generators Composing generators}
 
       QCheck generators compose well: it means one can easily craft generators for new values

test/core/QCheck2_unit_tests.ml

@@ -583,10 +583,75 @@ module Gen = struct
     let b = nb > 400 && nb < 600 in
     Alcotest.(check bool) "Gen.option produces around 50% of Some" b true
 
+  type tree = Leaf of int | Node of tree * tree
+
+  let tree_gen =
+    Gen.(recursive oneof
+           [ map (fun i -> Leaf i) nat ]
+           [ (fun self -> map2 (fun l r -> Node (l, r)) self self) ])
+
+  let rec tree_depth = function
+    | Leaf _ -> 1
+    | Node (l, r) -> 1 + max (tree_depth l) (tree_depth r)
+
+  let sample_depths ?(count = 200) ~seed gen =
+    let rand = rand_init seed in
+    List.init count (fun _ -> tree_depth (Gen.generate1 ~rand gen))
+
+  let test_gen_recursive_terminates () =
+    let depths = sample_depths ~seed:1234 tree_gen in
+    let max_depth = List.fold_left max 0 depths in
+    (* [nat] draws at most 9999 and the size is multiplied by 0.618 per level,
+       so no sample can be deeper than log(9999) / log(1/0.618) ~ 20 levels. *)
+    Alcotest.(check bool)
+      "Gen.recursive bounds the depth by the golden ratio schedule"
+      true (max_depth <= 25);
+    Alcotest.(check bool)
+      "Gen.recursive actually uses its recursive cases"
+      true (max_depth > 1)
+
+  let test_gen_recursive_requires_base_case () =
+    Alcotest.check_raises
+      "Gen.recursive rejects an empty list of base cases"
+      (Failure "QCheck2.Gen.recursive called with an empty list of base cases")
+      (fun () -> ignore (Gen.recursive Gen.oneof [] [ (fun self -> self) ]))
+
+  let test_gen_recursive_scale_cannot_diverge () =
+    (* A [scale] that grows the size is clamped to [n - 1], so the recursion
+       still terminates - here on a linear structure, to keep it cheap. *)
+    let list_gen =
+      Gen.(recursive ~scale:(fun n -> n * 100) oneof
+             [ pure [] ]
+             [ (fun self -> map2 (fun x xs -> x :: xs) nat self) ])
+    in
+    let rand = rand_init 99 in
+    let lengths = List.init 20 (fun _ -> List.length (Gen.generate1 ~rand list_gen)) in
+    Alcotest.(check bool)
+      "Gen.recursive clamps a non-decreasing scale"
+      true (List.for_all (fun n -> n <= 10_000) lengths)
+
+  let test_gen_recursive_shrinks_to_base_case () =
+    let rand = rand_init 7 in
+    let rec find_recursive_tree remaining =
+      if remaining = 0
+      then Alcotest.fail "Gen.recursive produced no recursive tree in 100 tries"
+      else
+        let t = Gen.generate_tree ~rand tree_gen in
+        if tree_depth (Tree.root t) > 1 then t else find_recursive_tree (remaining - 1)
+    in
+    let path = repeated_success (find_recursive_tree 100) in
+    Alcotest.(check bool)
+      "Gen.recursive shrinks down to a base case"
+      true (List.exists (fun v -> tree_depth v = 1) path)
+
   let tests =
     ("Gen", Alcotest.[
          test_case "option with default ratio" `Quick test_gen_option_default;
          test_case "option with custom ratio" `Quick test_gen_option_custom;
+         test_case "recursive terminates" `Quick test_gen_recursive_terminates;
+         test_case "recursive requires a base case" `Quick test_gen_recursive_requires_base_case;
+         test_case "recursive clamps its scale" `Quick test_gen_recursive_scale_cannot_diverge;
+         test_case "recursive shrinks to a base case" `Quick test_gen_recursive_shrinks_to_base_case;
        ])
 end