From 697707d8560a5735be38fd9b1ff91a02c289d48f Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 16 Apr 2019 20:53:41 -0400
Subject: Made some new-luxc modules "old".

---
 new-luxc/source/luxc/lang/translation/jvm/loop.lux | 79 ++++++++++++++++++++++
 1 file changed, 79 insertions(+)
 create mode 100644 new-luxc/source/luxc/lang/translation/jvm/loop.lux

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

diff --git a/new-luxc/source/luxc/lang/translation/jvm/loop.lux b/new-luxc/source/luxc/lang/translation/jvm/loop.lux
new file mode 100644
index 000000000..d7e706aaf
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/jvm/loop.lux
@@ -0,0 +1,79 @@
+(.module:
+  [lux #*
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["." function]]
+   [data
+    ["." text
+     format]
+    [collection
+     ["." list ("#/." functor monoid)]]]
+   [tool
+    [compiler
+     [reference (#+ Register)]
+     ["." synthesis (#+ Synthesis)]
+     ["." phase
+      ["." generation]]]]]
+  [luxc
+   [lang
+    [host
+     [jvm (#+ Inst Operation Phase)
+      ["_" inst]]]]]
+  ["." //])
+
+(def: (constant? register changeS)
+  (-> Register Synthesis Bit)
+  (case changeS
+    (^ (synthesis.variable/local var))
+    (n/= register var)
+
+    _
+    #0))
+
+(def: #export (recur translate argsS)
+  (-> Phase (List Synthesis) (Operation Inst))
+  (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 (constant? register argS)
+                                  (wrap function.identity)
+                                  (translate argS))))
+                         pairs)
+     #let [storesI+ (list/map (function (_ [register argS])
+                                (: Inst
+                                   (if (constant? register argS)
+                                     function.identity
+                                     (_.ASTORE register))))
+                              (list.reverse pairs))]]
+    (wrap (|>> (_.fuse valuesI+)
+               (_.fuse storesI+)
+               (_.GOTO @begin)))))
+
+(def: #export (scope translate [start initsS+ iterationS])
+  (-> Phase [Nat (List Synthesis) Synthesis] (Operation Inst))
+  (do phase.monad
+    [@begin _.make-label
+     initsI+ (monad.map @ translate initsS+)
+     iterationI (generation.with-anchor [@begin start]
+                  (translate iterationS))
+     #let [initializationI (|> (list.enumerate initsI+)
+                               (list/map (function (_ [register initI])
+                                           (|>> initI
+                                                (_.ASTORE (n/+ start register)))))
+                               _.fuse)]]
+    (wrap (|>> initializationI
+               (_.label @begin)
+               iterationI))))
-- 
cgit v1.2.3