This repository has been archived by the owner on Dec 5, 2022. It is now read-only.
-
-
Notifications
You must be signed in to change notification settings - Fork 9
/
cek.rkt
69 lines (64 loc) · 1.98 KB
/
cek.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
#lang racket/base
(require racket/match)
(struct pv () #:transparent)
(struct succ pv () #:transparent)
(struct num pv (n) #:transparent)
(struct clo pv (term env) #:transparent)
(define step
(match-lambda
[(vector (? pv? pv) E `(* ,Ep ,e --> ,k))
(vector e Ep `(,pv * --> ,k))]
[(vector (? pv? pv) E
`(,(clo `(λ (,x) ,e) Ep) * --> ,k))
(vector e (hash-set Ep x pv) k)]
[(vector (num n) E
`(,(succ) * --> ,k))
(vector (num (add1 n)) E k)]
[(vector (? symbol? x) E k)
(vector (hash-ref E x) E k)]
[(vector `(,e ,ep) E k)
(vector e E `(* ,E ,ep --> ,k))]
[(vector `(λ (,x) ,e) E k)
(vector (clo `(λ (,x) ,e) E) E k)]))
(define step*
(match-lambda
[(vector (? pv? pv) _ 'halt)
pv]
[st
(step* (step st))]))
(define (eval e)
(step* (vector e (hasheq) 'halt)))
(eval `(λ (s) (λ (z) z)))
(eval `(λ (s) (λ (z) (s z))))
(eval `(λ (n) (λ (m)
(λ (s) (λ (z)
((n s) ((m s) z)))))))
(eval `(((λ (n) (λ (m)
(λ (s) (λ (z)
((n s) ((m s) z))))))
(λ (s) (λ (z) (s z))))
(λ (s) (λ (z) (s z)))))
(eval `(((((λ (n) (λ (m)
(λ (s) (λ (z)
((n s) ((m s) z))))))
(λ (s) (λ (z) (s z))))
(λ (s) (λ (z) (s z))))
,(succ)) ,(num 0)))
(eval `(((((λ (n) (λ (m)
(λ (s) (λ (z)
((n s) ((m s) z))))))
(λ (s) (λ (z) (s (s z)))))
(λ (s) (λ (z) (s (s z)))))
,(succ)) ,(num 0)))
(eval `(((((λ (n) (λ (m)
(λ (s) (λ (z)
((n (m s)) z)))))
(λ (s) (λ (z) (s (s z)))))
(λ (s) (λ (z) (s (s z)))))
,(succ)) ,(num 0)))
(eval `(((((λ (n) (λ (m)
(λ (s) (λ (z)
((n (m s)) z)))))
(λ (s) (λ (z) (s (s (s z))))))
(λ (s) (λ (z) (s (s z)))))
,(succ)) ,(num 0)))