From 07c70ad15ba4a8c9b00773a0a14eade28fe06569 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 7 May 2018 21:43:19 -0400
Subject: - Implemented bit-count in pure Lux.

---
 stdlib/source/lux/data/bit.lux    | 30 +++++++++++++++++++++---------
 stdlib/test/test/lux/data/bit.lux | 14 ++++++++------
 2 files changed, 29 insertions(+), 15 deletions(-)

(limited to 'stdlib')

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)))))
-- 
cgit v1.2.3