(* Problem 1 *)

signature RATIONAL = sig
  type int
  type t (* for rationals *)

  exception DenominatorIsZero

  val zero: t
  val one: t

  val make: int * int -> t
  val fromInt: int -> t

  val numerator: t -> int
  val denominator: t -> int
  val unmake: t -> int * int

  val isZero: t -> bool
  val isNegative: t -> bool
  val isPositive: t -> bool
  val eq: t * t -> bool

  val neg: t -> t

  val add: t * t -> t
  val sub: t * t -> t
  val mul: t * t -> t

  exception DivisionByZero
  val recip: t -> t
  val div: t * t -> t

  val toString: t -> string
end

functor RationalFun (I: INTEGER) :> RATIONAL where type int = I.int = struct
  local
    val izero = I.fromInt 0
    val ione = I.fromInt 1
  in
    type int = I.int
    type t = int * int

    exception DenominatorIsZero
    exception DivisionByZero

    fun fromInt (n: int): t = (n, ione)

    val zero = fromInt izero
    val one = fromInt ione

    (* Note: this implementation only simplifies when exposing numerator and
     * denominator values to the user.
     *)

    fun make ((a: int), (b: int)): t =
	if b = izero then raise DenominatorIsZero else (a, b)

    (* Note: we design gcd so if b < 0, then gcd(a, b) < 0. This makes our
     * simplification of rational numbers easy. Just divide by gcd(a, b) to
     * make denominators always positive.
     *)

    fun gcd (a, b) =
	if b = izero then a else gcd (b, I.mod (a, b))

    fun simp (a, b) =
	let
	  val d = gcd (a, b)
	in
	  (I.div (a, d), I.div (b, d))
	end

    fun numerator (r: t): int =
	let val (a, _) = simp r in a end

    fun denominator (r: t): int =
	let val (_, b) = simp r in b end

    fun unmake (r: t): int * int =
	simp r

    fun isZero ((a, b): t): bool = (I.sign a = 0)

    fun sign ((a, b): t): Int31.int =
	Int31.* (I.sign a, I.sign b)

    fun isNegative r = (sign r = ~1)

    fun isPositive r = (sign r = 1)

    local
      val (op + ) = I.+
      val (op - ) = I.-
      val (op * ) = I.*
      val (op div ) = I.div
      val ~ = I.~
    in
      fun eq ((a, b): t, (c, d): t): bool =
	  a * d = b * c

      fun neg ((a, b): t): t = (~a, b)

      fun add ((a, b): t, (c, d): t): t =
	  (a * d + b * c, b * d)

      fun sub ((a, b): t, (c, d): t): t =
	  (a * d - b * c, b * d)

      fun mul ((a, b): t, (c, d): t): t =
	  (a * c, b * d)

      nonfix div

      fun div ((a, b): t, (c, d): t): t =
	  make (a * d, b * c) handle
	  DenominatorIsZero => raise DivisionByZero
    end

    fun recip ((a, b): t): t =
	make (b, a) handle
	DenominatorIsZero => raise DivisionByZero

    fun toString (r: t): string =
	let val (a, b) = simp r in
	  if b = ione then
	    I.toString a
	  else
	    I.toString a ^ "/" ^ I.toString b
	end
  end
end

(* Problem 6 *)

datatype exp =
	 EXPbool of bool
       | EXPint of int
       | EXPprimfun of string * exp list
       | EXPif of exp * exp * exp
       | EXPtup of exp * exp
       | EXPfst of exp
       | EXPsnd of exp

datatype value =
	 VALbool of bool
       | VALint of int
       | VALtup of value * value

datatype binop_kind =
	 IntBinOp of int * int -> int
       | BoolBinOp of bool * bool -> bool

val binops =
    [ ("+", IntBinOp op+ ),
      ("-", IntBinOp op- ),
      ("*", IntBinOp op* ),
      ("/", IntBinOp op div ),
      ("&&", BoolBinOp (fn (a, b) => a andalso b)),
      ("||", BoolBinOp (fn (a, b) => a orelse b)) ]

fun oplookup [] s = raise Match
  | oplookup ((s', f) :: xs) s =
    if s = s' then f else oplookup xs s

val rec eval = fn
    EXPbool v => VALbool v
  | EXPint v => VALint v
  | EXPprimfun (binop, [e1, e2]) =>
    (case oplookup binops binop of
      IntBinOp f =>
      let val (VALint i, VALint j) = (eval e1, eval e2) in
	VALint (f (i, j))
      end
    | BoolBinOp f =>
      let val (VALbool a, VALbool b) = (eval e1, eval e2) in
	VALbool (f (a, b))
      end)
  | EXPif (e0, e1, e2) =>
    (case eval e0 of
       VALbool true => eval e1
     | VALbool false => eval e2)
  | EXPtup (e1, e2) => VALtup (eval e1, eval e2)
  | EXPfst e => let val VALtup (v1, v2) = eval e in v1 end
  | EXPsnd e => let val VALtup (v1, v2) = eval e in v2 end