From 83c809e53f339f9eb20e2a950680c8843d147ecb Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 3 May 2017 19:42:23 -0400 Subject: - Gave less cryptic names to bit-wise functions. - Improved the tests for lux/data/bit. --- stdlib/source/lux/data/bit.lux | 50 ++++++++++-------- stdlib/source/lux/data/coll/dict.lux | 22 ++++---- stdlib/source/lux/data/coll/vector.lux | 20 ++++---- stdlib/source/lux/math/random.lux | 22 ++++---- stdlib/test/test/lux/data/bit.lux | 92 +++++++++++++++++++--------------- 5 files changed, 111 insertions(+), 95 deletions(-) (limited to 'stdlib') diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux index 75791d35e..4e87a23dc 100644 --- a/stdlib/source/lux/data/bit.lux +++ b/stdlib/source/lux/data/bit.lux @@ -1,4 +1,4 @@ -(;module: [lux #- & | ^]) +(;module: [lux #- and or not]) ## [Values] (do-template [ ] @@ -7,12 +7,18 @@ (-> Nat ) (_lux_proc ["bit" ] [subject param]))] - [& "and" "Bitwise and." Nat] - [| "or" "Bitwise or." Nat] - [^ "xor" "Bitwise xor." Nat] - [<< "shift-left" "Bitwise shift-left." Nat] - [>> "shift-right" "Bitwise shift-right." Int] - [>>> "unsigned-shift-right" "Bitwise unsigned-shift-right." Nat] + [and "and" + "Bitwise and." Nat] + [or "or" + "Bitwise or." Nat] + [xor "xor" + "Bitwise xor." Nat] + [shift-left "shift-left" + "Bitwise shift-left." Nat] + [shift-right "shift-right" + "Bitwise shift-right." Int] + [unsigned-shift-right "unsigned-shift-right" + "Bitwise unsigned-shift-right." Nat] ) (def: #export (count subject) @@ -20,42 +26,42 @@ (-> Nat Nat) (_lux_proc ["bit" "count"] [subject])) -(def: mask Nat (int-to-nat -1)) - -(def: #export ~ +(def: #export not {#;doc "Bitwise negation."} (-> Nat Nat) - (^ mask)) + (let [mask (int-to-nat -1)] + (xor mask))) (def: #export (clear idx input) {#;doc "Clear bit at given index."} (-> Nat Nat Nat) - (& (~ (<< idx +1)) input)) + (;;and (;;not (shift-left idx +1)) + input)) (do-template [ ] [(def: #export ( idx input) {#;doc } (-> Nat Nat Nat) - ( (<< idx +1) input))] + ( (shift-left idx +1) input))] - [set | "Set bit at given index."] - [flip ^ "Flip bit at given index."] + [set ;;or "Set bit at given index."] + [flip ;;xor "Flip bit at given index."] ) (def: #export (set? idx input) (-> Nat Nat Bool) - (|> input (& (<< idx +1)) (n.= +0) not)) + (|> input (;;and (shift-left idx +1)) (n.= +0) ;not)) (def: rot-top Nat +64) (do-template [
] [(def: #export ( distance input) (-> Nat Nat Nat) - (| (
distance input) - ( (n.- (n.% rot-top distance) - rot-top) - input)))] + (;;or (
distance input) + ( (n.- (n.% rot-top distance) + rot-top) + input)))] - [rotate-left << >>>] - [rotate-right >>> <<] + [rotate-left shift-left unsigned-shift-right] + [rotate-right unsigned-shift-right shift-left] ) diff --git a/stdlib/source/lux/data/coll/dict.lux b/stdlib/source/lux/data/coll/dict.lux index 47929c72f..4ebb9a746 100644 --- a/stdlib/source/lux/data/coll/dict.lux +++ b/stdlib/source/lux/data/coll/dict.lux @@ -98,18 +98,18 @@ ## which is 1/4 of the branching factor (or a left-shift 2). (def: demotion-threshold Nat - (bit;<< (n.- +2 branching-exponent) +1)) + (bit;shift-left (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;<< (n.- +1 branching-exponent) +1)) + (bit;shift-left (n.- +1 branching-exponent) +1)) ## The size of hierarchy-nodes, which is 2^(branching-exponent). (def: hierarchy-nodes-size Nat - (bit;<< branching-exponent +1)) + (bit;shift-left branching-exponent +1)) ## The cannonical empty node, which is just an empty #Base node. (def: empty @@ -162,13 +162,13 @@ ## to a particular level, and uses that as an index into the array. (def: (level-index level hash) (-> Level Hash-Code Index) - (bit;& hierarchy-mask - (bit;>>> level hash))) + (bit;and hierarchy-mask + (bit;unsigned-shift-right level hash))) ## A mechanism to go from indices to bit-positions. (def: (->bit-position index) (-> Index BitPosition) - (bit;<< index +1)) + (bit;shift-left index +1)) ## The bit-position within a base that a given hash-code would have. (def: (bit-position level hash) @@ -177,7 +177,7 @@ (def: (bit-position-is-set? bit bitmap) (-> BitPosition BitMap Bool) - (not (n.= clean-bitmap (bit;& bit bitmap)))) + (not (n.= clean-bitmap (bit;and bit bitmap)))) ## Figures out whether a bitmap only contains a single bit-position. (def: only-bit-position? @@ -186,11 +186,11 @@ (def: (set-bit-position bit bitmap) (-> BitPosition BitMap BitMap) - (bit;| bit bitmap)) + (bit;or bit bitmap)) (def: unset-bit-position (-> BitPosition BitMap BitMap) - bit;^) + bit;xor) ## Figures out the size of a bitmap-indexed array by counting all the ## 1s within the bitmap. @@ -208,8 +208,8 @@ ## The index on the base array, based on it's bit-position. (def: (base-index bit-position bitmap) (-> BitPosition BitMap Index) - (bitmap-size (bit;& (bit-position-mask bit-position) - bitmap))) + (bitmap-size (bit;and (bit-position-mask bit-position) + bitmap))) ## Produces the index of a KV-pair within a #Collisions node. (def: (collision-index Hash key colls) diff --git a/stdlib/source/lux/data/coll/vector.lux b/stdlib/source/lux/data/coll/vector.lux index d99a4d77a..9d7bcba2c 100644 --- a/stdlib/source/lux/data/coll/vector.lux +++ b/stdlib/source/lux/data/coll/vector.lux @@ -51,7 +51,7 @@ (def: full-node-size Nat - (bit;<< branching-exponent +1)) + (bit;shift-left branching-exponent +1)) (def: branch-idx-mask Nat @@ -59,7 +59,7 @@ (def: branch-idx (-> Index Index) - (bit;& branch-idx-mask)) + (bit;and branch-idx-mask)) (def: (new-hierarchy _) (All [a] (-> Top (Hierarchy a))) @@ -70,8 +70,8 @@ (if (n.< full-node-size vec-size) +0 (|> (n.dec vec-size) - (bit;>>> branching-exponent) - (bit;<< branching-exponent)))) + (bit;unsigned-shift-right branching-exponent) + (bit;shift-left branching-exponent)))) (def: (new-path level tail) (All [a] (-> Level (Base a) (Node a))) @@ -90,7 +90,7 @@ (def: (push-tail size level tail parent) (All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (bit;>>> level (n.dec size))) + (let [sub-idx (branch-idx (bit;unsigned-shift-right 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 @@ -121,7 +121,7 @@ (def: (put' level idx val hierarchy) (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (bit;>>> level idx))] + (let [sub-idx (branch-idx (bit;unsigned-shift-right level idx))] (case (array;get sub-idx hierarchy) (#;Some (#Hierarchy sub-node)) (|> (array;clone hierarchy) @@ -139,7 +139,7 @@ (def: (pop-tail size level hierarchy) (All [a] (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a)))) - (let [sub-idx (branch-idx (bit;>>> level (n.- +2 size)))] + (let [sub-idx (branch-idx (bit;unsigned-shift-right level (n.- +2 size)))] (cond (n.= +0 sub-idx) #;None @@ -206,8 +206,8 @@ ## Otherwise, push tail into the tree ## -------------------------------------------------------- ## Will the root experience an overflow with this addition? - (|> (if (n.> (bit;<< (get@ #level vec) +1) - (bit;>>> branching-exponent vec-size)) + (|> (if (n.> (bit;shift-left (get@ #level vec) +1) + (bit;unsigned-shift-right branching-exponent vec-size)) ## If so, a brand-new root must be established, that is ## 1-level taller. (|> vec @@ -235,7 +235,7 @@ (loop [level (get@ #level vec) hierarchy (get@ #root vec)] (case [(n.> branching-exponent level) - (array;get (branch-idx (bit;>>> level idx)) hierarchy)] + (array;get (branch-idx (bit;unsigned-shift-right level idx)) hierarchy)] [true (#;Some (#Hierarchy sub))] (recur (level-down level) sub) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 372aafbfc..91ef541c7 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -62,7 +62,7 @@ (function [prng] (let [[prng left] (prng []) [prng right] (prng [])] - [prng (n.+ (bit;<< +32 left) + [prng (n.+ (bit;shift-left +32 left) right)]))) (def: #export int @@ -70,20 +70,20 @@ (function [prng] (let [[prng left] (prng []) [prng right] (prng [])] - [prng (nat-to-int (n.+ (bit;<< +32 left) + [prng (nat-to-int (n.+ (bit;shift-left +32 left) right))]))) (def: #export bool (Random Bool) (function [prng] (let [[prng output] (prng [])] - [prng (|> output (bit;& +1) (n.= +1))]))) + [prng (|> output (bit;and +1) (n.= +1))]))) (def: (bits n) (-> Nat (Random Nat)) (function [prng] (let [[prng output] (prng [])] - [prng (bit;>>> (n.- n +64) output)]))) + [prng (bit;unsigned-shift-right (n.- n +64) output)]))) (def: #export real (Random Real) @@ -91,10 +91,10 @@ [left (bits +26) right (bits +27)] (wrap (|> right - (n.+ (bit;<< +27 left)) + (n.+ (bit;shift-left +27 left)) nat-to-int int-to-real - (r./ (|> +1 (bit;<< +53) nat-to-int int-to-real)))))) + (r./ (|> +1 (bit;shift-left +53) nat-to-int int-to-real)))))) (def: #export deg (Random Deg) @@ -259,8 +259,8 @@ (-> [Nat Nat] PRNG) (function [_] (let [seed' (|> seed (n.* pcg-32-magic-mult) (n.+ inc)) - xor-shifted (|> seed (bit;>>> +18) (bit;^ seed) (bit;>>> +27)) - rot (|> seed (bit;>>> +59))] + xor-shifted (|> seed (bit;unsigned-shift-right +18) (bit;xor seed) (bit;unsigned-shift-right +27)) + rot (|> seed (bit;unsigned-shift-right +59))] [(pcg-32 [inc seed']) (bit;rotate-right rot xor-shifted)] ))) @@ -272,10 +272,10 @@ (-> [Nat Nat] PRNG) (function [_] (let [result (n.+ s0 s1) - s01 (bit;^ s0 s1) + s01 (bit;xor s0 s1) s0' (|> (bit;rotate-left +55 s0) - (bit;^ s01) - (bit;^ (bit;<< +14 s01))) + (bit;xor s01) + (bit;xor (bit;shift-left +14 s01))) s1' (bit;rotate-left +36 s01)] [(xoroshiro-128+ [s0' s1']) result]) )) diff --git a/stdlib/test/test/lux/data/bit.lux b/stdlib/test/test/lux/data/bit.lux index 0c9f5ac3d..2ba2c8e57 100644 --- a/stdlib/test/test/lux/data/bit.lux +++ b/stdlib/test/test/lux/data/bit.lux @@ -13,49 +13,59 @@ [pattern R;nat idx (:: @ map (n.% width) R;nat)] ($_ seq - (assert "" (and (n.< (&;count (&;set idx pattern)) - (&;count (&;clear idx pattern))) - (n.<= (&;count pattern) - (&;count (&;clear idx pattern))) - (n.>= (&;count pattern) - (&;count (&;set idx pattern))) + (assert "Clearing and settings bits should alter the count." + (and (n.< (&;count (&;set idx pattern)) + (&;count (&;clear idx pattern))) + (n.<= (&;count pattern) + (&;count (&;clear idx pattern))) + (n.>= (&;count pattern) + (&;count (&;set idx pattern))))) + (assert "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 (&;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)))) - - (n.= width - (n.+ (&;count pattern) - (&;count (&;~ pattern)))) - - (n.= +0 - (&;& pattern - (&;~ pattern))) - (n.= (&;~ +0) - (&;| pattern - (&;~ pattern))) - (n.= (&;~ +0) - (&;^ pattern - (&;~ pattern))) - (n.= +0 - (&;^ pattern - pattern)) - - (|> pattern (&;rotate-left idx) (&;rotate-right idx) (n.= pattern)) - (|> pattern (&;rotate-right idx) (&;rotate-left idx) (n.= pattern)) - (|> pattern (&;rotate-left idx) (&;rotate-left (n.- idx width)) (n.= pattern)) - (|> pattern (&;rotate-right idx) (&;rotate-right (n.- idx width)) (n.= pattern)) - )) - + (or (and (&;set? idx pattern) + (not (&;set? idx (&;flip idx pattern)))) + (and (not (&;set? idx pattern)) + (&;set? idx (&;flip idx pattern)))))) + (assert "The negation of a bit pattern should have a complementary bit count." + (n.= width + (n.+ (&;count pattern) + (&;count (&;not pattern))))) + (assert "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)))) + (assert "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)))) + (assert "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)))) (assert "Shift right respect the sign of ints." (let [value (nat-to-int pattern)] (if (i.< 0 value) - (i.< 0 (&;>> idx value)) - (i.>= 0 (&;>> idx value))))) + (i.< 0 (&;shift-right idx value)) + (i.>= 0 (&;shift-right idx value))))) )) -- cgit v1.2.3