diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/source/lux/data/bit.lux | 30 | ||||
| -rw-r--r-- | stdlib/test/test/lux/data/bit.lux | 14 |
2 files changed, 29 insertions, 15 deletions
diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux index 90f98f245..c6d680563 100644 --- a/stdlib/source/lux/data/bit.lux +++ b/stdlib/source/lux/data/bit.lux @@ -3,24 +3,36 @@ (def: #export width Nat +64) ## [Values] -(do-template [<short-name> <op> <doc> <type>] - [(def: #export (<short-name> param subject) +(do-template [<name> <type> <op> <doc>] + [(def: #export (<name> param subject) {#.doc <doc>} (-> Nat <type> <type>) (<op> subject param))] - [and "lux bit and" "Bitwise and." Nat] - [or "lux bit or" "Bitwise or." Nat] - [xor "lux bit xor" "Bitwise xor." Nat] - [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] + [and Nat "lux bit and" "Bitwise and."] + [or Nat "lux bit or" "Bitwise or."] + [xor Nat "lux bit xor" "Bitwise xor."] + [left-shift Nat "lux bit left-shift" "Bitwise left-shift."] + [logical-right-shift Nat "lux bit logical-right-shift" "Unsigned bitwise logical-right-shift."] + [arithmetic-right-shift Int "lux bit 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."} (-> Nat Nat) - ("lux bit count" subject)) + (let [count' (n/- (|> subject (logical-right-shift +1) (and +6148914691236517205)) + 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."} diff --git a/stdlib/test/test/lux/data/bit.lux b/stdlib/test/test/lux/data/bit.lux index f8c9bc8ef..1b8110d31 100644 --- a/stdlib/test/test/lux/data/bit.lux +++ b/stdlib/test/test/lux/data/bit.lux @@ -14,12 +14,14 @@ idx (:: @ map (n/% &.width) r.nat)] ($_ seq (test "Clearing and settings bits should alter the count." - (and (n/< (&.count (&.set idx pattern)) + (and (n/= (n/dec (&.count (&.set idx pattern))) (&.count (&.clear idx pattern))) - (n/<= (&.count pattern) - (&.count (&.clear idx pattern))) - (n/>= (&.count pattern) - (&.count (&.set 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)))) @@ -30,7 +32,7 @@ (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." + (test "The negation of a bit pattern should have a complementary bit-count." (n/= &.width (n/+ (&.count pattern) (&.count (&.not pattern))))) |