blob: 6fb6f48d48e553f15282e7349a87bb64ea3786cf (
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
120
121
122
123
124
125
126
127
128
|
(.module:
[lux #*
[abstract
["." equivalence (#+ Equivalence)]
[monoid (#+)]
["." monad (#+ do)]]
[control
[parser (#+)]
["." state (#+ State)]]
[data
[number (#+)
[i64 (#+)]]
[format
["." binary (#+ Format)]]
[collection
["." row (#+ Row)]]]
[type
[abstract (#+)]]]
["." // #_
["#." encoding (#+)]
["#." modifier (#+ modifiers:)]
["#." version (#+ Version Minor Major)]
["#." name (#+ Internal)]
["#." magic (#+ Magic)]
["#." index (#+ Index)]
["#." attribute (#+ Attribute)]
["#." field (#+ Field)]
["#." method (#+ Method)]
["#." constant (#+ Constant)
["#/." pool (#+ Pool)]]])
(modifiers:
["0001" public]
["0010" final]
["0020" super]
["0200" interface]
["0400" abstract]
["1000" synthetic]
["2000" annotation]
["4000" enum]
)
(type: #export Class
{#magic Magic
#minor-version Minor
#major-version Major
#constant-pool Pool
#modifier Modifier
#this (Index //constant.Class)
#super (Index //constant.Class)
#interfaces (Row (Index //constant.Class))
#fields (Row Field)
#methods (Row Method)
#attributes (Row Attribute)})
(def: #export equivalence
(Equivalence Class)
($_ equivalence.product
//encoding.u4-equivalence
//encoding.u2-equivalence
//encoding.u2-equivalence
//constant/pool.equivalence
..modifier-equivalence
//index.equivalence
//index.equivalence
(row.equivalence //index.equivalence)
(row.equivalence //field.equivalence)
(row.equivalence //method.equivalence)
(row.equivalence //attribute.equivalence)))
(def: default-minor-version Minor (//version.version 0))
(def: (install-classes this super interfaces)
(-> Internal Internal (List Internal)
(State Pool [(Index //constant.Class) (Index //constant.Class) (Row (Index //constant.Class))]))
(do state.monad
[@this (//constant/pool.class (//name.read this))
@super (//constant/pool.class (//name.read super))
@interfaces (: (State Pool (Row (Index //constant.Class)))
(monad.fold @ (function (_ interface @interfaces)
(do @
[@interface (//constant/pool.class (//name.read interface))]
(wrap (row.add @interface @interfaces))))
row.empty
interfaces))]
(wrap [@this @super @interfaces])))
(def: #export (class version modifier
super this interfaces
fields methods attributes)
(-> Major Modifier
Internal Internal (List Internal)
(List (State Pool Field))
(Row Method)
(Row Attribute)
Class)
(let [[pool [@this @super @interfaces] =fields]
(state.run //constant/pool.empty
(do state.monad
[classes (install-classes this super interfaces)
=fields (monad.seq state.monad fields)]
(wrap [classes =fields])))]
{#magic //magic.code
#minor-version ..default-minor-version
#major-version version
#constant-pool pool
#modifier modifier
#this @this
#super @super
#interfaces @interfaces
#fields (row.from-list =fields)
#methods methods
#attributes attributes}))
(def: #export format
(Format Class)
($_ binary.and
//magic.format
//version.format
//version.format
//constant/pool.format
..modifier-format
//index.format
//index.format
(binary.row/16 //index.format)
(binary.row/16 //field.format)
(binary.row/16 //method.format)
(binary.row/16 //attribute.format)))
|