aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/runtime.jvm.lux
blob: e8831d005aa6e17a695cf45efc4b81eda48e8c21 (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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
(;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] #try Object))

(jvm-import (java.lang.Class a)
  (getField [String] Field))

(type: Flags Int)
(type: Descriptor Text)

(jvm-import org.objectweb.asm.Opcodes
  (#static ACC_PUBLIC int)
  (#static ACC_SUPER int)
  (#static ACC_FINAL int)
  (#static ACC_STATIC int)
  (#static DUP int)
  (#static PUTSTATIC int)
  (#static ILOAD int)
  (#static ALOAD int)
  (#static ANEWARRAY int)
  (#static AASTORE int)
  (#static RETURN int)
  (#static ARETURN int)
  (#static V1_6 int)
  )

(jvm-import org.objectweb.asm.MethodVisitor
  (visitCode [] void)
  (visitEnd [] void)
  (visitInsn [int] void)
  (visitLdcInsn [Object] void)
  (visitFieldInsn [int String String String] void)
  (visitVarInsn [int int] void)
  (visitTypeInsn [int String] 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: (generate-adt-methods writer)
  (-> ClassWriter ClassWriter)
  (let [## I commented-out some parts because a null-check was
        ## done to ensure variants were never created with null
        ## values (this would interfere later with
        ## pattern-matching).
        ## Since Lux itself does not have null values as part of
        ## the language, the burden of ensuring non-nulls was
        ## shifted to library code dealing with host-interop, to
        ## ensure variant-making was as fast as possible.
        ## The null-checking code was left as comments in case I
        ## ever change my mind.
        _ (let [## $is-null (new Label)
                visitor (ClassWriter.visitMethod [(i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_STATIC)
                                                  "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"
                                                  (host;null) (host;null)]
                                                 writer)
                _ (do-to visitor
                    (MethodVisitor.visitCode [])
                    ## (MethodVisitor.visitVarInsn [Opcodes.ALOAD 2])
                    ## (MethodVisitor.visitJumpInsn [Opcodes.IFNULL $is-null])
                    (MethodVisitor.visitLdcInsn [(host;l2i 3)])
                    (MethodVisitor.visitTypeInsn [Opcodes.ANEWARRAY "java/lang/Object"])
                    (MethodVisitor.visitInsn [Opcodes.DUP])
                    (MethodVisitor.visitLdcInsn [(host;l2i 0)])
                    (MethodVisitor.visitVarInsn [Opcodes.ILOAD 0]))
                _ (&common;wrap-int visitor)
                _ (do-to visitor
                    (MethodVisitor.visitInsn [Opcodes.AASTORE])
                    (MethodVisitor.visitInsn [Opcodes.DUP])
                    (MethodVisitor.visitLdcInsn [(host;l2i 1)])
                    (MethodVisitor.visitVarInsn [Opcodes.ALOAD 1])
                    (MethodVisitor.visitInsn [Opcodes.AASTORE])
                    (MethodVisitor.visitInsn [Opcodes.DUP])
                    (MethodVisitor.visitLdcInsn [(host;l2i 2)])
                    (MethodVisitor.visitVarInsn [Opcodes.ALOAD 2])
                    (MethodVisitor.visitInsn [Opcodes.AASTORE])
                    (MethodVisitor.visitInsn [Opcodes.ARETURN])
                    ## (MethodVisitor.visitLabel [$is-null])
                    ## (MethodVisitor.visitTypeInsn [Opcodes.NEW "java/lang/IllegalStateException"])
                    ## (MethodVisitor.visitInsn [Opcodes.DUP])
                    ## (MethodVisitor.visitLdcInsn ["Cannot create variant for null pointer"])
                    ## (MethodVisitor.visitMethodInsn [Opcodes.INVOKESPECIAL "java/lang/IllegalStateException" "<init>" "(Ljava/lang/String;)V"])
                    ## (MethodVisitor.visitInsn [Opcodes.ATHROW])
                    (MethodVisitor.visitMaxs [0 0])
                    (MethodVisitor.visitEnd []))]
            [])]
    writer))

(def: #export generate
  (Lux &common;Bytecode)
  (do Monad<Lux>
    [_ (wrap [])
     #let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
                        (ClassWriter.visit [&common;bytecode-version
                                            ($_ i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_FINAL Opcodes.ACC_SUPER)
                                            &common;runtime-class-name (host;null)
                                            "java/lang/Object" (host;null)]))
                      generate-adt-methods)
           bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))]
     _ (&common;store-class &common;runtime-class-name bytecode)]
    (wrap bytecode)))