blob: a304d5ac4166f7170d7b74e3516770d553309705 (
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
|
(.module:
[lux #*
[abstract
["." equivalence (#+ Equivalence)]
[monad (#+ do)]]
[control
["." state (#+ State)]]
[data
["." text ("#;." equivalence)]
[format
["." binary (#+ Format)]]
[collection
["." list ("#;." fold)]
["." row (#+ Row)]]]
[type
abstract]]
["." // (#+ UTF8 Class Constant) ("#;." class-equivalence)
[//
["." encoding]
["." index (#+ Index)]
["." descriptor (#+ Descriptor)]]])
(def: offset 1)
(type: #export Pool (Row Constant))
(def: #export equivalence
(Equivalence Pool)
(row.equivalence //.equivalence))
(template: (!add <value> <tag> <=>)
(function (_ pool)
(with-expansions [<index> (as-is (index.index (encoding.to-u2 (n/+ offset idx))))
<try-again> (as-is (recur (.inc idx)))]
(loop [idx 0]
(case (row.nth idx pool)
(#.Some entry)
(case entry
(<tag> reference)
(if (<=> reference <value>)
[pool
<index>]
<try-again>)
_
<try-again>)
#.None
[(row.add (<tag> <value>) pool)
<index>])))))
(def: #export (utf8 value)
(-> UTF8 (State Pool (Index UTF8)))
(!add value #//.UTF8 text;=))
(def: (class' value)
(-> Class (State Pool (Index Class)))
(!add value #//.Class //;=))
(def: #export (class name)
(-> UTF8 (State Pool (Index Class)))
(do state.monad
[@name (utf8 name)]
(class' (//.class @name))))
(def: #export (descriptor value)
(All [kind]
(-> (Descriptor kind)
(State Pool (Index (Descriptor kind)))))
(let [value (descriptor.descriptor value)]
(!add value #//.UTF8 text;=)))
(def: #export format
(Format Pool)
(binary.row/16' ..offset //.format))
(def: #export empty
Pool
row.empty)
|
