blob: 9a283439ffd9cf1164eb7e245bc9718c2246c87d (
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
|
(.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 #+ Synthesis Arity]
[".L" variable #+ Register Variable]
(host ["_" php #+ Expression Var Computation Statement])))
[//]
(// [".T" reference]))
(def: #export (translate-apply translate functionS argsS+)
(-> //.Translator Synthesis (List Synthesis) (Meta Computation))
(do macro.Monad<Meta>
[functionO (translate functionS)
argsO+ (monad.map @ translate argsS+)]
(wrap (_.apply argsO+ functionO))))
(def: @curried (_.var "curried"))
(def: (input-declaration! register)
(-> Register Statement)
(_.set! (referenceT.variable (n/inc register))
(_.nth (|> register nat-to-int _.int)
@curried)))
(def: (with-closure function-name inits function-definition!)
(-> Text (List Expression) (-> (List Var) Statement) (Meta Expression))
(let [@function (_.var function-name)]
(case inits
#.Nil
(do macro.Monad<Meta>
[_ (//.save (function-definition! (list)))]
(wrap @function))
_
(do macro.Monad<Meta>
[#let [closure-name (format function-name "___CLOSURE")
@closure (_.global (format function-name "___CLOSURE"))
captured (|> (list.enumerate inits) (list/map (|>> product.left referenceT.closure)))]
_ (//.save (_.function! @closure (list/map _.parameter captured)
(|> (function-definition! captured)
(_.then! (_.return! @function)))))]
(wrap (_.apply inits @closure))))))
(def: #export (translate-function translate env arity bodyS)
(-> //.Translator (List Variable) Arity Synthesis (Meta Expression))
(do macro.Monad<Meta>
[[base-function-name bodyO] (//.with-sub-context
(do @
[function-name //.context]
(//.with-anchor [function-name +1]
(translate bodyS))))
current-module-name macro.current-module-name
#let [function-name (format current-module-name "___" base-function-name)]
closureO+ (monad.map @ referenceT.translate-variable env)
#let [@function (_.var function-name)
self-init! (_.set! (referenceT.variable +0) @function)
args-inits! (|> (list.n/range +0 (n/dec arity))
(list/map input-declaration!)
(list/fold _.then! self-init!))
arityO (|> arity nat-to-int _.int)
@num_args (_.var "num_args")]]
(with-closure function-name closureO+
(function (_ captured)
(_.set! @function
(_.function (list) (|> captured
(list/map _.reference)
(list& (_.reference @function)))
(|> (_.set! @num_args _.func-num-args/0)
(_.then! (_.set! @curried _.func-get-args/0))
(_.then! (_.if! (|> @num_args (_.= arityO))
(|> args-inits!
(_.then! (_.return! bodyO)))
(_.if! (|> @num_args (_.> arityO))
(let [arity-args (_.array-slice/3 @curried (_.int 0) arityO)
output-func-args (_.array-slice/2 @curried arityO)]
(_.return! (_.call-user-func-array/2 (_.call-user-func-array/2 @function arity-args)
output-func-args)))
(let [@missing (_.var "missing")]
(_.return! (_.function (list) (list (_.reference @function) (_.reference @curried))
(|> (_.set! @missing _.func-get-args/0)
(_.then! (_.return! (_.call-user-func-array/2 @function
(_.array-merge/+ @curried (list @missing)))))))))))))))))))
|
