From 9eaaaf953ba7ce1eeb805603f4e113aa15f5178f Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 8 Jan 2018 21:40:06 -0400
Subject: - Moved all translation code under the JVM path (in preparation for
 porting the JS back-end).

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

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

diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux
new file mode 100644
index 000000000..ddb6541cf
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux
@@ -0,0 +1,61 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data text/format
+             (coll [list]))
+       [macro]
+       [host #+ do-to])
+  (luxc ["&" lang]
+        (lang [".L" host]
+              (host ["$" jvm]
+                    (jvm ["$t" type]
+                         ["$d" def]
+                         ["$i" inst]))
+              ["la" analysis]
+              ["ls" synthesis]))
+  (// [".T" common]))
+
+(exception: #export Not-A-Tuple)
+
+(def: $Object $.Type ($t.class "java.lang.Object" (list)))
+
+(def: #export (translate-tuple translate members)
+  (-> (-> ls.Synthesis (Meta $.Inst)) (List ls.Synthesis) (Meta $.Inst))
+  (do macro.Monad<Meta>
+    [#let [size (list.size members)]
+     _ (&.assert Not-A-Tuple (%code (` [(~+ members)]))
+                 (n/>= +2 size))
+     membersI (|> members
+                  list.enumerate
+                  (monad.map @ (function [[idx member]]
+                                 (do @
+                                   [memberI (translate member)]
+                                   (wrap (|>> $i.DUP
+                                              ($i.int (nat-to-int idx))
+                                              memberI
+                                              $i.AASTORE)))))
+                  (:: @ map $i.fuse))]
+    (wrap (|>> ($i.int (nat-to-int size))
+               ($i.array $Object)
+               membersI))))
+
+(def: (flagI tail?)
+  (-> Bool $.Inst)
+  (if tail?
+    ($i.string "")
+    $i.NULL))
+
+(def: #export (translate-variant translate tag tail? member)
+  (-> (-> ls.Synthesis (Meta $.Inst)) Nat Bool ls.Synthesis (Meta $.Inst))
+  (do macro.Monad<Meta>
+    [memberI (translate member)]
+    (wrap (|>> ($i.int (nat-to-int tag))
+               (flagI tail?)
+               memberI
+               ($i.INVOKESTATIC hostL.runtime-class
+                                "variant_make"
+                                ($t.method (list $t.int $Object $Object)
+                                           (#.Some ($t.array +1 $Object))
+                                           (list))
+                                false)))))
-- 
cgit v1.2.3