You could use a functor which requires a module implementing a signature that contains those 3 functions and a type. Similar to what is done with Set or Map.
module type My_Dim =
sig
type t [@@deriving sexp]
val (+): t -> t -> t
val (-): t -> t -> t
val min: t -> t -> t
val max: t -> t -> t
end
module Rect (D: My_Dim) = struct
type t = {
x0: D.t;
y0: D.t;
x1: D.t;
y1: D.t;
} [@@deriving sexp];;
let min_x (r: t) = D.min r.x0 r.x1;;
let min_y (r: t) = D.min r.y0 r.y1;;
let width (r: t) = D.((max r.x0 r.x1) - (min r.x0 r.x1));;
let height (r: t) = D.((max r.y0 r.y1) - (min r.y0 r.y1));;
(*
let map (fx: 'a -> 'b) (fy: 'a -> 'b) (r: 'a t ) : 'b t =
{ x0 = fx r.x0;
x1 = fx r.x1;
y0 = fy r.y0;
y1 = fy r.y1; }
*)
end
I need some help with the commented out function. The idea I want to express is:
given D: My_Dim, D2: My_Dim, fx: D.t → D2.t, fy: D.t → D2.t, r: D Rect.t
we can produce a D2 Rect.t
module type My_Dim =
sig
type t [@@deriving sexp]
val (+): t -> t -> t
val (-): t -> t -> t
val min: t -> t -> t
val max: t -> t -> t
end
module Rect (D: My_Dim) = struct
type t = {
x0: D.t;
y0: D.t;
x1: D.t;
y1: D.t;
} [@@deriving sexp];;
let min_x (r: t) = D.min r.x0 r.x1;;
let min_y (r: t) = D.min r.y0 r.y1;;
let width (r: t) = D.((max r.x0 r.x1) - (min r.x0 r.x1));;
let height (r: t) = D.((max r.y0 r.y1) - (min r.y0 r.y1));;
end
module RectConv (D1: My_Dim) (D2: My_Dim) = struct
let map (fx: D1.t -> D2.t) (fy: D1.t -> D2.t) (r: Rect(D1).t ) : Rect(D2).t =
{ x0 = fx r.x0;
x1 = fx r.x1;
y0 = fy r.y0;
y1 = fy r.y1; }
end
One possibility is to pass first-class modules as witnesses:
module type Dim = sig
type t
val ( + ) : t -> t -> t
val ( - ) : t -> t -> t
val min : t -> t -> t
val max : t -> t -> t
end
type 'a dim = (module Dim with type t = 'a)
module Dim = struct
let add (type a) ((module D) : a dim) x y : a = D.(x + y)
let sub (type a) ((module D) : a dim) x y : a = D.(x - y)
let min (type a) ((module D) : a dim) x y : a = D.min x y
let max (type a) ((module D) : a dim) x y : a = D.max x y
end
type 'a rect = { x0 : 'a; y0 : 'a; x1 : 'a; y1 : 'a }
let min_x d r = Dim.min d r.x0 r.x1
let max_x d r = Dim.max d r.x0 r.x1
let min_y d r = Dim.min d r.y0 r.y1
let max_y d r = Dim.max d r.y0 r.y1
let width (type a) (d : a dim) (r : a rect) =
let open (val d) in
max_x d r - min_x d r
let height d r = Dim.sub d (max_y d r) (min_y d r)
let map (d1 : 'a dim) (d2 : 'b dim) (f : 'a -> 'b) r =
{ x0 = f r.x0; y0 = f r.y0; x1 = f r.x1; y1 = f r.y1 }
module Int = struct
include Int
let ( + ) = ( + )
let ( - ) = ( - )
end
module Float = struct
include Float
let ( + ) = ( +. )
let ( - ) = ( -. )
end
let int : int dim = (module Int)
let float : float dim = (module Float)
let fi = map int float Float.of_int { x0 = 0; y0 = 1; x1 = 2; y1 = 3 }
if you move a type out of the Rect functor then you can get rid of RectConv?
type 'a rect = {
x0 : 'a;
y0 : 'a;
x1 : 'a;
y1 : 'a;
}
module type My_Dim = sig
type t
val ( + ) : t -> t -> t
val ( - ) : t -> t -> t
val min : t -> t -> t
val max : t -> t -> t
end
module Rect (D : My_Dim) = struct
type t = D.t rect
let min_x (r : t) = D.min r.x0 r.x1
let min_y (r : t) = D.min r.y0 r.y1
let width (r : t) = D.(max r.x0 r.x1 - min r.x0 r.x1)
let height (r : t) = D.(max r.y0 r.y1 - min r.y0 r.y1)
end
let map fx fy r = { x0 = fx r.x0; x1 = fx r.x1; y0 = fy r.y0; y1 = fy r.y1 }