aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/common-lisp/function.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/common-lisp/function.jvm.lux')
-rw-r--r--new-luxc/source/luxc/lang/translation/common-lisp/function.jvm.lux82
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))))
- ))