diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/r/function.jvm.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/r/function.jvm.lux | 94 |
1 files changed, 0 insertions, 94 deletions
diff --git a/new-luxc/source/luxc/lang/translation/r/function.jvm.lux b/new-luxc/source/luxc/lang/translation/r/function.jvm.lux deleted file mode 100644 index f39a5e1a2..000000000 --- a/new-luxc/source/luxc/lang/translation/r/function.jvm.lux +++ /dev/null @@ -1,94 +0,0 @@ -(.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] - [".L" variable #+ Variable] - (host [r #+ Expression @@]))) - [//] - (// [".T" reference])) - -(def: #export (translate-apply translate functionS argsS+) - (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis (List ls.Synthesis) (Meta Expression)) - (do {@ macro.Monad<Meta>} - [functionO (translate functionS) - argsO+ (monad.map @ translate argsS+)] - (wrap (r.apply argsO+ functionO)))) - -(def: $curried (r.var "curried")) - -(def: (input-declaration register) - (r.set! (referenceT.variable (inc register)) - (|> (@@ $curried) (r.nth (|> register inc .int r.int))))) - -(def: (with-closure function-name inits function-definition) - (-> Text (List Expression) Expression (Meta Expression)) - (let [$closure (r.var (format function-name "___CLOSURE"))] - (case inits - #.Nil - (do macro.Monad<Meta> - [_ (//.save function-definition)] - (wrap (r.global function-name))) - - _ - (do macro.Monad<Meta> - [_ (//.save (r.set! $closure - (r.function (|> (list.enumerate inits) - (list/map (|>> product.left referenceT.closure))) - ($_ r.then - function-definition - (r.global function-name)))))] - (wrap (r.apply inits (@@ $closure))))))) - -(def: #export (translate-function translate env arity bodyS) - (-> (-> ls.Synthesis (Meta Expression)) - (List Variable) ls.Arity ls.Synthesis - (Meta Expression)) - (do {@ macro.Monad<Meta>} - [[function-name bodyO] (//.with-sub-context - (do @ - [function-name //.context] - (//.with-anchor [function-name +1] - (translate bodyS)))) - closureO+ (monad.map @ referenceT.translate-variable env) - #let [arityO (|> arity .int r.int) - $num_args (r.var "num_args") - $function (r.var function-name) - var-args (r.code (format "list" (r.expression (@@ r.var-args)))) - apply-poly (function (_ args func) - (r.apply (list func args) (r.global "do.call")))]] - (with-closure function-name closureO+ - (r.set! $function - (r.function (list r.var-args) - ($_ r.then - (r.set! $curried var-args) - (r.set! $num_args (r.length (@@ $curried))) - (r.cond (list [(|> (@@ $num_args) (r.= arityO)) - ($_ r.then - (r.set! (referenceT.variable +0) (@@ $function)) - (|> (list.n/range +0 (dec arity)) - (list/map input-declaration) - (list/fold r.then bodyO)))] - [(|> (@@ $num_args) (r.> arityO)) - (let [arity-args (r.slice (r.int 1) arityO (@@ $curried)) - output-func-args (r.slice (|> arityO (r.+ (r.int 1))) - (@@ $num_args) - (@@ $curried))] - (|> (@@ $function) - (apply-poly arity-args) - (apply-poly output-func-args)))]) - ## (|> (@@ $num_args) (r.< arityO)) - (let [$missing (r.var "missing")] - (r.function (list r.var-args) - ($_ r.then - (r.set! $missing var-args) - (|> (@@ $function) - (apply-poly (r.apply (list (@@ $curried) (@@ $missing)) - (r.global "append")))))))))))) - )) |