//
// Course: BU CAS CS 520
// Instructor: Hongwei Xi (hwxi AT cs DOT bu DOT edu)
//

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

//
// How to compile:
//   atscc -o eval eval-big.dats
// How to test:
//   ./eval
//

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

typedef id = string

datatype expr = INT of int
              | SUCC of expr
              | VAR of id
              | LAM of (id, expr)
              | APP of (expr, expr)

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

extern fun print_expr (e: expr): void
overload print with print_expr

implement print_expr (e) = case+ e of
  | INT i => printf ("INT(%i)", @(i))
  | SUCC e => (print "SUCC("; print e; print ")")
  | VAR x => printf ("VAR(%s)", @(x))
  | LAM (x, e0) => (print "LAM("; print x; print ", "; print e0; print ")")
  | APP (e1, e2) => (print "APP("; print e1; print ", "; print e2; print ")")
// end of [print_expr]

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

// [v] is assumed to be closed
fun subst (e: expr, x: id, v: expr): expr =
  case+ e of
  | INT _ => e
  | SUCC e0 => SUCC (subst (e0, x, v))
  | VAR x1 => if x = x1 then v else e
  | LAM (x1, e0) =>
      if x = x1 then e else LAM (x1, subst (e0, x, v))
    // end of [LAM]
  | APP (e1, e2) => APP (subst (e1, x, v), subst (e2, x, v))
// end of [subst]

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

extern fun eval (e: expr): expr

implement eval (e) =
  case+ e of
  | INT _ => e
  | LAM _ => e
  | SUCC e0 => let
      val v0 = eval e0
      val- INT i = v0
    in
      INT (i+1)
    end // end of [SUCC]
  | APP (e1, e2) => let
      val v1 = eval e1
      val- LAM (x, e10) = v1 // canonical-form-lemma
      val v2 = eval e2
    in
      eval (subst (e10, x, v2))
    end // end of [APP]
  | VAR x => (
      prerrf ("exit(ATS): eval: e = VAR(%s)\n", @(x)); exit (1)
    ) // end of [VAR]
// end of [eval]

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

val omega = LAM ("x", APP (VAR "x", VAR "x"))
val Omega = APP (omega, omega)
// val _(*infinite loop*) = eval (Omega)

val K = LAM ("x", LAM ("y", VAR "x")) // K = \x\y.x
val S = LAM ("x", LAM ("y", LAM ("z", APP (APP (VAR "x", VAR "z"), APP (VAR "y", VAR "z"))))) // S = \x\y\z.(x z)(y z)
val SKK = APP (APP (S, K), K) // this is the identity function

val succf = LAM ("x", SUCC (VAR "x"))

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

fn numeral_gen
  {n:nat} (n: int n): expr = let
  val f = VAR "f"
  val x = VAR "x"
  fun gen {i:nat | i <= n} .<n-i>.
    (i: int i):<cloref> expr =
    if i < n then APP (f, gen (i+1)) else x
  // end of [gen]
    
in
  LAM ("f", LAM ("x", gen (0)))
end // end of [numeral_gen]

fn print_numeral (e: expr): void = let
  val- INT n = eval (APP (APP (e, succf), INT 0))
in
  printf ("'%i'", @(n))
end

val _2 = numeral_gen (2)
val _3 = numeral_gen (3)

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

val () = () where {
  val e = APP (SKK, INT 1000)
  val () = begin
    print "eval("; print e; print ") = "; print (eval e); print_newline ()
  end // end of [val]
} // end of [val]

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

val _2_3 = APP (_2, _3)
val () = (print "_2_3 (9) = "; print_numeral _2_3; print_newline ())

val _3_2 = APP (_3, _2)
val () = (print "_3_2 (8) = "; print_numeral _3_2; print_newline ())

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

implement main () = ()

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

(* end of [eval-big.dats] *)