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.

---
 .../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 +++----
 4 files changed, 49 insertions(+), 8 deletions(-)
 create mode 100644 stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux

(limited to 'stdlib/source')

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