blob: 4f9497869793d1abefe2b75debfc960de43120fa (
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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
(.using
[library
[lux (.except Primitive Type int char)
[abstract
[equivalence (.only Equivalence)]
[hash (.only Hash)]]
[control
["[0]" maybe]]
[data
["[0]" text
["%" format (.only Format)]]
[collection
["[0]" list ("[1]#[0]" functor)]]]
[math
[number
["n" nat]]]
[type
[primitive "*"]]]]
["[0]" // "_"
[encoding
["[1][0]" name (.only External)]]]
["[0]" / "_"
[category (.only Void Value' Value Return' Return Method Primitive Object Class Array Var Parameter Declaration)]
["[1][0]" signature (.only Signature)]
["[1][0]" descriptor (.only Descriptor)]
["[1][0]" reflection (.only Reflection)]])
(primitive: .public (Type category)
[(Signature category)
(Descriptor category)
(Reflection category)]
(type: .public Argument
[Text (Type Value)])
(type: .public (Typed a)
[(Type Value) a])
(type: .public Constraint
(Record
[#name Text
#super_class (Type Class)
#super_interfaces (List (Type Class))]))
(template [<name> <style>]
[(def: .public (<name> type)
(All (_ category) (-> (Type category) (<style> category)))
(let [[signature descriptor reflection] (representation type)]
<name>))]
[signature Signature]
[descriptor Descriptor]
)
(def: .public (reflection type)
(All (_ category)
(-> (Type (<| Return' Value' category))
(Reflection (<| Return' Value' category))))
(let [[signature descriptor reflection] (representation type)]
reflection))
(template [<category> <name> <signature> <descriptor> <reflection>]
[(def: .public <name>
(Type <category>)
(abstraction [<signature> <descriptor> <reflection>]))]
[Void void /signature.void /descriptor.void /reflection.void]
[Primitive boolean /signature.boolean /descriptor.boolean /reflection.boolean]
[Primitive byte /signature.byte /descriptor.byte /reflection.byte]
[Primitive short /signature.short /descriptor.short /reflection.short]
[Primitive int /signature.int /descriptor.int /reflection.int]
[Primitive long /signature.long /descriptor.long /reflection.long]
[Primitive float /signature.float /descriptor.float /reflection.float]
[Primitive double /signature.double /descriptor.double /reflection.double]
[Primitive char /signature.char /descriptor.char /reflection.char]
)
(def: .public (array type)
(-> (Type Value) (Type Array))
(abstraction
[(/signature.array (..signature type))
(/descriptor.array (..descriptor type))
(/reflection.array (..reflection type))]))
(def: .public (class name parameters)
(-> External (List (Type Parameter)) (Type Class))
(abstraction
[(/signature.class name (list#each ..signature parameters))
(/descriptor.class name)
(/reflection.class name)]))
(def: .public (declaration name variables)
(-> External (List (Type Var)) (Type Declaration))
(abstraction
[(/signature.declaration name (list#each ..signature variables))
(/descriptor.declaration name)
(/reflection.declaration name)]))
(def: .public (as_class type)
(-> (Type Declaration) (Type Class))
(abstraction
(let [[signature descriptor reflection] (representation type)]
[(/signature.as_class signature)
(/descriptor.as_class descriptor)
(/reflection.as_class reflection)])))
(def: .public wildcard
(Type Parameter)
(abstraction
[/signature.wildcard
/descriptor.wildcard
/reflection.wildcard]))
(def: .public (var name)
(-> Text (Type Var))
(abstraction
[(/signature.var name)
/descriptor.var
/reflection.var]))
(def: .public (lower bound)
(-> (Type Parameter) (Type Parameter))
(abstraction
(let [[signature descriptor reflection] (representation bound)]
[(/signature.lower signature)
(/descriptor.lower descriptor)
(/reflection.lower reflection)])))
(def: .public (upper bound)
(-> (Type Parameter) (Type Parameter))
(abstraction
(let [[signature descriptor reflection] (representation bound)]
[(/signature.upper signature)
(/descriptor.upper descriptor)
(/reflection.upper reflection)])))
(def: .public (method [type_variables inputs output exceptions])
(-> [(List (Type Var))
(List (Type Value))
(Type Return)
(List (Type Class))]
(Type Method))
(abstraction
[(/signature.method [(list#each ..signature type_variables)
(list#each ..signature inputs)
(..signature output)
(list#each ..signature exceptions)])
(/descriptor.method [(list#each ..descriptor inputs)
(..descriptor output)])
(as_expected ..void)]))
(implementation: .public equivalence
(All (_ category) (Equivalence (Type category)))
(def: (= parameter subject)
(# /signature.equivalence =
(..signature parameter)
(..signature subject))))
(implementation: .public hash
(All (_ category) (Hash (Type category)))
(def: equivalence ..equivalence)
(def: hash (|>> ..signature (# /signature.hash hash))))
(def: .public (primitive? type)
(-> (Type Value) (Either (Type Object)
(Type Primitive)))
(if (`` (or (~~ (template [<type>]
[(# ..equivalence = (is (Type Value) <type>) type)]
[..boolean]
[..byte]
[..short]
[..int]
[..long]
[..float]
[..double]
[..char]))))
(|> type (as (Type Primitive)) {.#Right})
(|> type (as (Type Object)) {.#Left})))
(def: .public (void? type)
(-> (Type Return) (Either (Type Value)
(Type Void)))
(if (`` (or (~~ (template [<type>]
[(# ..equivalence = (is (Type Return) <type>) type)]
[..void]))))
(|> type (as (Type Void)) {.#Right})
(|> type (as (Type Value)) {.#Left})))
)
(def: .public (class? type)
(-> (Type Value) (Maybe External))
(let [repr (|> type ..descriptor /descriptor.descriptor)]
(if (and (text.starts_with? /descriptor.class_prefix repr)
(text.ends_with? /descriptor.class_suffix repr))
(let [prefix_size (text.size /descriptor.class_prefix)
suffix_size (text.size /descriptor.class_suffix)
name_size (|> (text.size repr)
(n.- prefix_size)
(n.- suffix_size))]
(|> repr
(text.clip prefix_size name_size)
(# maybe.monad each (|>> //name.internal //name.external))))
{.#None})))
(def: .public format
(All (_ a) (Format (Type a)))
(|>> ..signature /signature.signature))
|
