This post extends http://www.yinwang.org/blog-cn/2012/08/01/interpreter, where how to construct a simple interpreter is documented. The main difference is that let and lambda could accept multiple arguments.

Pattern matching using quasiquote is rather neat.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
#lang racket

; http://www.yinwang.org/blog-cn/2012/08/01/interpreter
(define (r2 e)
  (myeval e empty-env))

(struct closure (args e env)
        #:transparent)

(define empty-env '())

(define (extend-env k v env)
  (cons `(,k . ,v) env))

(define (look-up x env)
  (match (assq x env)
    [`(,_ . ,v) v]
    [_ (error 'var-loop-up "can't find ~a" x)]))

; iterate over l, eval then add bindings
(define (extend-env-let l env)
  (match l
    ['() env]
    [`([,k ,v] . ,rest)
      (let* ([v (myeval v env)]
             [new-env (extend-env k v env)])
        (extend-env-let rest new-env))]))

; bind already-evaluated args to syms in env
(define (bind-syms syms args-v env)
  (foldl
    (lambda (sym v acc-env)
      (extend-env sym v acc-env))
    env
    syms
    args-v))

(define (myeval e env)
  (match e
    [(? number? e) e]
    [(? symbol? e) (look-up e env)]
    [`(let ,bindings ,body)
      (myeval body (extend-env-let bindings env))]
    [`(lambda ,args ,body) (closure args body env)]
    [`(,op ,x ,y) #:when (member op '(+ - * /))
      (let ([x (myeval x env)]
            [y (myeval y env)])
        (match op
          ['+ (+ x y)]
          ['- (- x y)]
          ['* (* x y)]
          ['/ (/ x y)]))]
    [`(,f . ,args)
      (match (myeval f env)
        [(closure syms body c-env)
         (let* ([args-v (map (lambda (x) (myeval x env)) args)]
                [new-env (bind-syms syms args-v c-env)])
           (myeval body new-env))])]))

(module+ main
  (require rackunit)
  (require rackunit/text-ui)
  (define-syntax-rule (tests)
    (list
      (check-equal? (r2 '3) 3)
      (check-equal? (r2 '(+ 1 2)) 3)
      (check-equal? (r2 '(- 1 2)) -1)
      (check-equal? (r2 '(* 1 2)) 2)
      (check-equal? (r2 '(/ 1 2)) 1/2)
      (check-equal? (r2 '(* (+ 1 2) (/ 3 4))) 9/4)
      (check-equal? (r2 '(let ([x 3]) (+ x 3))) 6)
      (check-equal? (r2 '(lambda (x) (* 2 x))) (closure '(x) '(* 2 x) '()))
      (check-equal? (r2 '(let ([f (lambda (x) x)]) 3)) 3)
      (check-equal? (r2 '(let ([f (lambda (x) x)]) (f 3))) 3)
      (check-equal? (r2
                      '(let ([x 2]
                             [f (lambda (y) (* x y))])
                         (f 3)))
                    6)
      (check-equal? (r2
                      '(let ([x 2]
                             [f (lambda (y) (* x y))])
                         (let ([x 4])
                           (f 3))))
                    6)
      (check-equal? (r2
                      '(let ([x 1]
                             [f (lambda (y) y)])
                         (let ([x 2])
                           (f x))))
                    2)
      (check-equal? (r2
                      '(let ([x 2]
                             [y 5])
                         (+ x y)))
                    7)
      (check-equal? (r2
                      '(let ([x 2]
                             [f (lambda (x y) (* x y))])
                         (f x 8)))
                    16)
      (check-equal? (r2
                      '(let ([x 2]
                             [f (lambda (x y) (* x y))])
                         (f 3 x)))
                    6)
      (check-equal? (r2
                      '(let ([power (lambda (x) (* x x))])
                         (power 3)))
                    9)
      ))

  (void (run-tests (test-suite "all" (tests))))
)