blob: 1fd87caea70f827477cd7da5e1799232a5628d59 (
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
131
132
133
134
135
136
137
138
139
140
141
142
|
(;module:
lux
(lux (data (coll ["a" array]
[list "L/" Functor<List>]))
[host #+ jvm-import do-to])
["$" ..]
(.. ["$t" type]))
## [Host]
(jvm-import #long java.lang.Object)
(jvm-import #long java.lang.String)
(jvm-import org.objectweb.asm.Opcodes
(#static ACC_PUBLIC int)
(#static ACC_PROTECTED int)
(#static ACC_PRIVATE int)
(#static ACC_ABSTRACT int)
(#static ACC_FINAL int)
(#static ACC_STATIC int)
(#static ACC_SYNCHRONIZED int)
(#static ACC_TRANSIENT int)
(#static ACC_VOLATILE int))
(jvm-import org.objectweb.asm.FieldVisitor
(visitEnd [] void))
(jvm-import org.objectweb.asm.MethodVisitor
(visitCode [] void)
(visitMaxs [int int] void)
(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))
## [Defs]
(def: (exceptions-array type)
(-> $;Method (a;Array Text))
(let [exs (|> type (get@ #$;exceptions) (L/map (|>. #$;Generic $t;descriptor)))
output (host;array String (list;size exs))]
(exec (L/map (function [[idx value]]
(host;array-store idx value output))
(list;enumerate exs))
output)))
(def: (visibility-flag visibility)
(-> $;Visibility Int)
(case visibility
#$;Public Opcodes.ACC_PUBLIC
#$;Protected Opcodes.ACC_PROTECTED
#$;Private Opcodes.ACC_PRIVATE
#$;Default 0))
(def: (method-flag config)
(-> $;Method-Config Int)
($_ i.+
(if (get@ #$;staticM config) Opcodes.ACC_STATIC 0)
(if (get@ #$;finalM config) Opcodes.ACC_FINAL 0)
(if (get@ #$;synchronizedM config) Opcodes.ACC_SYNCHRONIZED 0)))
(def: (field-flag config)
(-> $;Field-Config Int)
($_ i.+
(if (get@ #$;staticF config) Opcodes.ACC_STATIC 0)
(if (get@ #$;finalF config) Opcodes.ACC_FINAL 0)
(if (get@ #$;transientF config) Opcodes.ACC_TRANSIENT 0)
(if (get@ #$;volatileF config) Opcodes.ACC_VOLATILE 0)))
(def: #export (method visibility config name type then)
(-> $;Visibility $;Method-Config Text $;Method $;Inst
$;Def)
(function [writer]
(let [=method (ClassWriter.visitMethod [($_ i.+
(visibility-flag visibility)
(method-flag config))
name
($t;method-descriptor type)
($t;method-signature type)
(exceptions-array type)]
writer)
_ (MethodVisitor.visitCode [] =method)
_ (then =method)
_ (MethodVisitor.visitMaxs [0 0] =method)
_ (MethodVisitor.visitEnd [] =method)]
writer)))
(def: #export (abstract-method visibility config name type)
(-> $;Visibility $;Method-Config Text $;Method
$;Def)
(function [writer]
(let [=method (ClassWriter.visitMethod [($_ i.+
(visibility-flag visibility)
(method-flag config)
Opcodes.ACC_ABSTRACT)
name
($t;method-descriptor type)
($t;method-signature type)
(exceptions-array type)]
writer)
_ (MethodVisitor.visitEnd [] =method)]
writer)))
(def: #export (field visibility config name type)
(-> $;Visibility $;Field-Config Text $;Type $;Def)
(function [writer]
(let [=field (do-to (ClassWriter.visitField [($_ i.+
(visibility-flag visibility)
(field-flag config))
name ($t;descriptor type) ($t;signature type) (host;null)] writer)
(FieldVisitor.visitEnd []))]
writer)))
(do-template [<name> <lux-type> <jvm-type> <prepare>]
[(def: #export (<name> visibility config name value)
(-> $;Visibility $;Field-Config Text <lux-type> $;Def)
(function [writer]
(let [=field (do-to (ClassWriter.visitField [($_ i.+
(visibility-flag visibility)
(field-flag config))
name ($t;descriptor <jvm-type>) ($t;signature <jvm-type>)
(<prepare> value)]
writer)
(FieldVisitor.visitEnd []))]
writer)))]
[boolean-field Bool $t;boolean id]
[byte-field Int $t;byte host;l2b]
[short-field Int $t;short host;l2s]
[int-field Int $t;int host;l2i]
[long-field Int $t;long id]
[float-field Real $t;float host;d2f]
[double-field Real $t;double id]
[char-field Char $t;char id]
[string-field Text ($t;class "java.lang.String" (list)) id]
)
|
