aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2018-05-07 21:43:19 -0400
committerEduardo Julian2018-05-07 21:43:19 -0400
commit07c70ad15ba4a8c9b00773a0a14eade28fe06569 (patch)
tree18d6e938cb0a79ecffddd64da1958de47d75ee0f /stdlib
parentfebfa99c2823219c2e76d2c73b1fd8db8f6c9918 (diff)
- Implemented bit-count in pure Lux.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/data/bit.lux30
-rw-r--r--stdlib/test/test/lux/data/bit.lux14
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)))))