OCaml Modular Programming

algebra.ml

module type BrokenRing = sig
  type t
  val zero : t
  val one : t
  val ( + ) : t -> t -> t
  val ( ~- ) : t -> t
  val ( * ) : t -> t -> t
  val to_string : t -> string
end

module type BrokenField = sig
  include BrokenRing
  val ( / ) : t -> t -> t
end

module type Ring = sig
  include BrokenRing
  val of_int : int -> t
end

module type Field = sig
  include BrokenField
  val of_int : int -> t
end

module type Impl = BrokenField

module Int = struct
  type t = int
  let zero = 0
  let one = 1
  let ( + ) = ( + )
  let ( ~- ) = ( ~- )
  let ( * ) = ( * )
  let ( / ) = ( / )
  let to_string = string_of_int
end

module Float = struct
  type t = float
  let zero = 0.
  let one = 1.
  let ( + ) = ( +. )
  let ( ~- ) = ( ~-. )
  let ( * ) = ( *. )
  let ( / ) = ( /. )
  let to_string = string_of_float
end

module AddOfInt (M : BrokenField) = struct
  include M
  let of_int n : M.t =
    let rec f n x =
      if n = 0 then x
      else if n < 0 then f (Stdlib.( + ) n 1) (M.( + ) x @@ M.( ~- ) M.one)
      else f (Stdlib.( - ) n 1) M.(x + M.one)
    in
    f n M.(one + ~- one)
end

module MakeRational (M : BrokenField) : BrokenField = struct
  type t = M.t * M.t
  let zero = M.(zero, zero)
  let one = M.(one, one)
  let ( + ) (a, b) (c, d) = M.((a * d + c * b), b * d)
  let ( ~- ) (a, b) = M.(~- a, b)
  let ( / ) (a, b) (c, d) = M.(a * d, b * c)
  let ( * ) (a, b) (c, d) = M.(a * c, b * d)
  let to_string (a, b) = M.(to_string a ^ "/" ^ to_string b)
end

module IntRing : Ring = AddOfInt(Int)
module IntField : Field = AddOfInt(Int)
module FloatRing : Ring = AddOfInt(Float)
module FloatField : Field = AddOfInt(Float)
module IntRational : Field = AddOfInt(MakeRational(Int))
module FloatRational : Field = AddOfInt(MakeRational(Float))

let i = IntRational.(of_int 1 / of_int 2)
let f = FloatRational.(of_int 1 / of_int 2)

module type Ring = sig
  type t
  val zero : t
  val one : t
  val ( + ) : t -> t -> t
  val ( ~- ) : t -> t
  val ( * ) : t -> t -> t
  val to_string : t -> string
  val of_int : int -> t
end

module type Field = sig
  include Ring
  val ( / ) : t -> t -> t
end

module Int = struct
  type t = int
  let zero = 0
  let one = 1
  let ( + ) = ( + )
  let ( ~- ) = ( ~- )
  let ( * ) = ( * )
  let ( / ) = ( / )
  let to_string = string_of_int
  let of_int n = n
end

module Float = struct
  type t = float
  let zero = 0.
  let one = 1.
  let ( + ) = ( +. )
  let ( ~- ) = ( ~-. )
  let ( * ) = ( *. )
  let ( / ) = ( /. )
  let to_string = string_of_float
  let of_int n = float_of_int n
end

module MakeRational (M : Field) : Field = struct
  type t = M.t * M.t
  let zero = M.zero, M.zero
  let one = M.one, M.one
  let ( + ) (a, b) (c, d) = (M.( + ) (M.( * ) a d) (M.( * ) c b), M.( * ) b d)
  let ( ~- ) (a, b) = (M.( ~- ) a, b)
  let ( / ) (a, b) (c, d) = (M.( * ) a d, M.( * ) b c)
  let ( * ) (a, b) (c, d) = (M.( * ) a c, M.( * ) b d)
  let to_string (a, b) = M.to_string a ^ "/" ^ M.to_string b
  let of_int n = (M.of_int n, M.one)
end

module IntRing : Ring = Int
module IntField : Field = Int
module FloatRing : Ring = Float
module FloatField :Field = Float
module IntRational : Field = MakeRational(Int)
module FloatRational : Field = MakeRational(Float)