From cf17b08c5d9b3aedc8aaa2b11456dcb69dec6049 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 20 Jun 2019 23:38:59 -0400 Subject: Moved "lux/world/binary" to "lux/data/binary". --- stdlib/source/lux/data/binary.lux | 287 ++++++++++++++++++++++++ stdlib/source/lux/data/format/binary.lux | 7 +- stdlib/source/lux/data/text/encoding.lux | 3 +- stdlib/source/lux/target/jvm/attribute.lux | 4 +- stdlib/source/lux/target/jvm/attribute/code.lux | 5 +- stdlib/source/lux/target/jvm/loader.lux | 3 +- stdlib/source/lux/world/binary.lux | 287 ------------------------ stdlib/source/lux/world/file.lux | 5 +- stdlib/source/test/lux/data.lux | 2 + stdlib/source/test/lux/data/binary.lux | 90 ++++++++ stdlib/source/test/lux/target/jvm.lux | 2 +- stdlib/source/test/lux/world.lux | 5 +- stdlib/source/test/lux/world/binary.lux | 90 -------- stdlib/source/test/lux/world/file.lux | 10 +- 14 files changed, 396 insertions(+), 404 deletions(-) create mode 100644 stdlib/source/lux/data/binary.lux delete mode 100644 stdlib/source/lux/world/binary.lux create mode 100644 stdlib/source/test/lux/data/binary.lux delete mode 100644 stdlib/source/test/lux/world/binary.lux (limited to 'stdlib/source') diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux new file mode 100644 index 000000000..485aab536 --- /dev/null +++ b/stdlib/source/lux/data/binary.lux @@ -0,0 +1,287 @@ +(.module: + [lux (#- i64) + ["." host] + ["@" target] + [abstract + [monad (#+ do)] + [equivalence (#+ Equivalence)]] + [control + ["." exception (#+ exception:)]] + [data + ["." maybe] + ["." error (#+ Error)] + [number + ["." i64]] + [text + ["%" format (#+ format)]] + [collection + ["." array]]]]) + +(exception: #export (index-out-of-bounds {size Nat} {index Nat}) + (exception.report + ["Size" (%.nat size)] + ["Index" (%.nat index)])) + +(template [] + [(exception: #export ( {size Nat} {from Nat} {to Nat}) + (exception.report + ["Size" (%.nat size)] + ["From" (%.nat from)] + ["To" (%.nat to)]))] + + [slice-out-of-bounds] + [inverted-slice] + ) + +(with-expansions [ (as-is (type: #export Binary (host.type [byte])) + + (host.import: #long java/lang/Object) + + (host.import: #long java/lang/System + (#static arraycopy [java/lang/Object int java/lang/Object int int] #try void)) + + (host.import: #long java/util/Arrays + (#static copyOfRange [[byte] int int] [byte]) + (#static equals [[byte] [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")) + (`` (for {(~~ (static @.old)) + (|>> .int host.long-to-byte) + + (~~ (static @.jvm)) + (|>> .int (:coerce (primitive "java.lang.Long")) host.long-to-byte)}))))] + (`` (for {(~~ (static @.old)) + (as-is ) + + (~~ (static @.jvm)) + (as-is ) + + (~~ (static @.js)) + (as-is (host.import: ArrayBuffer + (new [host.Number])) + + (host.import: Uint8Array + (new [ArrayBuffer]) + (length host.Number)) + + (type: #export Binary Uint8Array))}))) + +(template: (!size binary) + (`` (for {(~~ (static @.old)) + (host.array-length binary) + + (~~ (static @.jvm)) + (host.array-length binary) + + (~~ (static @.js)) + (.frac-to-nat (Uint8Array::length binary))}))) + +(template: (!read idx binary) + (`` (for {(~~ (static @.old)) + (..i64 (host.array-read idx binary)) + + (~~ (static @.jvm)) + (..i64 (host.array-read idx binary)) + + (~~ (static @.js)) + (|> binary + (: ..Binary) + (:coerce (array.Array .Frac)) + ("js array read" idx) + .frac-to-nat)}))) + +(template: (!write idx value binary) + (`` (for {(~~ (static @.old)) + (host.array-write idx (..byte value) binary) + + (~~ (static @.jvm)) + (host.array-write idx (..byte value) binary) + + (~~ (static @.js)) + (|> binary + (: ..Binary) + (:coerce (array.Array .Frac)) + ("js array write" idx (.nat-to-frac value)) + (:coerce ..Binary))}))) + +(def: #export size + (-> Binary Nat) + (|>> !size)) + +(def: #export create + (-> Nat Binary) + (`` (for {(~~ (static @.old)) + (|>> (host.array byte)) + + (~~ (static @.jvm)) + (|>> (host.array byte)) + + (~~ (static @.js)) + (|>> .nat-to-frac [] ArrayBuffer::new Uint8Array::new)}))) + +(def: #export (read/8 idx binary) + (-> Nat Binary (Error I64)) + (if (n/< (..!size binary) idx) + (#error.Success (!read idx binary)) + (exception.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 (!read idx binary)) + (!read (n/+ 1 idx) binary))) + (exception.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 (!read idx binary)) + (i64.left-shift 16 (!read (n/+ 1 idx) binary)) + (i64.left-shift 8 (!read (n/+ 2 idx) binary)) + (!read (n/+ 3 idx) binary))) + (exception.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 (!read idx binary)) + (i64.left-shift 48 (!read (n/+ 1 idx) binary)) + (i64.left-shift 40 (!read (n/+ 2 idx) binary)) + (i64.left-shift 32 (!read (n/+ 3 idx) binary)) + (i64.left-shift 24 (!read (n/+ 4 idx) binary)) + (i64.left-shift 16 (!read (n/+ 5 idx) binary)) + (i64.left-shift 8 (!read (n/+ 6 idx) binary)) + (!read (n/+ 7 idx) binary))) + (exception.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 + (!write idx value)) + (#error.Success binary)) + (exception.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 + (!write idx (i64.logic-right-shift 8 value)) + (!write (n/+ 1 idx) value)) + (#error.Success binary)) + (exception.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 + (!write idx (i64.logic-right-shift 24 value)) + (!write (n/+ 1 idx) (i64.logic-right-shift 16 value)) + (!write (n/+ 2 idx) (i64.logic-right-shift 8 value)) + (!write (n/+ 3 idx) value)) + (#error.Success binary)) + (exception.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 + (!write idx (i64.logic-right-shift 56 value)) + (!write (n/+ 1 idx) (i64.logic-right-shift 48 value)) + (!write (n/+ 2 idx) (i64.logic-right-shift 40 value)) + (!write (n/+ 3 idx) (i64.logic-right-shift 32 value)) + (!write (n/+ 4 idx) (i64.logic-right-shift 24 value)) + (!write (n/+ 5 idx) (i64.logic-right-shift 16 value)) + (!write (n/+ 6 idx) (i64.logic-right-shift 8 value)) + (!write (n/+ 7 idx) value)) + (#error.Success binary)) + (exception.throw index-out-of-bounds [(..!size binary) idx]))) + +(structure: #export equivalence (Equivalence Binary) + (def: (= reference sample) + (`` (for {(~~ (static @.old)) + (java/util/Arrays::equals reference sample) + + (~~ (static @.jvm)) + (java/util/Arrays::equals reference sample)} + (let [limit (!size reference)] + (and (n/= limit + (!size sample)) + (loop [idx 0] + (if (n/< limit idx) + (and (n/= (!read idx reference) + (!read idx sample)) + (recur (inc idx))) + true)))))))) + +(`` (for {(~~ (static @.old)) + (as-is) + + (~~ (static @.jvm)) + (as-is)} + + ## Default + (exception: #export (cannot-copy-bytes {source-input Nat} + {target-output Nat}) + (exception.report + ["Source input space" (%.nat source-input)] + ["Target output space" (%.nat target-output)])))) + +(def: #export (copy bytes source-offset source target-offset target) + (-> Nat Nat Binary Nat Binary (Error Binary)) + (with-expansions [ (as-is (do error.monad + [_ (java/lang/System::arraycopy source (.int source-offset) target (.int target-offset) (.int bytes))] + (wrap target)))] + (`` (for {(~~ (static @.old)) + + + (~~ (static @.jvm)) + } + + ## Default + (let [source-input (n/- source-offset (!size source)) + target-output (n/- target-offset (!size target))] + (if (n/<= target-output source-input) + (loop [idx 0] + (if (n/< source-input idx) + (exec (!write (n/+ target-offset idx) + (!read (n/+ source-offset idx) source) + target) + (recur (inc idx))) + (#error.Success target))) + (exception.throw ..cannot-copy-bytes [source-input target-output]))))))) + +(def: #export (slice from to binary) + (-> Nat Nat Binary (Error Binary)) + (let [size (..!size binary)] + (if (n/<= to from) + (if (and (n/< size from) + (n/< size to)) + (with-expansions [ (as-is (#error.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))] + (`` (for {(~~ (static @.old)) + + + (~~ (static @.jvm)) + } + + ## Default + (let [how-many (n/- from to)] + (..copy how-many from binary 0 (..create how-many)))))) + (exception.throw slice-out-of-bounds [size from to])) + (exception.throw inverted-slice [size from to])))) + +(def: #export (slice' from binary) + (-> Nat Binary (Error Binary)) + (slice from (dec (..!size binary)) binary)) diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux index ff43f4384..f7aaff36b 100644 --- a/stdlib/source/lux/data/format/binary.lux +++ b/stdlib/source/lux/data/format/binary.lux @@ -1,5 +1,6 @@ (.module: [lux (#- and or nat int rev list type) + [type (#+ :share)] [abstract [monoid (#+ Monoid)] ["." fold] @@ -12,6 +13,7 @@ [data ["." product] ["." error (#+ Error)] + ["." binary (#+ Binary)] [number ["." i64] ["." frac]] @@ -20,10 +22,7 @@ ["%" format]] [collection ["." list] - ["." row (#+ Row) ("#;." functor)]]] - [type (#+ :share)] - [world - ["." binary (#+ Binary)]]]) + ["." row (#+ Row) ("#;." functor)]]]]) (exception: #export (binary-was-not-fully-read {length Nat} {read Nat}) (ex.report ["Binary length" (%.nat length)] diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index e4d24f709..fca1e7632 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -4,11 +4,10 @@ [abstract [codec (#+ Codec)]] [data + [binary (#+ Binary)] ["." error (#+ Error)]] [type abstract] - [world - [binary (#+ Binary)]] ["." host]]) ## https://docs.oracle.com/javase/8/docs/technotes/guides/intl/encoding.doc.html diff --git a/stdlib/source/lux/target/jvm/attribute.lux b/stdlib/source/lux/target/jvm/attribute.lux index 82ca49111..421dbab17 100644 --- a/stdlib/source/lux/target/jvm/attribute.lux +++ b/stdlib/source/lux/target/jvm/attribute.lux @@ -11,9 +11,7 @@ ["." product] ["." error] [format - [".F" binary (#+ Reader Writer Format) ("#@." monoid)]]] - [world - ["." binary (#+ Binary)]]] + [".F" binary (#+ Reader Writer Format) ("#@." monoid)]]]] ["." // #_ ["#." index (#+ Index)] [encoding diff --git a/stdlib/source/lux/target/jvm/attribute/code.lux b/stdlib/source/lux/target/jvm/attribute/code.lux index c466fa838..a52d32538 100644 --- a/stdlib/source/lux/target/jvm/attribute/code.lux +++ b/stdlib/source/lux/target/jvm/attribute/code.lux @@ -6,12 +6,11 @@ [control ["<>" parser]] [data + ["." binary (#+ Binary)] [format [".F" binary (#+ Reader Writer) ("#@." monoid)]] [collection - ["." row (#+ Row) ("#@." functor fold)]]] - [world - ["." binary (#+ Binary)]]] + ["." row (#+ Row) ("#@." functor fold)]]]] ["." /// #_ [encoding ["#." unsigned (#+ U2)]]] diff --git a/stdlib/source/lux/target/jvm/loader.lux b/stdlib/source/lux/target/jvm/loader.lux index d8cb567e7..7fc9f4ff8 100644 --- a/stdlib/source/lux/target/jvm/loader.lux +++ b/stdlib/source/lux/target/jvm/loader.lux @@ -10,14 +10,13 @@ ["." atom (#+ Atom)]]] [data ["." error (#+ Error)] + ["." binary (#+ Binary)] ["." text ["%" format (#+ format)]] [collection ["." array] ["." list ("#;." functor)] ["." dictionary (#+ Dictionary)]]] - [world - ["." binary (#+ Binary)]] ["." host (#+ import: object do-to)]]) (type: #export Library diff --git a/stdlib/source/lux/world/binary.lux b/stdlib/source/lux/world/binary.lux deleted file mode 100644 index 485aab536..000000000 --- a/stdlib/source/lux/world/binary.lux +++ /dev/null @@ -1,287 +0,0 @@ -(.module: - [lux (#- i64) - ["." host] - ["@" target] - [abstract - [monad (#+ do)] - [equivalence (#+ Equivalence)]] - [control - ["." exception (#+ exception:)]] - [data - ["." maybe] - ["." error (#+ Error)] - [number - ["." i64]] - [text - ["%" format (#+ format)]] - [collection - ["." array]]]]) - -(exception: #export (index-out-of-bounds {size Nat} {index Nat}) - (exception.report - ["Size" (%.nat size)] - ["Index" (%.nat index)])) - -(template [] - [(exception: #export ( {size Nat} {from Nat} {to Nat}) - (exception.report - ["Size" (%.nat size)] - ["From" (%.nat from)] - ["To" (%.nat to)]))] - - [slice-out-of-bounds] - [inverted-slice] - ) - -(with-expansions [ (as-is (type: #export Binary (host.type [byte])) - - (host.import: #long java/lang/Object) - - (host.import: #long java/lang/System - (#static arraycopy [java/lang/Object int java/lang/Object int int] #try void)) - - (host.import: #long java/util/Arrays - (#static copyOfRange [[byte] int int] [byte]) - (#static equals [[byte] [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")) - (`` (for {(~~ (static @.old)) - (|>> .int host.long-to-byte) - - (~~ (static @.jvm)) - (|>> .int (:coerce (primitive "java.lang.Long")) host.long-to-byte)}))))] - (`` (for {(~~ (static @.old)) - (as-is ) - - (~~ (static @.jvm)) - (as-is ) - - (~~ (static @.js)) - (as-is (host.import: ArrayBuffer - (new [host.Number])) - - (host.import: Uint8Array - (new [ArrayBuffer]) - (length host.Number)) - - (type: #export Binary Uint8Array))}))) - -(template: (!size binary) - (`` (for {(~~ (static @.old)) - (host.array-length binary) - - (~~ (static @.jvm)) - (host.array-length binary) - - (~~ (static @.js)) - (.frac-to-nat (Uint8Array::length binary))}))) - -(template: (!read idx binary) - (`` (for {(~~ (static @.old)) - (..i64 (host.array-read idx binary)) - - (~~ (static @.jvm)) - (..i64 (host.array-read idx binary)) - - (~~ (static @.js)) - (|> binary - (: ..Binary) - (:coerce (array.Array .Frac)) - ("js array read" idx) - .frac-to-nat)}))) - -(template: (!write idx value binary) - (`` (for {(~~ (static @.old)) - (host.array-write idx (..byte value) binary) - - (~~ (static @.jvm)) - (host.array-write idx (..byte value) binary) - - (~~ (static @.js)) - (|> binary - (: ..Binary) - (:coerce (array.Array .Frac)) - ("js array write" idx (.nat-to-frac value)) - (:coerce ..Binary))}))) - -(def: #export size - (-> Binary Nat) - (|>> !size)) - -(def: #export create - (-> Nat Binary) - (`` (for {(~~ (static @.old)) - (|>> (host.array byte)) - - (~~ (static @.jvm)) - (|>> (host.array byte)) - - (~~ (static @.js)) - (|>> .nat-to-frac [] ArrayBuffer::new Uint8Array::new)}))) - -(def: #export (read/8 idx binary) - (-> Nat Binary (Error I64)) - (if (n/< (..!size binary) idx) - (#error.Success (!read idx binary)) - (exception.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 (!read idx binary)) - (!read (n/+ 1 idx) binary))) - (exception.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 (!read idx binary)) - (i64.left-shift 16 (!read (n/+ 1 idx) binary)) - (i64.left-shift 8 (!read (n/+ 2 idx) binary)) - (!read (n/+ 3 idx) binary))) - (exception.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 (!read idx binary)) - (i64.left-shift 48 (!read (n/+ 1 idx) binary)) - (i64.left-shift 40 (!read (n/+ 2 idx) binary)) - (i64.left-shift 32 (!read (n/+ 3 idx) binary)) - (i64.left-shift 24 (!read (n/+ 4 idx) binary)) - (i64.left-shift 16 (!read (n/+ 5 idx) binary)) - (i64.left-shift 8 (!read (n/+ 6 idx) binary)) - (!read (n/+ 7 idx) binary))) - (exception.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 - (!write idx value)) - (#error.Success binary)) - (exception.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 - (!write idx (i64.logic-right-shift 8 value)) - (!write (n/+ 1 idx) value)) - (#error.Success binary)) - (exception.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 - (!write idx (i64.logic-right-shift 24 value)) - (!write (n/+ 1 idx) (i64.logic-right-shift 16 value)) - (!write (n/+ 2 idx) (i64.logic-right-shift 8 value)) - (!write (n/+ 3 idx) value)) - (#error.Success binary)) - (exception.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 - (!write idx (i64.logic-right-shift 56 value)) - (!write (n/+ 1 idx) (i64.logic-right-shift 48 value)) - (!write (n/+ 2 idx) (i64.logic-right-shift 40 value)) - (!write (n/+ 3 idx) (i64.logic-right-shift 32 value)) - (!write (n/+ 4 idx) (i64.logic-right-shift 24 value)) - (!write (n/+ 5 idx) (i64.logic-right-shift 16 value)) - (!write (n/+ 6 idx) (i64.logic-right-shift 8 value)) - (!write (n/+ 7 idx) value)) - (#error.Success binary)) - (exception.throw index-out-of-bounds [(..!size binary) idx]))) - -(structure: #export equivalence (Equivalence Binary) - (def: (= reference sample) - (`` (for {(~~ (static @.old)) - (java/util/Arrays::equals reference sample) - - (~~ (static @.jvm)) - (java/util/Arrays::equals reference sample)} - (let [limit (!size reference)] - (and (n/= limit - (!size sample)) - (loop [idx 0] - (if (n/< limit idx) - (and (n/= (!read idx reference) - (!read idx sample)) - (recur (inc idx))) - true)))))))) - -(`` (for {(~~ (static @.old)) - (as-is) - - (~~ (static @.jvm)) - (as-is)} - - ## Default - (exception: #export (cannot-copy-bytes {source-input Nat} - {target-output Nat}) - (exception.report - ["Source input space" (%.nat source-input)] - ["Target output space" (%.nat target-output)])))) - -(def: #export (copy bytes source-offset source target-offset target) - (-> Nat Nat Binary Nat Binary (Error Binary)) - (with-expansions [ (as-is (do error.monad - [_ (java/lang/System::arraycopy source (.int source-offset) target (.int target-offset) (.int bytes))] - (wrap target)))] - (`` (for {(~~ (static @.old)) - - - (~~ (static @.jvm)) - } - - ## Default - (let [source-input (n/- source-offset (!size source)) - target-output (n/- target-offset (!size target))] - (if (n/<= target-output source-input) - (loop [idx 0] - (if (n/< source-input idx) - (exec (!write (n/+ target-offset idx) - (!read (n/+ source-offset idx) source) - target) - (recur (inc idx))) - (#error.Success target))) - (exception.throw ..cannot-copy-bytes [source-input target-output]))))))) - -(def: #export (slice from to binary) - (-> Nat Nat Binary (Error Binary)) - (let [size (..!size binary)] - (if (n/<= to from) - (if (and (n/< size from) - (n/< size to)) - (with-expansions [ (as-is (#error.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))] - (`` (for {(~~ (static @.old)) - - - (~~ (static @.jvm)) - } - - ## Default - (let [how-many (n/- from to)] - (..copy how-many from binary 0 (..create how-many)))))) - (exception.throw slice-out-of-bounds [size from to])) - (exception.throw inverted-slice [size from to])))) - -(def: #export (slice' from binary) - (-> Nat Binary (Error Binary)) - (slice from (dec (..!size binary)) binary)) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 7fd5b9fb4..8c79ca0e8 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -15,6 +15,7 @@ ["." product] ["." maybe] ["." error (#+ Error) ("#;." functor)] + ["." binary (#+ Binary)] ["." text ["%" format (#+ format)]] [collection @@ -24,9 +25,7 @@ ["." instant (#+ Instant)] ["." duration]] [macro - ["." template]] - [world - ["." binary (#+ Binary)]]]) + ["." template]]]) (type: #export Path Text) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index a29358b6b..65d43e5e6 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -2,6 +2,7 @@ [lux #* ["_" test (#+ Test)]] ["." / #_ + ["#." binary] ["#." bit] ["#." color] ["#." error] @@ -53,6 +54,7 @@ (def: #export test Test ($_ _.and + /binary.test /bit.test /color.test /error.test diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux new file mode 100644 index 000000000..8fb17114e --- /dev/null +++ b/stdlib/source/test/lux/data/binary.lux @@ -0,0 +1,90 @@ +(.module: + [lux #* + ["%" data/text/format (#+ format)] + ["r" math/random (#+ Random)] + ["_" test (#+ Test)] + [abstract + ["." monad (#+ do)] + {[0 #test] + [/ + ["$." equivalence]]}] + [data + ["." error (#+ Error)] + [number + ["." i64] + ["." nat]] + [collection + ["." list]]]] + {1 + ["." / (#+ Binary)]}) + +(def: (succeed result) + (-> (Error Bit) Bit) + (case result + (#error.Failure _) + #0 + + (#error.Success output) + output)) + +(def: #export (binary size) + (-> Nat (Random Binary)) + (let [output (/.create size)] + (loop [idx 0] + (if (n/< size idx) + (do r.monad + [byte r.nat] + (exec (error.assume (/.write/8 idx byte output)) + (recur (inc idx)))) + (:: r.monad wrap output))))) + +(def: (bits-io bytes read write value) + (-> Nat (-> Nat Binary (Error Nat)) (-> Nat Nat Binary (Error Any)) Nat Bit) + (let [binary (/.create bytes) + cap (case bytes + 8 (dec 0) + _ (|> 1 (i64.left-shift (n/* 8 bytes)) dec)) + capped-value (i64.and cap value)] + (succeed + (do error.monad + [_ (write 0 value binary) + output (read 0 binary)] + (wrap (n/= capped-value output)))))) + +(def: #export test + Test + (<| (_.context (%.name (name-of /._))) + (do r.monad + [#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.and gen-idx gen-idx) + #let [[from to] [(n/min from to) (n/max from to)]]] + ($_ _.and + ($equivalence.spec /.equivalence (binary binary-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 (error.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 error.monad (reader random-slice) idxs) + (monad.map error.monad (|>> (n/+ from) (reader random-binary)) idxs)] + [(#error.Success slice-vals) (#error.Success binary-vals)] + (:: (list.equivalence nat.equivalence) = slice-vals binary-vals) + + _ + #0)))) + )))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index e5032ed44..8176756cc 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -8,6 +8,7 @@ [security ["!" capability]]] [data + [binary (#+ Binary)] ["." error (#+ Error)] ["." text ["%" format (#+ format)]] @@ -17,7 +18,6 @@ ["." dictionary] ["." row]]] [world - [binary (#+ Binary)] ["." file (#+ File)]] [math ["r" random (#+ Random) ("#@." monad)]] diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index bfd9e6194..e46eecda3 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -2,13 +2,10 @@ [lux #* ["_" test (#+ Test)]] ["." / #_ - ["#." binary] - ["#." file] - ]) + ["#." file]]) (def: #export test Test ($_ _.and - /binary.test /file.test )) diff --git a/stdlib/source/test/lux/world/binary.lux b/stdlib/source/test/lux/world/binary.lux deleted file mode 100644 index 8fb17114e..000000000 --- a/stdlib/source/test/lux/world/binary.lux +++ /dev/null @@ -1,90 +0,0 @@ -(.module: - [lux #* - ["%" data/text/format (#+ format)] - ["r" math/random (#+ Random)] - ["_" test (#+ Test)] - [abstract - ["." monad (#+ do)] - {[0 #test] - [/ - ["$." equivalence]]}] - [data - ["." error (#+ Error)] - [number - ["." i64] - ["." nat]] - [collection - ["." list]]]] - {1 - ["." / (#+ Binary)]}) - -(def: (succeed result) - (-> (Error Bit) Bit) - (case result - (#error.Failure _) - #0 - - (#error.Success output) - output)) - -(def: #export (binary size) - (-> Nat (Random Binary)) - (let [output (/.create size)] - (loop [idx 0] - (if (n/< size idx) - (do r.monad - [byte r.nat] - (exec (error.assume (/.write/8 idx byte output)) - (recur (inc idx)))) - (:: r.monad wrap output))))) - -(def: (bits-io bytes read write value) - (-> Nat (-> Nat Binary (Error Nat)) (-> Nat Nat Binary (Error Any)) Nat Bit) - (let [binary (/.create bytes) - cap (case bytes - 8 (dec 0) - _ (|> 1 (i64.left-shift (n/* 8 bytes)) dec)) - capped-value (i64.and cap value)] - (succeed - (do error.monad - [_ (write 0 value binary) - output (read 0 binary)] - (wrap (n/= capped-value output)))))) - -(def: #export test - Test - (<| (_.context (%.name (name-of /._))) - (do r.monad - [#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.and gen-idx gen-idx) - #let [[from to] [(n/min from to) (n/max from to)]]] - ($_ _.and - ($equivalence.spec /.equivalence (binary binary-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 (error.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 error.monad (reader random-slice) idxs) - (monad.map error.monad (|>> (n/+ from) (reader random-binary)) idxs)] - [(#error.Success slice-vals) (#error.Success binary-vals)] - (:: (list.equivalence nat.equivalence) = slice-vals binary-vals) - - _ - #0)))) - )))) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index c0c3f7d18..451f4671b 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -11,6 +11,7 @@ [security ["!" capability]]] [data + ["." binary (#+ Binary)] ["." error (#+ Error)] ["." text] [number @@ -19,13 +20,12 @@ ["." list]]] [time ["." instant] - ["." duration]] - [world - ["." binary (#+ Binary)]]] + ["." duration]]] {1 ["." / (#+ Path File)]} - [// - ["_." binary]]) + [/// + [data + ["_." binary]]]) (def: truncate-millis (let [millis +1,000] -- cgit v1.2.3