blob: b0030c84ff0e33f630ab46ff2d569072a77613f5 (
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
|
(.module:
[lux #*
[control
["." monad (#+ do)]
["." state (#+ State)]]
[data
[format
["." binary (#+ Format)]]
[collection
["." row (#+ Row)]]]]
[/
["/." version (#+ Version Minor Major)]
["/." name (#+ Internal)]
["/." magic (#+ Magic)]
["/." index (#+ Index)]
["/." attribute (#+ Attribute)]
["/." field (#+ Field)]
[modifier
["/.M" class]]
["/." constant (#+ Constant)
["/." pool (#+ Pool)]]])
(type: #export Interface
(Index /constant.Class))
(type: #export Method
Any)
(type: #export Class
{#magic Magic
#minor-version Minor
#major-version Major
#constant-pool Pool
#access-flags /classM.Modifier
#this (Index /constant.Class)
#super (Index /constant.Class)
#interfaces (Row Interface)
#fields (Row Field)
#methods (Row Method)
#attributes (Row Attribute)})
(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 Interface)]))
(do state.Monad<State>
[@this (/pool.class (/name.read this))
@super (/pool.class (/name.read super))
@interfaces (monad.fold @ (function (_ interface @interfaces)
(do @
[@interface (/pool.class (/name.read interface))]
(wrap (row.add @interface @interfaces))))
(: (Row Interface) row.empty)
interfaces)]
(wrap [@this @super @interfaces])))
(def: #export (class version access super this interfaces fields)
(-> Major /classM.Modifier Internal Internal (List Internal) (Row Field) Class)
(let [[pool [@this @super @interfaces]] (state.run (: Pool row.empty)
(install-classes this super interfaces))]
{#magic /magic.code
#minor-version ..default-minor-version
#major-version version
#constant-pool pool
#access-flags access
#this @this
#super @super
#interfaces @interfaces
#fields fields
#methods row.empty
#attributes row.empty}))
(def: #export classF
(Format Class)
($_ binary.and
/magic.format
/version.format
/version.format
/pool.format
/classM.modifier-format
/index.format
/index.format
(binary.row/16 /index.format)
(binary.row/16 /field.format)
(binary.row/16 (binary.ignore []))
(binary.row/16 /attribute.format)))
|
