blob: 4ec6012572c679975c8d0749b5ab0f899fca5827 (
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
|
(.module:
[lux #- function]
(lux (control [monad #+ do]
pipe)
(data [product]
text/format
(coll [list "list/" Functor<List>])))
(///// [reference #+ Register Variable]
[name]
(host ["_" scheme #+ Expression Computation Var])
[compiler "operation/" Monad<Operation>]
(compiler [analysis #+ Variant Tuple Environment Arity Abstraction Application Analysis]
[synthesis #+ Synthesis]))
[///]
[//runtime #+ Operation Translator]
[//primitive]
[//reference])
(def: #export (apply translate [functionS argsS+])
(-> Translator (Application Synthesis) (Operation Computation))
(do compiler.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])
(-> Translator (Abstraction Synthesis) (Operation Computation))
(do compiler.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))
))
|
