aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/eval.jvm.lux
blob: 9514741f85ec4a4e5b073a3ad71c9ad406b1f3cc (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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))))))