Skip to content

Commit d3c0a4d

Browse files
jmctjmct
committed
Update loot interpreter and notes
1 parent fefd12c commit d3c0a4d

File tree

7 files changed

+499
-243
lines changed

7 files changed

+499
-243
lines changed

‎langs/loot/ast.rkt‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -60,6 +60,10 @@
6060
(struct App (f es) #:prefab)
6161

6262

63+
;; For pedagogical purposes
64+
(struct Closure (xs e r) #:prefab)
65+
(struct RecClosure (f r) #:prefab)
66+
6367
;; Helper functions
6468

6569
;; Does an Expr represent an immediate (i.e. flat) value?

‎langs/loot/env.rkt‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,4 +12,4 @@
1212

1313
;; Env Variable Value -> Value
1414
(define (ext r x i)
15-
(cons (list x i) r))
15+
(cons (list x i) r))

‎langs/loot/interp-defun.rkt‎

Lines changed: 123 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,123 @@
1+
#lang racket
2+
(provide interp interp-env interp-prim1 apply-function)
3+
(require "ast.rkt"
4+
"env.rkt"
5+
"interp-prims.rkt")
6+
7+
;; type Answer = Value | 'err
8+
9+
;; type Value =
10+
;; | Integer
11+
;; | Boolean
12+
;; | Character
13+
;; | (Fun f)
14+
;; | Eof
15+
;; | Void
16+
;; | '()
17+
;; | (cons Value Value)
18+
;; | (box Value)
19+
;; | Function
20+
21+
;; type Function =
22+
;; | `(closure ,Formals ,Expr ,Env)
23+
;; | `(rec-closure ,Lambda ,(-> Env))
24+
25+
;; type REnv = (Listof (List Id Value))
26+
;; type Defns = (Listof Defn)
27+
28+
;; Prog Defns -> Answer
29+
(define (interp p)
30+
(interp-env (desugar p) '()))
31+
32+
;; Expr Env Defns -> Answer
33+
(define (interp-env e r)
34+
(match e
35+
[(Prog '() e) (interp-env e r)]
36+
[(Int i) i]
37+
[(Bool b) b]
38+
[(Char c) c]
39+
[(Eof) eof]
40+
[(Empty) '()]
41+
[(Var x) (lookup r x)]
42+
[(Prim0 'void) (void)]
43+
[(Prim0 'read-byte) (read-byte)]
44+
[(Prim0 'peek-byte) (peek-byte)]
45+
[(Prim1 p e)
46+
(match (interp-env e r)
47+
['err 'err]
48+
[v (interp-prim1 p v)])]
49+
[(Prim2 p e1 e2)
50+
(match (interp-env e1 r)
51+
['err 'err]
52+
[v1 (match (interp-env e2 r)
53+
['err 'err]
54+
[v2 (interp-prim2 p v1 v2)])])]
55+
[(If p e1 e2)
56+
(match (interp-env p r)
57+
['err 'err]
58+
[v
59+
(if v
60+
(interp-env e1 r)
61+
(interp-env e2 r))])]
62+
[(Begin e1 e2)
63+
(match (interp-env e1 r)
64+
['err 'err]
65+
[_ (interp-env e2 r)])]
66+
[(Let x e1 e2)
67+
(match (interp-env e1 r)
68+
['err 'err]
69+
[v (interp-env e2 (ext r x v))])]
70+
[(LetRec bs e)
71+
(letrec ((r* (λ ()
72+
(append
73+
(zip (map car bs)
74+
;; η-expansion to delay evaluating r*
75+
;; relies on RHSs being functions
76+
(map (λ (l) (RecClosure l r*))
77+
(map cadr bs)))
78+
r))))
79+
(interp-env e (r*)))]
80+
[(Lam _ xs e1)
81+
(Closure xs e r)]
82+
[(App f es)
83+
(match (interp-env* (cons f es) r)
84+
[(list (? function? f) vs ...)
85+
(apply apply-function f vs)]
86+
[e e])]
87+
[_ 'err]))
88+
89+
(define (function? f)
90+
(match f
91+
[(Closure _ _ _) #t]
92+
[(RecClosure _ _) #t]
93+
[(? procedure?) #t]
94+
[_ #f]))
95+
96+
;; Function Value ... -> Answer
97+
(define (apply-function f . vs)
98+
(match f
99+
[(Closure xs e r)
100+
(if (= (length xs) (length vs))
101+
(interp-env e (append (zip xs vs) r))
102+
'errwat)]
103+
[(RecClosure (Lam '() xs e) r*)
104+
; You've got to apply the the r* thunk
105+
(apply apply-function (Closure xs e (r*)) vs)]
106+
[(? procedure? f) (apply f vs)]))
107+
108+
109+
;; (Listof Expr) REnv Defns -> (Listof Value) | 'err
110+
(define (interp-env* es r)
111+
(match es
112+
['() '()]
113+
[(cons e es)
114+
(match (interp-env e r)
115+
['err 'errsdf]
116+
[v (cons v (interp-env* es r))])]))
117+
118+
(define (zip xs ys)
119+
(match* (xs ys)
120+
[('() '()) '()]
121+
[((cons x xs) (cons y ys))
122+
(cons (list x y)
123+
(zip xs ys))]))

‎langs/loot/interp.rkt‎

Lines changed: 36 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -22,13 +22,12 @@
2222

2323
;; Prog Defns -> Answer
2424
(define (interp p)
25-
(match p
26-
[(Prog ds e)
27-
(interp-env e '() ds)]))
25+
(interp-env (desugar p) '()))
2826

2927
;; Expr Env Defns -> Answer
30-
(define (interp-env e r ds)
28+
(define (interp-env e r)
3129
(match e
30+
[(Prog '() e) (interp-env e r)]
3231
[(Int i) i]
3332
[(Bool b) b]
3433
[(Char c) c]
@@ -39,68 +38,61 @@
3938
[(Prim0 'read-byte) (read-byte)]
4039
[(Prim0 'peek-byte) (peek-byte)]
4140
[(Prim1 p e)
42-
(match (interp-env e r ds)
41+
(match (interp-env e r)
4342
['err 'err]
4443
[v (interp-prim1 p v)])]
4544
[(Prim2 p e1 e2)
46-
(match (interp-env e1 r ds)
45+
(match (interp-env e1 r)
4746
['err 'err]
48-
[v1 (match (interp-env e2 r ds)
47+
[v1 (match (interp-env e2 r)
4948
['err 'err]
5049
[v2 (interp-prim2 p v1 v2)])])]
5150
[(If p e1 e2)
52-
(match (interp-env p r ds)
51+
(match (interp-env p r)
5352
['err 'err]
5453
[v
5554
(if v
56-
(interp-env e1 r ds)
57-
(interp-env e2 r ds))])]
55+
(interp-env e1 r)
56+
(interp-env e2 r))])]
5857
[(Begin e1 e2)
59-
(match (interp-env e1 r ds)
58+
(match (interp-env e1 r)
6059
['err 'err]
61-
[_ (interp-env e2 r ds)])]
60+
[_ (interp-env e2 r)])]
6261
[(Let x e1 e2)
63-
(match (interp-env e1 r ds)
62+
(match (interp-env e1 r)
6463
['err 'err]
65-
[v (interp-env e2 (ext r x v) ds)])]
66-
[(App f es)
67-
(match (interp-env* es r ds)
68-
[(list vs ...)
69-
(match (defns-lookup ds f)
70-
[(Defn f xs body)
71-
; arity check
64+
[v (interp-env e2 (ext r x v))])]
65+
[(LetRec bs e)
66+
(letrec ((r* (λ ()
67+
(append
68+
(zip (map car bs)
69+
;; η-expansion to delay evaluating r*
70+
;; relies on RHSs being functions
71+
(map (λ (l) (λ vs (apply (interp-env l (r*)) vs)))
72+
(map cadr bs)))
73+
r))))
74+
(interp-env e (r*)))]
75+
[(Lam _ xs e1)
76+
(lambda vs
7277
(if (= (length vs) (length xs))
73-
(interp-env body (zip xs vs) ds)
74-
'err)])])]
75-
[(Fun f)
76-
(match (defns-lookup ds f)
77-
[(Defn f xs body)
78-
(lambda (es r)
79-
(match (interp-env* es r ds)
80-
[(list vs ...)
81-
(if (= (length vs) (length xs))
82-
(interp-env body (zip xs vs) ds)
83-
'err)]))]
84-
[_ 'err])]
85-
[(FCall f es)
86-
(match (interp-env f r ds)
87-
[(? procedure? f) (f es r)]
88-
[_ 'err])]
78+
(interp-env e1 (append (zip xs vs) r))
79+
'err))]
80+
[(App f es)
81+
(match (interp-env* (cons f es) r)
82+
[(list f vs ...)
83+
(if (procedure? f)
84+
(apply f vs)
85+
'err)])]
8986
[_ 'err]))
9087

9188
;; (Listof Expr) REnv Defns -> (Listof Value) | 'err
92-
(define (interp-env* es r ds)
89+
(define (interp-env* es r)
9390
(match es
9491
['() '()]
9592
[(cons e es)
96-
(match (interp-env e r ds)
93+
(match (interp-env e r)
9794
['err 'err]
98-
[v (cons v (interp-env* es r ds))])]))
99-
100-
;; Defns Symbol -> Defn
101-
(define (defns-lookup ds f)
102-
(findf (match-lambda [(Defn g _ _) (eq? f g)])
103-
ds))
95+
[v (cons v (interp-env* es r))])]))
10496

10597
(define (zip xs ys)
10698
(match* (xs ys)

‎langs/loot/regexp-defun.rkt‎

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
#lang racket
2+
(provide accepts)
3+
4+
;; type Regexp =
5+
;; | 'zero
6+
;; | 'one
7+
;; | `(char ,Char)
8+
;; | `(times ,Regexp ,Regexp)
9+
;; | `(plus ,Regexp ,Regexp)
10+
;; | `(star ,Regexp)
11+
12+
;; type K =
13+
;; | '(k0)
14+
;; | `(k1 ,Regexp ,K)
15+
;; | `(k2 ,K ,Regexp)
16+
17+
;; Regexp String -> Boolean
18+
(define (accepts r s)
19+
(matcher r (string->list s) '(k0)))
20+
21+
;; Regexp (Listof Char) K -> Bool
22+
(define (matcher r cs k)
23+
(match r
24+
['zero #f]
25+
['one (apply-k k cs)]
26+
[`(char ,c)
27+
(match cs
28+
['() #f]
29+
[(cons d cs)
30+
(and (char=? c d) (apply-k k cs))])]
31+
[`(plus ,r1 ,r2)
32+
(or (matcher r1 cs k) (matcher r2 cs k))]
33+
[`(times ,r1 ,r2)
34+
(matcher r1 cs `(k1 ,r2 ,k))]
35+
[`(star ,r)
36+
(apply-k `(k2 ,k ,r) cs)]))
37+
38+
;; K (Listof Char) -> Bool
39+
(define (apply-k k cs)
40+
(match k
41+
[`(k0) (empty? cs)]
42+
[`(k1 ,r2 ,k) (matcher r2 cs k)]
43+
[`(k2 ,k* ,r) (or (apply-k k* cs) (matcher r cs k))]))

‎langs/loot/regexp.rkt‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
#lang racket
2+
(provide accepts)
3+
4+
;; type Regexp =
5+
;; | 'zero
6+
;; | 'one
7+
;; | `(char ,Char)
8+
;; | `(times ,Regexp ,Regexp)
9+
;; | `(plus ,Regexp ,Regexp)
10+
;; | `(star ,Regexp)
11+
12+
;; Regexp String -> Boolean
13+
(define (accepts r s)
14+
(matcher r (string->list s) (λ (cs) (empty? cs))))
15+
16+
;; Regexp (Listof Char) ((Listof Char) -> Bool) -> Bool
17+
(define (matcher r cs k)
18+
(match r
19+
['zero #f]
20+
['one (k cs)]
21+
[`(char ,c)
22+
(match cs
23+
['() #f]
24+
[(cons d cs) (and (char=? c d) (k cs))])]
25+
[`(plus ,r1 ,r2)
26+
(or (matcher r1 cs k) (matcher r2 cs k))]
27+
[`(times ,r1 ,r2)
28+
(matcher r1 cs (λ (cs) (matcher r2 cs k)))]
29+
[`(star ,r)
30+
(letrec ((matcher* (λ (cs) (or (k cs) (matcher r cs matcher*)))))
31+
(matcher* cs))]))

0 commit comments

Comments
 (0)