#lang shplait
~untyped

// On object is a tuple containing
//   - a list for fields
//   - a list for methods, where each method
//     is a function that takes `this` and one argument
type Object = Mapof(Symbol, ....) * Mapof(Symbol, (...., ....) -> ....)

macro 'object ($f_id = $f_expr,
               ...):
         method $m_id($arg): $m_expr
         ...':
  'values([values(#' $f_id, $f_expr),
           ...],
          [values(#' $m_id, method ($arg): $m_expr),
           ...])'

macro 'method ($arg): $expr':
  'fun ($(replace_scopes('this', arg)), $arg): $expr'

macro
| '$o_expr . $(id :: Identifier) ($arg)':
    // Extract a method form the second hash table
    'let o = $o_expr:
       find(snd(o), #' $id)(o, $arg)'
| '$o_expr . $(id :: Identifier)':
    // Extract a field form the first list table    
    'find(fst($o_expr), #' $id)'

fun find(l :: Listof(Symbol * ?a), name :: Symbol) :: ?a:
  match l
  | []: error(#'find, "not found: " +& name)
  | cons(p, rst_l):
      if name == fst(p)
      | snd(p)
      | find(rst_l, name)

// ----------------------------------------

type Value = Listof(Symbol * Int)

macro 'intV($n)':
  'object (n = $n):
     method apply (arg):
       error(#'interp, "not a function")
     method number (arg):
       this.n'

macro 'closV($n, $body, $c_env)':
  'object (n = $n, body = $body, c_env = $c_env):
     method apply(arg):      
       this.body.interp(extend_env(bind(this.n, arg),
                                   this.c_env))
     method number(arg):
       error(#'interp, "not a number")'

// ----------------------------------------

type Exp = Listof(Symbol * (Env -> Value))

macro 'intE($n)':
  'object (n = $n):
     method interp(arg):
       intV(this.n)'

macro 'idE($s)':
  'object (s = $s):
     method interp(arg):
       arg.lookup(this.s)'

macro 'plusE($l, $r)':
  'object (l = $l, r = $r):
     method interp(arg):
       num_plus(this.l.interp(arg), this.r.interp(arg))'

macro 'multE($l, $r)':
  'object (l = $l, r = $r):
     method interp(arg):
       num_mult(this.l.interp(arg), this.r.interp(arg))'

macro 'funE($n, $body)':
  'object (n = $n, body = $body):
     method interp(arg):
       closV(this.n, this.body, arg)'

macro 'appE($fn, $arg)':
  'object (fn = $fn, arg = $arg):
     method interp(arg):
       (this.fn.interp(arg)).apply(this.arg.interp(arg))'

// ----------------------------------------

type Binding
| bind(name :: Symbol,
       val :: Value)

type Env  = Symbol -> Value

macro 'mt_env':
  'object ():
     method lookup(arg):
       error(#'interp, "free variable: " +& arg)'

macro 'extend_env($b, $env)':
  'object (b = $b, env = $env):
     method lookup(arg):
       if bind.name(this.b) == arg
       | bind.val(this.b)
       | this.env.lookup(arg)'

// parse ----------------------------------------
fun parse(s :: Syntax) :: Exp:
  cond
  | syntax_is_integer(s):
      intE(syntax_to_integer(s))
  | syntax_is_symbol(s):
      idE(syntax_to_symbol(s))
  | ~else:
      match s
      | 'let $name = $rhs:
           $body':
          appE(funE(syntax_to_symbol(name),
                    parse(body)),
               parse(rhs))               
      | '$left + $right':
          plusE(parse(left),
                parse(right))
      | '$left * $right':
          multE(parse(left),
                parse(right))
      | 'fun ($id): $body':
          funE(syntax_to_symbol(id),
               parse(body))
      | '$fn($arg)':
          appE(parse(fn),
               parse(arg))
      | '($e)':
          parse(e)
      | ~else:
          error(#'parse, "invalid input: " +& s)

// Testing is a problem, because we can't easily inspect
// function results...
#//
module test:
  check: parse('2')
         ~is intE(2)
  check: parse('x')
         ~is idE(#'x)
  check: parse('2 + 1')
         ~is plusE(intE(2), intE (1))
  check: parse('3 * 4')
         ~is multE(intE(3), intE(4))
  check: parse('3 * 4 + 8')
         ~is plusE(multE(intE(3), intE(4)),
                   intE(8))
  check: parse('fun (x): 9')
         ~is funE(#'x, intE(9))
  check: parse('double(9)')
         ~is appE(idE(#'double), intE(9))
  check: parse('1 + double(9)')
         ~is plusE(intE(1),
                   appE(idE(#'double), intE(9)))
  check: parse('3 * (4 + 8)')
         ~is multE(intE(3),
                   plusE(intE(4), intE(8)))
  check: parse('let x = 1 + 2:
                  y')
         ~is appE(funE(#'x,
                       idE(#'y)),
                  plusE(intE(1), intE(2)))                  
  check: parse('1 2')
         ~raises "invalid input"
      
// interp ----------------------------------------
fun interp(a :: Exp, env :: Env) :: Value:
  a.interp(env)

module test:
  check: interp(parse('2'), mt_env).number(0)
         ~is 2
  check: interp(parse('x'), mt_env)
         ~raises "free variable"
  check: interp(parse('x'),
                extend_env(bind(#'x, intV(9)), mt_env)).number(0)
         ~is 9
  check: interp(parse('2 + 1'), mt_env).number(0)
         ~is 3
  check: interp(parse('2 * 1'), mt_env).number(0)
         ~is 2
  check: interp(parse('(2 * 3) + (5 + 8)'), mt_env).number(0)
         ~is 19
  // The following test is a problem, too, since the
  // expected result has a function representing
  // the body expression in the closure.
  #//
  check: interp(parse('fun (x): x + x'),
                mt_env)
         ~is closV(#'x, plusE(idE(#'x), idE(#'x)), mt_env)
  #//
  check: interp(parse('fun (x): x + x'),
                mt_env)
         ~is closV(#'x, plusE(idE(#'x), idE(#'x)), mt_env)
  check: interp(parse('let x = 5: x + x'),
                mt_env).number(0)
         ~is 10
  check: interp(parse('let x = 5:
                         let x = x + 1:
                           x + x'),
                mt_env).number(0)
         ~is 12
  check: interp(parse('let x = 5:
                         let y = 6:
                           x'),
                mt_env).number(0)
         ~is 5
  check: interp(parse('(fun (x): x + x)(8)'),
                mt_env).number(0)
         ~is 16
  check: interp(parse('1(2)'), mt_env)
         ~raises "not a function"
  check: interp(parse('1 + (fun (x): x)'), mt_env)
         ~raises "not a number"
  check: interp(parse('let bad = (fun (x): x + y):
                         let y = 5:
                           bad(2)'),
                mt_env)
         ~raises "free variable"
               
// num_plus and num_mult ----------------------------------------
fun num_op(op :: (Int, Int) -> Int, l :: Value, r :: Value) :: Value:
  intV(op(l.number(0), r.number(0)))
fun num_plus(l :: Value, r :: Value) :: Value:
  num_op(fun (a, b): a+b, l, r)
fun num_mult(l :: Value, r :: Value) :: Value:
  num_op(fun (a, b): a*b, l, r)

module test:
  check: num_plus(intV(1), intV(2)).number(0)
         ~is 3
  check: num_mult(intV(3), intV(2)).number(0)
         ~is 6
  
// lookup ----------------------------------------
fun lookup(n :: Symbol, env :: Env) :: Value:
  env.lookup(n)
  
module test:
  check: lookup(#'x, mt_env)
         ~raises "free variable"
  check: lookup(#'x, extend_env(bind(#'x, intV(8)), mt_env)).number(0)
         ~is 8
  check: lookup(#'x, extend_env(bind(#'x, intV(9)),
                                extend_env(bind(#'x, intV(8)),
                                           mt_env))).number(0)
         ~is 9
  check: lookup(#'y, extend_env(bind(#'x, intV(9)),
                                extend_env(bind(#'y, intV(8)),
                                           mt_env))).number(0)
         ~is 8