blob: 97b936fc446c451966fb17d67fa1b6317dc19a49 (
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
|
(.module:
lux
(lux (control [monad #+ do]
pipe)
(data [product]
[text]
text/format
(coll [list "list/" Functor<List> Fold<List>]))
[macro])
(luxc ["&" lang]
(lang ["ls" synthesis]
[".L" variable #+ Variable]
(host [python #+ Expression Statement @@])))
[//]
(// [".T" reference]))
(def: #export (translate-apply translate functionS argsS+)
(-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis (List ls.Synthesis) (Meta Expression))
(do macro.Monad<Meta>
[functionO (translate functionS)
argsO+ (monad.map @ translate argsS+)]
(wrap (python.apply argsO+ functionO))))
(def: $curried (python.var "curried"))
(def: (input-declaration register)
(python.set! (list (referenceT.variable (n/inc register)))
(python.nth (|> register nat-to-int python.int)
(@@ $curried))))
(def: (with-closure function-name inits function-definition)
(-> Text (List Expression) Statement (Meta Expression))
(let [$closure (python.var (format function-name "___CLOSURE"))]
(case inits
#.Nil
(do macro.Monad<Meta>
[_ (//.save function-definition)]
(wrap (python.global function-name)))
_
(do macro.Monad<Meta>
[_ (//.save (python.def! $closure
(|> (list.enumerate inits)
(list/map (|>> product.left referenceT.closure)))
($_ python.then!
function-definition
(python.return! (python.global function-name)))))]
(wrap (python.apply inits (@@ $closure)))))))
(def: #export (translate-function translate env arity bodyS)
(-> (-> ls.Synthesis (Meta Expression))
(List Variable) ls.Arity ls.Synthesis
(Meta Expression))
(do macro.Monad<Meta>
[[function-name bodyO] (//.with-sub-context
(do @
[function-name //.context]
(//.with-anchor [function-name +1]
(translate bodyS))))
closureO+ (monad.map @ referenceT.translate-variable env)
#let [args-initsO+ (|> (list.n/range +0 (n/dec arity))
(list/map input-declaration)
(case> #.Nil
python.no-op!
(#.Cons head tail)
(list/fold python.then! head tail)))
arityO (|> arity nat-to-int python.int)
@curried (@@ $curried)
$num_args (python.var "num_args")
@num_args (@@ $num_args)
$function (python.var function-name)
@function (@@ $function)]]
(with-closure function-name closureO+
(python.def! $function (list (python.poly $curried))
($_ python.then!
(let [@len (python.global "len")]
(python.set! (list $num_args) (python.apply (list @curried) @len)))
(python.if! (python.= arityO @num_args)
($_ python.then!
(python.set! (list (referenceT.variable +0)) @function)
args-initsO+
(python.while! (python.bool true)
(python.return! bodyO)))
(python.if! (python.> arityO @num_args)
(let [arity-args (python.slice (python.int 0) arityO @curried)
output-func-args (python.slice arityO @num_args @curried)]
(python.return! (|> @function
(python.apply-poly (list) arity-args)
(python.apply-poly (list) output-func-args))))
(let [$next (python.var "next")
$missing (python.var "missing")]
($_ python.then!
(python.def! $next (list (python.poly $missing))
(python.return! (|> @function
(python.apply-poly (list) (|> @curried
(python.+ (@@ $missing)))))))
(python.return! (@@ $next)))))))))
))
|
