-
Notifications
You must be signed in to change notification settings - Fork 3
/
cant.cant
81 lines (73 loc) · 2.1 KB
/
cant.cant
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
;; A kernel-Cant interpreter in direct-style Cant.
;; Variable names:
;; e expression
;; p pattern
;; r setting (environment)
(to (play e r)
(may e.term
(be {constant value}
value)
(be {variable name}
(r name))
(be {make _ stamp trait clauses}
(actor<- (script<- (if trait (play trait r) miranda-trait)
clauses)
r))
(be {so e1 e2}
(play e1 r)
(play e2 r))
(be {let p e1}
(let value (play e1 r))
(if (match value p r)
value
(oops "Match failure" p value)))
(be {call e1 e2}
(call (play e1 r) (play e2 r)))
(be {term tag es}
(term<- tag (for each [(e1 es)]
(play e1 r))))
(be {list es}
(for each [(e1 es)]
(play e1 r)))))
(to (actor<- script r)
(make actor
(to message
(script .receive message actor r))))
(to (script<- trait clauses)
(to (script .receive message actor parent-r)
(do matching [clauses]
(may clauses
(be '()
(trait actor message))
(be `((,pattern ,pat-vars ,body-vars ,body) ,@rest)
(let pat-r (parent-r .extend-promises pat-vars))
(if (match message pattern pat-r)
(play body (pat-r .extend-promises body-vars))
(matching rest)))))))
(to (match subject p r)
(may p.term
(be {any-pat}
#yes)
(be {variable-pat name}
(r .resolve! name subject)
#yes)
(be {constant-pat value}
(= subject value))
(be {list-pat p-args}
(and (list? subject)
(match-all subject p-args r)))
(be {term-pat tag p-parts}
(and (term? subject)
(= subject.tag tag)
(match-all subject.parts p-parts r)))
(be {and-pat p1 p2}
(and (match subject p1 r)
(match subject p2 r)))
(be {view-pat e p}
(match ((play e r) subject) p r))))
(to (match-all values pats r)
(hm (if values.none? pats.none?)
(if pats.none? #no)
(else (and (match values.first pats.first r)
(match-all values.rest pats.rest r)))))
(export play match)