(* All the code *) module type DivAlgebra = sig type kind val conj : kind -> kind val zero : kind val one : kind val zeroQ : kind -> bool val (+) : kind -> kind -> kind val (-) : kind -> kind -> kind val ( * ) : kind -> kind -> kind val inv : kind -> kind val str : kind -> string end;; module BareReals = struct type kind = float let conj x = x let zero = 0. let one = 1. let zeroQ x = (abs_float x) < 1.e-10 let (+) = (+.) let (-) = (-.) let ( * ) = ( *.) let inv x = 1. /. x let str = string_of_float end;; module G = functor (Alg: DivAlgebra) -> struct open Alg type kind = {r: Alg.kind; i: Alg.kind} let conj x = {r = conj x.r; i = zero - x.i} and zero = {r = zero; i = zero} and one = {r = one; i = zero} and zeroQ x = zeroQ x.r & zeroQ x.i and (+) x y = {r = x.r + y.r; i = x.i + y.i} and (-) x y = {r = x.r - y.r; i = x.i - y.i} and ( * ) x y = {r = x.r * y.r - (conj y.i) * x.i; i = y.i * x.r + x.i * (conj y.r)} and inv x = let d = inv (x.r * (conj x.r) + x.i * (conj x.i)) in {r = d * (conj x.r); i = zero - d * x.i} and str x = str x.r ^ ", " ^ str x.i end;; module Reals = (BareReals : DivAlgebra);; module Quaternion = G(G(Reals));; let open Quaternion in str (one+one); (* yields - : string = "2.,0.,0.,0." *)