(* rational.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Support for rational numbers.
 *)

signature RATIONAL =
  sig

    eqtype rat

    val zero : rat

    val explode : rat -> {sign : int, num : IntInf.int, denom : IntInf.int}

    val ~ : rat -> rat
    val + : rat * rat -> rat
    val - : rat * rat -> rat
    val * : rat * rat -> rat
    val div : rat * rat -> rat

(*
    val min : rat * rat -> rat
    val max : rat * rat -> rat
*)
    val abs : rat -> rat

    val sign : rat -> int
    val sameSign : rat * rat -> bool

(*
    val > : rat * rat -> bool
    val >= : rat * rat -> bool
    val < : rat * rat -> bool
    val <= : rat * rat -> bool
*)

    val compare : rat * rat -> order

    val / : LargeInt.int * LargeInt.int -> rat

    val fromInt : int -> rat
    val fromLargeInt : LargeInt.int -> rat

    val toString : rat -> string

    val toReal : rat -> real

  end

structure Rational :> RATIONAL =
  struct

    structure II = IntInf

  (* invariants:
   *   denom > 0
   *   gcd(num, denom) = 1
   *)
    datatype rat = R of {num : II.int, denom : II.int}

    fun explode (R{num, denom}) =
	  if (num < 0)
	    then {sign = ~1, num = ~num, denom = denom}
	  else if (num = 0)
	    then {sign = 0, num = 0, denom = 0}
	    else {sign = 1, num = num, denom = denom}

    val zero = R{num=0, denom=1}

    fun gcd (a : II.int, 0) = a
      | gcd (a, b) = if (a > b)
	  then gcd(a-b, b)
	  else gcd(a, b-a)

    fun mkRat (0, _) = zero
      | mkRat (n, 1) = R{num=n, denom=1}
      | mkRat (num, denom) = let
	  val d = gcd(II.abs num, denom)
	  in
	    R{num = num div d, denom = denom div d}
	  end

    fun neg (R{num, denom}) = R{num = ~num, denom = denom}

    fun add (R{num=n1, denom=d1}, R{num=n2, denom=d2}) = let
	  val d = gcd(d1, d2)
	  val a1 = d2 div d
	  val a2 = d1 div d
	  val lcm = a1 * d1
	  in
	    mkRat (a1*n1 + a2*n2, lcm)
	  end

    fun sub (R{num=n1, denom=d1}, R{num=n2, denom=d2}) = let
	  val d = gcd(d1, d2)
	  val a1 = d2 div d
	  val a2 = d1 div d
	  val lcm = a1 * d1
	  in
	    mkRat (a1*n1 - a2*n2, lcm)
	  end

    fun mul (R{num=n1, denom=d1}, R{num=n2, denom=d2}) =
	  mkRat (n1*n2, d1*d2)

    fun divide (_, R{num=0, ...}) = raise Div
      | divide (R{num=n1, denom=d1}, R{num=n2, denom=d2}) = let
	  val n = n1 * d2
	  val d = n2 * d1
	  in
	    if (d < 0) then mkRat(~n, ~d) else mkRat(n, d)
	  end

    fun abs (R{num, denom}) = R{num = II.abs num, denom = denom}

    fun sign (R{num, ...}) = II.sign num

    fun sameSign (R{num=n1, ...}, R{num=n2, ...}) = II.sameSign(n1, n2)

    fun compare (R{num=n1, denom=d1}, R{num=n2, denom=d2}) = (
	  case Int.compare(II.sign n1, II.sign n2)
	   of EQUAL =>
		if (d1 = d2)
		  then II.compare(n1, n2)
		  else let
		    val d = gcd(d1, d2)
		    val a1 = d2 div d
		    val a2 = d1 div d
		    in
		      II.compare(a1*n1, a2*n2)
		    end
	    | order => order
	  (* end case *))

(*
    val > : rat * rat -> bool
    val >= : rat * rat -> bool
    val < : rat * rat -> bool
    val <= : rat * rat -> bool

    val min : rat * rat -> rat
    val max : rat * rat -> rat
*)

    fun fromInt n = mkRat(II.fromInt n, 1)
    fun fromLargeInt n = mkRat(n, 1)

    fun toString (R{num, denom = 1}) = II.toString num
      | toString (R{num, denom}) =
	  String.concat[II.toString num, "/", II.toString denom]

    fun toReal (R{num, denom = 1}) = Real.fromLargeInt num
      | toReal (R{num, denom}) = Real.fromLargeInt num / Real.fromLargeInt denom

    fun op / (_, 0) = raise Div
      | op / (a, b) = if (b < 0)
	  then mkRat(~a, ~b)
	  else mkRat(a, b)

  (* bind operators *)
    val ~ : rat -> rat = neg
    val op + : rat * rat -> rat = add
    val op - : rat * rat -> rat = sub
    val op * : rat * rat -> rat = mul
    val op div : rat * rat -> rat = divide
(*
    val > : rat * rat -> bool
    val >= : rat * rat -> bool
    val < : rat * rat -> bool
    val <= : rat * rat -> bool
*)

  end