blob: 1f04f579868cca20deae1d4a0b8530524ccc119d (
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
|
(;module:
[lux #- function]
(lux (control ["ex" exception #+ exception:])
[io]
(concurrency ["A" atom])
(data ["R" result]
(coll ["d" dict]))
[host])
(luxc (generator (host ["$" jvm]
(jvm ["$t" type]
["$d" def]
["$i" inst])))))
(host;import org.objectweb.asm.Opcodes
(#static V1_6 int))
(host;import java.lang.Object)
(host;import (java.lang.Class a))
(host;import java.lang.ClassLoader
(loadClass [String] (Class Object)))
(type: #export Bytecode host;Byte-Array)
(type: #export Class-Store (A;Atom (d;Dict Text Bytecode)))
(type: #export Host
{#loader ClassLoader
#store Class-Store
#function-class (Maybe Text)})
(exception: Unknown-Class)
(exception: Class-Already-Stored)
(exception: No-Function-Being-Compiled)
(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))
(ex;throw Class-Already-Stored 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))])
(ex;throw Unknown-Class name)))))
(def: #export (with-function class expr)
(All [a] (-> Text (Lux a) (Lux a)))
(;function [compiler]
(let [host (:! Host (get@ #;host compiler))
old-function-class (get@ #function-class host)]
(case (expr (set@ #;host
(:! Void (set@ #function-class
(#;Some class)
host))
compiler))
(#R;Success [compiler' output])
(#R;Success [(update@ #;host
(|>. (:! Host)
(set@ #function-class old-function-class)
(:! Void))
compiler')
output])
(#R;Error error)
(#R;Error error)))))
(def: #export function
(Lux Text)
(;function [compiler]
(let [host (:! Host (get@ #;host compiler))]
(case (get@ #function-class host)
#;None
(ex;throw No-Function-Being-Compiled "")
(#;Some function-class)
(#R;Success [compiler function-class])))))
(def: #export bytecode-version Int Opcodes.V1_6)
|
