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 | 62 |
1 files changed, 26 insertions, 36 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 index c42327839..3d4407bd0 100644 --- a/new-luxc/source/luxc/lang/translation/r/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/function.jvm.lux @@ -10,7 +10,7 @@ (luxc ["&" lang] (lang ["ls" synthesis] [".L" variable #+ Variable] - (host [r #+ Expression Statement @@]))) + (host [r #+ Expression @@]))) [//] (// [".T" reference])) @@ -28,7 +28,7 @@ (|> (@@ $curried) (r.nth (|> register n/inc nat-to-int r.int))))) (def: (with-closure function-name inits function-definition) - (-> Text (List Expression) Statement (Meta Expression)) + (-> Text (List Expression) Expression (Meta Expression)) (let [$closure (r.var (format function-name "___CLOSURE"))] (case inits #.Nil @@ -41,9 +41,9 @@ [_ (//.save (r.set! $closure (r.function (|> (list.enumerate inits) (list/map (|>> product.left referenceT.closure))) - ($_ r.then! + ($_ r.then function-definition - (r.do! (r.global function-name))))))] + (r.global function-name)))))] (wrap (r.apply inits (@@ $closure))))))) (def: #export (translate-function translate env arity bodyS) @@ -57,14 +57,7 @@ (//.with-anchor [function-name +1] (translate bodyS)))) closureO+ (monad.map @ referenceT.translate-variable env) - #let [args-inits! (|> (list.n/range +0 (n/dec arity)) - (list/map input-declaration) - (case> #.Nil - r.no-op! - - (#.Cons head tail) - (list/fold r.then! head tail))) - arityO (|> arity nat-to-int r.int) + #let [arityO (|> arity nat-to-int r.int) $num_args (r.var "num_args") $function (r.var function-name) apply-poly (function (_ args func) @@ -72,30 +65,27 @@ (with-closure function-name closureO+ (r.set! $function (r.function (list r.var-args) - ($_ r.then! - ## (r.set! $curried (r.apply (list (@@ r.var-args)) (r.global "list"))) + ($_ r.then (r.set! $curried (@@ r.var-args)) (r.set! $num_args (r.length (@@ $curried))) - (r.do! - (r.cond (list [(|> (@@ $num_args) (r.= arityO)) - (r.block - ($_ r.then! - (r.set! (referenceT.variable +0) (@@ $function)) - args-inits! - (r.do! bodyO)))] - [(|> (@@ $num_args) (r.> arityO)) - (let [arity-args (r.slice (r.int 1) arityO (@@ $curried)) - output-func-args (r.slice arityO (@@ $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 (r.apply (list (@@ r.var-args)) (r.global "list"))) - (r.set! $missing (@@ r.var-args)) - (r.do! (|> (@@ $function) - (apply-poly (r.apply (list (@@ $curried) (@@ $missing)) - (r.global "append")))))))))))))) + (r.cond (list [(|> (@@ $num_args) (r.= arityO)) + ($_ r.then + (r.set! (referenceT.variable +0) (@@ $function)) + (|> (list.n/range +0 (n/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 (@@ $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 (@@ r.var-args)) + (|> (@@ $function) + (apply-poly (r.apply (list (@@ $curried) (@@ $missing)) + (r.global "append")))))))))))) )) |