quasiquote interpreter

quasi.rkt

#lang racket

(define (eval e env)
  (match e
    [(? symbol?) (hash-ref env e)]
    [`(let ([,(? symbol? x) ,e]) ,b)
     (eval b (hash-set env x (eval e env)))]
    [(? number?)
     e]
    [`(+ ,e1 ,e2)
     (+ (eval e1 env) (eval e2 env))]
    [(list 'quote datum)
     datum]
    [(list 'quasiquote datum)
     (eval-quote datum 1 env)]))

(define (eval-quote e depth env)
  (match e
    [(list 'unquote ue)
     (if (= depth 1)
         (eval ue env)
         (list 'unquote (eval-quote ue (- depth 1) env)))]
    [(list 'quasiquote datum)
     (list 'quasiquote (eval-quote datum (+ depth 1) env))]
    [(cons a d)
     (cons (eval-quote a depth env)
           (eval-quote d depth env))]
    [_ e]))

(define (eval-top e)
  (eval e (hash)))

(define-syntax-rule
  (ev e)
  (eval 'e (hash)))

(require rackunit)

; quasiquote tests

(check-equal?
 (ev `,(+ 1 1))
 2)

(check-equal?
 (ev `(+ 1 1))
 '(+ 1 1))

(check-equal?
 (ev `(+ ,(+ 1 1) 1))
 '(+ 2 1))

(check-equal?
 (ev ``5)
 '(quasiquote 5))

(check-equal?
   (ev ``,(+ 1 1))
   '(quasiquote (unquote (+ 1 1))))

(check-equal?
   (ev ``,,(+ 1 1))
   '(quasiquote (unquote 2)))

(check-equal?
 (eval-top (ev (let ([x 5]) `(let ([x 6]) `,,(+ x 2)))))
 7)

(check-equal?
 (eval-top (ev (let ([x 5]) `(let ([x 6]) `,(+ x 2)))))
 8)

(check-equal?
 (eval-top (ev (let ([stx '(+ x 2)]) `(let ([x 6]) `,,stx))))
 8)

(check-equal?
 (eval-top (ev (let ([stx '(+ x 2)]) `(let ([x 6]) `,',stx))))
 '(+ x 2))

(check-equal?
 (ev (let ([x 5]) `(,`unquote ,x)))
 '(unquote 5))

; This is a spot where Racket behaves oddly, complaining about the shape
; of unquote despite it being quoted. The interpreter here behaves the
; same as chez.
(check-equal?
 (eval-top (ev `(let ([x 5]) `(,`unquote ,x))))
 '(unquote 5))

(check-equal?
 (ev ``,`unquote)
 '`,`unquote)

(check-equal?
 (eval-top (ev ``,`unquote))
 'unquote)

; tests for the other bits of eval

(check-equal?
 (ev (+ 1 2))
 3)

(check-equal?
 (ev (+ 1 (+ 1 1)))
 3)

(check-equal?
 (ev 'x)
 'x)

(check-equal?
 (ev ',x)
 '(unquote x))

(check-equal?
 (ev (let ([x (+ 1 1)])
       (+ x 2)))
 4)