blob: 73cf967f94a07c83552c65d21ed0f05ca3ee2646 (
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 #*
[control
[monad (#+ do)]
[concurrency
["." atom]]
[security
["!" capability]]]
[data
["." error (#+ Error)]
["." text
format]
[format
["." binary]]
[collection
["." dictionary]
["." row]]]
["." io (#+ IO)]
[world
["." file (#+ File)]
[binary (#+ Binary)]]
[math
["r" random]]
["_" test (#+ Test)]]
{1
[/
["/." loader (#+ Library)]
["/." version]
["/." name]
["/." descriptor]
["/." field]
["/." class]
[modifier
["/.M" inner]]]})
(def: (write-class! name bytecode)
(-> Text Binary (IO Text))
(let [file-path (format name ".class")]
(do io.monad
[outcome (do (error.with @)
[file (: (IO (Error (File IO)))
(file.get-file io.monad file.system file-path))]
(!.use (:: file over-write) bytecode))]
(wrap (case outcome
(#error.Success definition)
(format "Wrote: " (%t file-path))
(#error.Failure error)
error)))))
(def: class
Test
(do r.monad
[_ (wrap [])
#let [package "my.package"
name "MyClass"
full-name (format package "." name)
input (/class.class /version.v6_0 /class.public
(/name.internal "java.lang.Object")
(/name.internal full-name)
(list (/name.internal "java.io.Serializable")
(/name.internal "java.lang.Runnable"))
(list (/field.field /field.public "foo" /descriptor.long (row.row))
(/field.field /field.public "bar" /descriptor.double (row.row)))
(row.row)
(row.row))
bytecode (binary.write /class.format input)
loader (/loader.memory (/loader.new-library []))]]
($_ _.and
(_.test "Can read a generated class."
(case (binary.read /class.format bytecode)
(#error.Success output)
(:: /class.equivalence = input output)
(#error.Failure error)
false))
(_.test "Can generate a class."
(case (/loader.define full-name bytecode loader)
(#error.Success definition)
true
(#error.Failure error)
false))
)))
(def: #export test
Test
(<| (_.context "Class")
..class))
|
