From 9cd2927a4f6175784e081d6b512d3e900c8069e7 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 12 Jun 2017 21:14:55 -0400
Subject: - Renamed the "compilation" phase as the "generation" phase. -
 Implemented compilation of primitives. - Implemented compilation of
 structures.

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

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

diff --git a/new-luxc/source/luxc/generator/structure.jvm.lux b/new-luxc/source/luxc/generator/structure.jvm.lux
new file mode 100644
index 000000000..1584cb170
--- /dev/null
+++ b/new-luxc/source/luxc/generator/structure.jvm.lux
@@ -0,0 +1,70 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data text/format
+             (coll [list]))
+       [macro #+ Monad<Lux> "Lux/" Monad<Lux>]
+       [host #+ jvm-import do-to])
+  (luxc ["&" base]
+        (lang ["la" analysis]
+              ["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))
+
+(jvm-import org.objectweb.asm.MethodVisitor
+  (visitInsn [int] void)
+  (visitLdcInsn [Object] void)
+  (visitTypeInsn [int String] void)
+  (visitMethodInsn [int String String String boolean] void))
+
+(def: #export (generate-tuple generate members)
+  (-> (-> ls;Synthesis (Lux Unit)) (List ls;Synthesis) (Lux Unit))
+  (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 [])))
+
+(def: (generate-variant-flag tail? visitor)
+  (-> Bool MethodVisitor MethodVisitor)
+  (if tail?
+    (do-to visitor (MethodVisitor.visitLdcInsn [(:! java.lang.Object "")]))
+    (do-to visitor (MethodVisitor.visitInsn [Opcodes.ACONST_NULL]))))
+
+(def: #export (generate-variant generate tag tail? member)
+  (-> (-> ls;Synthesis (Lux Unit)) Nat Bool ls;Synthesis (Lux Unit))
+  (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 [])))
-- 
cgit v1.2.3