aboutsummaryrefslogtreecommitdiff
path: root/lux-r/source/luxc/lang/translation/r/function.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'lux-r/source/luxc/lang/translation/r/function.jvm.lux')
-rw-r--r--lux-r/source/luxc/lang/translation/r/function.jvm.lux94
1 files changed, 0 insertions, 94 deletions
diff --git a/lux-r/source/luxc/lang/translation/r/function.jvm.lux b/lux-r/source/luxc/lang/translation/r/function.jvm.lux
deleted file mode 100644
index f39a5e1a2..000000000
--- a/lux-r/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"))))))))))))
- ))