Bounded values experiment

bound.ml

(* Experimenting with different ideas for convenience additions to BatBounded *)

module type S = sig
  type base_t
  type t
  val make : base_t -> t
  val bind : (base_t -> t) -> t -> t
  val map2 : (base_t -> base_t -> base_t) -> t -> t -> t
end

module type S_numeric = sig
  include S
  val add : base_t -> base_t -> base_t
  val sub : base_t -> base_t -> base_t
  val mul : base_t -> base_t -> base_t
  val div : base_t -> base_t -> base_t
end

module type O = sig
  type base_t
  type t
  type u = private t
  val make : base_t -> u
  val map2 : (base_t -> base_t -> base_t) -> u -> u -> u
end

module type O_numeric = sig
  include O
  val ( + ) : u -> u -> u
  val ( - ) : u -> u -> u
  val ( * ) : u -> u -> u
  val ( / ) : u -> u -> u
end

module Make(M : S) : O 
  with type base_t = M.base_t
  with type t = M.t
  with type u = private M.t
= struct
  type base_t = M.base_t
  type t = M.t
  type u = t
  let make x = M.make x
  let map2 f a b = M.bind make (M.map2 f a b)
end

module MakeNumeric(M : S_numeric) : O_numeric
  with type base_t = M.base_t
  with type t = M.t
  with type u = private M.t
= struct
  include Make(M)
  let ( + ) = map2 M.add
  let ( - ) = map2 M.sub
  let ( * ) = map2 M.mul
  let ( / ) = map2 M.div
end

module Base = struct
  type base_t = int
  type t = base_t option
  let make x = if x < 10 && x > 0 then Some x else None
  let bind f x =
    match x with
    | None -> None
    | Some x -> f x
  let map2 f a b =
    match a, b with
    | None, _
    | _, None -> None
    | Some x, Some y -> Some (f x y)
  let add = ( + )
  let sub = ( - )
  let mul = ( * )
  let div = ( / )
end

module BaseFloat = struct
  type base_t = float
  type t = base_t
  let make x = if x < 10.0 && x > 0.0 then x else nan
  let bind f x = f x
  let map2 f a b = f a b
  let add = ( +. )
  let sub = ( -. )
  let mul = ( *. )
  let div = ( /. )
end

module I10 = Make(Base)
module N10 = MakeNumeric(Base)
module F10 = MakeNumeric(BaseFloat)