package goblint

  1. Overview
  2. Docs
package goblint
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file gobQCheck.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
(** {!QCheck} extensions. *)

open QCheck

let shrink arb = BatOption.default Shrink.nil arb.shrink

module Gen =
struct
  let sequence (gens: 'a Gen.t list): 'a list Gen.t =
    let open Gen in
    let f gen acc = acc >>= (fun xs -> gen >|= (fun x -> x :: xs)) in
    List.fold_right f gens (return [])
end

module Iter =
struct
  let of_gen ~n gen = QCheck.Gen.generate ~n gen |> Iter.of_list

  let of_arbitrary ~n arb = of_gen ~n (gen arb)
end

module Shrink =
struct
  let sequence (shrinks: 'a Shrink.t list) (xs: 'a list) =
    let open QCheck.Iter in
    BatList.combine xs shrinks |>
    BatList.fold_lefti (fun acc i (x, shrink) ->
        let modify_ith y = BatList.modify_at i (fun _ -> y) xs in
        acc <+> (shrink x >|= modify_ith)
      ) empty
end

module Arbitrary =
struct
  let int64: int64 arbitrary =
    (* https://github.com/c-cube/qcheck/blob/e2c27723bbffd85b992355f91e2e2ba7dcd04f43/src/QCheck.ml#L330-L337 *)
    (* only divisions are fast enough *)
    let shrink x yield =
      let y = ref x in
      (* try some divisors *)
      while !y <> 0L do y := Int64.div !y 2L; yield !y; done; (* fast path *)
      ()
    in
    set_shrink shrink int64

  let big_int: Z.t arbitrary =
    let shrink x yield =
      let y = ref x in
      let two_big_int = Z.of_int 2 in
      while not (Z.equal !y Z.zero) do y := Z.ediv !y two_big_int; yield !y; done;
      ()
    in
    set_print Z.to_string @@ set_shrink shrink @@ QCheck.map Z.of_int64 int64

  let sequence (arbs: 'a arbitrary list): 'a list arbitrary =
    let gens = List.map gen arbs in
    let shrinks = List.map shrink arbs in
    make ~shrink:(Shrink.sequence shrinks) (Gen.sequence gens)
end
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct