//
//
// A simple example of programming with proofs
//
// Hongwei Xi (hwxi AT cs DOT BU DOT edu)
// September, 2008
//

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

dataprop TALLY (int, int) =
  | TALLYbas (0, 0)
  | {n:nat;r:int} TALLYind (n+1, n+1+r) of TALLY (n, r)

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

#define INTINF 1

#if INTINF == 0 #then

extern fun tally {n:nat}
  (n: int n): [r:int] (TALLY (n, r) | int r)

implement tally (n) = let
  fun loop {n:nat;r0:int}
    (n: int n, r0: int r0): [r: int] (TALLY (n, r) | int (r+r0)) =
    if n > 0 then begin
      let val (pf | res) = loop (n-1, r0+n) in (TALLYind pf | res) end
    end else begin
      (TALLYbas () | r0)
    end // end of [loop]
in
  loop (n, 0)
end // end of [tally]

#endif // end of [INTINF == 0]

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

#if INTINF == 1 #then

staload "libats/SATS/intinf.sats"

extern fun tally {n:nat}
  (n: int n): [r:int] (TALLY (n, r) | intinfptr_gc r)

implement tally (n) = let
  fun loop {n:nat;r0:int}
    (n: int n, r0: intinfptr_gc r0): [r:int] (TALLY (n, r) | intinfptr_gc (r+r0)) =
    if n > 0 then let
      val (pf_gc, pf_at | p_r0) = r0
      val r1 = !p_r0 + n; val () = intinf_free (pf_gc, pf_at | p_r0)
      val (pf | res) = loop (n-1, r1)
    in
      (TALLYind pf | res)
    end else begin
      (TALLYbas () | r0)
    end // end of [loop]
in
  loop (n, intinf_make 0)
end // end of [tally]

#endif // end of [INTINF == 1]

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

dynload "libats/DATS/intinf.dats"

implement main (argc, argv) = let
  val () = assert (argc >= 2)
  val n = int1_of_string (argv.[1])
  val () = assert (n >= 0)
  val (pf | res) = tally (n)
#if INTINF == 0 #then
  val () = (printf ("tally (%i) = ", @(n)); print res; print_newline ())
#endif // end of [INTINF == 0]
#if INTINF == 1 #then
  val (pf_gc, pf_at | p_res) = res
  val () = begin
    printf ("tally (%i) = ", @(n)); print !p_res; print_newline ()
  end // end of [val]
  val () = intinf_free (pf_gc, pf_at | p_res)
#endif // end of [INTINF == 1]
in
  // empty
end // end of [main]

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

(* end of [tally-2008-09-30.dats] *)