From 72603f38074a67f9ab1e53df1b5fb5da3836162d Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 14 Nov 2017 02:00:14 -0400
Subject: - Implemented loop translation.

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

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

diff --git a/new-luxc/source/luxc/lang/translation/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/loop.jvm.lux
new file mode 100644
index 000000000..d9216f1a7
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/loop.jvm.lux
@@ -0,0 +1,62 @@
+(;module:
+  lux
+  (lux (control [monad #+ do])
+       (data [text]
+             text/format
+             (coll [list "list/" Functor<List> Monoid<List>]))
+       [meta])
+  (luxc ["&" base]
+        [";L" host]
+        (host ["$" jvm]
+              (jvm ["$t" type]
+                   ["$d" def]
+                   ["$i" inst]))
+        (lang ["la" analysis]
+              ["ls" synthesis]
+              (translation [";T" common]
+                           [";T" runtime]
+                           [";T" reference])
+              [";L" variable #+ Variable])))
+
+(def: #export (translate-recur translate argsS)
+  (-> (-> ls;Synthesis (Meta $;Inst))
+      (List ls;Synthesis)
+      (Meta $;Inst))
+  (do meta;Monad<Meta>
+    [[@begin offset] hostL;anchor
+     argsI (monad;map @ (function [[register argS]]
+                          (let [register' (n.+ offset register)]
+                            (: (Meta $;Inst)
+                               (case argS
+                                 (^multi (^code ((~ [_ (#;Int var)])))
+                                         (i.= (variableL;local register')
+                                              var))
+                                 (wrap id)
+
+                                 _
+                                 (do @
+                                   [argI (translate argS)]
+                                   (wrap (|>. argI
+                                              ($i;ASTORE register'))))))))
+                      (list;zip2 (list;n.range +0 (n.dec (list;size argsS)))
+                                 argsS))]
+    (wrap (|>. ($i;fuse argsI)
+               ($i;GOTO @begin)))))
+
+(def: #export (translate-loop translate offset initsS+ bodyS)
+  (-> (-> ls;Synthesis (Meta $;Inst))
+      Nat (List ls;Synthesis) ls;Synthesis
+      (Meta $;Inst))
+  (do meta;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 (|> register n.inc (n.+ offset))))))
+                               $i;fuse)]]
+    (wrap (|>. initializationI
+               ($i;label @begin)
+               bodyI))))
-- 
cgit v1.2.3