diff options
Diffstat (limited to '')
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))))) |