aboutsummaryrefslogtreecommitdiff
path: root/lux-jvm/source/luxc/lang/translation/jvm/structure.lux
diff options
context:
space:
mode:
authorEduardo Julian2020-05-30 15:19:28 -0400
committerEduardo Julian2020-05-30 15:19:28 -0400
commitb4d0eba7485caf0c6cf58de1193a9114fa273d8b (patch)
treef6f7fa2967bb5923347db1ed1d4c9b08e56bf8c6 /lux-jvm/source/luxc/lang/translation/jvm/structure.lux
parent6eaa3b57f3f1ea2ce13b942bdb4ef502fc1729bc (diff)
Split new-luxc into lux-jvm and lux-r.
Diffstat (limited to 'lux-jvm/source/luxc/lang/translation/jvm/structure.lux')
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/structure.lux79
1 files changed, 79 insertions, 0 deletions
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux
new file mode 100644
index 000000000..46f87142a
--- /dev/null
+++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux
@@ -0,0 +1,79 @@
+(.module:
+ [lux (#- Type)
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["ex" exception (#+ exception:)]]
+ [data
+ [number
+ ["n" nat]]
+ [text
+ ["%" format (#+ format)]]
+ [collection
+ ["." list]]]
+ [target
+ [jvm
+ ["." type (#+ Type)
+ ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
+ ["." descriptor (#+ Descriptor)]
+ ["." signature (#+ Signature)]]]]
+ [tool
+ [compiler
+ ["." phase]
+ [meta
+ [archive (#+ Archive)]]
+ [language
+ [lux
+ [synthesis (#+ Synthesis)]]]]]]
+ [luxc
+ [lang
+ [host
+ [jvm (#+ Inst Operation Phase Generator)
+ ["_" inst]]]]]
+ ["." //
+ ["#." runtime]])
+
+(exception: #export (not-a-tuple {size Nat})
+ (ex.report ["Expected size" ">= 2"]
+ ["Actual size" (%.nat size)]))
+
+(def: #export (tuple generate archive members)
+ (Generator (List Synthesis))
+ (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 (generate archive member)]
+ (wrap (|>> _.DUP
+ (_.int (.int idx))
+ memberI
+ _.AASTORE)))))
+ (:: @ map _.fuse))]
+ (wrap (|>> (_.int (.int size))
+ (_.array //runtime.$Value)
+ membersI))))
+
+(def: (flagI right?)
+ (-> Bit Inst)
+ (if right?
+ (_.string "")
+ _.NULL))
+
+(def: #export (variant generate archive [lefts right? member])
+ (Generator [Nat Bit Synthesis])
+ (do phase.monad
+ [memberI (generate archive member)]
+ (wrap (|>> (_.int (.int (if right?
+ (.inc lefts)
+ lefts)))
+ (flagI right?)
+ memberI
+ (_.INVOKESTATIC //.$Runtime
+ "variant_make"
+ (type.method [(list //runtime.$Tag //runtime.$Flag //runtime.$Value)
+ //.$Variant
+ (list)]))))))