forked from bao-qian/lightsabers
-
Notifications
You must be signed in to change notification settings - Fork 1
/
interp-lazy.rkt
94 lines (68 loc) · 1.81 KB
/
interp-lazy.rkt
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
;; A lazy interpreter for lambda calculus with some primitives
(define env0 '())
(define ext
(lambda (x v env)
(cons (cons x v) env)))
(define lookup
(lambda (x env)
(cond
[(assq x env) => cdr]
[else #f])))
;; Thunk structure. Fields:
;; 1. the function or the value depending on whether cached? is #t
;; 2. whether the function has been forced already
(struct thunk (fv cached?) #:transparent #:mutable)
;; Closure structure
(struct closure (fun env))
;; Redefining "delay" and "force" of Scheme just for independence
(define make-thunk
(lambda (fun)
(thunk fun #f)))
(define force-thunk
(lambda (th)
(cond
[(thunk-cached? th)
(thunk-fv th)]
[else
(let loop ([val ((thunk-fv th))])
(cond
[(thunk? val)
(loop ((thunk-fv val)))]
[else
(set-thunk-fv! th val)
(set-thunk-cached?! th #t)
val]))])))
(define interp1
(lambda (exp env)
(match exp
[(? number? x) x]
[(? symbol? x)
(lookup x env)]
[`(lambda (,x) ,e)
(closure exp env)]
[`(,e1 ,e2)
(let ([v1 (make-thunk (lambda () (interp1 e1 env)))]
[v2 (make-thunk (lambda () (interp1 e2 env)))])
(make-thunk
(lambda ()
(let ([v1+ (force-thunk v1)])
(match v1+
[(closure `(lambda (,x) ,e) env1)
(interp1 e (ext x v2 env1))])))))])))
(define interp
(lambda (exp)
(force-thunk (interp1 exp env0))))
;; ------------------------ tests -------------------------
(interp
'((lambda (x) 42)
((lambda (x) (x x))
(lambda (x) (x x)))))
(interp
'((lambda (x) 42)
((lambda (x) x)
((lambda (x) (x x))
(lambda (x) (x x))))))
;;; infinite loop
;; (interp
;; '((lambda (x) (x x))
;; (lambda (x) (x x))))