From 47890ee876d2a33d9d7d1c559912123359ab9f87 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 21 Jul 2018 00:20:16 -0400 Subject: Re-named "lux/world/blob" to "lux/world/binary". --- stdlib/source/lux/data/format/binary.lux | 86 +++++------ stdlib/source/lux/data/text/encoding.lux | 6 +- stdlib/source/lux/language/compiler/meta/io.lux | 11 +- .../lux/language/compiler/meta/io/archive.lux | 4 +- .../lux/language/compiler/meta/io/context.lux | 6 +- stdlib/source/lux/world/binary.lux | 158 +++++++++++++++++++++ stdlib/source/lux/world/blob.jvm.lux | 158 --------------------- stdlib/source/lux/world/file.lux | 8 +- stdlib/source/lux/world/net/tcp.jvm.lux | 6 +- stdlib/source/lux/world/net/udp.jvm.lux | 6 +- stdlib/test/test/lux/world/binary.lux | 88 ++++++++++++ stdlib/test/test/lux/world/blob.lux | 88 ------------ stdlib/test/test/lux/world/file.lux | 14 +- stdlib/test/test/lux/world/net/tcp.lux | 16 +-- stdlib/test/test/lux/world/net/udp.lux | 14 +- stdlib/test/tests.lux | 2 +- 16 files changed, 332 insertions(+), 339 deletions(-) create mode 100644 stdlib/source/lux/world/binary.lux delete mode 100644 stdlib/source/lux/world/blob.jvm.lux create mode 100644 stdlib/test/test/lux/world/binary.lux delete mode 100644 stdlib/test/test/lux/world/blob.lux (limited to 'stdlib') diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux index 592aba473..27a510b44 100644 --- a/stdlib/source/lux/data/format/binary.lux +++ b/stdlib/source/lux/data/format/binary.lux @@ -12,11 +12,11 @@ ["." encoding] [format (#+ %n)]]] [world - ["." blob (#+ Blob)]]]) + ["." binary (#+ Binary)]]]) ## Exceptions -(exception: #export (blob-was-not-fully-read {length Nat} {read Nat}) - (ex.report ["Blob length" (%n length)] +(exception: #export (binary-was-not-fully-read {length Nat} {read Nat}) + (ex.report ["Binary length" (%n length)] ["Read bytes" (%n read)])) (exception: #export (invalid-tag {range Nat} {byte Nat}) @@ -34,10 +34,10 @@ (def: #export size/64 +8) (type: #export Read - (p.Parser [Offset Blob])) + (p.Parser [Offset Binary])) (type: #export (Write a) - (-> a [Size (-> Offset Blob Blob)])) + (-> a [Size (-> Offset Binary Binary)])) (type: #export (Format a) {#read (Read a) @@ -45,44 +45,44 @@ ## Operators (def: #export (read format input) - (All [a] (-> (Format a) Blob (Error a))) + (All [a] (-> (Format a) Binary (Error a))) (case ((get@ #read format) [+0 input]) (#error.Error msg) (#error.Error msg) (#error.Success [[end _] output]) - (let [length (blob.size input)] + (let [length (binary.size input)] (if (n/= end length) (#error.Success output) - (ex.throw blob-was-not-fully-read [length end]))))) + (ex.throw binary-was-not-fully-read [length end]))))) (def: #export (write format value) - (All [a] (-> (Format a) a Blob)) + (All [a] (-> (Format a) a Binary)) (let [[valueS valueT] ((get@ #write format) value)] - (|> valueS blob.create (valueT +0)))) + (|> valueS binary.create (valueT +0)))) ## Primitives (do-template [ ] [(def: (Format (I64 Any)) - {#read (function (_ [offset blob]) - (case ( offset blob) + {#read (function (_ [offset binary]) + (case ( offset binary) (#error.Success data) - (#error.Success [(n/+ offset) blob] data) + (#error.Success [(n/+ offset) binary] data) (#error.Error error) (#error.Error error))) #write (function (_ value) [ - (function (_ offset blob) - (|> blob + (function (_ offset binary) + (|> binary ( offset value) error.assume))])})] - [bits/8 size/8 blob.read/8 blob.write/8] - [bits/16 size/16 blob.read/16 blob.write/16] - [bits/32 size/32 blob.read/32 blob.write/32] - [bits/64 size/64 blob.read/64 blob.write/64] + [bits/8 size/8 binary.read/8 binary.write/8] + [bits/16 size/16 binary.read/16 binary.write/16] + [bits/32 size/32 binary.read/32 binary.write/32] + [bits/64 size/64 binary.read/64 binary.write/64] ) ## Combinators @@ -99,18 +99,18 @@ (#.Left leftV) (let [[leftS leftT] ((get@ #write leftB) leftV)] [(.inc leftS) - (function (_ offset blob) - (|> blob - (blob.write/8 offset +0) + (function (_ offset binary) + (|> binary + (binary.write/8 offset +0) error.assume (leftT (.inc offset))))]) (#.Right rightV) (let [[rightS rightT] ((get@ #write rightB) rightV)] [(.inc rightS) - (function (_ offset blob) - (|> blob - (blob.write/8 offset +1) + (function (_ offset binary) + (|> binary + (binary.write/8 offset +1) error.assume (rightT (.inc offset))))]) ))}) @@ -142,8 +142,8 @@ (#error.Success [input default])) #write (function (_ value) [+0 - (function (_ offset blob) - blob)])}) + (function (_ offset binary) + binary)])}) (def: #export any (Format Any) @@ -151,12 +151,12 @@ (def: #export bit (Format Bit) - {#read (function (_ [offset blob]) - (case (blob.read/8 offset blob) + {#read (function (_ [offset binary]) + (case (binary.read/8 offset binary) (#error.Success data) (case (: Nat data) (^template [ ] - (#error.Success [(inc offset) blob] )) + (#error.Success [(inc offset) binary] )) ([+0 #0] [+1 #1]) @@ -167,9 +167,9 @@ (#error.Error error))) #write (function (_ value) [+1 - (function (_ offset blob) - (|> blob - (blob.write/8 offset (if value +1 +0)) + (function (_ offset binary) + (|> binary + (binary.write/8 offset (if value +1 +0)) error.assume))])}) (def: #export nat (Format Nat) (:assume ..bits/64)) @@ -182,27 +182,27 @@ {#read (:: p.Monad map number.bits-to-frac read) #write (|>> number.frac-to-bits write)})) -(def: #export blob - (Format Blob) +(def: #export binary + (Format Binary) {#read (do p.Monad [size (get@ #read nat)] - (function (_ [offset blob]) + (function (_ [offset binary]) (do error.Monad [#let [end (n/+ size offset)] - output (blob.slice offset end blob)] - (wrap [[end blob] output])))) + output (binary.slice offset end binary)] + (wrap [[end binary] output])))) #write (function (_ value) - (let [size (blob.size value)] + (let [size (binary.size value)] [(n/+ size/64 size) - (function (_ offset blob) + (function (_ offset binary) (error.assume (do error.Monad - [_ (blob.write/64 offset size blob)] - (blob.copy size +0 value (n/+ size/64 offset) blob))))]))}) + [_ (binary.write/64 offset size binary)] + (binary.copy size +0 value (n/+ size/64 offset) binary))))]))}) (def: #export text (Format Text) - (let [(^slots [#read #write]) ..blob] + (let [(^slots [#read #write]) ..binary] {#read (do p.Monad [utf8 read] (p.lift (encoding.from-utf8 utf8))) diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index d5246e382..661e0bbf9 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -3,7 +3,7 @@ [data ["." error (#+ Error)]] [world - [blob (#+ Blob)]] + [binary (#+ Binary)]] [language ["_" host]] [host (#+ import:)]]) @@ -16,11 +16,11 @@ (getBytes [String] (Array byte))))})) (def: #export (to-utf8 value) - (-> Text Blob) + (-> Text Binary) (`` (for {(~~ (static _.jvm)) (String::getBytes [..utf8] value)}))) (def: #export (from-utf8 value) - (-> Blob (Error Text)) + (-> Binary (Error Text)) (`` (for {(~~ (static _.jvm)) (#error.Success (String::new [value ..utf8]))}))) diff --git a/stdlib/source/lux/language/compiler/meta/io.lux b/stdlib/source/lux/language/compiler/meta/io.lux index 3ba31fa82..a46f78d5a 100644 --- a/stdlib/source/lux/language/compiler/meta/io.lux +++ b/stdlib/source/lux/language/compiler/meta/io.lux @@ -1,16 +1,9 @@ (.module: [lux (#- Module) - [control - monad - ["ex" exception (#+ exception:)]] [data - [error] - ["." text - format - [encoding]]] + ["." text]] [world - [file (#+ File System)] - [blob (#+ Blob)]]]) + [file (#+ File System)]]]) (type: #export Context File) diff --git a/stdlib/source/lux/language/compiler/meta/io/archive.lux b/stdlib/source/lux/language/compiler/meta/io/archive.lux index 4a6e3fb39..5a7789a95 100644 --- a/stdlib/source/lux/language/compiler/meta/io/archive.lux +++ b/stdlib/source/lux/language/compiler/meta/io/archive.lux @@ -9,7 +9,7 @@ format]] [world ["." file (#+ File System)] - [blob (#+ Blob)]]] + [binary (#+ Binary)]]] ["." /////host] ["." // (#+ Module)]) @@ -57,7 +57,7 @@ (:: System throw cannot-prepare [archive module])))))) (def: #export (write System root content name) - (All [m] (-> (System m) File Blob Text (m Any))) + (All [m] (-> (System m) File Binary Text (m Any))) (:: System write content (..document System root name))) (def: #export (module System root document) diff --git a/stdlib/source/lux/language/compiler/meta/io/context.lux b/stdlib/source/lux/language/compiler/meta/io/context.lux index eab4b284a..8288718aa 100644 --- a/stdlib/source/lux/language/compiler/meta/io/context.lux +++ b/stdlib/source/lux/language/compiler/meta/io/context.lux @@ -10,7 +10,7 @@ ["." encoding]]] [world ["." file (#+ File System)] - [blob (#+ Blob)]]] + [binary (#+ Binary)]]] ["." // (#+ Context Module) [//// ["." host]]]) @@ -85,8 +85,8 @@ (list (find-source' (format host-extension lux-extension)) (find-source' lux-extension)) module-not-found [name]) - blob (:: System read file)] - (case (encoding.from-utf8 blob) + binary (:: System read file)] + (case (encoding.from-utf8 binary) (#error.Success code) (wrap [path code]) diff --git a/stdlib/source/lux/world/binary.lux b/stdlib/source/lux/world/binary.lux new file mode 100644 index 000000000..d89b7ae3a --- /dev/null +++ b/stdlib/source/lux/world/binary.lux @@ -0,0 +1,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 [ (as-is (format "from = " (%n from) " | " "to = " (%n to)))] + (let [size (host.array-length binary)] + (cond (not (n/<= to from)) + (ex.throw inverted-range ) + + (not (and (n/< size from) + (n/< size to))) + (ex.throw index-out-of-bounds ) + + ## 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 + [_ (System::arraycopy [source (.int source-offset) target (.int target-offset) (.int bytes)])] + (wrap target))) diff --git a/stdlib/source/lux/world/blob.jvm.lux b/stdlib/source/lux/world/blob.jvm.lux deleted file mode 100644 index c4c659ccf..000000000 --- a/stdlib/source/lux/world/blob.jvm.lux +++ /dev/null @@ -1,158 +0,0 @@ -(.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 Blob (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 Blob) - (host.array byte size)) - -(def: #export (read/8 idx blob) - (-> Nat Blob (Error I64)) - (if (n/< (host.array-length blob) idx) - (|> (host.array-read idx blob) ..i64 #error.Success) - (ex.throw index-out-of-bounds (%n idx)))) - -(def: #export (read/16 idx blob) - (-> Nat Blob (Error I64)) - (if (n/< (host.array-length blob) (n/+ +1 idx)) - (#error.Success ($_ i64.or - (i64.left-shift +8 (..i64 (host.array-read idx blob))) - (..i64 (host.array-read (n/+ +1 idx) blob)))) - (ex.throw index-out-of-bounds (%n idx)))) - -(def: #export (read/32 idx blob) - (-> Nat Blob (Error I64)) - (if (n/< (host.array-length blob) (n/+ +3 idx)) - (#error.Success ($_ i64.or - (i64.left-shift +24 (..i64 (host.array-read idx blob))) - (i64.left-shift +16 (..i64 (host.array-read (n/+ +1 idx) blob))) - (i64.left-shift +8 (..i64 (host.array-read (n/+ +2 idx) blob))) - (..i64 (host.array-read (n/+ +3 idx) blob)))) - (ex.throw index-out-of-bounds (%n idx)))) - -(def: #export (read/64 idx blob) - (-> Nat Blob (Error I64)) - (if (n/< (host.array-length blob) (n/+ +7 idx)) - (#error.Success ($_ i64.or - (i64.left-shift +56 (..i64 (host.array-read idx blob))) - (i64.left-shift +48 (..i64 (host.array-read (n/+ +1 idx) blob))) - (i64.left-shift +40 (..i64 (host.array-read (n/+ +2 idx) blob))) - (i64.left-shift +32 (..i64 (host.array-read (n/+ +3 idx) blob))) - (i64.left-shift +24 (..i64 (host.array-read (n/+ +4 idx) blob))) - (i64.left-shift +16 (..i64 (host.array-read (n/+ +5 idx) blob))) - (i64.left-shift +8 (..i64 (host.array-read (n/+ +6 idx) blob))) - (..i64 (host.array-read (n/+ +7 idx) blob)))) - (ex.throw index-out-of-bounds (%n idx)))) - -(def: #export (write/8 idx value blob) - (-> Nat (I64 Any) Blob (Error Blob)) - (if (n/< (host.array-length blob) idx) - (exec (|> blob - (host.array-write idx (..byte value))) - (#error.Success blob)) - (ex.throw index-out-of-bounds (%n idx)))) - -(def: #export (write/16 idx value blob) - (-> Nat (I64 Any) Blob (Error Blob)) - (if (n/< (host.array-length blob) (n/+ +1 idx)) - (exec (|> blob - (host.array-write idx (..byte (i64.logical-right-shift +8 value))) - (host.array-write (n/+ +1 idx) (..byte value))) - (#error.Success blob)) - (ex.throw index-out-of-bounds (%n idx)))) - -(def: #export (write/32 idx value blob) - (-> Nat (I64 Any) Blob (Error Blob)) - (if (n/< (host.array-length blob) (n/+ +3 idx)) - (exec (|> blob - (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 blob)) - (ex.throw index-out-of-bounds (%n idx)))) - -(def: #export (write/64 idx value blob) - (-> Nat (I64 Any) Blob (Error Blob)) - (if (n/< (host.array-length blob) (n/+ +7 idx)) - (exec (|> blob - (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 blob)) - (ex.throw index-out-of-bounds (%n idx)))) - -(def: #export (size blob) - (-> Blob Nat) - (host.array-length blob)) - -(def: #export (slice from to blob) - (-> Nat Nat Blob (Error Blob)) - (with-expansions [ (as-is (format "from = " (%n from) " | " "to = " (%n to)))] - (let [size (host.array-length blob)] - (cond (not (n/<= to from)) - (ex.throw inverted-range ) - - (not (and (n/< size from) - (n/< size to))) - (ex.throw index-out-of-bounds ) - - ## else - (#error.Success (Arrays::copyOfRange [blob (:coerce Int from) (:coerce Int (inc to))])))))) - -(def: #export (slice' from blob) - (-> Nat Blob (Error Blob)) - (slice from (dec (host.array-length blob)) blob)) - -(structure: #export _ (eq.Equivalence Blob) - (def: (= reference sample) - (Arrays::equals [reference sample]))) - -(def: #export (copy bytes source-offset source target-offset target) - (-> Nat Nat Blob Nat Blob (Error Blob)) - (do error.Monad - [_ (System::arraycopy [source (.int source-offset) target (.int target-offset) (.int bytes)])] - (wrap target))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index acaa2c244..5c359f26b 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -14,7 +14,7 @@ ["." instant (#+ Instant)] ["." duration]] [world - ["." blob (#+ Blob)]] + ["." binary (#+ Binary)]] ["." io (#+ Process)] [host (#+ import:)] ["." language/host]]) @@ -40,7 +40,7 @@ lift) (do-template [] - [(: (-> Blob File (m Any)) + [(: (-> Binary File (m Any)) )] [append] [write]) @@ -49,7 +49,7 @@ [(: (-> File (m )) )] - [read Blob] + [read Binary] [size Nat] [files (List File)] [last-modified Instant]) @@ -164,7 +164,7 @@ (do io.Monad [#let [file' (java/io/File::new file)] size (java/io/File::length [] file') - #let [data (blob.create (.nat size))] + #let [data (binary.create (.nat size))] stream (FileInputStream::new [file']) bytes-read (InputStream::read [data] stream) _ (AutoCloseable::close [] stream)] diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux index 6c65a92ca..ee866203e 100644 --- a/stdlib/source/lux/world/net/tcp.jvm.lux +++ b/stdlib/source/lux/world/net/tcp.jvm.lux @@ -11,7 +11,7 @@ [type abstract] [world - [blob (#+ Blob)]] + [binary (#+ Binary)]] ["." io (#+ Process)] [host (#+ import:)]] ["." //]) @@ -47,7 +47,7 @@ #out OutputStream} (def: #export (read data offset length self) - (-> Blob Nat Nat TCP (Task Nat)) + (-> Binary Nat Nat TCP (Task Nat)) (promise.future (do io.Monad [bytes-read (InputStream::read [data (.int offset) (.int length)] @@ -55,7 +55,7 @@ (wrap (.nat bytes-read))))) (def: #export (write data offset length self) - (-> Blob Nat Nat TCP (Task Any)) + (-> Binary Nat Nat TCP (Task Any)) (let [out (get@ #out (:representation self))] (promise.future (do io.Monad diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux index 82614842c..6974af0ba 100644 --- a/stdlib/source/lux/world/net/udp.jvm.lux +++ b/stdlib/source/lux/world/net/udp.jvm.lux @@ -14,7 +14,7 @@ [type abstract] [world - [blob (#+ Blob)]] + [binary (#+ Binary)]] ["." io] [host (#+ import:)]] ["." //]) @@ -66,7 +66,7 @@ {#socket DatagramSocket} (def: #export (read data offset length self) - (-> Blob Nat Nat UDP (T.Task [Nat //.Address //.Port])) + (-> Binary Nat Nat UDP (T.Task [Nat //.Address //.Port])) (let [(^open ".") (:representation self) packet (DatagramPacket::new|receive [data (.int offset) (.int length)])] (P.future @@ -78,7 +78,7 @@ (.nat (DatagramPacket::getPort [] packet))]))))) (def: #export (write address port data offset length self) - (-> //.Address //.Port Blob Nat Nat UDP (T.Task Any)) + (-> //.Address //.Port Binary Nat Nat UDP (T.Task Any)) (P.future (do (e.ErrorT io.Monad) [address (resolve address) diff --git a/stdlib/test/test/lux/world/binary.lux b/stdlib/test/test/lux/world/binary.lux new file mode 100644 index 000000000..25c59c88d --- /dev/null +++ b/stdlib/test/test/lux/world/binary.lux @@ -0,0 +1,88 @@ +(.module: + [lux #* + [control + ["." monad (#+ do)]] + [data + ["e" error] + ["." number + ["." i64]] + [collection + ["." list]]] + [world + ["/" binary]] + [math + ["r" random]]] + lux/test + [test + [lux + [control + ["_eq" equivalence]]]]) + +(def: (succeed result) + (-> (e.Error Bit) Bit) + (case result + (#e.Error _) + #0 + + (#e.Success output) + output)) + +(def: #export (binary size) + (-> Nat (r.Random /.Binary)) + (let [output (/.create size)] + (loop [idx +0] + (if (n/< size idx) + (do r.Monad + [byte r.nat] + (exec (e.assume (/.write/8 idx byte output)) + (recur (inc idx)))) + (:: r.Monad wrap output))))) + +(def: (bits-io bytes read write value) + (-> Nat (-> Nat /.Binary (e.Error Nat)) (-> Nat Nat /.Binary (e.Error Any)) Nat Bit) + (let [binary (/.create +8) + bits (n/* +8 bytes) + capped-value (|> +1 (i64.left-shift bits) dec (i64.and value))] + (succeed + (do e.Monad + [_ (write +0 value binary) + output (read +0 binary)] + (wrap (n/= capped-value output)))))) + +(context: "Binary." + (<| (times +100) + (do @ + [#let [gen-size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +8))))] + binary-size gen-size + random-binary (binary binary-size) + value r.nat + #let [gen-idx (|> r.nat (:: @ map (n/% binary-size)))] + [from to] (r.seq gen-idx gen-idx) + #let [[from to] [(n/min from to) (n/max from to)]]] + ($_ seq + ## TODO: De-comment... + ## (_eq.spec /.Equivalence (:: @ map binary gen-size)) + (test "Can get size of binary." + (|> random-binary /.size (n/= binary-size))) + (test "Can read/write 8-bit values." + (bits-io +1 /.read/8 /.write/8 value)) + (test "Can read/write 16-bit values." + (bits-io +2 /.read/16 /.write/16 value)) + (test "Can read/write 32-bit values." + (bits-io +4 /.read/32 /.write/32 value)) + (test "Can read/write 64-bit values." + (bits-io +8 /.read/64 /.write/64 value)) + (test "Can slice binaries." + (let [slice-size (|> to (n/- from) inc) + random-slice (e.assume (/.slice from to random-binary)) + idxs (list.n/range +0 (dec slice-size)) + reader (function (_ binary idx) (/.read/8 idx binary))] + (and (n/= slice-size (/.size random-slice)) + (case [(monad.map e.Monad (reader random-slice) idxs) + (monad.map e.Monad (|>> (n/+ from) (reader random-binary)) idxs)] + [(#e.Success slice-vals) (#e.Success binary-vals)] + (:: (list.Equivalence number.Equivalence) = slice-vals binary-vals) + + _ + #0)))) + )))) diff --git a/stdlib/test/test/lux/world/blob.lux b/stdlib/test/test/lux/world/blob.lux deleted file mode 100644 index e24017587..000000000 --- a/stdlib/test/test/lux/world/blob.lux +++ /dev/null @@ -1,88 +0,0 @@ -(.module: - [lux #* - [control - ["." monad (#+ do)]] - [data - ["e" error] - ["." number - ["." i64]] - [collection - ["." list]]] - [world - ["/" blob]] - [math - ["r" random]]] - lux/test - [test - [lux - [control - ["_eq" equivalence]]]]) - -(def: (succeed result) - (-> (e.Error Bit) Bit) - (case result - (#e.Error _) - #0 - - (#e.Success output) - output)) - -(def: #export (blob size) - (-> Nat (r.Random /.Blob)) - (let [output (/.create size)] - (loop [idx +0] - (if (n/< size idx) - (do r.Monad - [byte r.nat] - (exec (e.assume (/.write/8 idx byte output)) - (recur (inc idx)))) - (:: r.Monad wrap output))))) - -(def: (bits-io bytes read write value) - (-> Nat (-> Nat /.Blob (e.Error Nat)) (-> Nat Nat /.Blob (e.Error Any)) Nat Bit) - (let [blob (/.create +8) - bits (n/* +8 bytes) - capped-value (|> +1 (i64.left-shift bits) dec (i64.and value))] - (succeed - (do e.Monad - [_ (write +0 value blob) - output (read +0 blob)] - (wrap (n/= capped-value output)))))) - -(context: "Blob." - (<| (times +100) - (do @ - [#let [gen-size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +8))))] - blob-size gen-size - random-blob (blob blob-size) - value r.nat - #let [gen-idx (|> r.nat (:: @ map (n/% blob-size)))] - [from to] (r.seq gen-idx gen-idx) - #let [[from to] [(n/min from to) (n/max from to)]]] - ($_ seq - ## TODO: De-comment... - ## (_eq.spec /.Equivalence (:: @ map blob gen-size)) - (test "Can get size of blob." - (|> random-blob /.size (n/= blob-size))) - (test "Can read/write 8-bit values." - (bits-io +1 /.read/8 /.write/8 value)) - (test "Can read/write 16-bit values." - (bits-io +2 /.read/16 /.write/16 value)) - (test "Can read/write 32-bit values." - (bits-io +4 /.read/32 /.write/32 value)) - (test "Can read/write 64-bit values." - (bits-io +8 /.read/64 /.write/64 value)) - (test "Can slice blobs." - (let [slice-size (|> to (n/- from) inc) - random-slice (e.assume (/.slice from to random-blob)) - idxs (list.n/range +0 (dec slice-size)) - reader (function (_ blob idx) (/.read/8 idx blob))] - (and (n/= slice-size (/.size random-slice)) - (case [(monad.map e.Monad (reader random-slice) idxs) - (monad.map e.Monad (|>> (n/+ from) (reader random-blob)) idxs)] - [(#e.Success slice-vals) (#e.Success blob-vals)] - (:: (list.Equivalence number.Equivalence) = slice-vals blob-vals) - - _ - #0)))) - )))) diff --git a/stdlib/test/test/lux/world/file.lux b/stdlib/test/test/lux/world/file.lux index 43b62ac3f..54a5e0e2a 100644 --- a/stdlib/test/test/lux/world/file.lux +++ b/stdlib/test/test/lux/world/file.lux @@ -15,12 +15,12 @@ [duration]] [world ["@" file] - [blob]] + [binary]] [math ["r" random]]] lux/test [// - ["_." blob]]) + ["_." binary]]) (def: truncate-millis (|>> (i// 1_000) (i/* 1_000))) @@ -28,8 +28,8 @@ (context: "File system." (do @ [file-size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10)))) - dataL (_blob.blob file-size) - dataR (_blob.blob file-size) + dataL (_binary.binary file-size) + dataR (_binary.binary file-size) code r.nat last-modified (|> r.int (:: @ map (|>> (:: number.Number abs) truncate-millis @@ -56,7 +56,7 @@ [_ (:: @.JVM@System write dataL file) output (:: @.JVM@System read file) _ (:: @.JVM@System delete file)] - (wrap (:: blob.Equivalence = dataL output))))] + (wrap (:: binary.Equivalence = dataL output))))] (assert "Can write/read files." (error.default #0 result)))) (wrap (do promise.Monad @@ -79,8 +79,8 @@ read-size (:: @.JVM@System size file) _ (:: @.JVM@System delete file)] (wrap (and (n/= (n/* +2 file-size) read-size) - (:: blob.Equivalence = dataL (error.assume (blob.slice +0 (dec file-size) output))) - (:: blob.Equivalence = dataR (error.assume (blob.slice file-size (dec read-size) output)))))))] + (:: binary.Equivalence = dataL (error.assume (binary.slice +0 (dec file-size) output))) + (:: binary.Equivalence = dataR (error.assume (binary.slice file-size (dec read-size) output)))))))] (assert "Can append to files." (error.default #0 result)))) (wrap (do promise.Monad diff --git a/stdlib/test/test/lux/world/net/tcp.lux b/stdlib/test/test/lux/world/net/tcp.lux index cda068a78..1991e33cd 100644 --- a/stdlib/test/test/lux/world/net/tcp.lux +++ b/stdlib/test/test/lux/world/net/tcp.lux @@ -13,14 +13,14 @@ ["." text format]] [world - ["." blob] + ["." binary] ["." net ["@" tcp]]] [math ["r" random]]] lux/test [/// - ["_." blob]]) + ["_." binary]]) (def: localhost net.Address "127.0.0.1") (def: port @@ -34,10 +34,10 @@ (do @ [port ..port size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10)))) - from (_blob.blob size) - to (_blob.blob size) - #let [temp-from (blob.create size) - temp-to (blob.create size)]] + from (_binary.binary size) + to (_binary.binary size) + #let [temp-from (binary.create size) + temp-to (binary.create size)]] ($_ seq (wrap (do P.Monad [result (do T.Monad @@ -48,7 +48,7 @@ (do @ [bytes-from (@.read temp-from +0 size socket) #let [_ (io.run (P.resolve (#E.Success (and (n/= size bytes-from) - (:: blob.Equivalence = from temp-from))) + (:: binary.Equivalence = from temp-from))) from-worked?))]] (@.write to +0 size socket))) server)] @@ -59,7 +59,7 @@ #################### bytes-to (@.read temp-to +0 size client) #let [to-worked? (and (n/= size bytes-to) - (:: blob.Equivalence = to temp-to))] + (:: binary.Equivalence = to temp-to))] #################### _ (@.close client) _ (T.from-promise (P.future (P.resolve [] server-close)))] diff --git a/stdlib/test/test/lux/world/net/udp.lux b/stdlib/test/test/lux/world/net/udp.lux index 444f8ac11..b3911aea3 100644 --- a/stdlib/test/test/lux/world/net/udp.lux +++ b/stdlib/test/test/lux/world/net/udp.lux @@ -10,14 +10,14 @@ ["." text format]] [world - ["." blob] + ["." binary] ["." net ["@" udp]]] [math ["r" random]]] lux/test [/// - ["_." blob]]) + ["_." binary]]) (def: localhost net.Address "127.0.0.1") (def: port @@ -31,9 +31,9 @@ (do @ [port ..port size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10)))) - from (_blob.blob size) - to (_blob.blob size) - #let [temp (blob.create size)]] + from (_binary.binary size) + to (_binary.binary size) + #let [temp (binary.create size)]] ($_ seq (wrap (do P.Monad [result (do T.Monad @@ -43,12 +43,12 @@ _ (@.write localhost port from +0 size client) [bytes-from from-address from-port] (@.read temp +0 size server) #let [from-worked? (and (n/= size bytes-from) - (:: blob.Equivalence = from temp))] + (:: binary.Equivalence = from temp))] #################### _ (@.write from-address from-port to +0 size server) [bytes-to to-address to-port] (@.read temp +0 size client) #let [to-worked? (and (n/= size bytes-to) - (:: blob.Equivalence = to temp) + (:: binary.Equivalence = to temp) (n/= port to-port))] #################### _ (@.close client) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index c79b17073..a795556eb 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -168,7 +168,7 @@ ["_.S" case] ["_.S" function]]]] [world - ["_." blob] + ["_." binary] ## ["_." file] ## TODO: Specially troublesome... [net ["_." tcp] -- cgit v1.2.3