eval.rkt

#lang typed/racket

(require "exp.rkt")
(require/typed "prim.rkt" [prim (Op (Listof Val) -> Val)])
(require/typed racket/dict
  [dict-ref (All (A) ((Listof (Pair Symbol A)) Symbol (-> A) -> A))])

;; evaluator (not partial)

(define-type Env (Listof (Pair Symbol Val)))

(provide eval)
(define: (eval [program : Prog]) : Val
  (match-define (Prog fdefs main) program)
  
  (define: (eval-expr [expr : Expr] [env : Env]) : Val
    (match expr
      [(Const val) val]
      [(Var var) (dict-ref env var (lambda () (error "unbound variable" var)))]
      [(Prim op es)
       (define rs (for/list: : (Listof Val) ([e : Expr es]) (eval-expr e env)))
       (prim op rs)]
      [(If test then else)
       (if (eval-expr test env)
           (eval-expr then env)
           (eval-expr else env))]
      [(Apply f es)
       (match-define (Func args body)
         (dict-ref fdefs f (lambda () (error "unbound variable" f))))
       (define es*     (map (lambda: ([e : Expr]) (eval-expr e env)) es))
       (define new-env (append (map (inst cons Symbol Val) args es*) env))
       (eval-expr body new-env)]))

  (eval-expr main empty))


(module* test typed/racket
  (require typed/rackunit "exp.rkt" (submod ".."))

  (define: (eval-no-env [e : Expr]) : Val (eval (Prog '() e)))
  
  (check-equal? (eval-no-env (Const 0)) 0)
  (check-equal? (eval-no-env (Prim '= `(,(Const 0) ,(Const 0)))) #t)
  (check-equal? (eval-no-env (Prim '= `(,(Const 0) ,(Const 1)))) #f)
  (check-equal? (eval-no-env (Prim '+ `(,(Const 0) ,(Const 1)))) 1)
  (check-equal? (eval-no-env
                 (If (Prim '= `(,(Const 0) ,(Const 0))) (Const 1) (Const 2)))
                1)

  (define base-env
    `((exp
       . ,(Func '(x n)
                (If (Prim '= `(,(Var 'n) ,(Const 0)))
                    (Const 1)
                    (Prim '* `(,(Var 'x)
                               ,(Apply 'exp
                                       `(,(Var 'x)
                                         ,(Prim '- `(,(Var 'n)
                                                     ,(Const 1))))))))))))

  (define exp-prog
    (Prog base-env (Apply 'exp `(,(Const 2) ,(Const 3)))))
    
  (check-equal? (eval exp-prog) 8))