(* All the code with array input *)

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
   val inp : float array -> kind
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
   let inp x = x.(0)
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
   and inp x = let hl = (Array.length x)/2 in 
         {r = inp (Array.sub x 0 hl);
          i = inp (Array.sub x hl hl)}
end;;

module Reals = (BareReals : DivAlgebra);;

module Quaternion = G(G(Reals));;

Quaternion.str (Quaternion.inp [|0.; 1.; 2.; 3.|]);;
(* yields - : string = "0., 1., 2., 3." *)

let open Quaternion in let a = inp [|0.; 0.; 1.; 0.|] in str (a*a);;
(* Yields - : string = "-1., 0., 0., 0." *)