package hardcaml

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

Source file with_valid.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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
open Base

type ('a, 'b) t2 = ('a, 'b) Comb.with_valid2 =
  { valid : 'a
  ; value : 'b
  }
[@@deriving sexp, bin_io]

module T = struct
  type 'a t = ('a, 'a) t2 [@@deriving sexp, bin_io]

  let map x ~f = { valid = f x.valid; value = f x.value }
  let map2 x y ~f = { valid = f x.valid y.valid; value = f x.value y.value }

  let iter x ~f =
    f x.valid;
    f x.value
  ;;

  let iter2 x y ~f =
    f x.valid y.valid;
    f x.value y.value
  ;;

  let to_list { valid; value } = [ valid; value ]
  let map_valid { valid; value } ~f = { valid = f valid; value }
  let map_value { valid; value } ~f = { valid; value = f value }
end

include T

module Fields = struct
  module Make (M : Interface.Pre) = struct
    module Pre = struct
      type nonrec 'a t = 'a t M.t [@@deriving sexp_of]

      let map t ~f = M.map ~f:(map ~f) t
      let iter (t : 'a t) ~(f : 'a -> unit) = M.iter ~f:(iter ~f) t
      let map2 a b ~f = M.map2 a b ~f:(map2 ~f)
      let iter2 a b ~f = M.iter2 a b ~f:(iter2 ~f)

      let port_names_and_widths =
        M.map M.port_names_and_widths ~f:(fun (n, w) ->
          { value = n ^ "$value", w; valid = n ^ "$valid", 1 })
      ;;

      let to_list t = M.map t ~f:to_list |> M.to_list |> List.concat
    end

    include Pre
    include Interface.Make (Pre)
  end

  module type S = sig
    type 'a value
    type nonrec 'a t = 'a t value

    include Interface.S with type 'a t := 'a t
  end

  module M (X : T1) = struct
    module type S = S with type 'a value := 'a X.t
  end
end

module Wrap = struct
  module Make (M : Interface.Pre) = struct
    module Pre = struct
      type nonrec 'a t = ('a, 'a M.t) t2 [@@deriving sexp_of]

      let map t ~f = { valid = f t.valid; value = M.map ~f t.value }

      let iter (t : 'a t) ~(f : 'a -> unit) =
        f t.valid;
        M.iter ~f t.value
      ;;

      let map2 a b ~f = { valid = f a.valid b.valid; value = M.map2 ~f a.value b.value }

      let iter2 a b ~f =
        f a.valid b.valid;
        M.iter2 ~f a.value b.value
      ;;

      let port_names_and_widths =
        { valid = "valid", 1
        ; value = M.map M.port_names_and_widths ~f:(fun (n, w) -> "value$" ^ n, w)
        }
      ;;

      let to_list t = t.valid :: M.to_list t.value
    end

    include Pre
    include Interface.Make (Pre)
  end

  module M (X : T1) = struct
    type nonrec 'a t = ('a, 'a X.t) t2

    module type S = Interface.S with type 'a t = 'a t
  end

  module type S = sig
    type 'a value

    include Interface.S with type 'a t = ('a, 'a value) t2
  end
end

module Vector (X : sig
    val width : int
  end) =
struct
  type 'a t = 'a T.t

  include Interface.Make (struct
      include T

      let port_names_and_widths = { value = "value", X.width; valid = "valid", 1 }
    end)
end