- Implemented bit-count in pure Lux.

18 files changed, 31 insertions, 159 deletions

diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj
index 93e83c2a2..44095998c 100644
--- a/luxc/src/lux/analyser/proc/common.clj
+++ b/luxc/src/lux/analyser/proc/common.clj
@@ -136,14 +136,6 @@
   ^:private analyse-bit-xor "xor"
   )
 
-(defn ^:private analyse-bit-count [analyse exo-type ?values]
-  (|do [:let [(&/$Cons input (&/$Nil)) ?values]
-        =input (&&/analyse-1 analyse &type/Nat input)
-        _ (&type/check exo-type &type/Nat)
-        _cursor &/cursor]
-    (return (&/|list (&&/|meta exo-type _cursor
-                               (&&/$proc (&/T ["bit" "count"]) (&/|list =input) (&/|list)))))))
-
 (do-template [<name> <op> <type>]
   (defn <name> [analyse exo-type ?values]
     (|do [:let [(&/$Cons input (&/$Cons shift (&/$Nil))) ?values]
@@ -456,7 +448,6 @@
          "lux text char"                 (analyse-text-char analyse exo-type ?values)
          "lux text contains?"            (analyse-text-contains? analyse exo-type ?values)
          
-         "lux bit count"                (analyse-bit-count analyse exo-type ?values)
          "lux bit and"                  (analyse-bit-and analyse exo-type ?values)
          "lux bit or"                   (analyse-bit-or analyse exo-type ?values)
          "lux bit xor"                  (analyse-bit-xor analyse exo-type ?values)
diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj
index 018ccf55d..4bf2e8dbf 100644
--- a/luxc/src/lux/compiler/jvm/proc/common.clj
+++ b/luxc/src/lux/compiler/jvm/proc/common.clj
@@ -130,17 +130,6 @@
   ^:private compile-bit-xor Opcodes/LXOR
   )
 
-(defn ^:private compile-bit-count [compile ?values special-args]
-  (|do [:let [(&/$Cons ?input (&/$Nil)) ?values]
-        ^MethodVisitor *writer* &/get-writer
-        _ (compile ?input)
-        :let [_ (&&/unwrap-long *writer*)]
-        :let [_ (doto *writer*
-                  (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "bitCount" "(J)I")
-                  (.visitInsn Opcodes/I2L)
-                  &&/wrap-long)]]
-    (return nil)))
-
 (do-template [<name> <op>]
   (defn <name> [compile ?values special-args]
     (|do [:let [(&/$Cons ?input (&/$Cons ?shift (&/$Nil))) ?values]
@@ -700,7 +689,6 @@
     
     "bit"
     (case proc
-      "count"                (compile-bit-count compile ?values special-args)
       "and"                  (compile-bit-and compile ?values special-args)
       "or"                   (compile-bit-or compile ?values special-args)
       "xor"                  (compile-bit-xor compile ?values special-args)
diff --git a/new-luxc/source/luxc/lang/extension/analysis/common.lux b/new-luxc/source/luxc/lang/extension/analysis/common.lux
index 1d4429e09..3b0286021 100644
--- a/new-luxc/source/luxc/lang/extension/analysis/common.lux
+++ b/new-luxc/source/luxc/lang/extension/analysis/common.lux
@@ -200,7 +200,6 @@
   Bundle
   (<| (prefix "bit")
       (|> (dict.new text.Hash<Text>)
-          (install "count" (unary Nat Nat))
           (install "and" (binary Nat Nat Nat))
           (install "or" (binary Nat Nat Nat))
           (install "xor" (binary Nat Nat Nat))
diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
index 28b993f91..3e8ec79cf 100644
--- a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
@@ -168,10 +168,6 @@
   [bit//logical-right-shift    runtimeT.bit//logical-right-shift]
   )
 
-(def: (bit//count subjectJS)
-  Unary
-  (format runtimeT.bit//count "(" subjectJS ")"))
-
 ## [[Arrays]]
 (def: (array//new sizeJS)
   Unary
@@ -435,7 +431,6 @@
   Bundle
   (<| (prefix "bit")
       (|> (dict.new text.Hash<Text>)
-          (install "count" (unary bit//count))
           (install "and" (binary bit//and))
           (install "or" (binary bit//or))
           (install "xor" (binary bit//xor))
diff --git a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
index a95268013..1839a1a5e 100644
--- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
@@ -287,29 +287,6 @@
                   "}")
           "})"))
 
-(runtime: bit//count32 "countI32"
-  (let [last-input-bit "input & 1"
-        update-count! (format "count += " last-input-bit ";")
-        consume-input! "input = input >>> 1;"
-        input-remaining? "input !== 0"]
-    (format "(function " @ "(input) {"
-            "var count = 0;"
-            "while(" input-remaining? ") {"
-            update-count!
-            consume-input!
-            "}"
-            "return count;"
-            "})")))
-
-(runtime: bit//count "countI64"
-  (let [high (format bit//count32 "(input.H)")
-        low (format bit//count32 "(input.L)")
-        whole (format "(" high " + " low ")")
-        cast (format int//from-number "(" whole ")")]
-    (format "(function " @ "(input) {"
-            "return " cast ";"
-            "})")))
-
 (runtime: bit//left-shift "shlI64"
   (format "(function " @ "(input,shift) {"
           "shift &= 63;"
@@ -377,8 +354,6 @@
           __bit//or
           __bit//xor
           __bit//not
-          __bit//count32
-          __bit//count
           __bit//left-shift
           __bit//arithmetic-right-shift
           __bit//logical-right-shift))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
index 59b7c8b4b..95d243761 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
@@ -206,12 +206,6 @@
   [bit//xor $i.LXOR]
   )
 
-(def: (bit//count inputI)
-  Unary
-  (|>> inputI ($i.unwrap #$.Long)
-       ($i.INVOKESTATIC "java.lang.Long" "bitCount" ($t.method (list $t.long) (#.Some $t.int) (list)) false)
-       lux-intI))
-
 (do-template [<name> <op>]
   [(def: (<name> [inputI shiftI])
      Binary
@@ -576,7 +570,6 @@
   Bundle
   (<| (prefix "bit")
       (|> (dict.new text.Hash<Text>)
-          (install "count" (unary bit//count))
           (install "and" (binary bit//and))
           (install "or" (binary bit//or))
           (install "xor" (binary bit//xor))
diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux
index d751c6781..3c8f94557 100644
--- a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux
@@ -159,10 +159,6 @@
   [bit//logical-right-shift  runtimeT.bit//logical-right-shift]
   )
 
-(def: bit//count
-  Unary
-  runtimeT.bit//count)
-
 ## [[Arrays]]
 (def: (array//new sizeO)
   Unary
@@ -422,7 +418,6 @@
   Bundle
   (<| (prefix "bit")
       (|> (dict.new text.Hash<Text>)
-          (install "count" (unary bit//count))
           (install "and" (binary bit//and))
           (install "or" (binary bit//or))
           (install "xor" (binary bit//xor))
diff --git a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux
index de2d574ec..03d84f400 100644
--- a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux
@@ -184,18 +184,9 @@
                      (lua.bit-shr param)
                      (lua.bit-and mask)))))
 
-(runtime: (bit//count subject)
-  (lua.block! (list (lua.local! "count" (#.Some (lua.int 0)))
-                    (lua.while! (lua.> (lua.int 0) subject)
-                                (lua.block! (list (lua.set! "count" (lua.+ (lua.% (lua.int 2) subject)
-                                                                           "count"))
-                                                  (lua.set! subject (lua.// (lua.int 2) subject)))))
-                    (lua.return! "count"))))
-
 (def: runtime//bit
   Runtime
-  (format @@bit//count
-          @@bit//logical-right-shift))
+  @@bit//logical-right-shift)
 
 (runtime: (text//index subject param start)
   (lua.block! (list (lua.local! "idx" (#.Some (lua.apply "string.find" (list subject param start (lua.bool true)))))
diff --git a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux
index 5850c0098..ce0038430 100644
--- a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux
@@ -179,7 +179,6 @@
 ##   Bundle
 ##   (<| (prefix "bit")
 ##       (|> (dict.new text.Hash<Text>)
-##           (install "count" (unary runtimeT.bit//count))
 ##           (install "and" (binary bit//and))
 ##           (install "or" (binary bit//or))
 ##           (install "xor" (binary bit//xor))
diff --git a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux
index 0f5a3fdc9..7a907edb0 100644
--- a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux
@@ -179,7 +179,6 @@
   Bundle
   (<| (prefix "bit")
       (|> (dict.new text.Hash<Text>)
-          (install "count" (unary runtimeT.bit//count))
           (install "and" (binary bit//and))
           (install "or" (binary bit//or))
           (install "xor" (binary bit//xor))
diff --git a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux
index 9bcc46680..a7bd45ff8 100644
--- a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux
@@ -220,23 +220,6 @@
       @@product//right
       @@sum//get))
 
-(def: full-32-bits (python.code "0xFFFFFFFF"))
-
-(runtime: (bit//32 input)
-  (with-vars [capped]
-    (python.cond! (list [(|> input (python.> full-32-bits))
-                         (python.return! (|> input (python.bit-and full-32-bits) bit//32))]
-                        [(|> input (python.> (python.code "0x7FFFFFFF")))
-                         ($_ python.then!
-                             (python.set! (list capped)
-                                          (python.apply (list (|> (python.code "0x100000000")
-                                                                  (python.- input)))
-                                                        (python.global "int")))
-                             (python.if! (|> (@@ capped) (python.<= (python.int 2147483647)))
-                                         (python.return! (|> (@@ capped) (python.* (python.int -1))))
-                                         (python.return! (python.int -2147483648))))])
-                  (python.return! input))))
-
 (def: full-64-bits (python.code "0xFFFFFFFFFFFFFFFF"))
 
 (runtime: (bit//64 input)
@@ -254,18 +237,6 @@
                                          (python.return! (python.code "-9223372036854775808L"))))])
                   (python.return! input))))
 
-(runtime: (bit//count subject)
-  (with-vars [count remaining]
-    ($_ python.then!
-        (python.set! (list count) (python.int 0))
-        (python.set! (list remaining) subject)
-        (python.while! (|> (@@ remaining) (python.> (python.int 0)))
-                       ($_ python.then!
-                           (let [last-bit (|> (@@ remaining) (python.% (python.int 2)))]
-                             (python.set! (list count) (|> (@@ count) (python.+ last-bit))))
-                           (python.set! (list remaining) (|> (@@ remaining) (python./ (python.int 2))))))
-        (python.return! (@@ count)))))
-
 (runtime: (bit//logical-right-shift param subject)
   (let [mask (|> (python.int 1)
                  (python.bit-shl (python.- param (python.int 64)))
@@ -277,9 +248,7 @@
 (def: runtime//bit
   Runtime
   ($_ python.then!
-      @@bit//32
       @@bit//64
-      @@bit//count
       @@bit//logical-right-shift))
 
 (runtime: (frac//decode input)
diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
index 68b0bb67d..5c4909d9b 100644
--- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
@@ -176,7 +176,6 @@
   Bundle
   (<| (prefix "bit")
       (|> (dict.new text.Hash<Text>)
-          (install "count" (unary runtimeT.bit//count))
           (install "and" (binary bit//and))
           (install "or" (binary bit//or))
           (install "xor" (binary bit//xor))
diff --git a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
index ced898662..5f073eb17 100644
--- a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
@@ -609,24 +609,6 @@
   [bit//xor r.bit-xor]
   )
 
-(runtime: (bit//count-32 input)
-  (with-vars [count]
-    ($_ r.then
-        (r.set! count (r.int 0))
-        (let [last-input-bit (|> (@@ input) (r.bit-and (r.int 1)))
-              update-count! (r.set! count (|> (@@ count) (r.+ last-input-bit)))
-              consume-input! (r.set! input (|> (@@ input) (r.bit-ushr (r.int 1))))
-              input-remaining? (|> (@@ input) (r.= (r.int 0)))]
-          (r.while input-remaining?
-                   ($_ r.then
-                       update-count!
-                       consume-input!)))
-        (@@ count))))
-
-(runtime: (bit//count input)
-  (int//from-float (r.+ (bit//count-32 (int64-high (@@ input)))
-                        (bit//count-32 (int64-low (@@ input))))))
-
 (runtime: (bit//logical-right-shift shift input)
   ($_ r.then
       (limit-shift! shift)
@@ -656,8 +638,6 @@
       @@bit//or
       @@bit//xor
       @@bit//not
-      @@bit//count-32
-      @@bit//count
       @@bit//left-shift
       @@bit//arithmetic-right-shift-32
       @@bit//arithmetic-right-shift
diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux
index 729acd978..bcc555fe2 100644
--- a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux
@@ -174,15 +174,10 @@
   [bit//logical-right-shift    runtimeT.bit//logical-right-shift]
   )
 
-(def: bit//count
-  Unary
-  runtimeT.bit//count)
-
 (def: bit-procs
   Bundle
   (<| (prefix "bit")
       (|> (dict.new text.Hash<Text>)
-          (install "count" (unary bit//count))
           (install "and" (binary bit//and))
           (install "or" (binary bit//or))
           (install "xor" (binary bit//xor))
diff --git a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux
index ac8f7b11a..ef840d210 100644
--- a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux
@@ -157,14 +157,6 @@
           @@product//right "\n"
           @@sum//get "\n"))
 
-(runtime: (bit//count subject)
-  (ruby.block! (list (ruby.set! (list "count") (ruby.int 0))
-                     (ruby.while! (ruby.> (ruby.int 0) subject)
-                                  (ruby.block! (list (ruby.set! (list "count") (ruby.+ (ruby.% (ruby.int 2) subject)
-                                                                                       "count"))
-                                                     (ruby.set! (list subject) (ruby./ (ruby.int 2) subject)))))
-                     (ruby.return! "count"))))
-
 (runtime: (bit//logical-right-shift param subject)
   (let [mask (|> (ruby.int 1)
                  (ruby.bit-shl (ruby.- param (ruby.int 64)))
@@ -175,8 +167,7 @@
 
 (def: runtime//bit
   Runtime
-  (format @@bit//count
-          @@bit//logical-right-shift))
+  @@bit//logical-right-shift)
 
 (runtime: (text//index subject param start)
   (ruby.block! (list (ruby.set! (list "idx") (ruby.send "index" (list param start) subject))
diff --git a/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux
index 81d753b7b..727f6fc40 100644
--- a/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux
@@ -178,7 +178,6 @@
   Bundle
   (<| (prefix "bit")
       (|> (dict.new text.Hash<Text>)
-          (install "count" (unary (_.apply1 (_.global "bit-count"))))
           (install "and" (binary bit//and))
           (install "or" (binary bit//or))
           (install "xor" (binary bit//xor))
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)))))