blob: 1132928d09aebfdac169cfcbc7ee79e9ec5d6640 (
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
|
(.module:
[lux #- function]
(lux (control ["ex" exception #+ exception:])
[io]
(concurrency [atom #+ Atom atom])
(data ["e" error]
[text]
text/format
(coll [dict #+ Dict]))
[host]
(world [blob #+ Blob]
[file #+ File]))
(luxc (lang [".L" variable #+ Register]
(host ["$" jvm]
(jvm ["$t" type]
["$d" def]
["$i" inst])))))
(host.import org/objectweb/asm/Opcodes
(#static V1_6 int))
(host.import org/objectweb/asm/Label)
(host.import java/lang/Object)
(host.import (java/lang/Class a))
(host.import java/lang/ClassLoader
(loadClass [String] (Class Object)))
(type: #export Bytecode Blob)
(type: #export Class-Store (Atom (Dict Text Bytecode)))
(type: #export Artifacts (Dict File Blob))
(type: #export Host
{#loader ClassLoader
#store Class-Store
#artifacts Artifacts
#context [Text Nat]
#anchor (Maybe [Label Register])})
(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 atom.read io.run))
(ex.throw Class-Already-Stored name)
(#e.Success [compiler (io.run (atom.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) atom.read io.run)]
(if (dict.contains? name store)
(#e.Success [compiler (ClassLoader::loadClass [name] (get@ #loader host))])
(ex.throw Unknown-Class name)))))
(def: #export value-field Text "_value")
(def: #export $Object $.Type ($t.class "java.lang.Object" (list)))
|
