blob: c3219f5acf48051f8d9b1828f199e0780bff8e62 (
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
|
(.module:
[lux #*
[control
[monad (#+ do)]]
[data
["." error]]
["." function]
[type
["tc" check]]
["." macro]]
[// (#+ Operation)
["/." //
["." extension]]])
(def: #export (with-type expected)
(All [a] (-> Type (Operation a) (Operation a)))
(extension.localized (get@ #.expected) (set@ #.expected)
(function.constant (#.Some expected))))
(def: #export (with-env action)
(All [a] (-> (tc.Check a) (Operation a)))
(function (_ (^@ stateE [bundle state]))
(case (action (get@ #.type-context state))
(#error.Success [context' output])
(#error.Success [[bundle (set@ #.type-context context' state)]
output])
(#error.Failure error)
((///.fail error) stateE))))
(def: #export with-fresh-env
(All [a] (-> (Operation a) (Operation a)))
(extension.localized (get@ #.type-context) (set@ #.type-context)
(function.constant tc.fresh-context)))
(def: #export (infer actualT)
(-> Type (Operation Any))
(do ///.Monad<Operation>
[expectedT (extension.lift macro.expected-type)]
(with-env
(tc.check expectedT actualT))))
(def: #export (with-inference action)
(All [a] (-> (Operation a) (Operation [Type a])))
(do ///.Monad<Operation>
[[_ varT] (..with-env
tc.var)
output (with-type varT
action)
knownT (..with-env
(tc.clean varT))]
(wrap [knownT output])))
|
