aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm/structure.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm/structure.lux')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/structure.lux70
1 files changed, 70 insertions, 0 deletions
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)))))