//
// Course: BU CAS CS 520, Fall 2010
// Instructor: Hongwei Xi (hwxi AT cs DOT bu DOT edu)
// Lecture on Tuesday, Sep. 14, 2010
//

//
// How to compile:
//   atscc-o fact fact.dats
// How to test:
//   ./fact
//

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

(*
//
// The following functions are declared in $ATSHOME/prelude/SATS/arith.sats
//
prfun mul_istot
  {m,n:int} ():<prf> [p:int] MUL (m, n, p)

prfun mul_associate {x,y,z:int} {xy,yz,xy_z,x_yz:int} (
    pf1: MUL (x, y, xy)
  , pf2: MUL (y, z, yz)
  , pf3: MUL (xy, z, xy_z)
  , pf4: MUL (x, yz, x_yz)
  ) :<prf> [xy_z==x_yz] void
*)

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

dataprop FACT (int, int) =
  | FACTbas (0, 1) of ()
  | {n:nat} {r,s:int}
    FACTind (n+1, s) of (FACT (n, r), MUL (r, n+1, s))
// end of [FACT]

(* ****** ****** *)
//
// [FACT] is a total relation
//

prfun FACTistot
  {n:nat} .<n>. (): [r:int] FACT (n, r) =
  sif n > 0 then let
    val pf1 = FACTistot () in FACTind {n-1} (pf1, mul_istot ())
  end else FACTbas ()
// end of [FACTistot]

(* ****** ****** *)
//
// [FACT] is a functional relation
//
prfun FACTisfun {n:nat} {r1,r2:int} .<n>.
  (pf1: FACT (n, r1), pf2: FACT (n, r2)): [r1==r2] void =
  sif n > 0 then let
    prval FACTind (pf11, pf12) = pf1 and FACTind (pf21, pf22) = pf2
    prval () = FACTisfun (pf11, pf21)
    prval () = mul_isfun (pf12, pf22)
  in
    // nothing
  end else let
    prval FACTbas () = pf1 and FACTbas () = pf2
  in
    // nothing
  end // end of [sif]
// end of [FACTisfun]

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

dataprop FACT2 (int, int, int) =
  | {r:int} FACT2bas (0, r, r) of ()
  | {n:nat} {r0,r1,r2:int}
    FACT2ind (n+1, r0, r2) of (MUL (n+1, r0, r1), FACT2 (n, r1, r2))
// end of [FACT2]

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

fun fact2 {n:nat} {r:int} .<n>.
  (n: int n, r: int r):<> [s:int] (FACT2 (n, r, s) | int s) =
  if n > 0 then let
    val (pfmul | r1) = n imul2 r
    val (pf1 | s) = fact2 (n-1, r1)
  in
    (FACT2ind (pfmul, pf1) | s)
  end else (FACT2bas () | r)
// end of [fact2]

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

prfun lemma {n:nat} {r,r1,r2:int} .<n>.
  (pf1: FACT (n, r), pf2: FACT2 (n, r1, r2)): MUL (r, r1, r2) =
  sif n > 0 then let
    prval FACTind (pf1, pf1mul) = pf1 // pf1: FACT (n-1,s1); pf1mul: MUL (s1, n, r)
    prval FACT2ind (pf2mul, pf2) = pf2 // pf2: FACT2 (n-1, n*r1, r2); pf2mul (n, r1, n*r1)
    prval pf1res = lemma {n-1} (pf1, pf2) // s1*(n*r1) = r2
    prval pfres = mul_istot {r,r1} ()
    prval () = mul_associate (pf1mul, pf2mul, pfres, pf1res)
  in
    pfres
  end else let
    prval FACTbas () = pf1
    prval FACT2bas () = pf2
    prval pfres = mul_istot {1,r1} ()
    prval () = mul_elim {1,r1} (pfres)
  in
    pfres
  end // end of [sif]
// end of [lemma]

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

fun fact {n:nat} .<>.
  (n: int n):<> [s:int] (FACT (n, s) | int s) = let
  val (pf1 | s) = fact2 (n, 1)
  prval [s:int] pf2 = FACTistot {n} ()
  prval pfmul = lemma (pf2, pf1)
  prval () = mul_elim {s,1} (pfmul)
in
  (pf2 | s)
end // end of [fact]

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

implement
main () = () where {
  #define N 10
  val (pf | ans) = fact (N)
  val () = printf ("mul(1 ... %i) = %i\n", @(N, ans))
} // end [main]

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

(* end of [fact.dats] *)