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
#lang racket

(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)]))

(define (extend-env* l env)
(match l
['() env]
[`([,k ,v] . ,rest)
(let* ([v (myeval v env)]
[new-env (extend-env k v env)])
(extend-env* rest new-env))]))

(define (myeval e env)
(match e
[(? number? e) e]
[(? symbol? e) (look-up e env)]
[`(let ,bindings ,body)
(let ([new-env (extend-env* bindings env)])
(myeval body new-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)
(let ([f (myeval f env)]
[args-v (for/list ([x args]) (myeval x env))])
(match f
[(closure args body env)
(let ([bindings (map list args args-v)])
(myeval body (extend-env* bindings 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 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 ([power (lambda (x) (* x x))])
(power 3)))
9)
))

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