blob: 0b72af60be82b3767c23d7f7176d16291c12cc9c (
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
|
(.module:
[lux (#- i64)
[control
[monad (#+ do)]
["ex" exception (#+ exception:)]
["eq" equivalence]]
[data
["." maybe]
["." error (#+ Error)]
[number
["." i64]]
[text
format]]
["." host (#+ import:)]])
(exception: #export (index-out-of-bounds {description Text})
description)
(exception: #export (inverted-range {description Text})
description)
(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
(|> |1 (i64.left-shift |8) dec .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))
(def: #export (create size)
(-> Nat Binary)
(host.array byte size))
(def: #export (read/8 idx binary)
(-> Nat Binary (Error I64))
(if (n/< (host.array-length binary) idx)
(|> (host.array-read idx binary) ..i64 #error.Success)
(ex.throw index-out-of-bounds (%n idx))))
(def: #export (read/16 idx binary)
(-> Nat Binary (Error I64))
(if (n/< (host.array-length 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 (%n idx))))
(def: #export (read/32 idx binary)
(-> Nat Binary (Error I64))
(if (n/< (host.array-length 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 (%n idx))))
(def: #export (read/64 idx binary)
(-> Nat Binary (Error I64))
(if (n/< (host.array-length 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 (%n idx))))
(def: #export (write/8 idx value binary)
(-> Nat (I64 Any) Binary (Error Binary))
(if (n/< (host.array-length binary) idx)
(exec (|> binary
(host.array-write idx (..byte value)))
(#error.Success binary))
(ex.throw index-out-of-bounds (%n idx))))
(def: #export (write/16 idx value binary)
(-> Nat (I64 Any) Binary (Error Binary))
(if (n/< (host.array-length binary) (n/+ |1 idx))
(exec (|> binary
(host.array-write idx (..byte (i64.logical-right-shift |8 value)))
(host.array-write (n/+ |1 idx) (..byte value)))
(#error.Success binary))
(ex.throw index-out-of-bounds (%n idx))))
(def: #export (write/32 idx value binary)
(-> Nat (I64 Any) Binary (Error Binary))
(if (n/< (host.array-length binary) (n/+ |3 idx))
(exec (|> binary
(host.array-write idx (..byte (i64.logical-right-shift |24 value)))
(host.array-write (n/+ |1 idx) (..byte (i64.logical-right-shift |16 value)))
(host.array-write (n/+ |2 idx) (..byte (i64.logical-right-shift |8 value)))
(host.array-write (n/+ |3 idx) (..byte value)))
(#error.Success binary))
(ex.throw index-out-of-bounds (%n idx))))
(def: #export (write/64 idx value binary)
(-> Nat (I64 Any) Binary (Error Binary))
(if (n/< (host.array-length binary) (n/+ |7 idx))
(exec (|> binary
(host.array-write idx (..byte (i64.logical-right-shift |56 value)))
(host.array-write (n/+ |1 idx) (..byte (i64.logical-right-shift |48 value)))
(host.array-write (n/+ |2 idx) (..byte (i64.logical-right-shift |40 value)))
(host.array-write (n/+ |3 idx) (..byte (i64.logical-right-shift |32 value)))
(host.array-write (n/+ |4 idx) (..byte (i64.logical-right-shift |24 value)))
(host.array-write (n/+ |5 idx) (..byte (i64.logical-right-shift |16 value)))
(host.array-write (n/+ |6 idx) (..byte (i64.logical-right-shift |8 value)))
(host.array-write (n/+ |7 idx) (..byte value)))
(#error.Success binary))
(ex.throw index-out-of-bounds (%n idx))))
(def: #export (size binary)
(-> Binary Nat)
(host.array-length binary))
(def: #export (slice from to binary)
(-> Nat Nat Binary (Error Binary))
(with-expansions [<description> (as-is (format "from = " (%n from) " | " "to = " (%n to)))]
(let [size (host.array-length binary)]
(cond (not (n/<= to from))
(ex.throw inverted-range <description>)
(not (and (n/< size from)
(n/< size to)))
(ex.throw index-out-of-bounds <description>)
## 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 (host.array-length binary)) binary))
(structure: #export _ (eq.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<Error>
[_ (System::arraycopy [source (.int source-offset) target (.int target-offset) (.int bytes)])]
(wrap target)))
|
