// An naive interpreter for untyped lambda-calculus
// Hongwei Xi (Oct 12, 2005)

staload String = "ATS/string.sats"
staload "ATS/stdio.sats"

datatype term0 =
  | TmVar0 of String
  | TmLam0 of (String, term0)
  | TmApp0 of (term0, term0)

exception Failure

fun failwith {a:type} (s: String): a =
  (fprint_string (s, stderr); raise Failure)

// t -> t' -> t'' -> .... -> v

fun subst (x: String, v: term0, t: term0): term0 =
  case t of
    | TmVar0 x' => if $String.equal (x, x') then v else t
    | TmLam0 (x', t0) =>
      if $String.equal (x, x') then t else TmLam0 (x', subst (x, v, t0))
    | TmApp0 (t1, t2) => TmApp0 (subst (x, v, t1), subst (x, v, t2))

fun print_term0 (t: term0): unit =
  case t of
    | TmVar0 (x) => begin
        print_string "TmVar0("; print_string x; print_string ")"
      end

    | TmLam0 (x, t0) => begin
        print_string "TmLam0(";
        print_string x;
        print_string ", ";
        print_term0 t0;
        print_string ")"
      end

    | TmApp0 (t1, t2) => begin
        print_string "TmApp0 (";
        print_term0 t1;
        print_string ", ";
        print_term0 t2;
        print_string ")"
      end

fun evaluate (t: term0): term0 = // t is required to be closed
  case t of
    | TmVar0 _ => failwith "The term is not closed.\n" 

    | TmLam0 _ => t

    // t1 -> ... -> v1 and t2 -> ... -> v2
    // t = t1(t2) -> ... -> (lam x.t0)(v2) -> t0[x->v2] -> ...
    | TmApp0 (t1, t2) =>
        let
           val v1 = evaluate t1
           val v2 = evaluate t2
        in
           case v1 of
             | TmLam0 (x, t0) => evaluate (subst (x, v2, t0))
             | _ => failwith "The application is ill-typed.\n"
        end