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/eval.jvm.lux | 89 +++++++++++++++++++++++++++++
 1 file changed, 89 insertions(+)
 create mode 100644 new-luxc/source/luxc/generator/eval.jvm.lux

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

diff --git a/new-luxc/source/luxc/generator/eval.jvm.lux b/new-luxc/source/luxc/generator/eval.jvm.lux
new file mode 100644
index 000000000..5fcf0b288
--- /dev/null
+++ b/new-luxc/source/luxc/generator/eval.jvm.lux
@@ -0,0 +1,89 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data ["R" result]
+             text/format)
+       [macro #+ Monad<Lux> "Lux/" Monad<Lux>]
+       [host #+ jvm-import do-to])
+  (luxc ["&" base]
+        (lang ["la" analysis]
+              ["ls" synthesis])
+        ["&;" analyser]
+        ["&;" synthesizer]
+        (generator ["&;" common])))
+
+(jvm-import java.lang.Object)
+(jvm-import java.lang.String)
+
+(jvm-import java.lang.reflect.Field
+  (get [Object] Object))
+
+(jvm-import (java.lang.Class a)
+  (getField [String] Field))
+
+(jvm-import org.objectweb.asm.Opcodes
+  (#static ACC_PUBLIC int)
+  (#static ACC_SUPER int)
+  (#static ACC_FINAL int)
+  (#static ACC_STATIC int)
+  (#static PUTSTATIC int)
+  (#static RETURN int)
+  (#static V1_6 int)
+  )
+
+(jvm-import org.objectweb.asm.MethodVisitor
+  (visitCode [] void)
+  (visitEnd [] void)
+  (visitLdcInsn [Object] void)
+  (visitFieldInsn [int String String String] void)
+  (visitInsn [int] void)
+  (visitMaxs [int int] void))
+
+(jvm-import org.objectweb.asm.FieldVisitor
+  (visitEnd [] void))
+
+(jvm-import org.objectweb.asm.ClassWriter
+  (#static COMPUTE_MAXS int)
+  (new [int])
+  (visit [int int String String String (Array String)] void)
+  (visitEnd [] void)
+  (visitField [int String String String Object] FieldVisitor)
+  (visitMethod [int String String String (Array String)] MethodVisitor)
+  (toByteArray [] Byte-Array))
+
+(def: (make-field flags name descriptor writer)
+  (-> &common;Flags Text &common;Descriptor ClassWriter FieldVisitor)
+  (do-to (ClassWriter.visitField [flags name descriptor (host;null) (host;null)] writer)
+    (FieldVisitor.visitEnd [])))
+
+(def: eval-field-name Text "_value")
+(def: eval-field-desc Text "Ljava/lang/Object;")
+
+(def: #export (eval generator)
+  (-> (Lux Unit) (Lux Top))
+  (do Monad<Lux>
+    [class-name (:: @ map %code (macro;gensym "eval"))
+     #let [writer (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
+                    (ClassWriter.visit [&common;bytecode-version
+                                        (i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_SUPER)
+                                        class-name
+                                        (host;null)
+                                        "java/lang/Object"
+                                        (host;null)]))
+           value-field (make-field ($_ i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_STATIC Opcodes.ACC_FINAL)
+                                   eval-field-name eval-field-desc
+                                   writer)
+           visitor (do-to (ClassWriter.visitMethod [Opcodes.ACC_STATIC "<clinit>" "()V" (host;null) (host;null)] writer)
+                     (MethodVisitor.visitCode []))]
+     _ (&common;with-visitor visitor generator)
+     #let [_ (do-to visitor
+               (MethodVisitor.visitFieldInsn [Opcodes.PUTSTATIC class-name eval-field-name eval-field-desc])
+               (MethodVisitor.visitInsn [Opcodes.RETURN])
+               (MethodVisitor.visitMaxs [0 0])
+               (MethodVisitor.visitEnd []))
+           bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))]
+     _ (&common;store-class class-name bytecode)
+     class (&common;load-class class-name)]
+    (wrap (|> class
+              (Class.getField [eval-field-name])
+              (Field.get (host;null))))))
-- 
cgit v1.2.3