(*
** 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 4 (Game-of-24)
//

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

// Author: Hongwei Xi (hwxi AT cs DOT bu DOT edu)

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

#include "../../code/BUCASCS320.hats"

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

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

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

staload "assignment2.sats"

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

abstype rat_t

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

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

extern fun rat_make_int (p: int): rat_t
extern fun rat_make_int_int (p: int, q: int): rat_t

extern fun neg_rat (r: rat_t): rat_t
overload ~ with neg_rat

extern fun add_rat_rat (r1: rat_t, r2: rat_t): rat_t
overload + with add_rat_rat

extern fun sub_rat_rat (r1: rat_t, r2: rat_t): rat_t
overload - with sub_rat_rat

extern fun mul_rat_rat (r1: rat_t, r2: rat_t): rat_t
overload * with mul_rat_rat

extern fun div_rat_rat (r1: rat_t, r2: rat_t): rat_t
overload / with div_rat_rat

extern fun rat_is_zero (r: rat_t): bool

extern fun eq_rat_rat (r1: rat_t, r2: rat_t): bool
overload = with eq_rat_rat

extern fun neq_rat_rat (r1: rat_t, r2: rat_t): bool
overload <> with neq_rat_rat

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

local

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

assume rat_t = rat

in

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

implement rat_make_int (p: int) = '{ numer= p, denom= 1}

implement rat_make_int_int (p: int, q: int) =
  if q >= 0 then let
    val n = gcd (p, q) in '{ numer= p/n, denom= q/n }
  end else begin
    rat_make_int_int (~p, ~q)
  end // end of [if]
(* end of [rat_make_int_int] *)    

implement fprint_rat (out, r) = let
  val p = r.numer and q = r.denom in
  if q = 1 then fprint_int (out, p)
           else fprintf (out, "%i/%i", @(p, q))
end // end of [fprint_rat]

implement print_rat (r) = fprint_rat (stdout_ref, r)

implement neg_rat (r) = let
  val p = r.numer and q = r.denom in '{ numer= ~p, denom= q }
end // end of [neg_rat]

implement add_rat_rat (r1, r2) = let
  val p1 = r1.numer and q1 = r1.denom
  val p2 = r2.numer and q2 = r2.denom
in
  rat_make_int_int (p1*q2 + p2*q1, q1*q2)
end (* end of [add_rat_rat] *) 

implement sub_rat_rat (r1, r2) = let
  val p1 = r1.numer and q1 = r1.denom
  val p2 = r2.numer and q2 = r2.denom
in
  rat_make_int_int (p1*q2 - p2*q1, q1*q2)
end (* end of [sub_rat_rat] *) 

implement mul_rat_rat (r1, r2) = let
  val p1 = r1.numer and q1 = r1.denom
  val p2 = r2.numer and q2 = r2.denom
in
  rat_make_int_int (p1*p2, q1*q2)
end (* end of [add_rat_rat] *) 

implement div_rat_rat (r1, r2) = let
  val p1 = r1.numer and q1 = r1.denom
  val p2 = r2.numer and q2 = r2.denom
in
  rat_make_int_int (p1*q2, p2*q1)
end (* end of [add_rat_rat] *) 

implement rat_is_zero (r) = (r.numer = 0)

implement eq_rat_rat (r1, r2) = 
  (r1.numer = r2.numer) andalso (r1.denom = r2.denom)
// end of [eq_rat_rat]

implement neq_rat_rat (r1, r2) = 
  (r1.numer <> r2.numer) orelse (r1.denom <> r2.denom)
// end of [eq_rat_rat]
  
end // end of [local]

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

fun fprint_exp (out: FILEref, e: exp): void =
  case+ e of
  | EXPint i => fprint_int (out, i)
  | EXPadd (e1, e2) => begin
      fprint_string (out, "(");
      fprint_exp (out, e1); fprint_string (out, " + "); fprint_exp (out, e2);
      fprint_string (out, ")")
    end (* end of [EXPadd] *)
  | EXPsub (e1, e2) => begin
      fprint_string (out, "(");
      fprint_exp (out, e1); fprint_string (out, " - "); fprint_exp (out, e2);
      fprint_string (out, ")")
    end (* end of [EXPsub] *)
  | EXPmul (e1, e2) => begin
      fprint_string (out, "(");
      fprint_exp (out, e1); fprint_string (out, " * "); fprint_exp (out, e2);
      fprint_string (out, ")")
    end (* end of [EXPmul] *)
  | EXPdiv (e1, e2) => begin
      fprint_string (out, "(");
      fprint_exp (out, e1); fprint_string (out, " / "); fprint_exp (out, e2);
      fprint_string (out, ")")
    end (* end of [EXPdiv] *)
// end of [fprint_exp]

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

abstype card_t // boxed abstract type

extern fun card_exp (c: card_t): exp
extern fun card_val (c: card_t): rat_t
extern fun card_make_exp_val (e: exp, v: rat_t): card_t

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

local

typedef card = '{
  expr= exp, valu= rat_t
}

assume card_t = card

in // in of [local]

implement card_exp (c) = c.expr
implement card_val (c) = c.valu
implement card_make_exp_val (e, v) = '{ expr= e, valu= v }

end // end of [local]

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

#define i2r rat_make_int

fun card_make_int (i: int): card_t = card_make_exp_val (EXPint i, i2r i)
fun fprint_card (out: FILEref, c: card_t): void = fprint_exp (out, card_exp c)
fun print_card (c: card_t): void = fprint_card (stdout_ref, c)

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

fun add_card_card
  (c1: card_t, c2: card_t): card_t = let
  val e1 = card_exp c1 and v1 = card_val c1
  val e2 = card_exp c2 and v2 = card_val c2
in
  card_make_exp_val (EXPadd (e1, e2), v1 + v2)
end (* end of [add_card_card] *)

fun sub_card_card
  (c1: card_t, c2: card_t): card_t = let
  val e1 = card_exp c1 and v1 = card_val c1
  val e2 = card_exp c2 and v2 = card_val c2
in
  card_make_exp_val (EXPsub (e1, e2), v1 - v2)
end (* end of [sub_card_card] *)

fun mul_card_card
  (c1: card_t, c2: card_t): card_t = let
  val e1 = card_exp c1 and v1 = card_val c1
  val e2 = card_exp c2 and v2 = card_val c2
in
  card_make_exp_val (EXPmul (e1, e2), v1 * v2)
end (* end of [mul_card_card] *)

fun div_card_card
  (c1: card_t, c2: card_t): card_t = let
  val e1 = card_exp c1 and v1 = card_val c1
  val e2 = card_exp c2 and v2 = card_val c2
in
  card_make_exp_val (EXPdiv (e1, e2), v1 / v2)
end (* end of [div_card_card] *)

overload + with add_card_card
overload - with sub_card_card
overload * with mul_card_card
overload / with div_card_card

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

typedef cardlst = list0 card_t

#define :: list0_cons
#define cons list0_cons
#define nil list0_nil

fn combine_card_card (x: card_t, y: card_t): cardlst = let
  val c1 = x + y
  val c2 = x - y and c3 = y - x
  val c4 = x * y
in
  if rat_is_zero (card_val x) then
    c1 :: c2 :: c3 :: c4 :: nil ()
  else if rat_is_zero (card_val y) then
    c1 :: c2 :: c3 :: c4 :: nil ()
  else let
    val c5 = x / y and c6 = y / x in
    c1 :: c2 :: c3 :: c4 :: c5 :: c6 :: nil ()
  end
end // end of [combine_card_card]

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

typedef rat2lst = list0 @(rat_t, rat_t)

fun ismem
  (x0: rat_t, y0: rat_t, xys: rat2lst): bool =
  case+ xys of
  | xy :: xys => begin
      if x0 = xy.0 then 
        (if y0 = xy.1 then true else ismem (x0, y0, xys))
      else ismem (x0, y0, xys)
    end // end of [rp_cons]
  | nil () => false
// end of [ismem]

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

fun cardlst_revapp (xs: cardlst, ys: cardlst): cardlst = list0_reverse_append (xs, ys)

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

typedef cardopt = option0 (card_t)

fun play_main (cs: cardlst, res: rat_t): cardopt = let
  // [fn*]: mutual tail-call optimization
  fn* aux_main (res: rat_t, zs: cardlst, xys: rat2lst): cardopt =
    case- zs of
    | x :: nil () => begin
       if res <> card_val x then option0_none () else option0_some x
      end // end of [cons (_, nil)]
    | x :: y :: zs => aux1 (res, x, nil (), y, nil (), zs, xys)
  // end of [aux_main]

  and aux1 (
      res: rat_t
    , x: card_t, xs: cardlst
    , y: card_t, ys: cardlst
    , zs: cardlst, xys: rat2lst
    ) : cardopt = let
    val test = ismem (card_val x, card_val y, xys)
  in
    if test then aux2 (res, x, xs, y, ys, zs, xys)
            else aux1_ (res, combine_card_card (x, y), x, xs, y, ys, zs, xys)
    // end of [if]
  end (* end of [aux1] *)

  and aux1_ (
      res: rat_t
    , rs: cardlst
    , x: card_t, xs: cardlst
    , y: card_t, ys: cardlst
    , zs: cardlst, xys: rat2lst
    ) : cardopt = begin case+ rs of
    | r :: rs => let
        val ans = aux_main (
          res, cardlst_revapp (xs, cardlst_revapp (ys, r :: zs)), nil ()
        )
      in
        case+ ans of
        | option0_none () => aux1_ (res, rs, x, xs, y, ys, zs, xys) | option0_some _ => ans
      end // end of [::]
    | nil () => aux2 (res, x, xs, y, ys, zs, @(card_val x, card_val y) :: xys)
  end // end of [aux1_]

  and aux2 (
      res: rat_t
    , x: card_t, xs: cardlst
    , y: card_t, ys: cardlst
    , zs: cardlst, xys: rat2lst
    ) : cardopt = begin case+ zs of
    | z :: zs => aux1 (res, x, xs, z, y :: ys, zs, xys) | nil () => (
        case+ cardlst_revapp (ys, y :: nil ()) of
        | x1 :: y1 :: zs1 => aux1 (res, x1, x :: xs, y1, nil (), zs1, xys)
        | _ => option0_none ()
      ) // end of [nil]
  end (* end of [aux2] *)
in
  aux_main (res, cs, nil ())
end // end of [play_main]

val answer = i2r 24

implement play24 (n1, n2, n3, n4) = let
  val c1 = card_make_int n1 and c2 = card_make_int n2
  and c3 = card_make_int n3 and c4 = card_make_int n4
  val cs = c1 :: c2 :: c3 :: c4 :: nil ()
  val ans = play_main (cs, answer)
  val () = printf ("play24 (%i, %i, %i, %i): ", @(n1, n2, n3, n4))
  val () = case+ ans of
    | option0_some c => begin
        print_card c; print " = "; print_rat answer; print_newline ()
      end // end of [option0_some]
    | option0_none () => (print "There is no solution"; print_newline ())
  // end of [val]  
in
  case+ ans of
  | option0_some c => EXPOPTsome (card_exp c) | option0_none () => EXPOPTnone ()
end (* end of [play] *)

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

fun exp_eval (e: exp): rat_t = case+ e of
  | EXPint i => rat_make_int (i)
  | EXPadd (e1, e2) => exp_eval e1 + exp_eval e2
  | EXPsub (e1, e2) => exp_eval e1 - exp_eval e2
  | EXPmul (e1, e2) => exp_eval e1 * exp_eval e2
  | EXPdiv (e1, e2) => exp_eval e1 / exp_eval e2
// end of [exp_eval]

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

extern fun exp_eval_check (e: exp, ans: int): bool
  = "assgn2ex4_exp_eval_check"

implement exp_eval_check (e, ans) = let
  val r = exp_eval (e)
in
  (rat_numer r = ans) andalso (rat_denom r = 1)
end // end of [exp_eval_check]  

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

(*

implement main () = let
  val _ = play24 (5, 5, 7, 11)
  val _ = play24 (5, 7, 7, 11)
  val _ = play24 (10, 10, 4, 4)
  val _ = play24 (13, 13, 1, 7)
  val _ = play24 (3, 3, 8, 8)
  val _ = play24 (7, 7, 11, 11)
in
  // empty
end // end of [main]

*)

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

(* end of [assgn2ex4_solu.dats] *)