From 2b105c8694b87a63bd151cd0966c9d5dcfaae672 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 19 Feb 2019 22:52:52 -0400
Subject: Moved looping machinery over.

---
 .../source/luxc/lang/translation/js/loop.jvm.lux   | 35 ------------------
 .../tool/compiler/phase/translation/js/case.lux    |  2 +-
 .../tool/compiler/phase/translation/js/loop.lux    | 41 ++++++++++++++++++++++
 .../compiler/phase/translation/scheme/case.jvm.lux |  2 +-
 .../compiler/phase/translation/scheme/loop.jvm.lux | 12 +++----
 5 files changed, 49 insertions(+), 43 deletions(-)
 delete mode 100644 new-luxc/source/luxc/lang/translation/js/loop.jvm.lux
 create mode 100644 stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux

diff --git a/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux
deleted file mode 100644
index c63cb2d32..000000000
--- a/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux
+++ /dev/null
@@ -1,35 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do])
-       (data [text]
-             text/format
-             (coll [list "list/" Functor<List>]))
-       [macro])
-  (luxc [lang]
-        (lang ["ls" synthesis]
-              (host [js #+ JS Expression Statement])))
-  [//]
-  (// [".T" reference]))
-
-(def: #export (translate-loop translate offset initsS+ bodyS)
-  (-> (-> ls.Synthesis (Meta Expression)) Nat (List ls.Synthesis) ls.Synthesis
-      (Meta Expression))
-  (do macro.Monad<Meta>
-    [loop-name (:: @ map (|>> %code lang.normalize-name)
-                   (macro.gensym "loop"))
-     initsJS+ (monad.map @ translate initsS+)
-     bodyJS (//.with-anchor [loop-name offset]
-              (translate bodyS))
-     #let [registersJS+ (|> (list.n/range +0 (dec (list.size initsS+)))
-                            (list/map (|>> (n/+ offset) referenceT.variable)))]]
-    (wrap (format "(function " loop-name "(" (text.join-with "," registersJS+) ") {"
-                  "return " bodyJS ";"
-                  "})(" (text.join-with "," initsJS+) ")"))))
-
-(def: #export (translate-recur translate argsS+)
-  (-> (-> ls.Synthesis (Meta Expression)) (List ls.Synthesis)
-      (Meta Expression))
-  (do macro.Monad<Meta>
-    [[loop-name offset] //.anchor
-     argsJS+ (monad.map @ translate argsS+)]
-    (wrap (format loop-name "(" (text.join-with "," argsJS+) ")"))))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux
index 91c7b4ace..0eee5383b 100644
--- a/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux
@@ -23,7 +23,7 @@
      [//
       [reference (#+ Register)]]]]])
 
-(def: register
+(def: #export register
   (common-reference.local _.var))
 
 (def: #export (let translate [valueS register bodyS])
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux
new file mode 100644
index 000000000..8d0cefe4e
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux
@@ -0,0 +1,41 @@
+(.module:
+  [lux (#- Scope)
+   [control
+    ["." monad (#+ do)]]
+   [data
+    ["." product]
+    ["." text
+     format]
+    [collection
+     ["." list ("#/." functor)]]]
+   [host
+    ["_" js (#+ Computation Var)]]]
+  [//
+   [runtime (#+ Operation Phase)]
+   ["." reference]
+   ["//." case]
+   ["/." //
+    ["//." //
+     [synthesis (#+ Scope Synthesis)]]]])
+
+(def: @scope (_.var "scope"))
+
+(def: #export (scope translate [start initsS+ bodyS])
+  (-> Phase (Scope Synthesis) (Operation Computation))
+  (do ////.monad
+    [initsO+ (monad.map @ translate initsS+)
+     bodyO (///.with-anchor @scope
+             (translate bodyS))
+     #let [closure (_.function @scope
+                     (|> initsS+
+                         list.enumerate
+                         (list/map (|>> product.left (n/+ start) //case.register)))
+                     (_.return bodyO))]]
+    (wrap (_.apply/* closure initsO+))))
+
+(def: #export (recur translate argsS+)
+  (-> Phase (List Synthesis) (Operation Computation))
+  (do ////.monad
+    [@scope ///.anchor
+     argsO+ (monad.map @ translate argsS+)]
+    (wrap (_.apply/* @scope argsO+))))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/case.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/case.jvm.lux
index 0cb6a6c9d..c20fea5fe 100644
--- a/stdlib/source/lux/tool/compiler/phase/translation/scheme/case.jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/case.jvm.lux
@@ -23,7 +23,7 @@
      [//
       [reference (#+ Register)]]]]])
 
-(def: register
+(def: #export register
   (common-reference.local _.var))
 
 (def: #export (let translate [valueS register bodyS])
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/loop.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/loop.jvm.lux
index 0d85654c1..e1db0477c 100644
--- a/stdlib/source/lux/tool/compiler/phase/translation/scheme/loop.jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/loop.jvm.lux
@@ -7,16 +7,16 @@
     ["." text
      format]
     [collection
-     ["." list ("#/." functor)]]]]
+     ["." list ("#/." functor)]]]
+   [host
+    ["_" scheme (#+ Computation Var)]]]
   [//
    [runtime (#+ Operation Phase)]
    ["." reference]
+   ["//." case]
    ["/." //
     ["//." //
-     [synthesis (#+ Scope Synthesis)]
-     [///
-      [host
-       ["_" scheme (#+ Computation Var)]]]]]])
+     [synthesis (#+ Scope Synthesis)]]]])
 
 (def: @scope (_.var "scope"))
 
@@ -28,7 +28,7 @@
              (translate bodyS))]
     (wrap (_.letrec (list [@scope (_.lambda [(|> initsS+
                                             list.enumerate
-                                            (list/map (|>> product.left (n/+ start) reference.local')))
+                                            (list/map (|>> product.left (n/+ start) //case.register)))
                                         #.None]
                                        bodyO)])
                     (_.apply/* @scope initsO+)))))
-- 
cgit v1.2.3