blob: c70ca9c3772028b3762d53ba864a1c7fa48b53a3 (
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
100
101
102
103
104
105
|
(.module:
[lux (#- function)
[abstract
["." monad (#+ do)]]
[control
pipe]
[data
["." product]
[collection
["." list ("#@." functor fold)]]]
[target
["_" python (#+ Expression Statement)]]]
["." // #_
[runtime (#+ Operation Phase)]
["#." reference]
["#." case]
["#/" //
["#." reference]
["#/" //
["." // #_
[reference (#+ Register Variable)]
[analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
[synthesis (#+ Synthesis)]]]]])
(def: #export (apply generate [functionS argsS+])
(-> Phase (Application Synthesis) (Operation (Expression Any)))
(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 Any)) (Statement Any) (Operation (Expression Any)))
(case inits
#.Nil
(do ////.monad
[_ (///.save! true ["" function-name]
function-definition)]
(wrap (_.apply/* (_.var function-name) inits)))
_
(do ////.monad
[@closure (:: @ map _.var (///.gensym "closure"))
_ (///.save! true ["" (_.code @closure)]
(_.def @closure
(|> (list.enumerate inits)
(list@map (|>> product.left ..capture)))
($_ _.then
function-definition
(_.return (_.var function-name)))))]
(wrap (_.apply/* @closure inits)))))
(def: input
(|>> inc //case.register))
(def: #export (function generate [environment arity bodyS])
(-> Phase (Abstraction Synthesis) (Operation (Expression Any)))
(do ////.monad
[[function-name bodyO] (///.with-context
(do @
[function-name ///.context]
(///.with-anchor (_.var function-name)
(generate bodyS))))
closureO+ (: (Operation (List (Expression Any)))
(monad.map @ (:: //reference.system variable) environment))
#let [@curried (_.var "curried")
arityO (|> arity .int _.int)
@num-args (_.var "num_args")
@self (_.var function-name)
apply-poly (.function (_ args func)
(_.apply-poly (list) args func))
initialize-self! (_.set (list (//case.register 0)) @self)
initialize! (list@fold (.function (_ post pre!)
($_ _.then
pre!
(_.set (list (..input post)) (_.nth (|> post .int _.int) @curried))))
initialize-self!
(list.indices arity))]]
(with-closure function-name closureO+
(_.def @self (list (_.poly @curried))
($_ _.then
(_.set (list @num-args) (_.len/1 @curried))
(_.cond (list [(|> @num-args (_.= arityO))
($_ _.then
initialize!
(_.return bodyO))]
[(|> @num-args (_.> arityO))
(let [arity-inputs (_.slice (_.int +0) arityO @curried)
extra-inputs (_.slice arityO @num-args @curried)]
(_.return (|> @self
(apply-poly arity-inputs)
(apply-poly extra-inputs))))])
## (|> @num-args (_.< arityO))
(let [@next (_.var "next")
@missing (_.var "missing")]
($_ _.then
(_.def @next (list (_.poly @missing))
(_.return (|> @self (apply-poly (|> @curried (_.+ @missing))))))
(_.return @next)
)))
)))
))
|
