From 6acf4ffc362c0f8ef77d96f8cfe991adb2d9a0eb Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 13 Jul 2018 20:17:21 -0400 Subject: - Re-named "lux/data/bit" to "lux/data/number/i64". --- stdlib/source/lux/data/bit.lux | 87 ------------------------ stdlib/source/lux/data/collection/bits.lux | 28 ++++---- stdlib/source/lux/data/collection/dictionary.lux | 26 +++---- stdlib/source/lux/data/collection/row.lux | 23 ++++--- stdlib/source/lux/data/number.lux | 45 ++++++------ stdlib/source/lux/data/number/i64.lux | 87 ++++++++++++++++++++++++ stdlib/source/lux/data/text.lux | 5 +- stdlib/source/lux/macro/poly/json.lux | 27 ++++---- stdlib/source/lux/math/random.lux | 26 +++---- stdlib/source/lux/world/blob.jvm.lux | 60 ++++++++-------- stdlib/test/test/lux.lux | 5 +- stdlib/test/test/lux/data/bit.lux | 76 --------------------- stdlib/test/test/lux/data/number/i64.lux | 76 +++++++++++++++++++++ stdlib/test/test/lux/world/blob.lux | 6 +- 14 files changed, 292 insertions(+), 285 deletions(-) delete mode 100644 stdlib/source/lux/data/bit.lux create mode 100644 stdlib/source/lux/data/number/i64.lux delete mode 100644 stdlib/test/test/lux/data/bit.lux create mode 100644 stdlib/test/test/lux/data/number/i64.lux (limited to 'stdlib') diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux deleted file mode 100644 index 353a1237a..000000000 --- a/stdlib/source/lux/data/bit.lux +++ /dev/null @@ -1,87 +0,0 @@ -(.module: [lux (#- and or not)]) - -(def: #export width Nat +64) - -## [Values] -(do-template [ ] - [(def: #export ( param subject) - {#.doc } - (All [s] (-> (I64 s) (I64 s) (I64 s))) - ( param subject))] - - [and "lux i64 and" "Bitwise and."] - [or "lux i64 or" "Bitwise or."] - [xor "lux i64 xor" "Bitwise xor."] - ) - -(do-template [ ] - [(def: #export ( param subject) - {#.doc } - (All [s] (-> Nat (I64 s) (I64 s))) - ( param subject))] - - [left-shift "lux i64 left-shift" "Bitwise left-shift."] - [logical-right-shift "lux i64 logical-right-shift" "Unsigned bitwise logical-right-shift."] - [arithmetic-right-shift "lux i64 arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."] - ) - -(def: (add-shift shift value) - (-> Nat Nat Nat) - (|> value (logical-right-shift shift) (n/+ value))) - -(def: #export (count subject) - {#.doc "Count the number of 1s in a bit-map."} - (-> (I64 Any) Nat) - (let [count' (n/- (|> subject (logical-right-shift +1) (..and +6148914691236517205) i64) - (i64 subject))] - (|> count' - (logical-right-shift +2) (..and +3689348814741910323) (n/+ (..and +3689348814741910323 count')) - (add-shift +4) (..and +1085102592571150095) - (add-shift +8) - (add-shift +16) - (add-shift +32) - (..and +127)))) - -(def: #export not - {#.doc "Bitwise negation."} - (All [s] (-> (I64 s) (I64 s))) - (xor (:coerce I64 -1))) - -(def: (flag idx) - (-> Nat I64) - (|> +1 (:coerce I64) (left-shift idx))) - -(def: #export (clear idx input) - {#.doc "Clear bit at given index."} - (All [s] (-> Nat (I64 s) (I64 s))) - (|> idx flag ..not (..and input))) - -(do-template [ ] - [(def: #export ( idx input) - {#.doc } - (All [s] (-> Nat (I64 s) (I64 s))) - (|> idx flag ( input)))] - - [set ..or "Set bit at given index."] - [flip ..xor "Flip bit at given index."] - ) - -(def: #export (set? idx input) - (-> Nat (I64 Any) Bool) - (|> input (:coerce I64) (..and (flag idx)) (n/= +0) .not)) - -(do-template [
] - [(def: #export ( distance input) - (All [s] (-> Nat (I64 s) (I64 s))) - (let [backwards-distance (n/- (n/% width distance) width)] - (|> input - ( backwards-distance) - (..or (
distance input)))))] - - [rotate-left left-shift logical-right-shift] - [rotate-right logical-right-shift left-shift] - ) - -(def: #export (region size offset) - (-> Nat Nat I64) - (|> +1 (:coerce I64) (left-shift size) dec (left-shift offset))) diff --git a/stdlib/source/lux/data/collection/bits.lux b/stdlib/source/lux/data/collection/bits.lux index 78d5b4b7d..b0e506cde 100644 --- a/stdlib/source/lux/data/collection/bits.lux +++ b/stdlib/source/lux/data/collection/bits.lux @@ -5,13 +5,15 @@ pipe] [data [maybe] - [bit] - [text format] + [number + [i64]] + [text + format] [collection [array ("array/" Fold)]]]]) (type: #export Chunk I64) -(def: #export chunk-size bit.width) +(def: #export chunk-size i64.width) (type: #export Bits (Array Chunk)) @@ -25,7 +27,7 @@ (def: #export (size bits) (-> Bits Nat) (array/fold (function (_ chunk total) - (|> chunk bit.count (n/+ total))) + (|> chunk i64.count (n/+ total))) +0 bits)) @@ -43,7 +45,7 @@ (.and (n/< (array.size bits) chunk-index) (|> (array.read chunk-index bits) (maybe.default empty-chunk) - (bit.set? bit-index))))) + (i64.set? bit-index))))) (def: (chunk idx bits) (-> Nat Bits Chunk) @@ -80,9 +82,9 @@ (recur (dec size|output)))) output)))))] - [set bit.set] - [clear bit.clear] - [flip bit.flip] + [set i64.set] + [clear i64.clear] + [flip i64.flip] ) (def: #export (intersects? reference sample) @@ -92,7 +94,7 @@ (loop [idx +0] (if (n/< chunks idx) (.or (|> (..chunk idx sample) - (bit.and (..chunk idx reference)) + (i64.and (..chunk idx reference)) ("lux i64 =" empty-chunk) .not) (recur (inc idx))) @@ -108,7 +110,7 @@ (loop [size|output size|output output ..empty] (let [idx (dec size|output)] - (case (|> input (..chunk idx) bit.not .nat) + (case (|> input (..chunk idx) i64.not .nat) +0 (recur (dec size|output) output) @@ -148,9 +150,9 @@ (recur (dec size|output)))) output)))))] - [and bit.and] - [or bit.or] - [xor bit.xor] + [and i64.and] + [or i64.or] + [xor i64.xor] ) (structure: #export _ (Equivalence Bits) diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux index a3e4be1d6..8e967b768 100644 --- a/stdlib/source/lux/data/collection/dictionary.lux +++ b/stdlib/source/lux/data/collection/dictionary.lux @@ -5,9 +5,9 @@ [equivalence (#+ Equivalence)]] [data [maybe] - [bit] [product] - [number] + ["." number + [i64]] [collection [list ("list/" Fold Functor Monoid)] [array ("array/" Functor Fold)]]] @@ -100,18 +100,18 @@ ## which is 1/4 of the branching factor (or a left-shift 2). (def: demotion-threshold Nat - (bit.left-shift (n/- +2 branching-exponent) +1)) + (i64.left-shift (n/- +2 branching-exponent) +1)) ## The threshold on which #Base nodes are promoted to #Hierarchy nodes, ## which is 1/2 of the branching factor (or a left-shift 1). (def: promotion-threshold Nat - (bit.left-shift (n/- +1 branching-exponent) +1)) + (i64.left-shift (n/- +1 branching-exponent) +1)) ## The size of hierarchy-nodes, which is 2^(branching-exponent). (def: hierarchy-nodes-size Nat - (bit.left-shift branching-exponent +1)) + (i64.left-shift branching-exponent +1)) ## The cannonical empty node, which is just an empty #Base node. (def: empty @@ -163,13 +163,13 @@ ## to a particular level, and uses that as an index into the array. (def: (level-index level hash) (-> Level Hash-Code Index) - (bit.and hierarchy-mask - (bit.logical-right-shift level hash))) + (i64.and hierarchy-mask + (i64.logical-right-shift level hash))) ## A mechanism to go from indices to bit-positions. (def: (->bit-position index) (-> Index BitPosition) - (bit.left-shift index +1)) + (i64.left-shift index +1)) ## The bit-position within a base that a given hash-code would have. (def: (bit-position level hash) @@ -178,7 +178,7 @@ (def: (bit-position-is-set? bit bitmap) (-> BitPosition BitMap Bool) - (not (n/= clean-bitmap (bit.and bit bitmap)))) + (not (n/= clean-bitmap (i64.and bit bitmap)))) ## Figures out whether a bitmap only contains a single bit-position. (def: only-bit-position? @@ -187,17 +187,17 @@ (def: (set-bit-position bit bitmap) (-> BitPosition BitMap BitMap) - (bit.or bit bitmap)) + (i64.or bit bitmap)) (def: unset-bit-position (-> BitPosition BitMap BitMap) - bit.xor) + i64.xor) ## Figures out the size of a bitmap-indexed array by counting all the ## 1s within the bitmap. (def: bitmap-size (-> BitMap Nat) - bit.count) + i64.count) ## A mask that, for a given bit position, only allows all the 1s prior ## to it, which would indicate the bitmap-size (and, thus, index) @@ -209,7 +209,7 @@ ## The index on the base array, based on it's bit-position. (def: (base-index bit-position bitmap) (-> BitPosition BitMap Index) - (bitmap-size (bit.and (bit-position-mask bit-position) + (bitmap-size (i64.and (bit-position-mask bit-position) bitmap))) ## Produces the index of a KV-pair within a #Collisions node. diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux index 1dce1d4c5..3b3b080eb 100644 --- a/stdlib/source/lux/data/collection/row.lux +++ b/stdlib/source/lux/data/collection/row.lux @@ -10,8 +10,9 @@ ["p" parser]] [data [maybe] - [bit] [product] + [number + [i64]] [collection [list ("list/" Fold Functor Monoid)] [array ("array/" Functor Fold)]]] @@ -51,7 +52,7 @@ (def: full-node-size Nat - (bit.left-shift branching-exponent +1)) + (i64.left-shift branching-exponent +1)) (def: branch-idx-mask Nat @@ -59,7 +60,7 @@ (def: branch-idx (-> Index Index) - (bit.and branch-idx-mask)) + (i64.and branch-idx-mask)) (def: (new-hierarchy _) (All [a] (-> Any (Hierarchy a))) @@ -70,8 +71,8 @@ (if (n/< full-node-size vec-size) +0 (|> (dec vec-size) - (bit.logical-right-shift branching-exponent) - (bit.left-shift branching-exponent)))) + (i64.logical-right-shift branching-exponent) + (i64.left-shift branching-exponent)))) (def: (new-path level tail) (All [a] (-> Level (Base a) (Node a))) @@ -88,7 +89,7 @@ (def: (push-tail size level tail parent) (All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (bit.logical-right-shift level (dec size))) + (let [sub-idx (branch-idx (i64.logical-right-shift level (dec size))) ## If we're currently on a bottom node sub-node (if (n/= branching-exponent level) ## Just add the tail to it @@ -117,7 +118,7 @@ (def: (put' level idx val hierarchy) (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (bit.logical-right-shift level idx))] + (let [sub-idx (branch-idx (i64.logical-right-shift level idx))] (case (array.read sub-idx hierarchy) (#.Some (#Hierarchy sub-node)) (|> (array.clone hierarchy) @@ -135,7 +136,7 @@ (def: (pop-tail size level hierarchy) (All [a] (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a)))) - (let [sub-idx (branch-idx (bit.logical-right-shift level (n/- +2 size)))] + (let [sub-idx (branch-idx (i64.logical-right-shift level (n/- +2 size)))] (cond (n/= +0 sub-idx) #.None @@ -202,8 +203,8 @@ ## Otherwise, push tail into the tree ## -------------------------------------------------------- ## Will the root experience an overflow with this addition? - (|> (if (n/> (bit.left-shift (get@ #level vec) +1) - (bit.logical-right-shift branching-exponent vec-size)) + (|> (if (n/> (i64.left-shift (get@ #level vec) +1) + (i64.logical-right-shift branching-exponent vec-size)) ## If so, a brand-new root must be established, that is ## 1-level taller. (|> vec @@ -233,7 +234,7 @@ (loop [level (get@ #level vec) hierarchy (get@ #root vec)] (case [(n/> branching-exponent level) - (array.read (branch-idx (bit.logical-right-shift level idx)) hierarchy)] + (array.read (branch-idx (i64.logical-right-shift level idx)) hierarchy)] [true (#.Some (#Hierarchy sub))] (recur (level-down level) sub) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 1b2fc62d7..773300f31 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -12,8 +12,9 @@ [data ["e" error] [maybe] - [bit] - [text]]]) + [text]]] + [/ + [i64]]) ## [Structures] (do-template [ ] @@ -735,7 +736,7 @@ (def: (make-digits _) (-> Any Digits) - ("lux array new" bit.width)) + ("lux array new" i64.width)) (def: (digits-get idx digits) (-> Nat Digits Nat) @@ -775,7 +776,7 @@ (def: (digits-to-text digits) (-> Digits Text) - (loop [idx (dec bit.width) + (loop [idx (dec i64.width) all-zeroes? true output ""] (if (i/>= 0 (:coerce Int idx)) @@ -794,7 +795,7 @@ (def: (digits-add param subject) (-> Digits Digits Digits) - (loop [idx (dec bit.width) + (loop [idx (dec i64.width) carry +0 output (make-digits [])] (if (i/>= 0 (:coerce Int idx)) @@ -810,7 +811,7 @@ (def: (text-to-digits input) (-> Text (Maybe Digits)) (let [length ("lux text size" input)] - (if (n/<= bit.width length) + (if (n/<= i64.width length) (loop [idx +0 output (make-digits [])] (if (n/< length idx) @@ -828,7 +829,7 @@ (def: (digits-lt param subject) (-> Digits Digits Bool) (loop [idx +0] - (and (n/< bit.width idx) + (and (n/< i64.width idx) (let [pd (digits-get idx param) sd (digits-get idx subject)] (if (n/= pd sd) @@ -849,7 +850,7 @@ (def: (digits-sub! param subject) (-> Digits Digits Digits) - (loop [idx (dec bit.width) + (loop [idx (dec i64.width) output subject] (if (i/>= 0 (.int idx)) (recur (dec idx) @@ -859,13 +860,13 @@ (structure: #export _ (Codec Text Rev) (def: (encode input) (let [input (:coerce Nat input) - last-idx (dec bit.width)] + last-idx (dec i64.width)] (if (n/= +0 input) ".0" (loop [idx last-idx digits (make-digits [])] (if (i/>= 0 (:coerce Int idx)) - (if (bit.set? idx input) + (if (i64.set? idx input) (let [digits' (digits-add (digits-power (n/- idx last-idx)) digits)] (recur (dec idx) @@ -884,7 +885,7 @@ _ false)] (if (and dotted? - (n/<= (inc bit.width) length)) + (n/<= (inc i64.width) length)) (case (|> ("lux text clip" input +1 length) maybe.assume text-to-digits) @@ -892,14 +893,14 @@ (loop [digits digits idx +0 output +0] - (if (n/< bit.width idx) + (if (n/< i64.width idx) (let [power (digits-power idx)] (if (digits-lt power digits) ## Skip power (recur digits (inc idx) output) (recur (digits-sub! power digits) (inc idx) - (bit.set (n/- idx (dec bit.width)) output)))) + (i64.set (n/- idx (dec i64.width)) output)))) (#e.Success (:coerce Rev output)))) #.None @@ -940,26 +941,26 @@ (let [sign (:: Number signum input) input (:: Number abs input) exponent ("lux math floor" (log2 input)) - exponent-mask (|> +1 (bit.left-shift exponent-size) dec) + exponent-mask (|> +1 (i64.left-shift exponent-size) dec) mantissa (|> input ## Normalize (f// ("lux math pow" 2.0 exponent)) ## Make it int-equivalent (f/* ("lux math pow" 2.0 52.0))) sign-bit (if (f/= -1.0 sign) +1 +0) - exponent-bits (|> exponent frac-to-int .nat (n/+ double-bias) (bit.and exponent-mask)) + exponent-bits (|> exponent frac-to-int .nat (n/+ double-bias) (i64.and exponent-mask)) mantissa-bits (|> mantissa frac-to-int .nat)] - ($_ bit.or - (bit.left-shift +63 sign-bit) - (bit.left-shift mantissa-size exponent-bits) - (bit.clear mantissa-size mantissa-bits))) + ($_ i64.or + (i64.left-shift +63 sign-bit) + (i64.left-shift mantissa-size exponent-bits) + (i64.clear mantissa-size mantissa-bits))) ))) (do-template [ ] - [(def: (|> +1 (bit.left-shift ) dec (bit.left-shift ))) + [(def: (|> +1 (i64.left-shift ) dec (i64.left-shift ))) (def: ( input) (-> (I64 Any) I64) - (|> input (bit.and ) (bit.logical-right-shift ) i64))] + (|> input (i64.and ) (i64.logical-right-shift ) i64))] [mantissa mantissa-mask mantissa-size +0] [exponent exponent-mask exponent-size mantissa-size] @@ -984,7 +985,7 @@ (f/* -1.0 0.0)) ## else - (let [normalized (|> M (bit.set mantissa-size) + (let [normalized (|> M (i64.set mantissa-size) .int int-to-frac (f// ("lux math pow" 2.0 52.0))) power (|> E (n/- double-bias) diff --git a/stdlib/source/lux/data/number/i64.lux b/stdlib/source/lux/data/number/i64.lux new file mode 100644 index 000000000..353a1237a --- /dev/null +++ b/stdlib/source/lux/data/number/i64.lux @@ -0,0 +1,87 @@ +(.module: [lux (#- and or not)]) + +(def: #export width Nat +64) + +## [Values] +(do-template [ ] + [(def: #export ( param subject) + {#.doc } + (All [s] (-> (I64 s) (I64 s) (I64 s))) + ( param subject))] + + [and "lux i64 and" "Bitwise and."] + [or "lux i64 or" "Bitwise or."] + [xor "lux i64 xor" "Bitwise xor."] + ) + +(do-template [ ] + [(def: #export ( param subject) + {#.doc } + (All [s] (-> Nat (I64 s) (I64 s))) + ( param subject))] + + [left-shift "lux i64 left-shift" "Bitwise left-shift."] + [logical-right-shift "lux i64 logical-right-shift" "Unsigned bitwise logical-right-shift."] + [arithmetic-right-shift "lux i64 arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."] + ) + +(def: (add-shift shift value) + (-> Nat Nat Nat) + (|> value (logical-right-shift shift) (n/+ value))) + +(def: #export (count subject) + {#.doc "Count the number of 1s in a bit-map."} + (-> (I64 Any) Nat) + (let [count' (n/- (|> subject (logical-right-shift +1) (..and +6148914691236517205) i64) + (i64 subject))] + (|> count' + (logical-right-shift +2) (..and +3689348814741910323) (n/+ (..and +3689348814741910323 count')) + (add-shift +4) (..and +1085102592571150095) + (add-shift +8) + (add-shift +16) + (add-shift +32) + (..and +127)))) + +(def: #export not + {#.doc "Bitwise negation."} + (All [s] (-> (I64 s) (I64 s))) + (xor (:coerce I64 -1))) + +(def: (flag idx) + (-> Nat I64) + (|> +1 (:coerce I64) (left-shift idx))) + +(def: #export (clear idx input) + {#.doc "Clear bit at given index."} + (All [s] (-> Nat (I64 s) (I64 s))) + (|> idx flag ..not (..and input))) + +(do-template [ ] + [(def: #export ( idx input) + {#.doc } + (All [s] (-> Nat (I64 s) (I64 s))) + (|> idx flag ( input)))] + + [set ..or "Set bit at given index."] + [flip ..xor "Flip bit at given index."] + ) + +(def: #export (set? idx input) + (-> Nat (I64 Any) Bool) + (|> input (:coerce I64) (..and (flag idx)) (n/= +0) .not)) + +(do-template [
] + [(def: #export ( distance input) + (All [s] (-> Nat (I64 s) (I64 s))) + (let [backwards-distance (n/- (n/% width distance) width)] + (|> input + ( backwards-distance) + (..or (
distance input)))))] + + [rotate-left left-shift logical-right-shift] + [rotate-right logical-right-shift left-shift] + ) + +(def: #export (region size offset) + (-> Nat Nat I64) + (|> +1 (:coerce I64) (left-shift size) dec (left-shift offset))) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 6106e434e..3a9e6ab3b 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -8,8 +8,9 @@ [codec (#+ Codec)] hash] [data - [bit] [maybe] + [number + [i64]] [collection [list ("list/" Fold)]]] [language @@ -184,7 +185,7 @@ (let [char (|> idx ("lux text char" input) (maybe.default +0))] (recur (inc idx) (|> hash - (bit.left-shift +5) + (i64.left-shift +5) (n/- hash) (n/+ char)))) hash))))))) diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 2745ad592..0474c3d4b 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -7,20 +7,20 @@ ["p" parser]] [data [bool] - [bit] - [text ("text/" Equivalence) - ["l" lexer] - format] - [number ("frac/" Codec) ("nat/" Codec)] maybe ["e" error] [sum] [product] + [number ("frac/" Codec) ("nat/" Codec) + [i64]] + [text ("text/" Equivalence) + ["l" lexer] + format] + [format ["//" json (#+ JSON)]] [collection [list ("list/" Fold Monad)] [row (#+ Row row) ("row/" Monad)] - ["d" dictionary]] - [format ["//" json (#+ JSON)]]] + ["d" dictionary]]] [time ## ["i" instant] ["du" duration] @@ -30,8 +30,7 @@ [code] [poly (#+ poly:)]] [type [unit]] - [language [type]] - ]) + [language [type]]]) (def: tag (-> Nat Frac) @@ -44,13 +43,13 @@ (function (_ input) (non-rec (rec-encode non-rec) input))) -(def: low-mask Nat (|> +1 (bit.left-shift +32) dec)) -(def: high-mask Nat (|> low-mask (bit.left-shift +32))) +(def: low-mask Nat (|> +1 (i64.left-shift +32) dec)) +(def: high-mask Nat (|> low-mask (i64.left-shift +32))) (structure: _ (Codec JSON Nat) (def: (encode input) - (let [high (|> input (bit.and high-mask) (bit.logical-right-shift +32)) - low (bit.and low-mask input)] + (let [high (|> input (i64.and high-mask) (i64.logical-right-shift +32)) + low (i64.and low-mask input)] (#//.Array (row (|> high .int int-to-frac #//.Number) (|> low .int int-to-frac #//.Number))))) (def: (decode input) @@ -59,7 +58,7 @@ (do p.Monad [high //.number low //.number]) - (wrap (n/+ (|> high frac-to-int .nat (bit.left-shift +32)) + (wrap (n/+ (|> high frac-to-int .nat (i64.left-shift +32)) (|> low frac-to-int .nat)))))) (structure: _ (Codec JSON Int) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 6366dde39..2ddb64f32 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -6,12 +6,12 @@ [monad (#+ do Monad)] hash] [data - [bit] [text ("text/" Monoid) [unicode (#+ Char Segment)]] [product] [maybe] [number (#+ hex) + [i64] ["r" ratio] ["c" complex]] [collection @@ -86,7 +86,7 @@ (Random Bool) (function (_ prng) (let [[prng output] (prng [])] - [prng (|> output (bit.and +1) (n/= +1))]))) + [prng (|> output (i64.and +1) (n/= +1))]))) (def: #export i64 (Random I64) @@ -94,7 +94,7 @@ (let [[prng left] (prng []) [prng right] (prng [])] [prng (|> left - (bit.left-shift +32) + (i64.left-shift +32) ("lux i64 +" right))]))) (def: #export nat @@ -267,12 +267,12 @@ (-> [(I64 Any) (I64 Any)] PRNG) (function (_ _) [(|> seed .nat (n/* pcg-32-magic-mult) ("lux i64 +" inc) [inc] pcg-32) - (let [rot (|> seed .i64 (bit.logical-right-shift +59))] + (let [rot (|> seed .i64 (i64.logical-right-shift +59))] (|> seed - (bit.logical-right-shift +18) - (bit.xor seed) - (bit.logical-right-shift +27) - (bit.rotate-right rot) + (i64.logical-right-shift +18) + (i64.xor seed) + (i64.logical-right-shift +27) + (i64.rotate-right rot) .i64))])) (def: #export (xoroshiro-128+ [s0 s1]) @@ -281,12 +281,12 @@ For more information, please see: http://xoroshiro.di.unimi.it/"} (-> [(I64 Any) (I64 Any)] PRNG) (function (_ _) - [(let [s01 (bit.xor s0 s1)] + [(let [s01 (i64.xor s0 s1)] (xoroshiro-128+ [(|> s0 - (bit.rotate-left +55) - (bit.xor s01) - (bit.xor (bit.left-shift +14 s01))) - (bit.rotate-left +36 s01)])) + (i64.rotate-left +55) + (i64.xor s01) + (i64.xor (i64.left-shift +14 s01))) + (i64.rotate-left +36 s01)])) ("lux i64 +" s0 s1)])) (def: (swap from to vec) diff --git a/stdlib/source/lux/world/blob.jvm.lux b/stdlib/source/lux/world/blob.jvm.lux index d1ee258a3..ce2e39984 100644 --- a/stdlib/source/lux/world/blob.jvm.lux +++ b/stdlib/source/lux/world/blob.jvm.lux @@ -5,10 +5,12 @@ ["ex" exception (#+ exception:)] ["eq" equivalence]] [data - [bit] [maybe] [error (#+ Error)] - [text format]] + [text + format] + [number + [i64]]] [host (#+ import:)]]) (exception: #export (index-out-of-bounds {description Text}) @@ -28,11 +30,11 @@ (def: byte-mask I64 - (|> +1 (bit.left-shift +8) dec .i64)) + (|> +1 (i64.left-shift +8) dec .i64)) (def: i64 (-> (primitive "java.lang.Byte") I64) - (|>> host.byte-to-long (:coerce I64) (bit.and byte-mask))) + (|>> host.byte-to-long (:coerce I64) (i64.and byte-mask))) (def: byte (-> (I64 Any) (primitive "java.lang.Byte")) @@ -51,32 +53,32 @@ (def: #export (read/16 idx blob) (-> Nat Blob (Error I64)) (if (n/< (host.array-length blob) (n/+ +1 idx)) - (#error.Success ($_ bit.or - (bit.left-shift +8 (..i64 (host.array-read idx blob))) + (#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 ($_ bit.or - (bit.left-shift +24 (..i64 (host.array-read idx blob))) - (bit.left-shift +16 (..i64 (host.array-read (n/+ +1 idx) blob))) - (bit.left-shift +8 (..i64 (host.array-read (n/+ +2 idx) blob))) + (#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 ($_ bit.or - (bit.left-shift +56 (..i64 (host.array-read idx blob))) - (bit.left-shift +48 (..i64 (host.array-read (n/+ +1 idx) blob))) - (bit.left-shift +40 (..i64 (host.array-read (n/+ +2 idx) blob))) - (bit.left-shift +32 (..i64 (host.array-read (n/+ +3 idx) blob))) - (bit.left-shift +24 (..i64 (host.array-read (n/+ +4 idx) blob))) - (bit.left-shift +16 (..i64 (host.array-read (n/+ +5 idx) blob))) - (bit.left-shift +8 (..i64 (host.array-read (n/+ +6 idx) blob))) + (#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)))) @@ -92,7 +94,7 @@ (-> Nat (I64 Any) Blob (Error Blob)) (if (n/< (host.array-length blob) (n/+ +1 idx)) (exec (|> blob - (host.array-write idx (..byte (bit.logical-right-shift +8 value))) + (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)))) @@ -101,9 +103,9 @@ (-> Nat (I64 Any) Blob (Error Blob)) (if (n/< (host.array-length blob) (n/+ +3 idx)) (exec (|> blob - (host.array-write idx (..byte (bit.logical-right-shift +24 value))) - (host.array-write (n/+ +1 idx) (..byte (bit.logical-right-shift +16 value))) - (host.array-write (n/+ +2 idx) (..byte (bit.logical-right-shift +8 value))) + (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)))) @@ -112,13 +114,13 @@ (-> Nat (I64 Any) Blob (Error Blob)) (if (n/< (host.array-length blob) (n/+ +7 idx)) (exec (|> blob - (host.array-write idx (..byte (bit.logical-right-shift +56 value))) - (host.array-write (n/+ +1 idx) (..byte (bit.logical-right-shift +48 value))) - (host.array-write (n/+ +2 idx) (..byte (bit.logical-right-shift +40 value))) - (host.array-write (n/+ +3 idx) (..byte (bit.logical-right-shift +32 value))) - (host.array-write (n/+ +4 idx) (..byte (bit.logical-right-shift +24 value))) - (host.array-write (n/+ +5 idx) (..byte (bit.logical-right-shift +16 value))) - (host.array-write (n/+ +6 idx) (..byte (bit.logical-right-shift +8 value))) + (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)))) diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index 706e6e4bb..4f1a810c2 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -6,7 +6,8 @@ ["r" math/random] [data [maybe] - [bit] + [number + [i64]] [text ("text/" Equivalence) format]] ["." macro @@ -133,7 +134,7 @@ (def: frac-rev (r.Random Rev) (|> r.rev - (:: r.Functor map (|>> (bit.left-shift +11) (bit.logical-right-shift +11))))) + (:: r.Functor map (|>> (i64.left-shift +11) (i64.logical-right-shift +11))))) (do-template [category rand-gen -> <- = ] [(context: (format "[" category "] " "Numeric conversions") diff --git a/stdlib/test/test/lux/data/bit.lux b/stdlib/test/test/lux/data/bit.lux deleted file mode 100644 index 6d76ac4e2..000000000 --- a/stdlib/test/test/lux/data/bit.lux +++ /dev/null @@ -1,76 +0,0 @@ -(.module: - [lux #* - [io] - [control - ["M" monad (#+ do Monad)]] - [data - ["&" bit] - number] - [math - ["r" random]]] - lux/test) - -(context: "Bitwise operations." - (<| (times +100) - (do @ - [pattern r.nat - idx (:: @ map (n/% &.width) r.nat)] - ($_ seq - (test "Clearing and settings bits should alter the count." - (and (n/= (dec (&.count (&.set idx pattern))) - (&.count (&.clear idx pattern))) - (|> (&.count pattern) - (n/- (&.count (&.clear idx pattern))) - (n/<= +1)) - (|> (&.count (&.set idx pattern)) - (n/- (&.count pattern)) - (n/<= +1)))) - (test "Can query whether a bit is set." - (and (or (and (&.set? idx pattern) - (not (&.set? idx (&.clear idx pattern)))) - (and (not (&.set? idx pattern)) - (&.set? idx (&.set idx pattern)))) - - (or (and (&.set? idx pattern) - (not (&.set? idx (&.flip idx pattern)))) - (and (not (&.set? idx pattern)) - (&.set? idx (&.flip idx pattern)))))) - (test "The negation of a bit pattern should have a complementary bit-count." - (n/= &.width - (n/+ (&.count pattern) - (&.count (&.not pattern))))) - (test "Can do simple binary boolean logic." - (and (n/= +0 - (&.and pattern - (&.not pattern))) - (n/= (&.not +0) - (&.or pattern - (&.not pattern))) - (n/= (&.not +0) - (&.xor pattern - (&.not pattern))) - (n/= +0 - (&.xor pattern - pattern)))) - (test "rotate-left and rotate-right are inverses of one another." - (and (|> pattern - (&.rotate-left idx) - (&.rotate-right idx) - (n/= pattern)) - (|> pattern - (&.rotate-right idx) - (&.rotate-left idx) - (n/= pattern)))) - (test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged." - (and (|> pattern - (&.rotate-left &.width) - (n/= pattern)) - (|> pattern - (&.rotate-right &.width) - (n/= pattern)))) - (test "Shift right respect the sign of ints." - (let [value (.int pattern)] - (if (i/< 0 value) - (i/< 0 (&.arithmetic-right-shift idx value)) - (i/>= 0 (&.arithmetic-right-shift idx value))))) - )))) diff --git a/stdlib/test/test/lux/data/number/i64.lux b/stdlib/test/test/lux/data/number/i64.lux new file mode 100644 index 000000000..1dd9dd314 --- /dev/null +++ b/stdlib/test/test/lux/data/number/i64.lux @@ -0,0 +1,76 @@ +(.module: + [lux #* + [io] + [control + ["M" monad (#+ do Monad)]] + [data + [number #* + ["&" i64]]] + [math + ["r" random]]] + lux/test) + +(context: "Bitwise operations." + (<| (times +100) + (do @ + [pattern r.nat + idx (:: @ map (n/% &.width) r.nat)] + ($_ seq + (test "Clearing and settings bits should alter the count." + (and (n/= (dec (&.count (&.set idx pattern))) + (&.count (&.clear idx pattern))) + (|> (&.count pattern) + (n/- (&.count (&.clear idx pattern))) + (n/<= +1)) + (|> (&.count (&.set idx pattern)) + (n/- (&.count pattern)) + (n/<= +1)))) + (test "Can query whether a bit is set." + (and (or (and (&.set? idx pattern) + (not (&.set? idx (&.clear idx pattern)))) + (and (not (&.set? idx pattern)) + (&.set? idx (&.set idx pattern)))) + + (or (and (&.set? idx pattern) + (not (&.set? idx (&.flip idx pattern)))) + (and (not (&.set? idx pattern)) + (&.set? idx (&.flip idx pattern)))))) + (test "The negation of a bit pattern should have a complementary bit-count." + (n/= &.width + (n/+ (&.count pattern) + (&.count (&.not pattern))))) + (test "Can do simple binary boolean logic." + (and (n/= +0 + (&.and pattern + (&.not pattern))) + (n/= (&.not +0) + (&.or pattern + (&.not pattern))) + (n/= (&.not +0) + (&.xor pattern + (&.not pattern))) + (n/= +0 + (&.xor pattern + pattern)))) + (test "rotate-left and rotate-right are inverses of one another." + (and (|> pattern + (&.rotate-left idx) + (&.rotate-right idx) + (n/= pattern)) + (|> pattern + (&.rotate-right idx) + (&.rotate-left idx) + (n/= pattern)))) + (test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged." + (and (|> pattern + (&.rotate-left &.width) + (n/= pattern)) + (|> pattern + (&.rotate-right &.width) + (n/= pattern)))) + (test "Shift right respect the sign of ints." + (let [value (.int pattern)] + (if (i/< 0 value) + (i/< 0 (&.arithmetic-right-shift idx value)) + (i/>= 0 (&.arithmetic-right-shift idx value))))) + )))) diff --git a/stdlib/test/test/lux/world/blob.lux b/stdlib/test/test/lux/world/blob.lux index 7bce91298..f93b4e5dd 100644 --- a/stdlib/test/test/lux/world/blob.lux +++ b/stdlib/test/test/lux/world/blob.lux @@ -5,9 +5,9 @@ [monad (#+ do)] [pipe]] [data - [bit] - [number] ["e" error] + ["." number + [i64]] [collection [list]]] [world ["/" blob]] @@ -43,7 +43,7 @@ (-> Nat (-> Nat /.Blob (e.Error Nat)) (-> Nat Nat /.Blob (e.Error Any)) Nat Bool) (let [blob (/.create +8) bits (n/* +8 bytes) - capped-value (|> +1 (bit.left-shift bits) dec (bit.and value))] + capped-value (|> +1 (i64.left-shift bits) dec (i64.and value))] (succeed (do e.Monad [_ (write +0 value blob) -- cgit v1.2.3