blob: 55c899143002fb8e86179682e580e57e7f74737f (
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
|
(;module:
lux
(lux (control [monad #+ do])
(concurrency ["A" atom])
(data ["R" result]
[text]
text/format
(coll ["d" dict]
[array #+ Array]))
[macro #+ Monad<Lux>]
[host #+ do-to object]
[io])
(luxc ["&" base]
(generator ["&&;" common])
))
(host;import java.lang.reflect.AccessibleObject
(setAccessible [boolean] void))
(host;import java.lang.reflect.Method
(invoke [Object (Array Object)] #try Object))
(host;import (java.lang.Class a)
(getDeclaredMethod [String (Array (Class Object))] #try Method))
(host;import java.lang.Object
(getClass [] (Class Object)))
(host;import java.lang.Integer
(#static TYPE (Class Integer)))
(host;import java.lang.ClassLoader)
(def: ClassLoader::defineClass
Method
(case (Class.getDeclaredMethod ["defineClass"
(|> (host;array (Class Object) +4)
(host;array-write +0 (:! (Class Object) (host;class-for String)))
(host;array-write +1 (Object.getClass [] (host;array byte +0)))
(host;array-write +2 (:! (Class Object) Integer.TYPE))
(host;array-write +3 (:! (Class Object) Integer.TYPE)))]
(host;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 (host;l2i 0))
(:! Object (host;l2i (nat-to-int (host;array-length byte-code))))))]
ClassLoader::defineClass))
(def: (fetch-byte-code class-name store)
(-> Text &&common;Class-Store (Maybe &&common;Bytecode))
(|> store A;get io;run (d;get class-name)))
(def: (memory-class-loader store)
(-> &&common;Class-Store ClassLoader)
(object ClassLoader []
[]
(ClassLoader (findClass [class-name String]) Class
(case (fetch-byte-code class-name store)
(#;Some bytecode)
(case (define-class class-name bytecode (:! ClassLoader _jvm_this))
(#R;Success class)
(:!! class)
(#R;Error error)
(error! (format "Class definiton error: " class-name "\n"
error)))
#;None
(error! (format "Class not found: " class-name))))))
(def: #export init-host
(io;IO &&common;Host)
(io;io (let [store (: &&common;Class-Store
(A;atom (d;new text;Hash<Text>)))]
{#&&common;loader (memory-class-loader store)
#&&common;store store
#&&common;function-class #;None})))
(def: #export class-loader
(Lux ClassLoader)
(function [compiler]
(#R;Success [compiler
(|> compiler
(get@ #;host)
(:! &&common;Host)
(get@ #&&common;loader))])))
|
