Racket interpreter

valof.rkt

(define unops '(sub1 zero? car cdr))
(define binops '(* + > >= < <= = cons))

(define empty-env
  (lambda ()
    '(empty-env)))

(define extend-env
  (lambda (var val env)
    `(extend-env ,var ,val ,env)))

(define apply-env
  (lambda (env search-var)
    (match env
      [`(extend-env ,var ,val ,e)
       (if (eqv? search-var var)
           val
           (apply-env e search-var))])))

(define closure
  (lambda (y body env)
    `(closure ,y ,body ,env)))

(define apply-closure
  (lambda (cs rand)
    (match cs
      [`(closure ,y ,body ,env)
       (value-of body (extend-env y rand env))])))

(define value-of
  (lambda (expr env)
    (match expr
      [`,y #:when (symbol? y) (apply-env env y)]
      [`,y #:when (number? y) y]
      [`,y #:when (boolean? y) y]
      [`(quote ,x) x]
      [`(lambda (,y) ,body) (closure y body env)]
      [`(if ,cmp ,then* ,else*)
       (if (value-of cmp env) (value-of then* env) (value-of else* env))]
      [`(let ([,var ,val]) ,body)
       (value-of body (extend-env var (value-of val env) env))]
      [`(,op ,x) #:when (memq op unops)
       ((namespace-variable-value op) (value-of x env))]
      [`(,op ,x ,y) #:when (memq op binops)
       ((namespace-variable-value op) (value-of x env) (value-of y env))]
      [`(,rator ,rand) (apply-closure (value-of rator env)
                                      (value-of rand env))])))

;; examples
#;
(value-of '((lambda (x) (sub1 x)) 10)
          (empty-env))

#;
(value-of '(car (cons 1 (cons 2 3)))
          (empty-env))

#;
(value-of ''(cons 1 (cons 2 3))
          (empty-env))

#;
(value-of '(quote (a b c))
          (empty-env))

#;
(value-of '(((lambda (x) (lambda (y) x)) 5) 6)
          (empty-env))

;; infinite loop !
#;
(value-of '((lambda (x) (x x)) (lambda (x) (x x)))
          (empty-env))