From e65e734e5df3746ffb7df2cc9fa33826e0083fcd Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 6 May 2018 03:30:47 -0400 Subject: - Re-named shift-left -> left-shift, shift-right -> logical-right-shift, signed-shift-right -> arithmetic-right-shift. --- stdlib/source/lux/data/bit.lux | 20 +++++----- .../source/lux/data/coll/dictionary/unordered.lux | 10 ++--- stdlib/source/lux/data/coll/sequence.lux | 18 ++++----- stdlib/source/lux/data/number.lux | 10 ++--- stdlib/source/lux/macro/poly/json.lux | 8 ++-- stdlib/source/lux/math/random.lux | 16 ++++---- stdlib/source/lux/world/blob.jvm.lux | 46 +++++++++++----------- 7 files changed, 64 insertions(+), 64 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux index 65d1bef84..90f98f245 100644 --- a/stdlib/source/lux/data/bit.lux +++ b/stdlib/source/lux/data/bit.lux @@ -12,9 +12,9 @@ [and "lux bit and" "Bitwise and." Nat] [or "lux bit or" "Bitwise or." Nat] [xor "lux bit xor" "Bitwise xor." Nat] - [shift-left "lux bit shift-left" "Bitwise shift-left." Nat] - [shift-right "lux bit unsigned-shift-right" "Unsigned bitwise shift-right." Nat] - [signed-shift-right "lux bit shift-right" "Signed bitwise shift-right." Int] + [left-shift "lux bit left-shift" "Bitwise left-shift." Nat] + [logical-right-shift "lux bit logical-right-shift" "Unsigned bitwise logical-right-shift." Nat] + [arithmetic-right-shift "lux bit arithmetic-right-shift" "Signed bitwise arithmetic-right-shift." Int] ) (def: #export (count subject) @@ -31,14 +31,14 @@ (def: #export (clear idx input) {#.doc "Clear bit at given index."} (-> Nat Nat Nat) - (..and (..not (shift-left idx +1)) + (..and (..not (left-shift idx +1)) input)) (do-template [ ] [(def: #export ( idx input) {#.doc } (-> Nat Nat Nat) - ( (shift-left idx +1) input))] + ( (left-shift idx +1) input))] [set ..or "Set bit at given index."] [flip ..xor "Flip bit at given index."] @@ -46,7 +46,7 @@ (def: #export (set? idx input) (-> Nat Nat Bool) - (|> input (..and (shift-left idx +1)) (n/= +0) .not)) + (|> input (..and (left-shift idx +1)) (n/= +0) .not)) (do-template [
] [(def: #export ( distance input) @@ -56,11 +56,11 @@ width) input)))] - [rotate-left shift-left shift-right] - [rotate-right shift-right shift-left] + [rotate-left left-shift logical-right-shift] + [rotate-right logical-right-shift left-shift] ) (def: #export (region-mask size offset) (-> Nat Nat Nat) - (let [pattern (|> +1 (shift-left size) n/dec)] - (shift-left offset pattern))) + (let [pattern (|> +1 (left-shift size) n/dec)] + (left-shift offset pattern))) diff --git a/stdlib/source/lux/data/coll/dictionary/unordered.lux b/stdlib/source/lux/data/coll/dictionary/unordered.lux index 97a119755..e0928e186 100644 --- a/stdlib/source/lux/data/coll/dictionary/unordered.lux +++ b/stdlib/source/lux/data/coll/dictionary/unordered.lux @@ -97,18 +97,18 @@ ## which is 1/4 of the branching factor (or a left-shift 2). (def: demotion-threshold Nat - (bit.shift-left (n/- +2 branching-exponent) +1)) + (bit.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.shift-left (n/- +1 branching-exponent) +1)) + (bit.left-shift (n/- +1 branching-exponent) +1)) ## The size of hierarchy-nodes, which is 2^(branching-exponent). (def: hierarchy-nodes-size Nat - (bit.shift-left branching-exponent +1)) + (bit.left-shift branching-exponent +1)) ## The cannonical empty node, which is just an empty #Base node. (def: empty @@ -161,12 +161,12 @@ (def: (level-index level hash) (-> Level Hash-Code Index) (bit.and hierarchy-mask - (bit.shift-right level hash))) + (bit.logical-right-shift level hash))) ## A mechanism to go from indices to bit-positions. (def: (->bit-position index) (-> Index BitPosition) - (bit.shift-left index +1)) + (bit.left-shift index +1)) ## The bit-position within a base that a given hash-code would have. (def: (bit-position level hash) diff --git a/stdlib/source/lux/data/coll/sequence.lux b/stdlib/source/lux/data/coll/sequence.lux index 45a22e73b..a160a9925 100644 --- a/stdlib/source/lux/data/coll/sequence.lux +++ b/stdlib/source/lux/data/coll/sequence.lux @@ -48,7 +48,7 @@ (def: full-node-size Nat - (bit.shift-left branching-exponent +1)) + (bit.left-shift branching-exponent +1)) (def: branch-idx-mask Nat @@ -67,8 +67,8 @@ (if (n/< full-node-size vec-size) +0 (|> (n/dec vec-size) - (bit.shift-right branching-exponent) - (bit.shift-left branching-exponent)))) + (bit.logical-right-shift branching-exponent) + (bit.left-shift branching-exponent)))) (def: (new-path level tail) (All [a] (-> Level (Base a) (Node a))) @@ -85,7 +85,7 @@ (def: (push-tail size level tail parent) (All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (bit.shift-right level (n/dec size))) + (let [sub-idx (branch-idx (bit.logical-right-shift level (n/dec size))) ## If we're currently on a bottom node sub-node (if (n/= branching-exponent level) ## Just add the tail to it @@ -114,7 +114,7 @@ (def: (put' level idx val hierarchy) (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (bit.shift-right level idx))] + (let [sub-idx (branch-idx (bit.logical-right-shift level idx))] (case (array.read sub-idx hierarchy) (#.Some (#Hierarchy sub-node)) (|> (array.clone hierarchy) @@ -132,7 +132,7 @@ (def: (pop-tail size level hierarchy) (All [a] (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a)))) - (let [sub-idx (branch-idx (bit.shift-right level (n/- +2 size)))] + (let [sub-idx (branch-idx (bit.logical-right-shift level (n/- +2 size)))] (cond (n/= +0 sub-idx) #.None @@ -199,8 +199,8 @@ ## Otherwise, push tail into the tree ## -------------------------------------------------------- ## Will the root experience an overflow with this addition? - (|> (if (n/> (bit.shift-left (get@ #level vec) +1) - (bit.shift-right branching-exponent vec-size)) + (|> (if (n/> (bit.left-shift (get@ #level vec) +1) + (bit.logical-right-shift branching-exponent vec-size)) ## If so, a brand-new root must be established, that is ## 1-level taller. (|> vec @@ -230,7 +230,7 @@ (loop [level (get@ #level vec) hierarchy (get@ #root vec)] (case [(n/> branching-exponent level) - (array.read (branch-idx (bit.shift-right level idx)) hierarchy)] + (array.read (branch-idx (bit.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 c67ad0e56..c784e81ef 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -937,7 +937,7 @@ (let [sign (:: Number signum input) input (:: Number abs input) exponent ("lux math floor" (log2 input)) - exponent-mask (|> +1 (bit.shift-left exponent-size) n/dec) + exponent-mask (|> +1 (bit.left-shift exponent-size) n/dec) mantissa (|> input ## Normalize (f// ("lux math pow" 2.0 exponent)) @@ -947,16 +947,16 @@ exponent-bits (|> exponent frac-to-int int-to-nat (n/+ double-bias) (bit.and exponent-mask)) mantissa-bits (|> mantissa frac-to-int int-to-nat)] ($_ bit.or - (bit.shift-left +63 sign-bit) - (bit.shift-left mantissa-size exponent-bits) + (bit.left-shift +63 sign-bit) + (bit.left-shift mantissa-size exponent-bits) (bit.clear mantissa-size mantissa-bits))) )) (do-template [ ] - [(def: (|> +1 (bit.shift-left ) n/dec (bit.shift-left ))) + [(def: (|> +1 (bit.left-shift ) n/dec (bit.left-shift ))) (def: ( input) (-> Nat Nat) - (|> input (bit.and ) (bit.shift-right )))] + (|> input (bit.and ) (bit.logical-right-shift )))] [mantissa mantissa-mask mantissa-size +0] [exponent exponent-mask exponent-size mantissa-size] diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 971048296..2e288648e 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -39,12 +39,12 @@ (function (_ input) (non-rec (rec-encode non-rec) input))) -(def: low-mask Nat (|> +1 (bit.shift-left +32) n/dec)) -(def: high-mask Nat (|> low-mask (bit.shift-left +32))) +(def: low-mask Nat (|> +1 (bit.left-shift +32) n/dec)) +(def: high-mask Nat (|> low-mask (bit.left-shift +32))) (struct: _ (Codec JSON Nat) (def: (encode input) - (let [high (|> input (bit.and high-mask) (bit.shift-right +32)) + (let [high (|> input (bit.and high-mask) (bit.logical-right-shift +32)) low (bit.and low-mask input)] (#//.Array (sequence (|> high nat-to-int int-to-frac #//.Number) (|> low nat-to-int int-to-frac #//.Number))))) @@ -54,7 +54,7 @@ (do p.Monad [high //.number low //.number]) - (wrap (n/+ (|> high frac-to-int int-to-nat (bit.shift-left +32)) + (wrap (n/+ (|> high frac-to-int int-to-nat (bit.left-shift +32)) (|> low frac-to-int int-to-nat)))))) (struct: _ (Codec JSON Int) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 2ae482c34..39d7d880d 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -69,7 +69,7 @@ (function (_ prng) (let [[prng left] (prng []) [prng right] (prng [])] - [prng (n/+ (bit.shift-left +32 left) + [prng (n/+ (bit.left-shift +32 left) right)]))) (def: #export int @@ -77,7 +77,7 @@ (function (_ prng) (let [[prng left] (prng []) [prng right] (prng [])] - [prng (nat-to-int (n/+ (bit.shift-left +32 left) + [prng (nat-to-int (n/+ (bit.left-shift +32 left) right))]))) (def: #export bool @@ -90,7 +90,7 @@ (-> Nat (Random Nat)) (function (_ prng) (let [[prng output] (prng [])] - [prng (bit.shift-right (n/- n +64) output)]))) + [prng (bit.logical-right-shift (n/- n +64) output)]))) (def: #export frac (Random Frac) @@ -98,10 +98,10 @@ [left (bits +26) right (bits +27)] (wrap (|> right - (n/+ (bit.shift-left +27 left)) + (n/+ (bit.left-shift +27 left)) nat-to-int int-to-frac - (f// (|> +1 (bit.shift-left +53) nat-to-int int-to-frac)))))) + (f// (|> +1 (bit.left-shift +53) nat-to-int int-to-frac)))))) (def: #export deg (Random Deg) @@ -327,8 +327,8 @@ (-> [Nat Nat] PRNG) (function (_ _) (let [seed' (|> seed (n/* pcg-32-magic-mult) (n/+ inc)) - xor-shifted (|> seed (bit.shift-right +18) (bit.xor seed) (bit.shift-right +27)) - rot (|> seed (bit.shift-right +59))] + xor-shifted (|> seed (bit.logical-right-shift +18) (bit.xor seed) (bit.logical-right-shift +27)) + rot (|> seed (bit.logical-right-shift +59))] [(pcg-32 [inc seed']) (bit.rotate-right rot xor-shifted)] ))) @@ -342,7 +342,7 @@ s01 (bit.xor s0 s1) s0' (|> (bit.rotate-left +55 s0) (bit.xor s01) - (bit.xor (bit.shift-left +14 s01))) + (bit.xor (bit.left-shift +14 s01))) s1' (bit.rotate-left +36 s01)] [(xoroshiro-128+ [s0' s1']) result]) )) diff --git a/stdlib/source/lux/world/blob.jvm.lux b/stdlib/source/lux/world/blob.jvm.lux index 0027a4750..077fa3863 100644 --- a/stdlib/source/lux/world/blob.jvm.lux +++ b/stdlib/source/lux/world/blob.jvm.lux @@ -23,7 +23,7 @@ (def: byte-mask Nat - (|> +1 (bit.shift-left +8) n/dec)) + (|> +1 (bit.left-shift +8) n/dec)) (def: byte-to-nat (-> (primitive "java.lang.Byte") Nat) @@ -43,7 +43,7 @@ (-> Nat Blob (e.Error Nat)) (if (n/< (host.array-length blob) (n/+ +1 idx)) (#e.Success ($_ bit.or - (bit.shift-left +8 (byte-to-nat (host.array-read idx blob))) + (bit.left-shift +8 (byte-to-nat (host.array-read idx blob))) (byte-to-nat (host.array-read (n/+ +1 idx) blob)))) (ex.throw index-out-of-bounds (%n idx)))) @@ -51,9 +51,9 @@ (-> Nat Blob (e.Error Nat)) (if (n/< (host.array-length blob) (n/+ +3 idx)) (#e.Success ($_ bit.or - (bit.shift-left +24 (byte-to-nat (host.array-read idx blob))) - (bit.shift-left +16 (byte-to-nat (host.array-read (n/+ +1 idx) blob))) - (bit.shift-left +8 (byte-to-nat (host.array-read (n/+ +2 idx) blob))) + (bit.left-shift +24 (byte-to-nat (host.array-read idx blob))) + (bit.left-shift +16 (byte-to-nat (host.array-read (n/+ +1 idx) blob))) + (bit.left-shift +8 (byte-to-nat (host.array-read (n/+ +2 idx) blob))) (byte-to-nat (host.array-read (n/+ +3 idx) blob)))) (ex.throw index-out-of-bounds (%n idx)))) @@ -61,13 +61,13 @@ (-> Nat Blob (e.Error Nat)) (if (n/< (host.array-length blob) (n/+ +7 idx)) (#e.Success ($_ bit.or - (bit.shift-left +56 (byte-to-nat (host.array-read idx blob))) - (bit.shift-left +48 (byte-to-nat (host.array-read (n/+ +1 idx) blob))) - (bit.shift-left +40 (byte-to-nat (host.array-read (n/+ +2 idx) blob))) - (bit.shift-left +32 (byte-to-nat (host.array-read (n/+ +3 idx) blob))) - (bit.shift-left +24 (byte-to-nat (host.array-read (n/+ +4 idx) blob))) - (bit.shift-left +16 (byte-to-nat (host.array-read (n/+ +5 idx) blob))) - (bit.shift-left +8 (byte-to-nat (host.array-read (n/+ +6 idx) blob))) + (bit.left-shift +56 (byte-to-nat (host.array-read idx blob))) + (bit.left-shift +48 (byte-to-nat (host.array-read (n/+ +1 idx) blob))) + (bit.left-shift +40 (byte-to-nat (host.array-read (n/+ +2 idx) blob))) + (bit.left-shift +32 (byte-to-nat (host.array-read (n/+ +3 idx) blob))) + (bit.left-shift +24 (byte-to-nat (host.array-read (n/+ +4 idx) blob))) + (bit.left-shift +16 (byte-to-nat (host.array-read (n/+ +5 idx) blob))) + (bit.left-shift +8 (byte-to-nat (host.array-read (n/+ +6 idx) blob))) (byte-to-nat (host.array-read (n/+ +7 idx) blob)))) (ex.throw index-out-of-bounds (%n idx)))) @@ -83,7 +83,7 @@ (-> Nat Nat Blob (e.Error Top)) (if (n/< (host.array-length blob) (n/+ +1 idx)) (exec (|> blob - (host.array-write idx (host.long-to-byte (:! Int (bit.shift-right +8 value)))) + (host.array-write idx (host.long-to-byte (:! Int (bit.logical-right-shift +8 value)))) (host.array-write (n/+ +1 idx) (host.long-to-byte (:! Int value)))) (#e.Success [])) (ex.throw index-out-of-bounds (%n idx)))) @@ -92,9 +92,9 @@ (-> Nat Nat Blob (e.Error Top)) (if (n/< (host.array-length blob) (n/+ +3 idx)) (exec (|> blob - (host.array-write idx (host.long-to-byte (:! Int (bit.shift-right +24 value)))) - (host.array-write (n/+ +1 idx) (host.long-to-byte (:! Int (bit.shift-right +16 value)))) - (host.array-write (n/+ +2 idx) (host.long-to-byte (:! Int (bit.shift-right +8 value)))) + (host.array-write idx (host.long-to-byte (:! Int (bit.logical-right-shift +24 value)))) + (host.array-write (n/+ +1 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +16 value)))) + (host.array-write (n/+ +2 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +8 value)))) (host.array-write (n/+ +3 idx) (host.long-to-byte (:! Int value)))) (#e.Success [])) (ex.throw index-out-of-bounds (%n idx)))) @@ -103,13 +103,13 @@ (-> Nat Nat Blob (e.Error Top)) (if (n/< (host.array-length blob) (n/+ +7 idx)) (exec (|> blob - (host.array-write idx (host.long-to-byte (:! Int (bit.shift-right +56 value)))) - (host.array-write (n/+ +1 idx) (host.long-to-byte (:! Int (bit.shift-right +48 value)))) - (host.array-write (n/+ +2 idx) (host.long-to-byte (:! Int (bit.shift-right +40 value)))) - (host.array-write (n/+ +3 idx) (host.long-to-byte (:! Int (bit.shift-right +32 value)))) - (host.array-write (n/+ +4 idx) (host.long-to-byte (:! Int (bit.shift-right +24 value)))) - (host.array-write (n/+ +5 idx) (host.long-to-byte (:! Int (bit.shift-right +16 value)))) - (host.array-write (n/+ +6 idx) (host.long-to-byte (:! Int (bit.shift-right +8 value)))) + (host.array-write idx (host.long-to-byte (:! Int (bit.logical-right-shift +56 value)))) + (host.array-write (n/+ +1 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +48 value)))) + (host.array-write (n/+ +2 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +40 value)))) + (host.array-write (n/+ +3 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +32 value)))) + (host.array-write (n/+ +4 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +24 value)))) + (host.array-write (n/+ +5 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +16 value)))) + (host.array-write (n/+ +6 idx) (host.long-to-byte (:! Int (bit.logical-right-shift +8 value)))) (host.array-write (n/+ +7 idx) (host.long-to-byte (:! Int value)))) (#e.Success [])) (ex.throw index-out-of-bounds (%n idx)))) -- cgit v1.2.3