blob: 37b62b30d0c2fb1366ee29669eabfc574d93d72d (
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
|
(;module:
lux
(lux (control monad)
(concurrency ["A" atom])
(data ["R" result]
[text]
text/format
(coll ["d" dict]
[array #+ Array]))
[macro #+ Monad<Lux>]
host
[io])
(luxc ["&" base]
(generator ["&&;" common])
))
(jvm-import java.lang.reflect.AccessibleObject
(setAccessible [boolean] void))
(jvm-import java.lang.reflect.Method
(invoke [Object (Array Object)] #try Object))
(jvm-import (java.lang.Class a)
(getDeclaredMethod [String (Array (Class Object))] #try Method))
(jvm-import java.lang.Object
(getClass [] (Class Object)))
(jvm-import java.lang.Integer
(#static TYPE (Class Integer)))
(jvm-import java.lang.ClassLoader)
(def: ClassLoader::defineClass
Method
(case (Class.getDeclaredMethod ["defineClass"
(|> (array (Class Object) +4)
(array-store +0 (:! (Class Object) (class-for String)))
(array-store +1 (Object.getClass [] (array byte +0)))
(array-store +2 (:! (Class Object) Integer.TYPE))
(array-store +3 (:! (Class Object) Integer.TYPE)))]
(class-for java.lang.ClassLoader))
(#R;Success method)
(do-to method
(AccessibleObject.setAccessible [true]))
(#R;Error error)
(error! error)))
(def: (define-class class-name byte-code loader)
(-> Text &&common;Bytecode ClassLoader (R;Result Object))
(Method.invoke [loader
(array;from-list (list (:! Object class-name)
(:! Object byte-code)
(:! Object (l2i 0))
(:! Object (l2i (nat-to-int (array-length byte-code))))))]
ClassLoader::defineClass))
(def: (fetch-byte-code class-name store)
(-> Text &&common;Class-Store &&common;Bytecode)
(|> store A;get io;run (d;get class-name) assume))
(def: (assume!! input)
(All [a] (-> (R;Result a) a))
(case input
(#R;Success output)
output
(#R;Error error)
(error! error)))
(def: (memory-class-loader store)
(-> &&common;Class-Store ClassLoader)
(object ClassLoader []
[]
(ClassLoader (findClass [class-name String]) Class
(:!! (assume!! (define-class class-name (fetch-byte-code class-name store) (:! ClassLoader _jvm_this))))
)))
(def: #export (init-host _)
(-> Top &&common;Host)
(let [store (: &&common;Class-Store
(A;atom (d;new text;Hash<Text>)))]
{#&&common;loader (memory-class-loader store)
#&&common;store store}))
|
