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".

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

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

diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.lux
new file mode 100644
index 000000000..527228c8e
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/jvm/structure.lux
@@ -0,0 +1,70 @@
+(.module:
+  [lux #*
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["ex" exception (#+ exception:)]]
+   [data
+    [text
+     format]
+    [collection
+     ["." list]]]
+   [tool
+    [compiler
+     [synthesis (#+ Synthesis)]
+     ["." phase]]]]
+  [luxc
+   [lang
+    [host
+     ["." jvm (#+ Inst Operation Phase)
+      ["$t" type]
+      ["_" inst]]]]]
+  ["." //])
+
+(exception: #export (not-a-tuple {size Nat})
+  (ex.report ["Expected size" ">= 2"]
+             ["Actual size" (%n size)]))
+
+(def: $Object jvm.Type ($t.class "java.lang.Object" (list)))
+
+(def: #export (tuple translate members)
+  (-> Phase (List Synthesis) (Operation Inst))
+  (do phase.monad
+    [#let [size (list.size members)]
+     _ (phase.assert not-a-tuple size
+                     (n/>= 2 size))
+     membersI (|> members
+                  list.enumerate
+                  (monad.map @ (function (_ [idx member])
+                                 (do @
+                                   [memberI (translate member)]
+                                   (wrap (|>> _.DUP
+                                              (_.int (.int idx))
+                                              memberI
+                                              _.AASTORE)))))
+                  (:: @ map _.fuse))]
+    (wrap (|>> (_.int (.int size))
+               (_.array $Object)
+               membersI))))
+
+(def: (flagI right?)
+  (-> Bit Inst)
+  (if right?
+    (_.string "")
+    _.NULL))
+
+(def: #export (variant translate lefts right? member)
+  (-> Phase Nat Bit Synthesis (Operation Inst))
+  (do phase.monad
+    [memberI (translate member)]
+    (wrap (|>> (_.int (.int (if right?
+                              (.inc lefts)
+                              lefts)))
+               (flagI right?)
+               memberI
+               (_.INVOKESTATIC //.runtime-class
+                               "variant_make"
+                               ($t.method (list $t.int $Object $Object)
+                                          (#.Some ($t.array 1 $Object))
+                                          (list))
+                               #0)))))
-- 
cgit v1.2.3