blob: 7b989d975f26acd2e07b2fa7780e6fda6c92d867 (
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
|
(.module:
lux
(lux (control [monad #+ do]
[state])
(data [maybe]
[error]
(coll [list "list/" Monoid<List>]))
(lang [".L" analysis #+ Variable Analysis]))
[// #+ Arity Synthesizer]
[//loop])
(def: nested?
(-> Arity Bool)
(n/> +1))
## (def: (adjust-var outer var)
## (-> Arity Variable Variable)
## (|> outer dec .int (i/+ var)))
(def: (unfold apply)
(-> Analysis [Analysis (List Analysis)])
(loop [apply apply
args (list)]
(case apply
(#analysisL.Apply arg func)
(recur func (#.Cons arg args))
_
[apply args])))
(def: #export (apply synthesize)
(-> Synthesizer Synthesizer)
(function (_ exprA)
(let [[funcA argsA] (unfold exprA)]
(do (state.Monad<State'> error.Monad<Error>)
[funcS (synthesize funcA)
argsS (monad.map @ synthesize argsA)
locals //.locals]
(case funcS
(^ (//.function/abstraction functionS))
(wrap (|> functionS
(//loop.loop (get@ #//.environment functionS) locals argsS)
(maybe.default (//.function/apply [funcS argsS]))))
(^ (//.function/apply [funcS' argsS']))
(wrap (//.function/apply [funcS' (list/compose argsS' argsS)]))
_
(wrap (//.function/apply [funcS argsS])))))))
|
