forked from bao-qian/lightsabers
-
Notifications
You must be signed in to change notification settings - Fork 1
/
interp-call-by-value.ss
93 lines (69 loc) · 1.75 KB
/
interp-call-by-value.ss
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
;; A call-by-value interpreter for lambda calculus with arithmetic
;; author: Yin Wang (yw21@cs.indiana.edu)
;; environment
(define env0 '())
(define ext-env
(lambda (x v env)
(cons `(,x . ,v) env)))
(define lookup
(lambda (x env)
(let ([p (assq x env)])
(cond
[(not p) x]
[else (cdr p)]))))
;; closure "structure"
(struct Closure (f env))
;; cbv interpreter
(define interp1
(lambda (exp env)
(match exp
[(? symbol? x) (lookup x env)]
[(? number? x) x]
[`(lambda (,x) ,e)
(Closure exp env)]
[`(if ,test ,conseq ,alt)
(let ([v0 (interp1 test env)])
(if v0
(interp1 conseq env)
(interp1 alt env)))]
[`(,e1 ,e2)
(let ([v1 (interp1 e1 env)]
[v2 (interp1 e2 env)])
(match v1
[(Closure `(lambda (,x) ,e) env1)
(interp1 e (ext-env x v2 env1))]
[else
(error "trying to apply non-function" v1)]))]
[`(,op ,e1 ,e2)
(let ([v1 (interp1 e1 env)]
[v2 (interp1 e2 env)])
(match op
['+ (+ v1 v2)]
['- (- v1 v2)]
['* (* v1 v2)]
['/ (/ v1 v2)]
['= (= v1 v2)]))]
[else
(error "unrecognized expression" exp)])))
(define interp
(lambda (exp)
(interp1 exp env0)))
;; ------------------------ tests -------------------------
(interp '(+ 1 2))
;; => 3
(interp '(* 2 3))
;; => 6
(interp '(* 2 (+ 3 4)))
;; => 14
(interp '(* (+ 1 2) (+ 3 4)))
;; => 21
(interp '(((lambda (x) (lambda (y) (* x y))) 2) 3))
;; => 6
(interp '((lambda (x) (* 2 x)) 3))
;; => 6
;; (interp '(1 2))
;; => ERROR: trying to apply non-function 1
(interp '(if (= 1 1) 0 1))
;; => 1
(interp '(if (= 1 2) 0 1))
;; => 1