diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/world/blob.jvm.lux | 152 |
1 files changed, 76 insertions, 76 deletions
diff --git a/stdlib/source/lux/world/blob.jvm.lux b/stdlib/source/lux/world/blob.jvm.lux index bb764dcb3..e4b130546 100644 --- a/stdlib/source/lux/world/blob.jvm.lux +++ b/stdlib/source/lux/world/blob.jvm.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do] ["ex" exception #+ exception:] @@ -12,127 +12,127 @@ (exception: #export Index-Out-Of-Bounds) (exception: #export Inverted-Range) -(type: #export Blob (host;type (Array byte))) +(type: #export Blob (host.type (Array byte))) -(host;import java/util/Arrays +(host.import java/util/Arrays (#static copyOfRange [(Array byte) int int] (Array byte)) (#static equals [(Array byte) (Array byte)] boolean)) (def: byte-mask Nat - (|> +1 (bit;shift-left +8) n/dec)) + (|> +1 (bit.shift-left +8) n/dec)) (def: byte-to-nat (-> (primitive "java.lang.Byte") Nat) - (|>> host;b2l (:! Nat) (bit;and byte-mask))) + (|>> host.b2l (:! Nat) (bit.and byte-mask))) (def: #export (create size) (-> Nat Blob) - (host;array byte size)) + (host.array byte size)) (def: #export (read-8 idx blob) - (-> Nat Blob (e;Error Nat)) - (if (n/< (host;array-length blob) idx) - (|> (host;array-read idx blob) byte-to-nat #e;Success) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (-> Nat Blob (e.Error Nat)) + (if (n/< (host.array-length blob) idx) + (|> (host.array-read idx blob) byte-to-nat #e.Success) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (read-16 idx blob) - (-> Nat Blob (e;Error Nat)) - (if (n/< (host;array-length blob) (n/+ +1 idx)) - (#e;Success ($_ bit;or - (bit;shift-left +8 (byte-to-nat (host;array-read idx blob))) - (byte-to-nat (host;array-read (n/+ +1 idx) blob)))) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (-> Nat Blob (e.Error Nat)) + (if (n/< (host.array-length blob) (n/+ +1 idx)) + (#e.Success ($_ bit.or + (bit.shift-left +8 (byte-to-nat (host.array-read idx blob))) + (byte-to-nat (host.array-read (n/+ +1 idx) blob)))) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (read-32 idx blob) - (-> Nat Blob (e;Error Nat)) - (if (n/< (host;array-length blob) (n/+ +3 idx)) - (#e;Success ($_ bit;or - (bit;shift-left +24 (byte-to-nat (host;array-read idx blob))) - (bit;shift-left +16 (byte-to-nat (host;array-read (n/+ +1 idx) blob))) - (bit;shift-left +8 (byte-to-nat (host;array-read (n/+ +2 idx) blob))) - (byte-to-nat (host;array-read (n/+ +3 idx) blob)))) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (-> Nat Blob (e.Error Nat)) + (if (n/< (host.array-length blob) (n/+ +3 idx)) + (#e.Success ($_ bit.or + (bit.shift-left +24 (byte-to-nat (host.array-read idx blob))) + (bit.shift-left +16 (byte-to-nat (host.array-read (n/+ +1 idx) blob))) + (bit.shift-left +8 (byte-to-nat (host.array-read (n/+ +2 idx) blob))) + (byte-to-nat (host.array-read (n/+ +3 idx) blob)))) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (read-64 idx blob) - (-> Nat Blob (e;Error Nat)) - (if (n/< (host;array-length blob) (n/+ +7 idx)) - (#e;Success ($_ bit;or - (bit;shift-left +56 (byte-to-nat (host;array-read idx blob))) - (bit;shift-left +48 (byte-to-nat (host;array-read (n/+ +1 idx) blob))) - (bit;shift-left +40 (byte-to-nat (host;array-read (n/+ +2 idx) blob))) - (bit;shift-left +32 (byte-to-nat (host;array-read (n/+ +3 idx) blob))) - (bit;shift-left +24 (byte-to-nat (host;array-read (n/+ +4 idx) blob))) - (bit;shift-left +16 (byte-to-nat (host;array-read (n/+ +5 idx) blob))) - (bit;shift-left +8 (byte-to-nat (host;array-read (n/+ +6 idx) blob))) - (byte-to-nat (host;array-read (n/+ +7 idx) blob)))) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (-> Nat Blob (e.Error Nat)) + (if (n/< (host.array-length blob) (n/+ +7 idx)) + (#e.Success ($_ bit.or + (bit.shift-left +56 (byte-to-nat (host.array-read idx blob))) + (bit.shift-left +48 (byte-to-nat (host.array-read (n/+ +1 idx) blob))) + (bit.shift-left +40 (byte-to-nat (host.array-read (n/+ +2 idx) blob))) + (bit.shift-left +32 (byte-to-nat (host.array-read (n/+ +3 idx) blob))) + (bit.shift-left +24 (byte-to-nat (host.array-read (n/+ +4 idx) blob))) + (bit.shift-left +16 (byte-to-nat (host.array-read (n/+ +5 idx) blob))) + (bit.shift-left +8 (byte-to-nat (host.array-read (n/+ +6 idx) blob))) + (byte-to-nat (host.array-read (n/+ +7 idx) blob)))) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (write-8 idx value blob) - (-> Nat Nat Blob (e;Error Unit)) - (if (n/< (host;array-length blob) idx) + (-> Nat Nat Blob (e.Error Unit)) + (if (n/< (host.array-length blob) idx) (exec (|> blob - (host;array-write idx (host;l2b (:! Int value)))) - (#e;Success [])) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (host.array-write idx (host.l2b (:! Int value)))) + (#e.Success [])) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (write-16 idx value blob) - (-> Nat Nat Blob (e;Error Unit)) - (if (n/< (host;array-length blob) (n/+ +1 idx)) + (-> Nat Nat Blob (e.Error Unit)) + (if (n/< (host.array-length blob) (n/+ +1 idx)) (exec (|> blob - (host;array-write idx (host;l2b (:! Int (bit;shift-right +8 value)))) - (host;array-write (n/+ +1 idx) (host;l2b (:! Int value)))) - (#e;Success [])) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (host.array-write idx (host.l2b (:! Int (bit.shift-right +8 value)))) + (host.array-write (n/+ +1 idx) (host.l2b (:! Int value)))) + (#e.Success [])) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (write-32 idx value blob) - (-> Nat Nat Blob (e;Error Unit)) - (if (n/< (host;array-length blob) (n/+ +3 idx)) + (-> Nat Nat Blob (e.Error Unit)) + (if (n/< (host.array-length blob) (n/+ +3 idx)) (exec (|> blob - (host;array-write idx (host;l2b (:! Int (bit;shift-right +24 value)))) - (host;array-write (n/+ +1 idx) (host;l2b (:! Int (bit;shift-right +16 value)))) - (host;array-write (n/+ +2 idx) (host;l2b (:! Int (bit;shift-right +8 value)))) - (host;array-write (n/+ +3 idx) (host;l2b (:! Int value)))) - (#e;Success [])) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (host.array-write idx (host.l2b (:! Int (bit.shift-right +24 value)))) + (host.array-write (n/+ +1 idx) (host.l2b (:! Int (bit.shift-right +16 value)))) + (host.array-write (n/+ +2 idx) (host.l2b (:! Int (bit.shift-right +8 value)))) + (host.array-write (n/+ +3 idx) (host.l2b (:! Int value)))) + (#e.Success [])) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (write-64 idx value blob) - (-> Nat Nat Blob (e;Error Unit)) - (if (n/< (host;array-length blob) (n/+ +7 idx)) + (-> Nat Nat Blob (e.Error Unit)) + (if (n/< (host.array-length blob) (n/+ +7 idx)) (exec (|> blob - (host;array-write idx (host;l2b (:! Int (bit;shift-right +56 value)))) - (host;array-write (n/+ +1 idx) (host;l2b (:! Int (bit;shift-right +48 value)))) - (host;array-write (n/+ +2 idx) (host;l2b (:! Int (bit;shift-right +40 value)))) - (host;array-write (n/+ +3 idx) (host;l2b (:! Int (bit;shift-right +32 value)))) - (host;array-write (n/+ +4 idx) (host;l2b (:! Int (bit;shift-right +24 value)))) - (host;array-write (n/+ +5 idx) (host;l2b (:! Int (bit;shift-right +16 value)))) - (host;array-write (n/+ +6 idx) (host;l2b (:! Int (bit;shift-right +8 value)))) - (host;array-write (n/+ +7 idx) (host;l2b (:! Int value)))) - (#e;Success [])) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (host.array-write idx (host.l2b (:! Int (bit.shift-right +56 value)))) + (host.array-write (n/+ +1 idx) (host.l2b (:! Int (bit.shift-right +48 value)))) + (host.array-write (n/+ +2 idx) (host.l2b (:! Int (bit.shift-right +40 value)))) + (host.array-write (n/+ +3 idx) (host.l2b (:! Int (bit.shift-right +32 value)))) + (host.array-write (n/+ +4 idx) (host.l2b (:! Int (bit.shift-right +24 value)))) + (host.array-write (n/+ +5 idx) (host.l2b (:! Int (bit.shift-right +16 value)))) + (host.array-write (n/+ +6 idx) (host.l2b (:! Int (bit.shift-right +8 value)))) + (host.array-write (n/+ +7 idx) (host.l2b (:! Int value)))) + (#e.Success [])) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (size blob) (-> Blob Nat) - (host;array-length blob)) + (host.array-length blob)) (def: #export (slice from to blob) - (-> Nat Nat Blob (e;Error Blob)) + (-> Nat Nat Blob (e.Error Blob)) (with-expansions [<description> (as-is (format "from = " (%n from) " | " "to = " (%n to)))] - (let [size (host;array-length blob)] + (let [size (host.array-length blob)] (cond (not (n/<= to from)) - (ex;throw Inverted-Range <description>) + (ex.throw Inverted-Range <description>) (not (and (n/< size from) (n/< size to))) - (ex;throw Index-Out-Of-Bounds <description>) + (ex.throw Index-Out-Of-Bounds <description>) ## else - (#e;Success (Arrays::copyOfRange [blob (:! Int from) (:! Int (n/inc to))])))))) + (#e.Success (Arrays::copyOfRange [blob (:! Int from) (:! Int (n/inc to))])))))) (def: #export (slice' from blob) - (-> Nat Blob (e;Error Blob)) - (slice from (n/dec (host;array-length blob)) blob)) + (-> Nat Blob (e.Error Blob)) + (slice from (n/dec (host.array-length blob)) blob)) -(struct: #export _ (eq;Eq Blob) +(struct: #export _ (eq.Eq Blob) (def: (= reference sample) (Arrays::equals [reference sample]))) |