
open Format
open Gmp

type t = Creal.t * float

let binop cf ff (c1,f1) (c2,f2) = (cf c1 c2, ff f1 f2)
let unop cf ff (c,f) = (cf c, ff f)

let add = binop Creal.add (+.)
let sub = binop Creal.sub (-.)
let mul = binop Creal.mul ( *.)
let div = binop Creal.div (/.)

let neg = unop Creal.neg (fun x -> -. x)
let inv = unop Creal.inv (fun x -> 1.0 /. x)
let sqrt = unop Creal.sqrt sqrt
let abs = unop Creal.abs abs_float

let ln = unop Creal.ln log
let exp = unop Creal.exp exp
let pow = binop Creal.pow ( ** )
let pow_int (c,f) n = (Creal.pow_int c n, f ** (float n))

let sin = unop Creal.sin sin
let cos = unop Creal.cos cos
let tan = unop Creal.tan tan
let arcsin = unop Creal.arcsin asin
let arccos = unop Creal.arccos acos
let arctan = unop Creal.arctan atan
let arctan_reciproqual n = (Creal.arctan_reciproqual n, atan (1.0 /. float n))

let sinh = unop Creal.sinh sinh
let cosh = unop Creal.cosh cosh
let tanh = unop Creal.tanh tanh

let zero = (Creal.zero, 0.0)
let one = (Creal.one, 1.0)
let two = (Creal.two, 2.0)

let e = (Creal.e, 2.71828182845904523536)
let pi = (Creal.pi, 3.14159265358979323846)
let pi_over_2 = (Creal.half_pi, 1.57079632679489661923)

let cmp (c1,f1) (c2,f2) = 
  let cmpf = compare f1 f2 in
  let cmpc = Creal.rel_cmp 50 c1 c2 in
  if cmpc <> cmpf then begin
    eprintf "comparisons differ: exact=%d  float=%d\n" cmpc cmpf;
    flush stderr
  end;
  cmpc

let of_z z = (Creal.of_z z,Z.float_from z)
let of_q q = (Creal.of_q q, Q.float_from q)
let of_float f = (Creal.of_float f, f)
let of_int n = (Creal.of_int n, float n)
let of_string s = (Creal.of_string s, float_of_string s)

let to_q (c,_) = Creal.to_q c
let to_float (c,_) = Creal.to_float c

(*s Pretty-print *)

let precision = ref 50

let set_precision = (:=) precision

let to_string (c,f) =
  let cf = Creal.of_float f in
  sprintf "exact = %s\nfp    = %s\ndelta = %s" 
  (Creal.to_string c !precision) (Creal.to_string cf !precision) 
    (Creal.to_string (Creal.sub c cf) !precision)

let pp fmt x = fprintf fmt "@[%s@]" (to_string x)

module Infixes = struct
  let (+) = add
  let (-) = sub
  let ( * ) = mul
  let (/) = div
end
