blob: acef6060f9f706c2dd2df093536bb2c12c83cf27 (
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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
(.module:
[lux #*
[abstract/monad (#+ do)]
[control
["." io (#+ IO)]
[concurrency
["." atom]]
[security
["!" capability]]]
[data
["." error (#+ Error)]
["." text
format]
[format
[".F" binary]]
[collection
["." dictionary]
["." row]]]
[world
[binary (#+ Binary)]
["." file (#+ File)]]
[math
["r" random (#+ Random) ("#@." monad)]]
["_" test (#+ Test)]]
{1
["." / #_
["#." loader (#+ Library)]
["#." version]
["#." name]
["#." descriptor (#+ Descriptor Value)]
["#." 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: descriptor
(Random (Descriptor (Value Any)))
(r.rec
(function (_ descriptor)
($_ r.either
(r@wrap /descriptor.boolean)
(r@wrap /descriptor.byte)
(r@wrap /descriptor.short)
(r@wrap /descriptor.int)
(r@wrap /descriptor.long)
(r@wrap /descriptor.float)
(r@wrap /descriptor.double)
(r@wrap /descriptor.char)
(r@map (|>> (text.join-with /name.external-separator)
/name.internal
/descriptor.object)
(r.list 3 (r.ascii/upper-alpha 10)))
(r@map /descriptor.array descriptor)
))))
(def: field
(Random [Text (Descriptor (Value Any))])
($_ r.and
(r.ascii/lower-alpha 10)
..descriptor
))
(def: class
Test
(do r.monad
[_ (wrap [])
super-package (r.ascii/lower-alpha 10)
package (r.ascii/lower-alpha 10)
name (r.ascii/upper-alpha 10)
[field0 descriptor0] ..field
[field1 descriptor1] ..field
#let [full-name (format super-package "." package "." name)
input (/class.class /version.v6_0 /class.public
(/name.internal full-name)
(/name.internal "java.lang.Object")
(list (/name.internal "java.io.Serializable")
(/name.internal "java.lang.Runnable"))
(list (/field.field /field.public field0 descriptor0 (row.row))
(/field.field /field.public field1 descriptor1 (row.row)))
(row.row)
(row.row))
bytecode (binaryF.write /class.format input)
loader (/loader.memory (/loader.new-library []))]]
($_ _.and
(_.test "Can read a generated class."
(case (binaryF.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))
|
