blob: 6d94c1b5bfc756e797725a1fc1510c0b8242ada8 (
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
|
(.module:
[library
[lux (#- Info Code)
[abstract
[monad (#+ do)]
["." equivalence (#+ Equivalence)]]
[control
["." try]
["." exception (#+ exception:)]]
[data
["." sum]
["." product]
[format
[".F" binary (#+ Writer)]]]
[math
[number
["n" nat]]]]]
["." // #_
["#." index (#+ Index)]
[encoding
["#." unsigned (#+ U2 U4)]]
["#." constant (#+ UTF8 Class Value)
["#/." pool (#+ Pool Resource)]]]
["." / #_
["#." constant (#+ Constant)]
["#." code]])
(type: #export (Info about)
{#name (Index UTF8)
#length U4
#info about})
(def: #export (info_equivalence Equivalence<about>)
(All [about]
(-> (Equivalence about)
(Equivalence (Info about))))
($_ product.equivalence
//index.equivalence
//unsigned.equivalence
Equivalence<about>))
(def: (info_writer writer)
(All [about]
(-> (Writer about)
(Writer (Info about))))
(function (_ [name length info])
(let [[nameS nameT] (//index.writer name)
[lengthS lengthT] (//unsigned.writer/4 length)
[infoS infoT] (writer info)]
[($_ n.+ nameS lengthS infoS)
(|>> nameT lengthT infoT)])))
(with_expansions [<Code> (as_is (/code.Code Attribute))]
(type: #export #rec Attribute
(#Constant (Info (Constant Any)))
(#Code (Info <Code>)))
(type: #export Code
<Code>)
)
(def: #export equivalence
(Equivalence Attribute)
(equivalence.rec
(function (_ equivalence)
($_ sum.equivalence
(info_equivalence /constant.equivalence)
(info_equivalence (/code.equivalence equivalence))))))
(def: common_attribute_length
($_ n.+
## u2 attribute_name_index;
//unsigned.bytes/2
## u4 attribute_length;
//unsigned.bytes/4
))
(def: (length attribute)
(-> Attribute Nat)
(case attribute
(^template [<tag>]
[(<tag> [name length info])
(|> length //unsigned.value (n.+ ..common_attribute_length))])
([#Constant] [#Code])))
## TODO: Inline ASAP
(def: (constant' @name index)
(-> (Index UTF8) (Constant Any) Attribute)
(#Constant {#name @name
#length (|> /constant.length //unsigned.u4 try.assumed)
#info index}))
(def: #export (constant index)
(-> (Constant Any) (Resource Attribute))
(do //constant/pool.monad
[@name (//constant/pool.utf8 "ConstantValue")]
(in (constant' @name index))))
## TODO: Inline ASAP
(def: (code' @name specification)
(-> (Index UTF8) Code Attribute)
(#Code {#name @name
## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3
#length (|> specification
(/code.length ..length)
//unsigned.u4
try.assumed)
#info specification}))
(def: #export (code specification)
(-> Code (Resource Attribute))
(do //constant/pool.monad
[@name (//constant/pool.utf8 "Code")]
(in (code' @name specification))))
(def: #export (writer value)
(Writer Attribute)
(case value
(#Constant attribute)
((info_writer /constant.writer) attribute)
(#Code attribute)
((info_writer (/code.writer writer)) attribute)))
|
