package base_quickcheck

  1. Overview
  2. Docs
Randomized testing framework, designed for compatibility with Base

Install 

dune-project
 Dependency

github.com MIT License Edit opam file Versions (9)

Authors

  1. J
    Jane Street Group, LLC

Maintainers

  1. J
    Jane Street developers

Sources

v0.14.1.tar.gz
sha256=b69a18bf0149e3b553ada9af5258681000948bfb7b6646fee66aa462b507b058
md5=d04738d4499e256b752bc40fcdb9730d

doc/src/ppx_quickcheck_expander/environment.ml.html

Source file environment.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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
open! Import

type 'a or_raise =
  | Ok of 'a
  | Error of { fail : 'a. loc:location -> 'a }

type t = (string, expression or_raise, String.comparator_witness) Map.t

let empty = Map.empty (module String)

let lookup t ~loc ~tyvar =
  match Map.find t tyvar with
  | Some (Ok expr) -> expr
  | Some (Error { fail }) -> fail ~loc
  | None -> invalid ~loc "unbound type variable: '%s" tyvar
;;

let of_alist ~loc alist =
  match Map.of_alist (module String) alist with
  | `Ok t -> t
  | `Duplicate_key name -> invalid ~loc "duplicate type parameter: '%s" name
;;

let create ~loc ~prefix param_list =
  let pat_list, alist =
    List.map param_list ~f:(fun ((core_type, _) as param) ->
      let loc = core_type.ptyp_loc in
      let name = get_type_param_name param in
      let pat, expr = gensym prefix loc in
      pat, (name.txt, Ok expr))
    |> List.unzip
  in
  let t = of_alist ~loc alist in
  pat_list, t
;;

let variance_error ~loc ~tyvar ~actual ~expect =
  invalid
    ~loc
    "misuse of type variable '%s: would confuse %s with %s in generated code; could be \
     due to a missing or incorrect covariance/contravariance annotation"
    tyvar
    actual
    expect
;;

let create_with_variance ~loc ~covariant ~contravariant param_list =
  let pat_list, by_variance_list =
    List.map param_list ~f:(fun ((core_type, (variance, injectivity)) as param) ->
      let loc = core_type.ptyp_loc in
      let name = get_type_param_name param in
      match (variance, injectivity) with
      | ((NoVariance | Covariant), NoInjectivity) ->
        let pat, expr = gensym covariant loc in
        pat, `Covariant (name.txt, expr)
      | (Contravariant, NoInjectivity) ->
        let pat, expr = gensym contravariant loc in
        pat, `Contravariant (name.txt, expr)
      | (_, Injective) -> Location.raise_errorf ~loc "Injective type parameters aren't supported.")
    |> List.unzip
  in
  let covariant_t =
    List.map by_variance_list ~f:(function
      | `Covariant (tyvar, expr) -> tyvar, Ok expr
      | `Contravariant (tyvar, _) ->
        let fail ~loc =
          variance_error ~loc ~tyvar ~expect:covariant ~actual:contravariant
        in
        tyvar, Error { fail })
    |> of_alist ~loc
  in
  let contravariant_t =
    List.map by_variance_list ~f:(function
      | `Contravariant (tyvar, expr) -> tyvar, Ok expr
      | `Covariant (tyvar, _) ->
        let fail ~loc =
          variance_error ~loc ~tyvar ~expect:contravariant ~actual:covariant
        in
        tyvar, Error { fail })
    |> of_alist ~loc
  in
  pat_list, `Covariant covariant_t, `Contravariant contravariant_t
;;