//
// A verified tail-recursive implementation of the factorial function
//
// Author: Hongwei Xi (hwxi AT cs DOT bu DOT edu)
// Time: October 31, 2008
//

(*

dataprop MUL (int, int, int) =
  | {n:int} MULbas (0, n, 0)
  | {m,n,p:int | m >= 0} MULind (m+1, n, p+n) of MUL (m, n, p)
  | {m,n,p:int | m > 0} MULneg (~m, n, ~p) of MUL (m, n, p)

*)

extern prfun mul_isfun {m,n:int} {p1,p2:int}
  (pf1: MUL (m, n, p1), pf2: MUL (m, n, p2)):<prf> [p1==p2] void

extern prfun mul_istot {m,n:int} ():<prf> [p:int] MUL (m, n, p)

extern 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) =
  | {n:nat} {rn,rn1:int}
      FACTind (n+1, rn1) of (FACT (n, rn), MUL (n+1, rn, rn1))
  | FACTbas (0, 1) of ()

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

fn fact {n:nat} (n: int n): [r:int] (FACT (n, r) | int r) = let
  fun loop {i:nat} {r:int} (i: int i, r: int r)
    : [ri,rri:int] (FACT (i, ri), MUL (r, ri, rri) | int rri) =
    if i > 0 then let
      val (pf_r_i | r_i) = r imul2 i
      val [ri1:int,rri:int] (pf_fact, pf_mul | res) = loop (i-1, r_i)
      prval [ri:int] pf_i_ri1 = mul_istot {i,ri1} ()
      prval pf_mul_new = mul_istot {r,ri} ()
      prval () = mul_associate (pf_r_i, pf_i_ri1, pf_mul, pf_mul_new)
      prval pf_fact_new = FACTind (pf_fact, pf_i_ri1)
    in
      (pf_fact_new, pf_mul_new | res)
    end else let
      prval pf_r_1 = mul_istot {r,1} (); prval () = mul_elim (pf_r_1)
    in
      (FACTbas (), pf_r_1 | r)
    end // end of [if]
  val (pf_fact, pf_mul | res) = loop (n, 1)
  prval () = mul_elim (pf_mul)
in
  (pf_fact | res)
end // end of [fact]

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

implement main () = let
  val (_(*pf*) | fact10) = fact 10
in
  print "fact (10) = "; print fact10; print_newline ()
end // end of [main]

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

(* end of [fact-2008-10-31.dats] *)