diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/eval.jvm.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/eval.jvm.lux | 80 |
1 files changed, 80 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/translation/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/eval.jvm.lux new file mode 100644 index 000000000..9514741f8 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/eval.jvm.lux @@ -0,0 +1,80 @@ +(;module: + lux + (lux (control monad) + (data text/format) + [meta] + [host #+ do-to]) + (luxc ["&" base] + (host ["$" jvm] + (jvm ["$t" type] + ["$d" def] + ["$i" inst])) + (lang ["la" analysis] + ["ls" synthesis] + (translation [";T" common])) + )) + +(host;import java.lang.Object) +(host;import java.lang.String) + +(host;import java.lang.reflect.Field + (get [Object] Object)) + +(host;import (java.lang.Class a) + (getField [String] Field)) + +(host;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) + ) + +(host;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)) + +(host;import org.objectweb.asm.FieldVisitor + (visitEnd [] void)) + +(host;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 [] (Array byte))) + +(def: #export (eval valueI) + (-> $;Inst (Meta Top)) + (do meta;Monad<Meta> + [class-name (:: @ map %code (meta;gensym "eval")) + #let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS) + (ClassWriter.visit [commonT;bytecode-version + (i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_SUPER) + class-name + (host;null) + "java/lang/Object" + (host;null)])) + ($d;field #$;Public ($_ $;++F $;finalF $;staticF) + commonT;value-field commonT;$Object) + ($d;method #$;Public ($_ $;++M $;staticM $;strictM) + "<clinit>" + ($t;method (list) #;None (list)) + (|>. valueI + ($i;PUTSTATIC class-name commonT;value-field commonT;$Object) + $i;RETURN))) + bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))] + _ (commonT;store-class class-name bytecode) + class (commonT;load-class class-name)] + (wrap (|> class + (Class.getField [commonT;value-field]) + (Field.get (host;null)))))) |