blob: 437c92520fac9b01e3d555ff5abda18bb364606b (
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
|
(.module:
[lux (#- function)
[control
["." monad (#+ do)]
pipe]
[data
["." product]
[text
format]
[collection
["." list ("list/." Functor<List>)]]]]
[//
["." runtime (#+ Operation Phase)]
["." reference]
["/." //
["//." // ("operation/." Monad<Operation>)
[analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
[synthesis (#+ Synthesis)]
[//
[reference (#+ Register Variable)]
["." name]
[//
[host
["_" scheme (#+ Expression Computation Var)]]]]]]])
(def: #export (apply translate [functionS argsS+])
(-> Phase (Application Synthesis) (Operation Computation))
(do ////.Monad<Operation>
[functionO (translate functionS)
argsO+ (monad.map @ translate argsS+)]
(wrap (_.apply/* functionO argsO+))))
(def: (with-closure function-name inits function-definition)
(-> Text (List Expression) Computation (Operation Computation))
(let [@closure (_.var (format function-name "___CLOSURE"))]
(operation/wrap
(case inits
#.Nil
function-definition
_
(_.letrec (list [@closure
(_.lambda [(|> (list.enumerate inits)
(list/map (|>> product.left reference.foreign')))
#.None]
function-definition)])
(_.apply/* @closure inits))))))
(def: @curried (_.var "curried"))
(def: @missing (_.var "missing"))
(def: input
(|>> inc reference.local'))
(def: #export (function translate [environment arity bodyS])
(-> Phase (Abstraction Synthesis) (Operation Computation))
(do ////.Monad<Operation>
[[function-name bodyO] (///.with-context
(do @
[function-name ///.context]
(///.with-anchor (_.var function-name)
(translate bodyS))))
closureO+ (monad.map @ reference.variable environment)
#let [arityO (|> arity .int _.int)
@num-args (_.var "num_args")
@function (_.var function-name)
apply-poly (.function (_ args func)
(_.apply/2 (_.global "apply") func args))]]
(with-closure function-name closureO+
(_.letrec (list [@function (_.lambda [(list) (#.Some @curried)]
(_.let (list [@num-args (_.length/1 @curried)])
(<| (_.if (|> @num-args (_.=/2 arityO))
(<| (_.let (list [(reference.local' |0) @function]))
(_.let-values (list [[(|> (list.n/range |0 (dec arity))
(list/map ..input))
#.None]
(_.apply/2 (_.global "apply") (_.global "values") @curried)]))
bodyO))
(_.if (|> @num-args (_.>/2 arityO))
(let [arity-args (runtime.slice (_.int 0) arityO @curried)
output-func-args (runtime.slice arityO
(|> @num-args (_.-/2 arityO))
@curried)]
(|> @function
(apply-poly arity-args)
(apply-poly output-func-args))))
## (|> @num-args (_.</2 arityO))
(_.lambda [(list) (#.Some @missing)]
(|> @function
(apply-poly (_.append/2 @curried @missing)))))))])
@function))
))
|
