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

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

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

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

typedef id = string

datatype expr = INT of int
              | 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))
  | 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]

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

fn isval (e: expr): bool = case+ e of
  | INT _ => true
  | VAR _ => true
  | LAM _ => true
  | APP _ => false

fn isredex (e: expr): bool = case+ e of
  | APP (LAM _, _) => true
  | _ => false

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

datatype evalc = // evaluation contexts
  | EChole of ()
  | ECapp1 of (evalc, expr)
  | ECapp2 of (expr(*value*), evalc)
// end of [evalc]

fun compose (E: evalc, e0: expr): expr =
  case+ E of
  | EChole () => e0
  | ECapp1 (evalc, e) => APP (compose (evalc, e0), e)
  | ECapp2 (e, evalc) => APP (e, compose (evalc, e0))
// end of [compose]

// [e] is closed
fun decompose (e: expr)
  : Option @(evalc, expr(*redex*)) =
  case+ e of
  | INT _ => None ()
  | LAM _ => None ()
  | VAR _ => None () // cannot happen
  | APP (e1, e2) => let
      val ans = decompose e1
    in
      case+ ans of
      | Some @(E1, r) => Some @(ECapp1 (E1, e2), r)
      | None () (* e1 is a value *) => let
          val ans = decompose e2
        in
          case+ ans of
          | Some @(E2, r) => Some @(ECapp2 (e1(*value*), E2), r)
          | None () (* e2 is a value *) => Some @(EChole, e)
        end // end of [None]
    end // end of [APP]
// end of [decompose]

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

// [v] is assumed to be closed
fun subst (e: expr, x: id, v: expr): expr =
  case+ e of
  | INT _ => e
  | 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]

fn eval_redex (e: expr): expr =
  case- e of
  | APP (LAM (x, e), v) => subst (e, x, v)
// end of [eval_redex]

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

extern fun eval (e: expr): expr

implement eval (e) = let
  val ans = decompose (e)
in
  case+ ans of
  | None () => e // [e] is a value!
  | Some @(E, r) => let
      val c = eval_redex (r)
    in
      eval (compose (E, c))
    end
end // end of [eval]

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

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 () = () 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]

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

implement main () = ()

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

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