aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/eval.jvm.lux
blob: 5fcf0b28822597e99e346cf4903fd5b19fd0021b (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
81
82
83
84
85
86
87
88
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))))))