blob: 72d1775c4b958fe793afda752552b3a810e7d39c (
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
|
(.module:
[lux (#- i64)
[control
[monad (#+ do)]
["ex" exception (#+ exception:)]
[equivalence (#+ Equivalence)]]
[data
["." maybe]
["." error (#+ Error)]
[number
["." i64]]
[text
format]
[collection
[array (#+ Array)]]]
["." host (#+ import:)]])
(exception: #export (index-out-of-bounds {size Nat} {index Nat})
(ex.report ["Size" (%n size)]
["Index" (%n index)]))
(do-template [<name>]
[(exception: #export (<name> {size Nat} {from Nat} {to Nat})
(ex.report ["Size" (%n size)]
["From" (%n from)]
["To" (%n to)]))]
[slice-out-of-bounds]
[inverted-slice]
)
(type: #export Binary (host.type (Array byte)))
(import: java/lang/System
(#static arraycopy [Object int Object int int] #try void))
(import: java/util/Arrays
(#static copyOfRange [(Array byte) int int] (Array byte))
(#static equals [(Array byte) (Array byte)] boolean))
(def: byte-mask
I64
(|> i64.bits-per-byte i64.mask .i64))
(def: i64
(-> (primitive "java.lang.Byte") I64)
(|>> host.byte-to-long (:coerce I64) (i64.and ..byte-mask)))
(def: byte
(-> (I64 Any) (primitive "java.lang.Byte"))
(|>> .int host.long-to-byte))
(template: (!size binary)
(host.array-length binary))
(def: #export size
(-> Binary Nat)
(|>> !size))
(def: #export (create size)
(-> Nat Binary)
(host.array byte size))
(def: #export (read/8 idx binary)
(-> Nat Binary (Error I64))
(if (n/< (..!size binary) idx)
(#error.Success (..i64 (host.array-read idx binary)))
(ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (read/16 idx binary)
(-> Nat Binary (Error I64))
(if (n/< (..!size binary) (n/+ 1 idx))
(#error.Success ($_ i64.or
(i64.left-shift 8 (..i64 (host.array-read idx binary)))
(..i64 (host.array-read (n/+ 1 idx) binary))))
(ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (read/32 idx binary)
(-> Nat Binary (Error I64))
(if (n/< (..!size binary) (n/+ 3 idx))
(#error.Success ($_ i64.or
(i64.left-shift 24 (..i64 (host.array-read idx binary)))
(i64.left-shift 16 (..i64 (host.array-read (n/+ 1 idx) binary)))
(i64.left-shift 8 (..i64 (host.array-read (n/+ 2 idx) binary)))
(..i64 (host.array-read (n/+ 3 idx) binary))))
(ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (read/64 idx binary)
(-> Nat Binary (Error I64))
(if (n/< (..!size binary) (n/+ 7 idx))
(#error.Success ($_ i64.or
(i64.left-shift 56 (..i64 (host.array-read idx binary)))
(i64.left-shift 48 (..i64 (host.array-read (n/+ 1 idx) binary)))
(i64.left-shift 40 (..i64 (host.array-read (n/+ 2 idx) binary)))
(i64.left-shift 32 (..i64 (host.array-read (n/+ 3 idx) binary)))
(i64.left-shift 24 (..i64 (host.array-read (n/+ 4 idx) binary)))
(i64.left-shift 16 (..i64 (host.array-read (n/+ 5 idx) binary)))
(i64.left-shift 8 (..i64 (host.array-read (n/+ 6 idx) binary)))
(..i64 (host.array-read (n/+ 7 idx) binary))))
(ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (write/8 idx value binary)
(-> Nat (I64 Any) Binary (Error Binary))
(if (n/< (..!size binary) idx)
(exec (|> binary
(host.array-write idx (..byte value)))
(#error.Success binary))
(ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (write/16 idx value binary)
(-> Nat (I64 Any) Binary (Error Binary))
(if (n/< (..!size binary) (n/+ 1 idx))
(exec (|> binary
(host.array-write idx (..byte (i64.logic-right-shift 8 value)))
(host.array-write (n/+ 1 idx) (..byte value)))
(#error.Success binary))
(ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (write/32 idx value binary)
(-> Nat (I64 Any) Binary (Error Binary))
(if (n/< (..!size binary) (n/+ 3 idx))
(exec (|> binary
(host.array-write idx (..byte (i64.logic-right-shift 24 value)))
(host.array-write (n/+ 1 idx) (..byte (i64.logic-right-shift 16 value)))
(host.array-write (n/+ 2 idx) (..byte (i64.logic-right-shift 8 value)))
(host.array-write (n/+ 3 idx) (..byte value)))
(#error.Success binary))
(ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (write/64 idx value binary)
(-> Nat (I64 Any) Binary (Error Binary))
(if (n/< (..!size binary) (n/+ 7 idx))
(exec (|> binary
(host.array-write idx (..byte (i64.logic-right-shift 56 value)))
(host.array-write (n/+ 1 idx) (..byte (i64.logic-right-shift 48 value)))
(host.array-write (n/+ 2 idx) (..byte (i64.logic-right-shift 40 value)))
(host.array-write (n/+ 3 idx) (..byte (i64.logic-right-shift 32 value)))
(host.array-write (n/+ 4 idx) (..byte (i64.logic-right-shift 24 value)))
(host.array-write (n/+ 5 idx) (..byte (i64.logic-right-shift 16 value)))
(host.array-write (n/+ 6 idx) (..byte (i64.logic-right-shift 8 value)))
(host.array-write (n/+ 7 idx) (..byte value)))
(#error.Success binary))
(ex.throw index-out-of-bounds [(..!size binary) idx])))
(def: #export (slice from to binary)
(-> Nat Nat Binary (Error Binary))
(let [size (..!size binary)]
(cond (not (n/<= to from))
(ex.throw inverted-slice [size from to])
(not (and (n/< size from)
(n/< size to)))
(ex.throw slice-out-of-bounds [size from to])
## else
(#error.Success (Arrays::copyOfRange binary (:coerce Int from) (:coerce Int (inc to)))))))
(def: #export (slice' from binary)
(-> Nat Binary (Error Binary))
(slice from (dec (..!size binary)) binary))
(structure: #export equivalence (Equivalence Binary)
(def: (= reference sample)
(Arrays::equals reference sample)))
(def: #export (copy bytes source-offset source target-offset target)
(-> Nat Nat Binary Nat Binary (Error Binary))
(do error.monad
[_ (System::arraycopy source (.int source-offset) target (.int target-offset) (.int bytes))]
(wrap target)))
|
