aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/structure.jvm.lux
diff options
context:
space:
mode:
authorEduardo Julian2017-06-14 17:56:24 -0400
committerEduardo Julian2017-06-14 17:56:24 -0400
commitc7e53036704b1a89b740c023c7b4bcc74b7e956a (patch)
treefa75c05b4233e654c17edd4de2d2b0b6fb3cece9 /new-luxc/source/luxc/generator/structure.jvm.lux
parent9cd2927a4f6175784e081d6b512d3e900c8069e7 (diff)
- Heavy refactoring.
Diffstat (limited to 'new-luxc/source/luxc/generator/structure.jvm.lux')
-rw-r--r--new-luxc/source/luxc/generator/structure.jvm.lux80
1 files changed, 34 insertions, 46 deletions
diff --git a/new-luxc/source/luxc/generator/structure.jvm.lux b/new-luxc/source/luxc/generator/structure.jvm.lux
index 1584cb170..74e44d1ca 100644
--- a/new-luxc/source/luxc/generator/structure.jvm.lux
+++ b/new-luxc/source/luxc/generator/structure.jvm.lux
@@ -1,3 +1,4 @@
+
(;module:
lux
(lux (control monad)
@@ -10,61 +11,48 @@
["ls" synthesis])
["&;" analyser]
["&;" synthesizer]
- (generator ["&;" common])))
-
-(jvm-import #long java.lang.Object)
-
-(jvm-import org.objectweb.asm.Opcodes
- (#static ANEWARRAY int)
- (#static DUP int)
- (#static AASTORE int)
- (#static ACONST_NULL int)
- (#static INVOKESTATIC int))
+ (generator ["&;" common]
+ (host ["$" jvm]
+ (jvm ["$t" type]
+ ["$d" def]
+ ["$i" inst])))))
-(jvm-import org.objectweb.asm.MethodVisitor
- (visitInsn [int] void)
- (visitLdcInsn [Object] void)
- (visitTypeInsn [int String] void)
- (visitMethodInsn [int String String String boolean] void))
+(def: $Object $;Type ($t;class "java.lang.Object" (list)))
(def: #export (generate-tuple generate members)
- (-> (-> ls;Synthesis (Lux Unit)) (List ls;Synthesis) (Lux Unit))
+ (-> (-> ls;Synthesis (Lux $;Inst)) (List ls;Synthesis) (Lux $;Inst))
(do Monad<Lux>
[#let [size (list;size members)]
_ (&;assert "Cannot generate tuples with less than 2 elements."
(n.>= +2 size))
- visitor &common;get-visitor
- #let [_ (do-to visitor
- (MethodVisitor.visitLdcInsn [(|> size nat-to-int host;l2i (:! java.lang.Object))])
- (MethodVisitor.visitTypeInsn [Opcodes.ANEWARRAY "java/lang/Object"]))]
- _ (mapM @ (function [[idx member]]
- (do @
- [#let [_ (do-to visitor
- (MethodVisitor.visitInsn [Opcodes.DUP])
- (MethodVisitor.visitLdcInsn [(|> idx nat-to-int host;l2i (:! java.lang.Object))]))]
- _ (generate member)
- #let [_ (MethodVisitor.visitInsn [Opcodes.AASTORE] visitor)]]
- (wrap [])))
- (list;enumerate members))]
- (wrap [])))
+ membersI (|> members
+ list;enumerate
+ (mapM @ (function [[idx member]]
+ (do @
+ [memberI (generate member)]
+ (wrap (|>. $i;DUP
+ ($i;int (nat-to-int idx))
+ memberI
+ $i;AASTORE)))))
+ (:: @ map $i;fuse))]
+ (wrap (|>. ($i;array $Object size) membersI))))
-(def: (generate-variant-flag tail? visitor)
- (-> Bool MethodVisitor MethodVisitor)
+(def: (flagI tail?)
+ (-> Bool $;Inst)
(if tail?
- (do-to visitor (MethodVisitor.visitLdcInsn [(:! java.lang.Object "")]))
- (do-to visitor (MethodVisitor.visitInsn [Opcodes.ACONST_NULL]))))
+ ($i;string "")
+ $i;NULL))
(def: #export (generate-variant generate tag tail? member)
- (-> (-> ls;Synthesis (Lux Unit)) Nat Bool ls;Synthesis (Lux Unit))
+ (-> (-> ls;Synthesis (Lux $;Inst)) Nat Bool ls;Synthesis (Lux $;Inst))
(do Monad<Lux>
- [visitor &common;get-visitor
- #let [_ (do-to visitor
- (MethodVisitor.visitLdcInsn [(|> tag nat-to-int host;l2i (:! java.lang.Object))]))
- _ (generate-variant-flag tail? visitor)]
- _ (generate member)
- #let [_ (do-to visitor
- (MethodVisitor.visitMethodInsn [Opcodes.INVOKESTATIC
- &common;runtime-class-name
- "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"
- false]))]]
- (wrap [])))
+ [memberI (generate member)]
+ (wrap (|>. ($i;int (nat-to-int tag))
+ (flagI tail?)
+ memberI
+ ($i;INVOKESTATIC &common;runtime-class-name
+ "sum_make"
+ ($t;method (list $t;int $Object $Object)
+ (#;Some ($t;array +1 $Object))
+ (list))
+ false)))))