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

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

staload "assignment3.sats"

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

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

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

// A given list [b1 :: b2 :: ... :: bn :: nil ()] represents the natural number
// [bn ... b2 b1] in binary notation. For instance, the number 16 is represented
// as [0 :: 0 :: 0 :: 1 :: nil ()]

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

local

typedef bitlst = list0 int
datatype bignum = BIGNUM of (int (*sgn*),  bitlst(*bits*))
assume bignum_t = bignum

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

fun uint_of_bitlst (bs: bitlst): uint = let
  fun loop {i:nat} (bs: bitlst, i: int i, res: uint): uint = case+ bs of
    | b :: bs => if b = 0 then loop (bs, i+1, res) else loop (bs, i+1, res + (1U<<i)) 
    | nil () => res
  // end of [loop]
in
  loop (bs, 0, 0U(*res*))
end // end of [uint_of_bitlst]

fun bitlst_of_uint (u: uint): bitlst =
  if u > 0U then let
    val b = int_of_uint (u land 01U) in b :: bitlst_of_uint (u >> 1)
  end else nil () 
// end of [bitlst_of_uint]

fun int_of_bignum (x: bignum): int = let
  val+ BIGNUM (sgn, bs) = x in sgn * int_of_uint (uint_of_bitlst bs)
end // end of [int_of_bignum]

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

nonfix ugt ugte ult ulte uadd usub umul udiv

fun ugt (bs1: bitlst, bs2: bitlst): bool =
  case+ (bs1, bs2) of
  | (b1 :: bs1, b2 :: bs2) =>
      if b1 > b2 then ugte (bs1, bs2) else ugt (bs1, bs2)
  | (nil (), _) => false
  | (_, nil ()) => true
// end of [ugt]

and ugte (bs1: bitlst, bs2: bitlst): bool =
  case+ (bs1, bs2) of
  | (b1 :: bs1, b2 :: bs2) =>
      if b1 >= b2 then ugte (bs1, bs2) else ugt (bs1, bs2)
  | (_, nil ()) => true
  | (nil (), _) => false
// end of [ugte]

fun ult (bs1: bitlst, bs2: bitlst): bool = ugt (bs2, bs1)
fun ulte (bs1: bitlst, bs2: bitlst): bool = ugte (bs2, bs1)

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

fun usucc (bs: bitlst): bitlst = case+ bs of
  | b :: bs => if b = 0 then 1 :: bs else 0 :: usucc bs
  | nil () => 1 :: nil ()
// end of [usucc]

exception UPREDexception of ()
fun upred (bs: bitlst): bitlst = case+ bs of
  | b :: nil () => nil ()
  | b :: bs => if b = 0 then 1 :: upred bs else 0 :: bs
  | nil () => $raise UPREDexception ()
// end of [usucc]

fun uadd (bs1: bitlst, bs2: bitlst): bitlst = let
  fun aux (bs1: bitlst, bs2: bitlst, c: int): bitlst =
    case+ (bs1, bs2) of
    | (b1 :: bs1, b2 :: bs2) => begin case+ b1+b2 of
      | 0 => c :: aux (bs1, bs2, 0)
      | 1 => (1-c) :: aux (bs1, bs2, c)
      | _ (*2*) => c :: aux (bs1, bs2, 1)
      end // end of [::, ::]
    | (_, nil ()) => if c = 0 then bs1 else usucc bs1
    | (nil (), _) => if c = 0 then bs2 else usucc bs2 
in
  aux (bs1, bs2, 0(*carry*))
end // end of [uadd]

exception USUBexception of ()
fun usub (bs1: bitlst, bs2: bitlst): bitlst = let
  fun aux (bs1: bitlst, bs2: bitlst): bitlst =
    case+ (bs1, bs2) of
    | (b1 :: bs1, b2 :: bs2) => let
        val bs = aux (bs1, bs2) in
        if b1 >= b2 then begin case+ bs of
          | cons _ => (b1-b2) :: bs | nil _ => if b1 = b2 then nil else 1 :: nil
        end else 1 :: upred bs
      end // end of [::, ::]   
    | (_, nil ()) => bs1
    | (nil (), _) => $raise USUBexception ()
  val bs = aux (bs1, bs2)   
in
  bs
end // end of [usub]
  
in // in of [local]

implement bignum_make_int (i) = let
  val u = (if i >= 0 then i else ~i): int
  val sgn = (if i >= 0 then 1 else ~1): int
in
  BIGNUM (sgn, bitlst_of_uint (uint_of_int u))
end // end of [bignum_make_int]

(*
** fun neg_bignum (x: bignum_t): bignum_t
*)
implement neg_bignum (x) = let
  val+ BIGNUM (sgn, bs) = x in BIGNUM (~sgn, bs)
end // end of [neg_bignum]

(*

// 5 points
fun succ_bignum (x: bignum_t): bignum_t

// 5 points
fun pred_bignum (x: bignum_t): bignum_t

*)

(*
** fun add_bignum_bignum (x1: bignum_t, x2: bignum_t): bignum_t
*)
implement add_bignum_bignum (x1, x2) = let
  val+ BIGNUM (sgn1, bs1) = x1
  val+ BIGNUM (sgn2, bs2) = x2
in
  case+ (sgn1, sgn2) of
   | (1, ~1) => begin
       if ugte (bs1, bs2) then BIGNUM (1, usub (bs1, bs2)) else BIGNUM (~1, usub (bs2, bs1))
     end // end of [1, ~1]
   | (~1, 1) => begin
       if ugt (bs1, bs2) then BIGNUM (~1, usub (bs1, bs2)) else BIGNUM (1, usub (bs2, bs1))
     end // end of [~1, 1] 
   | (_, _) (*sgn1=sgn2*) => BIGNUM (sgn1, uadd (bs1, bs2))
end // end of [add_bignum]

(*

// 10 points
fun sub_bignum_bignum (x1: bignum_t, x2: bignum_t): bignum_t

// 20 points
fun mul_bignum_bignum (x1: bignum_t, x2: bignum_t): bignum_t

// 20 points
fun div_bignum_bignum (x1: bignum_t, x2: bignum_t): bignum_t
fun divrem_bignum_bignum (x1: bignum_t, x2: bignum_t): @(bignum_t, bignum_t)

// 20 points
fun sqrt_bignum (x: bignum_t): bignum_t

*)

end // end of [local]

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

(* end of [assgn3ex2.dats] *)