From b4d0eba7485caf0c6cf58de1193a9114fa273d8b Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 30 May 2020 15:19:28 -0400
Subject: Split new-luxc into lux-jvm and lux-r.

---
 .../luxc/lang/translation/r/function.jvm.lux       | 94 ----------------------
 1 file changed, 94 deletions(-)
 delete mode 100644 new-luxc/source/luxc/lang/translation/r/function.jvm.lux

(limited to 'new-luxc/source/luxc/lang/translation/r/function.jvm.lux')

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"))))))))))))
-    ))
-- 
cgit v1.2.3