1 files changed, 81 insertions, 0 deletions
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux
new file mode 100644
index 000000000..1f2168fed
--- /dev/null
+++ b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux
@@ -0,0 +1,81 @@
+(.module:
+  [lux #*
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["." function]]
+   [data
+    [number
+     ["n" nat]]
+    [collection
+     ["." list ("#/." functor monoid)]]]
+   [tool
+    [compiler
+     [reference (#+ Register)]
+     ["." phase]
+     [language
+      [lux
+       ["." synthesis (#+ Synthesis)]
+       ["." generation]]]]]]
+  [luxc
+   [lang
+    [host
+     [jvm (#+ Inst Operation Phase Generator)
+      ["_" inst]]]]]
+  ["." //])
+
+(def: (invariant? register changeS)
+  (-> Register Synthesis Bit)
+  (case changeS
+    (^ (synthesis.variable/local var))
+    (n.= register var)
+
+    _
+    false))
+
+(def: #export (recur translate archive argsS)
+  (Generator (List Synthesis))
+  (do {@ phase.monad}
+    [[@begin start] generation.anchor
+     #let [end (|> argsS list.size dec (n.+ start))
+           pairs (list.zip2 (list.n/range start end)
+                            argsS)]
+     ## It may look weird that first I compile the values separately,
+     ## and then I compile the stores/allocations.
+     ## It must be done that way in order to avoid a potential bug.
+     ## Let's say that you'll recur with 2 expressions: X and Y.
+     ## If Y depends on the value of X, and you don't compile values
+     ## and stores separately, then by the time Y is evaluated, it
+     ## will refer to the new value of X, instead of the old value, as
+     ## should be the case.
+     valuesI+ (monad.map @ (function (_ [register argS])
+                             (: (Operation Inst)
+                                (if (invariant? register argS)
+                                  (wrap function.identity)
+                                  (translate archive argS))))
+                         pairs)
+     #let [storesI+ (list/map (function (_ [register argS])
+                                (: Inst
+                                   (if (invariant? register argS)
+                                     function.identity
+                                     (_.ASTORE register))))
+                              (list.reverse pairs))]]
+    (wrap (|>> (_.fuse valuesI+)
+               (_.fuse storesI+)
+               (_.GOTO @begin)))))
+
+(def: #export (scope translate archive [start initsS+ iterationS])
+  (Generator [Nat (List Synthesis) Synthesis])
+  (do {@ phase.monad}
+    [@begin _.make-label
+     initsI+ (monad.map @ (translate archive) initsS+)
+     iterationI (generation.with-anchor [@begin start]
+                  (translate archive iterationS))
+     #let [initializationI (|> (list.enumerate initsI+)
+                               (list/map (function (_ [register initI])
+                                           (|>> initI
+                                                (_.ASTORE (n.+ start register)))))
+                               _.fuse)]]
+    (wrap (|>> initializationI
+               (_.label @begin)
+               iterationI))))