1 files changed, 80 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux
new file mode 100644
index 000000000..2e585fb11
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux
@@ -0,0 +1,80 @@
+(.module:
+  lux
+  (lux (control [monad #+ do])
+       (data [text]
+             text/format
+             (coll [list "list/" Functor<List> Monoid<List>]))
+       [macro])
+  (luxc ["&" lang]
+        (lang [".L" host]
+              (host ["$" jvm]
+                    (jvm ["$t" type]
+                         ["$d" def]
+                         ["$i" inst]))
+              ["la" analysis]
+              ["ls" synthesis]
+              [".L" variable #+ Variable Register]))
+  (// [".T" common]
+      [".T" runtime]
+      [".T" reference]))
+
+(def: (constant? register changeS)
+  (-> Register ls.Synthesis Bool)
+  (case changeS
+    (^multi (^code ((~ [_ (#.Int var)])))
+            (i/= (variableL.local register)
+                 var))
+    true
+
+    _
+    false))
+
+(def: #export (translate-recur translate argsS)
+  (-> (-> ls.Synthesis (Meta $.Inst))
+      (List ls.Synthesis)
+      (Meta $.Inst))
+  (do macro.Monad<Meta>
+    [[@begin offset] hostL.anchor
+     #let [pairs (list.zip2 (list.n/range offset (|> (list.size argsS) n/dec (n/+ offset)))
+                            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
+     ## must be the case.
+     valuesI+ (monad.map @ (function [[register argS]]
+                             (: (Meta $.Inst)
+                                (if (constant? register argS)
+                                  (wrap id)
+                                  (translate argS))))
+                         pairs)
+     #let [storesI+ (list/map (function [[register argS]]
+                                (: $.Inst
+                                   (if (constant? register argS)
+                                     id
+                                     ($i.ASTORE register))))
+                              (list.reverse pairs))]]
+    (wrap (|>> ($i.fuse valuesI+)
+               ($i.fuse storesI+)
+               ($i.GOTO @begin)))))
+
+(def: #export (translate-loop translate offset initsS+ bodyS)
+  (-> (-> ls.Synthesis (Meta $.Inst))
+      Nat (List ls.Synthesis) ls.Synthesis
+      (Meta $.Inst))
+  (do macro.Monad<Meta>
+    [@begin $i.make-label
+     initsI+ (monad.map @ translate initsS+)
+     bodyI (hostL.with-anchor [@begin offset]
+             (translate bodyS))
+     #let [initializationI (|> (list.enumerate initsI+)
+                               (list/map (function [[register initI]]
+                                           (|>> initI
+                                                ($i.ASTORE (n/+ offset register)))))
+                               $i.fuse)]]
+    (wrap (|>> initializationI
+               ($i.label @begin)
+               bodyI))))