blob: 28bfd36bad67435c036f63ad974ba31f30e1d22e (
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
|
(.module:
[lux (#- function)
[abstract
["." monad (#+ do)]]
[control
pipe]
[data
["." product]
[text
format]
[collection
["." list ("#;." functor)]]]
[host
["_" scheme (#+ Expression Computation Var)]]]
["." // #_
["#." runtime (#+ Operation Phase)]
["#." reference]
["#." case]
["#/" //
["#." reference]
["#/" // ("#;." monad)
["#/" // #_
[reference (#+ Register Variable)]
[analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
[synthesis (#+ Synthesis)]]]]])
(def: #export (apply generate [functionS argsS+])
(-> Phase (Application Synthesis) (Operation Computation))
(do ////.monad
[functionO (generate functionS)
argsO+ (monad.map @ generate argsS+)]
(wrap (_.apply/* functionO argsO+))))
(def: #export capture
(///reference.foreign _.var))
(def: (with-closure function-name inits function-definition)
(-> Text (List Expression) Computation (Operation Computation))
(////;wrap
(case inits
#.Nil
function-definition
_
(let [@closure (_.var (format function-name "___CLOSURE"))]
(_.letrec (list [@closure
(_.lambda [(|> (list.enumerate inits)
(list;map (|>> product.left ..capture)))
#.None]
function-definition)])
(_.apply/* @closure inits))))))
(def: @curried (_.var "curried"))
(def: @missing (_.var "missing"))
(def: input
(|>> inc //case.register))
(def: #export (function generate [environment arity bodyS])
(-> Phase (Abstraction Synthesis) (Operation Computation))
(do ////.monad
[[function-name bodyO] (///.with-context
(do @
[function-name ///.context]
(///.with-anchor (_.var function-name)
(generate bodyS))))
closureO+ (: (Operation (List Expression))
(monad.map @ (:: //reference.system variable) environment))
#let [arityO (|> arity .int _.int)
apply-poly (.function (_ args func)
(_.apply/2 (_.global "apply") func args))
@num-args (_.var "num_args")
@function (_.var function-name)]]
(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 [(//case.register 0) @function]))
(_.let-values (list [[(|> (list.indices 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))))
|
