aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/bit.lux50
-rw-r--r--stdlib/source/lux/data/coll/dict.lux22
-rw-r--r--stdlib/source/lux/data/coll/vector.lux20
-rw-r--r--stdlib/source/lux/math/random.lux22
-rw-r--r--stdlib/test/test/lux/data/bit.lux92
5 files changed, 111 insertions, 95 deletions
diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux
index 75791d35e..4e87a23dc 100644
--- a/stdlib/source/lux/data/bit.lux
+++ b/stdlib/source/lux/data/bit.lux
@@ -1,4 +1,4 @@
-(;module: [lux #- & | ^])
+(;module: [lux #- and or not])
## [Values]
(do-template [<short-name> <op> <doc> <type>]
@@ -7,12 +7,18 @@
(-> Nat <type> <type>)
(_lux_proc ["bit" <op>] [subject param]))]
- [& "and" "Bitwise and." Nat]
- [| "or" "Bitwise or." Nat]
- [^ "xor" "Bitwise xor." Nat]
- [<< "shift-left" "Bitwise shift-left." Nat]
- [>> "shift-right" "Bitwise shift-right." Int]
- [>>> "unsigned-shift-right" "Bitwise unsigned-shift-right." Nat]
+ [and "and"
+ "Bitwise and." Nat]
+ [or "or"
+ "Bitwise or." Nat]
+ [xor "xor"
+ "Bitwise xor." Nat]
+ [shift-left "shift-left"
+ "Bitwise shift-left." Nat]
+ [shift-right "shift-right"
+ "Bitwise shift-right." Int]
+ [unsigned-shift-right "unsigned-shift-right"
+ "Bitwise unsigned-shift-right." Nat]
)
(def: #export (count subject)
@@ -20,42 +26,42 @@
(-> Nat Nat)
(_lux_proc ["bit" "count"] [subject]))
-(def: mask Nat (int-to-nat -1))
-
-(def: #export ~
+(def: #export not
{#;doc "Bitwise negation."}
(-> Nat Nat)
- (^ mask))
+ (let [mask (int-to-nat -1)]
+ (xor mask)))
(def: #export (clear idx input)
{#;doc "Clear bit at given index."}
(-> Nat Nat Nat)
- (& (~ (<< idx +1)) input))
+ (;;and (;;not (shift-left idx +1))
+ input))
(do-template [<name> <op> <doc>]
[(def: #export (<name> idx input)
{#;doc <doc>}
(-> Nat Nat Nat)
- (<op> (<< idx +1) input))]
+ (<op> (shift-left idx +1) input))]
- [set | "Set bit at given index."]
- [flip ^ "Flip bit at given index."]
+ [set ;;or "Set bit at given index."]
+ [flip ;;xor "Flip bit at given index."]
)
(def: #export (set? idx input)
(-> Nat Nat Bool)
- (|> input (& (<< idx +1)) (n.= +0) not))
+ (|> input (;;and (shift-left idx +1)) (n.= +0) ;not))
(def: rot-top Nat +64)
(do-template [<name> <main> <comp>]
[(def: #export (<name> distance input)
(-> Nat Nat Nat)
- (| (<main> distance input)
- (<comp> (n.- (n.% rot-top distance)
- rot-top)
- input)))]
+ (;;or (<main> distance input)
+ (<comp> (n.- (n.% rot-top distance)
+ rot-top)
+ input)))]
- [rotate-left << >>>]
- [rotate-right >>> <<]
+ [rotate-left shift-left unsigned-shift-right]
+ [rotate-right unsigned-shift-right shift-left]
)
diff --git a/stdlib/source/lux/data/coll/dict.lux b/stdlib/source/lux/data/coll/dict.lux
index 47929c72f..4ebb9a746 100644
--- a/stdlib/source/lux/data/coll/dict.lux
+++ b/stdlib/source/lux/data/coll/dict.lux
@@ -98,18 +98,18 @@
## which is 1/4 of the branching factor (or a left-shift 2).
(def: demotion-threshold
Nat
- (bit;<< (n.- +2 branching-exponent) +1))
+ (bit;shift-left (n.- +2 branching-exponent) +1))
## The threshold on which #Base nodes are promoted to #Hierarchy nodes,
## which is 1/2 of the branching factor (or a left-shift 1).
(def: promotion-threshold
Nat
- (bit;<< (n.- +1 branching-exponent) +1))
+ (bit;shift-left (n.- +1 branching-exponent) +1))
## The size of hierarchy-nodes, which is 2^(branching-exponent).
(def: hierarchy-nodes-size
Nat
- (bit;<< branching-exponent +1))
+ (bit;shift-left branching-exponent +1))
## The cannonical empty node, which is just an empty #Base node.
(def: empty
@@ -162,13 +162,13 @@
## to a particular level, and uses that as an index into the array.
(def: (level-index level hash)
(-> Level Hash-Code Index)
- (bit;& hierarchy-mask
- (bit;>>> level hash)))
+ (bit;and hierarchy-mask
+ (bit;unsigned-shift-right level hash)))
## A mechanism to go from indices to bit-positions.
(def: (->bit-position index)
(-> Index BitPosition)
- (bit;<< index +1))
+ (bit;shift-left index +1))
## The bit-position within a base that a given hash-code would have.
(def: (bit-position level hash)
@@ -177,7 +177,7 @@
(def: (bit-position-is-set? bit bitmap)
(-> BitPosition BitMap Bool)
- (not (n.= clean-bitmap (bit;& bit bitmap))))
+ (not (n.= clean-bitmap (bit;and bit bitmap))))
## Figures out whether a bitmap only contains a single bit-position.
(def: only-bit-position?
@@ -186,11 +186,11 @@
(def: (set-bit-position bit bitmap)
(-> BitPosition BitMap BitMap)
- (bit;| bit bitmap))
+ (bit;or bit bitmap))
(def: unset-bit-position
(-> BitPosition BitMap BitMap)
- bit;^)
+ bit;xor)
## Figures out the size of a bitmap-indexed array by counting all the
## 1s within the bitmap.
@@ -208,8 +208,8 @@
## The index on the base array, based on it's bit-position.
(def: (base-index bit-position bitmap)
(-> BitPosition BitMap Index)
- (bitmap-size (bit;& (bit-position-mask bit-position)
- bitmap)))
+ (bitmap-size (bit;and (bit-position-mask bit-position)
+ bitmap)))
## Produces the index of a KV-pair within a #Collisions node.
(def: (collision-index Hash<K> key colls)
diff --git a/stdlib/source/lux/data/coll/vector.lux b/stdlib/source/lux/data/coll/vector.lux
index d99a4d77a..9d7bcba2c 100644
--- a/stdlib/source/lux/data/coll/vector.lux
+++ b/stdlib/source/lux/data/coll/vector.lux
@@ -51,7 +51,7 @@
(def: full-node-size
Nat
- (bit;<< branching-exponent +1))
+ (bit;shift-left branching-exponent +1))
(def: branch-idx-mask
Nat
@@ -59,7 +59,7 @@
(def: branch-idx
(-> Index Index)
- (bit;& branch-idx-mask))
+ (bit;and branch-idx-mask))
(def: (new-hierarchy _)
(All [a] (-> Top (Hierarchy a)))
@@ -70,8 +70,8 @@
(if (n.< full-node-size vec-size)
+0
(|> (n.dec vec-size)
- (bit;>>> branching-exponent)
- (bit;<< branching-exponent))))
+ (bit;unsigned-shift-right branching-exponent)
+ (bit;shift-left branching-exponent))))
(def: (new-path level tail)
(All [a] (-> Level (Base a) (Node a)))
@@ -90,7 +90,7 @@
(def: (push-tail size level tail parent)
(All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a)))
- (let [sub-idx (branch-idx (bit;>>> level (n.dec size)))
+ (let [sub-idx (branch-idx (bit;unsigned-shift-right level (n.dec size)))
## If we're currently on a bottom node
sub-node (if (n.= branching-exponent level)
## Just add the tail to it
@@ -121,7 +121,7 @@
(def: (put' level idx val hierarchy)
(All [a] (-> Level Index a (Hierarchy a) (Hierarchy a)))
- (let [sub-idx (branch-idx (bit;>>> level idx))]
+ (let [sub-idx (branch-idx (bit;unsigned-shift-right level idx))]
(case (array;get sub-idx hierarchy)
(#;Some (#Hierarchy sub-node))
(|> (array;clone hierarchy)
@@ -139,7 +139,7 @@
(def: (pop-tail size level hierarchy)
(All [a] (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a))))
- (let [sub-idx (branch-idx (bit;>>> level (n.- +2 size)))]
+ (let [sub-idx (branch-idx (bit;unsigned-shift-right level (n.- +2 size)))]
(cond (n.= +0 sub-idx)
#;None
@@ -206,8 +206,8 @@
## Otherwise, push tail into the tree
## --------------------------------------------------------
## Will the root experience an overflow with this addition?
- (|> (if (n.> (bit;<< (get@ #level vec) +1)
- (bit;>>> branching-exponent vec-size))
+ (|> (if (n.> (bit;shift-left (get@ #level vec) +1)
+ (bit;unsigned-shift-right branching-exponent vec-size))
## If so, a brand-new root must be established, that is
## 1-level taller.
(|> vec
@@ -235,7 +235,7 @@
(loop [level (get@ #level vec)
hierarchy (get@ #root vec)]
(case [(n.> branching-exponent level)
- (array;get (branch-idx (bit;>>> level idx)) hierarchy)]
+ (array;get (branch-idx (bit;unsigned-shift-right level idx)) hierarchy)]
[true (#;Some (#Hierarchy sub))]
(recur (level-down level) sub)
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index 372aafbfc..91ef541c7 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -62,7 +62,7 @@
(function [prng]
(let [[prng left] (prng [])
[prng right] (prng [])]
- [prng (n.+ (bit;<< +32 left)
+ [prng (n.+ (bit;shift-left +32 left)
right)])))
(def: #export int
@@ -70,20 +70,20 @@
(function [prng]
(let [[prng left] (prng [])
[prng right] (prng [])]
- [prng (nat-to-int (n.+ (bit;<< +32 left)
+ [prng (nat-to-int (n.+ (bit;shift-left +32 left)
right))])))
(def: #export bool
(Random Bool)
(function [prng]
(let [[prng output] (prng [])]
- [prng (|> output (bit;& +1) (n.= +1))])))
+ [prng (|> output (bit;and +1) (n.= +1))])))
(def: (bits n)
(-> Nat (Random Nat))
(function [prng]
(let [[prng output] (prng [])]
- [prng (bit;>>> (n.- n +64) output)])))
+ [prng (bit;unsigned-shift-right (n.- n +64) output)])))
(def: #export real
(Random Real)
@@ -91,10 +91,10 @@
[left (bits +26)
right (bits +27)]
(wrap (|> right
- (n.+ (bit;<< +27 left))
+ (n.+ (bit;shift-left +27 left))
nat-to-int
int-to-real
- (r./ (|> +1 (bit;<< +53) nat-to-int int-to-real))))))
+ (r./ (|> +1 (bit;shift-left +53) nat-to-int int-to-real))))))
(def: #export deg
(Random Deg)
@@ -259,8 +259,8 @@
(-> [Nat Nat] PRNG)
(function [_]
(let [seed' (|> seed (n.* pcg-32-magic-mult) (n.+ inc))
- xor-shifted (|> seed (bit;>>> +18) (bit;^ seed) (bit;>>> +27))
- rot (|> seed (bit;>>> +59))]
+ xor-shifted (|> seed (bit;unsigned-shift-right +18) (bit;xor seed) (bit;unsigned-shift-right +27))
+ rot (|> seed (bit;unsigned-shift-right +59))]
[(pcg-32 [inc seed']) (bit;rotate-right rot xor-shifted)]
)))
@@ -272,10 +272,10 @@
(-> [Nat Nat] PRNG)
(function [_]
(let [result (n.+ s0 s1)
- s01 (bit;^ s0 s1)
+ s01 (bit;xor s0 s1)
s0' (|> (bit;rotate-left +55 s0)
- (bit;^ s01)
- (bit;^ (bit;<< +14 s01)))
+ (bit;xor s01)
+ (bit;xor (bit;shift-left +14 s01)))
s1' (bit;rotate-left +36 s01)]
[(xoroshiro-128+ [s0' s1']) result])
))
diff --git a/stdlib/test/test/lux/data/bit.lux b/stdlib/test/test/lux/data/bit.lux
index 0c9f5ac3d..2ba2c8e57 100644
--- a/stdlib/test/test/lux/data/bit.lux
+++ b/stdlib/test/test/lux/data/bit.lux
@@ -13,49 +13,59 @@
[pattern R;nat
idx (:: @ map (n.% width) R;nat)]
($_ seq
- (assert "" (and (n.< (&;count (&;set idx pattern))
- (&;count (&;clear idx pattern)))
- (n.<= (&;count pattern)
- (&;count (&;clear idx pattern)))
- (n.>= (&;count pattern)
- (&;count (&;set idx pattern)))
+ (assert "Clearing and settings bits should alter the count."
+ (and (n.< (&;count (&;set idx pattern))
+ (&;count (&;clear idx pattern)))
+ (n.<= (&;count pattern)
+ (&;count (&;clear idx pattern)))
+ (n.>= (&;count pattern)
+ (&;count (&;set idx pattern)))))
+ (assert "Can query whether a bit is set."
+ (and (or (and (&;set? idx pattern)
+ (not (&;set? idx (&;clear idx pattern))))
+ (and (not (&;set? idx pattern))
+ (&;set? idx (&;set idx pattern))))
- (or (and (&;set? idx pattern)
- (not (&;set? idx (&;clear idx pattern))))
- (and (not (&;set? idx pattern))
- (&;set? idx (&;set idx pattern))))
-
- (or (and (&;set? idx pattern)
- (not (&;set? idx (&;flip idx pattern))))
- (and (not (&;set? idx pattern))
- (&;set? idx (&;flip idx pattern))))
-
- (n.= width
- (n.+ (&;count pattern)
- (&;count (&;~ pattern))))
-
- (n.= +0
- (&;& pattern
- (&;~ pattern)))
- (n.= (&;~ +0)
- (&;| pattern
- (&;~ pattern)))
- (n.= (&;~ +0)
- (&;^ pattern
- (&;~ pattern)))
- (n.= +0
- (&;^ pattern
- pattern))
-
- (|> pattern (&;rotate-left idx) (&;rotate-right idx) (n.= pattern))
- (|> pattern (&;rotate-right idx) (&;rotate-left idx) (n.= pattern))
- (|> pattern (&;rotate-left idx) (&;rotate-left (n.- idx width)) (n.= pattern))
- (|> pattern (&;rotate-right idx) (&;rotate-right (n.- idx width)) (n.= pattern))
- ))
-
+ (or (and (&;set? idx pattern)
+ (not (&;set? idx (&;flip idx pattern))))
+ (and (not (&;set? idx pattern))
+ (&;set? idx (&;flip idx pattern))))))
+ (assert "The negation of a bit pattern should have a complementary bit count."
+ (n.= width
+ (n.+ (&;count pattern)
+ (&;count (&;not pattern)))))
+ (assert "Can do simple binary boolean logic."
+ (and (n.= +0
+ (&;and pattern
+ (&;not pattern)))
+ (n.= (&;not +0)
+ (&;or pattern
+ (&;not pattern)))
+ (n.= (&;not +0)
+ (&;xor pattern
+ (&;not pattern)))
+ (n.= +0
+ (&;xor pattern
+ pattern))))
+ (assert "rotate-left and rotate-right are inverses of one another."
+ (and (|> pattern
+ (&;rotate-left idx)
+ (&;rotate-right idx)
+ (n.= pattern))
+ (|> pattern
+ (&;rotate-right idx)
+ (&;rotate-left idx)
+ (n.= pattern))))
+ (assert "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged."
+ (and (|> pattern
+ (&;rotate-left width)
+ (n.= pattern))
+ (|> pattern
+ (&;rotate-right width)
+ (n.= pattern))))
(assert "Shift right respect the sign of ints."
(let [value (nat-to-int pattern)]
(if (i.< 0 value)
- (i.< 0 (&;>> idx value))
- (i.>= 0 (&;>> idx value)))))
+ (i.< 0 (&;shift-right idx value))
+ (i.>= 0 (&;shift-right idx value)))))
))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 11:25:11 +0000