#lang shplait

type Expr
| eNum(value :: Int)
| eBool(value :: Boolean)
| eVar(name :: Symbol)
| eAdd(lhs :: Expr, rhs :: Expr)
| eMul(lhs :: Expr, rhs :: Expr)
| eIf(tst :: Expr, thn :: Expr, els :: Expr)
| eLet1(var :: Symbol, rhs :: Expr, body :: Expr)
| eLam(var :: Symbol, body :: Expr)
| eApp(proc :: Expr, arg :: Expr)

fun parse(stx :: Syntax) :: Expr:
  if syntax_is_integer(stx)
  | eNum(syntax_to_integer(stx))
  | if syntax_is_symbol(stx)
    | match stx
      | 'true': eBool(#true)
      | 'false': eBool(#false)
      | ~else: eVar(syntax_to_symbol(stx))
    | match stx
      | '($a)': parse(a)
      | 'if $c | $t | $e': eIf(parse(c), parse(t), parse(e))
      | 'let $x = $rhs : $body': eLet1(syntax_to_symbol(x), parse(rhs), parse(body))
      | '$a + $b': eAdd(parse(a), parse(b))
      | '$a * $b': eMul(parse(a), parse(b))
      | 'lam($a): $b': eLam(syntax_to_symbol(a), parse(b))
      | '$a($b)': eApp(parse(a), parse(b))
      | ~else: error(#'parse, "bad syntax")

check:
  parse('2 * (2 + 3)')
  ~is eMul(eNum(2), eAdd(eNum(2), eNum(3)))
check:
  parse('let x = 3 : x')
  ~is eLet1(#'x, eNum(3), eVar(#'x))
check:
  parse('lam(x): x + 3')
  ~is eLam(#'x, eAdd(eVar(#'x), eNum(3)))
check:
  parse('f(x)')
  ~is eApp(eVar(#'f), eVar(#'x))
check:
  parse('(f(x))(y + 4)')
  ~is eApp(eApp(eVar(#'f), eVar(#'x)),
           eAdd(eVar(#'y), eNum(4)))

check:
  parse('true')
  ~is eBool(#true)
check:
  parse('if true | 1 | 2')
  ~is eIf(eBool(#true), eNum(1), eNum(2))

check:
  parse('1 / 2')
  ~raises "bad syntax"

type Value
| vNum(value :: Int)
| vBool(value :: Boolean)
| vLam(var :: Symbol, body :: Expr, env :: Env)

def extend = map_update

type Env = Mapof(Symbol, Value)

fun lookup(env :: Env, name :: Symbol) :: Value:
  match map_get(env, name)
  | none(): error(#'lookup, "variable not bound")
  | some(v): v

fun interp(expr :: Expr, env :: Env) :: Value:
  match expr
  | eNum(v): vNum(v)
  | eBool(v): vBool(v)
  | eVar(s): lookup(env, s)
  | eAdd(l, r): num2(fun (a, b): a + b, interp(l, env), interp(r, env))
  | eMul(l, r): num2(fun (a, b): a * b, interp(l, env), interp(r, env))
  | eIf(c, t, f):
      match interp(c, env)
      | vBool(bv): (if bv | interp(t, env) | interp(f, env))
      | ~else: error(#'interp, "if expects a boolean")
  | eLet1(v, r, b):
      interp(b, extend(env, v, interp(r, env)))
  | eLam(v, b): vLam(v, b, env)
  | eApp(p, a):
      match interp(p, env)
      | vLam(bound_var, lam_body, clo_env):
          interp(lam_body, extend(clo_env, bound_var,
                                  interp(a, env)))
      | ~else: error(#'interp, "eApp expects a vLam")

fun num2(op :: (Int, Int) -> Int, vl :: Value, vr :: Value) :: Value:
  match vl
  | vNum(lv):
      match vr
      | vNum(rv): vNum(op(lv, rv))
      | ~else: error(#'num2, "rhs did not evaluate to a number")
  | ~else: error(#'num2, "lhs did not evaluate to a number")

def mt_env :: Env = { }

fun run(stx :: Syntax) :: Value:
  interp(parse(stx), mt_env)

check:
  run('2 * (2 + 3)')
  ~is vNum(10)
check:
  run('let x = 3 : x + x')
  ~is vNum(6)
check:
  run('lam(x): x + x')
  ~is vLam(#'x, eAdd(eVar(#'x), eVar(#'x)), mt_env)
check:
  run('((lam(x): x + x)(5 + 10))')
  ~is vNum(30)
check:
  run('true')
  ~is vBool(#true)
check:
  run('if true | 1 | 2')
  ~is vNum(1)
check:
  run('if false | 1 | 2')
  ~is vNum(2)
check:
  run('if 0 | 1 | 2')
  ~raises "if expects a boolean"
check:
  run('true + 1')
  ~raises "lhs did not evaluate to a number"
check:
  run('1 * false')
  ~raises "rhs did not evaluate to a number"
check:
  run('3(4)')
  ~raises "eApp expects a vLam"
check:
  run('y')
  ~raises "variable not bound"

// Static scope: `x` is free in f's body and unbound where f is defined.
// The `x` bound to 10 at the call site is irrelevant, so this is an error.
check:
  run('let f = (lam(y): x + y) : let x = 10 : f(1)')
  ~raises "variable not bound"

// f's closure remembers x = 3, so this is 6.
check:
  run('let f = (let x = 3 : lam(y): x + x) : f(4)')
  ~is vNum(6)

// The lexically scoped answer is 3 + 1 = 4: f's `x` is the outer 3, not
// the 10 at the call site.
check:
  run('let x = 3 : let f = (lam(y): x + y) : let x = 10 : f(1)')
  ~is vNum(4)

// The argument must be evaluated in the caller's environment, not the
// closure's. Here x is 10 at the call site.
check:
  run('let x = 3 : let f = (lam(y): y) : let x = 10 : f(x)')
  ~is vNum(10)