blob: f9825614a6652945f5b9f7fa9527e6407767ecbb (
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
|
(;module:
[lux #- function]
(lux (control ["ex" exception #+ exception:])
[io]
(concurrency ["A" atom])
(data ["e" error]
[text]
text/format
(coll [dict #+ Dict]))
[host]
(world [blob #+ Blob]))
(luxc (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;type (Array byte)))
(type: #export Class-Store (A;Atom (Dict Text Bytecode)))
(type: #export Artifacts (Dict Text Blob))
(type: #export Host
{#loader ClassLoader
#store Class-Store
#artifacts Artifacts
#context [Text Nat]})
(exception: Unknown-Class)
(exception: Class-Already-Stored)
(exception: No-Function-Being-Compiled)
(exception: Cannot-Overwrite-Artifact)
(def: #export (with-artifacts action)
(All [a] (-> (Meta a) (Meta [Artifacts a])))
(;function [compiler]
(case (action (update@ #;host
(|>. (:! Host)
(set@ #artifacts (dict;new text;Hash<Text>))
(:! Void))
compiler))
(#e;Success [compiler' output])
(#e;Success [(update@ #;host
(|>. (:! Host)
(set@ #artifacts (|> (get@ #;host compiler) (:! Host) (get@ #artifacts)))
(:! Void))
compiler')
[(|> compiler' (get@ #;host) (:! Host) (get@ #artifacts))
output]])
(#e;Error error)
(#e;Error error))))
(def: #export (record-artifact name content)
(-> Text Blob (Meta Unit))
(;function [compiler]
(if (|> compiler (get@ #;host) (:! Host) (get@ #artifacts) (dict;contains? name))
(ex;throw Cannot-Overwrite-Artifact name)
(#e;Success [(update@ #;host
(|>. (:! Host)
(update@ #artifacts (dict;put name content))
(:! Void))
compiler)
[]]))))
(def: #export (store-class name byte-code)
(-> Text Bytecode (Meta Unit))
(;function [compiler]
(let [store (|> (get@ #;host compiler)
(:! Host)
(get@ #store))]
(if (dict;contains? name (|> store A;get io;run))
(ex;throw Class-Already-Stored name)
(#e;Success [compiler (io;run (A;update (dict;put name byte-code) store))])
))))
(def: #export (load-class name)
(-> Text (Meta (Class Object)))
(;function [compiler]
(let [host (:! Host (get@ #;host compiler))
store (|> host (get@ #store) A;get io;run)]
(if (dict;contains? name store)
(#e;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))])
(ex;throw Unknown-Class name)))))
(def: #export bytecode-version Int Opcodes.V1_6)
(def: #export value-field Text "_value")
(def: #export $Object $;Type ($t;class "java.lang.Object" (list)))
|
