blob: be68f84e98c5de2bf103ed90370679d20d20ff11 (
plain)
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
95
96
97
98
99
100
101
102
103
104
105
106
|
(;module:
lux
(lux (control monad)
(data [text "T/" Eq<Text>]
text/format
[maybe #+ Monad<Maybe> "Maybe/" Monad<Maybe>]
[product]
(coll [list "L/" Fold<List> Monoid<List>])))
(luxc ["&" base]))
(type: Captured (Bindings Text [Type Ref]))
(def: (pl::contains? key mappings)
(All [a] (-> Text (List [Text a]) Bool))
(case mappings
#;Nil
false
(#;Cons [k v] mappings')
(or (T/= key k)
(pl::contains? key mappings'))))
(def: (pl::get key mappings)
(All [a] (-> Text (List [Text a]) (Maybe a)))
(case mappings
#;Nil
#;None
(#;Cons [k v] mappings')
(if (T/= key k)
(#;Some v)
(pl::get key mappings'))))
(def: (pl::put key value mappings)
(All [a] (-> Text a (List [Text a]) (List [Text a])))
(case mappings
#;Nil
(list [key value])
(#;Cons [k v] mappings')
(if (T/= key k)
(#;Cons [key value] mappings')
(#;Cons [k v]
(pl::put key value mappings')))))
(do-template [<slot> <is> <get> <then>]
[(def: (<is> name scope)
(-> Text Scope Bool)
(|> scope
(get@ [<slot> #;mappings])
(pl::contains? name)))
(def: (<get> name scope)
(-> Text Scope (Maybe [Type Ref]))
(|> scope
(get@ [<slot> #;mappings])
(pl::get name)
(Maybe/map (function [[type value]]
[type (<then> value)]))))]
[#;locals is-local? get-local #;Local]
[#;captured is-captured? get-captured id]
)
(def: (is-ref? name scope)
(-> Text Scope Bool)
(or (is-local? name scope)
(is-captured? name scope)))
(def: (get-ref name scope)
(-> Text Scope (Maybe [Type Ref]))
(case (get-local name scope)
(#;Some type)
(#;Some type)
_
(get-captured name scope)))
(def: #export (find name)
(-> Text (Lux (Maybe [Type Ref])))
(function [compiler]
(let [[inner outer] (|> compiler
(get@ #;scopes)
(list;split-with (|>. (is-ref? name) not)))]
(case outer
#;Nil
(#;Right [compiler #;None])
(#;Cons top-outer _)
(let [[ref-type init-ref] (default (undefined)
(get-ref name top-outer))
[ref inner'] (L/fold (: (-> Scope [Ref (List Scope)] [Ref (List Scope)])
(function [scope [ref inner]]
[(#;Captured (get@ [#;captured #;counter] scope))
(#;Cons (update@ #;captured
(: (-> Captured Captured)
(|>. (update@ #;counter n.inc)
(update@ #;mappings (pl::put name [ref-type ref]))))
scope)
inner)]))
[init-ref #;Nil]
(list;reverse inner))
scopes (L/append inner' outer)]
(#;Right [(set@ #;scopes scopes compiler)
(#;Some [ref-type ref])]))
))))
|
