diff options
author | Eduardo Julian | 2019-05-01 20:33:42 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-05-01 20:33:42 -0400 |
commit | c923517c864dad362ef00ae78b449bb40cc27e84 (patch) | |
tree | a758099e76424db4fc8ec8d8cc18a8a699d68d66 /new-luxc/source/luxc/lang/translation/common-lisp/function.jvm.lux | |
parent | 0c20f4a8362d42572edecb6ef9844b75c4c859f8 (diff) |
The Common Lisp compiler is alive.
Diffstat (limited to '')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/common-lisp/function.jvm.lux | 82 |
1 files changed, 0 insertions, 82 deletions
diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/function.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/function.jvm.lux deleted file mode 100644 index 54834b65c..000000000 --- a/new-luxc/source/luxc/lang/translation/common-lisp/function.jvm.lux +++ /dev/null @@ -1,82 +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 ["_" common-lisp #+ Expression @@]))) - [//] - (// [".T" reference] - [".T" runtime])) - -(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 (_.funcall argsO+ functionO)))) - -(def: $curried (_.var "curried")) -(def: $missing (_.var "missing")) - -(def: input-declaration - (|>> inc referenceT.variable)) - -(def: (with-closure function-name inits function-definition) - (-> Text (List Expression) Expression (Meta Expression)) - (let [$closure (_.var (format function-name "___CLOSURE"))] - (do macro.Monad<Meta> - [] - (case inits - #.Nil - (wrap function-definition) - - _ - (wrap (_.labels (list [$closure [(|> (list.enumerate inits) - (list/map (|>> product.left referenceT.closure)) - _.poly) - function-definition]]) - (_.funcall inits (_.function (@@ $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 _.int) - $num_args (_.var "num_args") - $function (_.var function-name)]] - (with-closure function-name closureO+ - (_.labels (list [$function [(_.poly+ (list) $curried) - (_.let (list [$num_args (_.length (@@ $curried))]) - (<| (_.if (|> (@@ $num_args) (_.= arityO)) - (_.let (list [(referenceT.variable +0) (_.function (@@ $function))]) - (_.destructuring-bind [(|> (list.n/range +0 (dec arity)) - (list/map input-declaration) - _.poly) - (@@ $curried)] - bodyO))) - (_.if (|> (@@ $num_args) (_.> arityO)) - (let [arity-args (_.subseq/3 (@@ $curried) (_.int 0) arityO) - output-func-args (_.subseq/3 (@@ $curried) arityO (@@ $num_args))] - (|> (_.function (@@ $function)) - (_.apply arity-args) - (_.apply output-func-args)))) - ## (|> (@@ $num_args) (_.< arityO)) - (_.lambda (_.poly+ (list) $missing) - (|> (_.function (@@ $function)) - (_.apply (_.append (@@ $curried) (@@ $missing)))))))]]) - (_.function (@@ $function)))) - )) |