blob: e5d3552c49d51417e8c9f25ab4c34a2e5c77992e (
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
127
128
129
130
|
(;module:
lux
(lux [io]
(concurrency ["A" atom])
(data ["R" result]
(coll ["d" dict])
text/format)
[macro #+ Monad<Lux>]
[host #+ jvm-import do-to]))
## [Host]
(jvm-import org.objectweb.asm.Opcodes
(#static V1_6 int)
(#static CHECKCAST int)
(#static INVOKESTATIC int)
(#static INVOKEVIRTUAL int))
(jvm-import org.objectweb.asm.MethodVisitor
(visitLdcInsn [Object] void)
(visitTypeInsn [int String] void)
(visitMethodInsn [int String String String boolean] void))
(jvm-import java.lang.Object
(toString [] String))
(jvm-import (java.lang.Class a))
(jvm-import java.lang.ClassLoader
(loadClass [String] (Class Object)))
## [Types]
(type: #export Bytecode host;Byte-Array)
(type: #export Class-Store (A;Atom (d;Dict Text Bytecode)))
(type: #export Host
{#visitor (Maybe MethodVisitor)
#loader ClassLoader
#store Class-Store})
(def: #export unit Text "\u0000")
(def: (visitor::get compiler)
(-> Compiler (Maybe MethodVisitor))
(|> (get@ #;host compiler)
(:! Host)
(get@ #visitor)))
(def: (visitor::put ?visitor compiler)
(-> (Maybe MethodVisitor) Compiler Compiler)
(update@ #;host
(function [host]
(|> host
(:! Host)
(set@ #visitor ?visitor)
(:! Void)))
compiler))
(def: #export get-visitor
(Lux MethodVisitor)
(function [compiler]
(case (visitor::get compiler)
#;None
(#R;Error "No visitor has been set.")
(#;Some visitor)
(#R;Success [compiler visitor]))))
(def: #export (with-visitor visitor body)
(All [a] (-> MethodVisitor (Lux a) (Lux a)))
(function [compiler]
(case (macro;run' (visitor::put (#;Some visitor) compiler) body)
(#R;Error error)
(#R;Error error)
(#R;Success [compiler' output])
(#R;Success [(visitor::put (visitor::get compiler) compiler')
output]))))
(def: #export (store-class name byte-code)
(-> Text Bytecode (Lux Unit))
(function [compiler]
(let [store (|> (get@ #;host compiler)
(:! Host)
(get@ #store))]
(if (d;contains? name (|> store A;get io;run))
(#R;Error (format "Cannot store class that already exists: " name))
(#R;Success [compiler (io;run (A;update (d;put name byte-code) store))])
))))
(def: #export (load-class name)
(-> Text (Lux (Class Object)))
(function [compiler]
(let [host (:! Host (get@ #;host compiler))
store (|> host (get@ #store) A;get io;run)]
(if (d;contains? name store)
(#R;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))])
(#R;Error (format "Unknown class: " name))))))
(do-template [<wrap> <unwrap> <class> <unwrap-method> <prim> <dup>]
[(def: #export (<wrap> writer)
(-> MethodVisitor MethodVisitor)
(do-to writer
(MethodVisitor.visitMethodInsn [Opcodes.INVOKESTATIC
<class> "valueOf" (format "(" <prim> ")" "L" <class> ";")
false])))
(def: #export (<unwrap> writer)
(-> MethodVisitor MethodVisitor)
(do-to writer
(MethodVisitor.visitTypeInsn [Opcodes.CHECKCAST <class>])
(MethodVisitor.visitMethodInsn [Opcodes.INVOKEVIRTUAL
<class> <unwrap-method> (format "()" <prim>)
false])))]
[wrap-boolean unwrap-boolean "java/lang/Boolean" "booleanValue" "Z" Opcodes.DUP_X1]
[wrap-byte unwrap-byte "java/lang/Byte" "byteValue" "B" Opcodes.DUP_X1]
[wrap-short unwrap-short "java/lang/Short" "shortValue" "S" Opcodes.DUP_X1]
[wrap-int unwrap-int "java/lang/Integer" "intValue" "I" Opcodes.DUP_X1]
[wrap-long unwrap-long "java/lang/Long" "longValue" "J" Opcodes.DUP_X2]
[wrap-float unwrap-float "java/lang/Float" "floatValue" "F" Opcodes.DUP_X1]
[wrap-double unwrap-double "java/lang/Double" "doubleValue" "D" Opcodes.DUP_X2]
[wrap-char unwrap-char "java/lang/Character" "charValue" "C" Opcodes.DUP_X1]
)
(type: #export Flags Int)
(type: #export Descriptor Text)
(def: #export bytecode-version Flags Opcodes.V1_6)
(def: #export runtime-class-name Text "LuxRT")
|
