(*
** Course: Concepts of Programming Languages (BU CAS CS 320)
** Semester: Summer I, 2009
** Instructor: Hongwei Xi (hwxi AT cs DOT bu DOT edu)
*)

//
// Assignment 2, Exercise 5
//

(* ****** ****** *)

staload _(*anonymous*) = "prelude/DATS/reference.dats"

(* ****** ****** *)

abstype rat_t

extern fun rat_numer (r: rat_t): int
extern fun rat_denom (r: rat_t): int

extern fun fprint_rat (out: FILEref, r: rat_t): void

extern fun ratgen_get (): rat_t
extern fun ratgen_reset (): void

(* ****** ****** *)

local

typedef rat = '{
  numer= int, denom= int
} (* end of [rat] *)

assume rat_t = rat

val theNumer = ref<int> (1)
val theDenom = ref<int> (1)

in

implement rat_numer (r) = r.numer
implement rat_denom (r) = r.denom

implement fprint_rat (out, r) =
  fprintf (out, "%i/%i", @(r.numer, r.denom))
// end of [fprint_rat]

implement ratgen_get () = let
  val p = !theNumer and q = !theDenom
  val () = if q = 1 then begin
    !theNumer := 1; !theDenom := p + q
  end else begin
    !theNumer := p + 1; !theDenom := q - 1
  end // end of [if]
  val gcd = gcd_int_int (p, q)
in
  if gcd > 1 then ratgen_get () else '{ numer= p, denom= q }
end (* end of [ratgen_get] *)

implement ratgen_reset () = (!theNumer := 1; !theDenom := 1)

end // end of [local]

(* ****** ****** *)

macdef _1 = int64_of_int (1)
macdef _2 = int64_of_int (2)
macdef _4 = int64_of_int (4)

fun int64_sqrt (x: int64): int64 =
  if x >= _2 then let
    val r = _2 * int64_sqrt (x / _4); val r1 = r + _1
  in
    if r1 * r1 <= x then r1 else r
  end else x (* x = 0 or 1 *)
// end of [int64_sqrt]

fun int64_is_square (x: int64): bool = let
  val x_rt = int64_sqrt (x) in if x = x_rt * x_rt then true else false
end // end of [int64_is_square]

(* ****** ****** *)

//
// the function tests whether [x] can be the area of a right triangle
// whose one side equal [r]
//
fun cong_test (x: int, r: rat_t): bool = let
  #define i64 int64_of_int
  val x = i64 x
  val p = rat_numer (r) and q = rat_denom (r)
  val p = i64 p and q = i64 q
  val P = _2 * x * q and Q = p
  val p2 = p * p and q2 = q * q
  val P2 = P * P and Q2 = Q * Q
  val S2 = p2 * Q2 + P2 * q2
  val ans = int64_is_square (S2)
in
  ans
end // end of [cong_test]

(* ****** ****** *)

#define :: list0_cons
#define nil list0_nil

typedef congnum = '(int, rat_t)
typedef congnumlst = list0 congnum

fun congnumlst_insert
  (xrs: congnumlst, xr: congnum): congnumlst =
  case+ xrs of
  | xr1 :: xrs1 => if xr1.0 <= xr.0 then
      xr1 :: congnumlst_insert (xrs1, xr) else xr :: xrs
    // end of [::]
  | nil () => xr :: nil ()
// end of [congnumlst_insert]

fun congnumlst_size
  (xrs: congnumlst): int = case+ xrs of
  | xr :: xrs => loop (xr.0, xrs, 1) where {
      fun loop (x: int, xrs: congnumlst, n: int): int =
        case+ xrs of
        | xr1 :: xrs1 => let
            val x1 = xr1.0 in
            if (x < x1) then loop (x1, xrs1, n + 1) else loop (x, xrs1, n)
          end // end of [::]
        | nil () => n
    } // end of [::]
  | nil () => 0
// end of [congnumlst_size]

(* ****** ****** *)

extern fun search_loop (xs: list0 int, n: int): congnumlst

(*
// the congnumlst returned by [search_loop (xs, n)] should
// contain at least [n] distinct elements of the type [congnum]
*)
implement search_loop (xs, n) = (* please fill in your code *)

(* ****** ****** *)

#define NCONG 15

implement main () = let
  // from_10_to_50 = 10, 11, ..., 47, 48, 49
  val from_10_to_50 = loop (10, 50) where {
    fun loop (lb: int, ub: int): list0 int =
      if lb < ub then lb :: loop (lb + 1, ub) else nil ()
    // end of [loop]
  }
  val res = search_loop (from_10_to_50, NCONG)
  val () = loop (res) where {
    fun loop (xrs: congnumlst): void =
      case+ xrs of
      | xr :: xrs => let
          val '(x, r) = xr
          val () = print (x)
          val () = print "("
          val () = fprint_rat (stdout_ref, r)
          val () = print ")"
          val () = print_newline ()
        in
          loop (xrs)
        end // end of [::]
      | nil () => ()
  } // end of [val]
in
  // empty
end // end of [main]

(* ****** ****** *)

(* end of [assgn2ex5.dats] *)