(*
 *
 * BU CAS CS 520, F2002
 * Assignment 1
 *
 *)

(* The code was written by Hongwei Xi in September 2002 *)

signature TWENTYFOUR =
  sig
      val play_game: int list * int -> bool
      val play24: int -> int -> int -> int -> bool
  end

structure Twentyfour :> TWENTYFOUR =
  struct
      exception Fatal
     
      fun fatal msg = (print msg; raise Fatal)

      structure R = Rational (Int)

      val padd = 2 and psub = 2 and pmul = 1 and pdiv = 1

      type display = int * string (* priority and expression *)
      type card = R.t * display

      fun v_of_c ((v, _): card): R.t = v

      fun cards_of_ints (ns: int list): card list =
         List.map (fn n => (R.rat (n, 1), (0, Int.toString n))) ns


      fun isRes (r: R.t, (v, _) : card): bool = R.eq (r, v)
      fun isZero ((v, _) : card): bool = R.isZero (v)

      fun show_card ((_, (_, s)): card): unit = print s

      fun card_op (opname: string,
		   (v1, (p1, s1)): card, (v2, (p2, s2)): card): card =
	  case opname of
	      "+" =>
		  let
		      val s1 = if p1 <= padd then s1 else "(" ^ s1 ^ ")"
		      val s2 = if p2 < padd then s2 else "(" ^ s2 ^ ")"
		  in
		      (R.radd (v1, v2), (padd, s1 ^ " + " ^ s2))
		  end
	    | "-" =>
		  let
		      val s1 = if p1 <= psub then s1 else "(" ^ s1 ^ ")"
		      val s2 = if p2 < psub then s2 else "(" ^ s2 ^ ")"
		  in
		      (R.rsub (v1, v2), (psub, s1 ^ " - " ^ s2))
		  end
	    | "*" =>
		  let
		      val s1 = if p1 < pmul then s1 else "(" ^ s1 ^ ")"
		      val s2 = if p2 < pmul then s2 else "(" ^ s2 ^ ")"
		  in
		      (R.rmul (v1, v2), (pmul, s1 ^ " * " ^ s2))
		  end
	    | "/" =>
		  let
		      val s1 = if p1 < pdiv then s1 else "(" ^ s1 ^ ")"
		      val s2 = if p2 < pdiv then s2 else "(" ^ s2 ^ ")"
		  in
		      (R.rdiv (v1, v2), (psub, s1 ^ " / " ^ s2))
		  end
	    | _ => fatal ("card_op: unsupported operation: " ^ opname)

      val rapp = List.revAppend

      infix $

      fun x $ y : card list =
	  let
	      val r1 = card_op ("+", x, y)
	      val r2 = card_op ("-", x, y)
	      val r3 = card_op ("-", y, x)
	      val r4 = card_op ("*", x, y)
	  in
	      if isZero (x) orelse isZero (y) then
		  [r1, r2, r3, r4]
	      else
		  let
		      val r5 = card_op ("/", x, y)
		      val r6 = card_op ("/", y, x)
		  in
		      [r1, r2, r3, r4, r5, r6]
		  end
	  end

      fun member ((x, y): R.t * R.t, xys: (R.t * R.t) list): bool =
	  case xys of
	      [] => false
	    | (x', y') :: xys' =>
	      R.eq (x, x') andalso R.eq (y, y') orelse member ((x, y), xys')

      fun play_game (ns: int list, n: int): bool =
	  let
	      val res = R.fromInt n
	      fun main (zs: card list, xys: (R.t * R.t) list): bool =
		  case zs of
		      [x] =>
			  if isRes (res, x) then
			      (show_card (x);
			       print (" = " ^ (R.toString res) ^ "\n");
			       true)
			  else false
		    | x :: y :: zs => aux1 (x, [], y, [], zs, xys)
		    | _ => fatal ("main: empty list")

	      and aux1 (x, xs, y, ys, zs, xys) =
		  if member ((v_of_c x, v_of_c y), xys) then
		      aux2 (x, xs, y, ys, zs, xys)
		  else aux11 (x $ y, x, xs, y, ys, zs, xys)

	      and aux11 ([], x, xs, y, ys, zs, xys) =
		  aux2 (x, xs, y, ys, zs,  (v_of_c x, v_of_c y) :: xys)
		| aux11 (r :: rs, x, xs, y, ys, zs, xys) =
		  main (rapp (xs, rapp (ys, r :: zs)), []) orelse
		  aux11 (rs, x, xs, y, ys, zs, xys)

	      and aux2 (x, xs, y, ys, zs, xys) =
		  case zs of
		      [] => (case rapp (ys, [y]) of
				 x' :: y' :: zs' =>
				     aux1 (x', x :: xs, y', [], zs', xys)
			       | _ => false)
		    | z :: zs => aux1 (x, xs, z, y :: ys, zs, xys)
	  in
	      main (cards_of_ints ns, [])
	  end

     fun play24 n1 n2 n3 n4: bool = play_game([n1,n2,n3,n4], 24)

  end