ref: 7115fd25751ee10e86c446d8ca601bde75d28ecd
parent: f84ee220398dbb33b8c871a80cd2071dfeb8aa5e
author: Lennart Augustsson <lennart@augustsson.net>
date: Sat Nov 4 08:52:50 EDT 2023
Add Bits class
--- /dev/null
+++ b/lib/Data/Bits.hs
@@ -1,0 +1,93 @@
+module Data.Bits(module Data.Bits) where
+import Primitives
+import Control.Error
+import Data.Bool
+import Data.Eq
+import Data.Int()
+import Data.Maybe
+import Data.Ord
+import Data.Num
+
+infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
+infixl 7 .&.
+infixl 6 `xor`
+infixl 5 .|.
+
+class Eq a => Bits a where
+ (.&.) :: a -> a -> a
+ (.|.) :: a -> a -> a
+ xor :: a -> a -> a
+ complement :: a -> a
+ shift :: a -> Int -> a
+ rotate :: a -> Int -> a
+ zeroBits :: a
+ bit :: Int -> a
+ setBit :: a -> Int -> a
+ clearBit :: a -> Int -> a
+ complementBit :: a -> Int -> a
+ testBit :: a -> Int -> Bool
+ shiftL :: a -> Int -> a
+ unsafeShiftL :: a -> Int -> a
+ shiftR :: a -> Int -> a
+ unsafeShiftR :: a -> Int -> a
+ rotateL :: a -> Int -> a
+ rotateR :: a -> Int -> a
+ popCount :: a -> Int
+ bitSizeMaybe :: a -> Maybe Int
+ bitSize :: a -> Int
+
+ x `shift` i | i<0 = x `shiftR` (negate i)
+ | i>0 = x `shiftL` i
+ | otherwise = x
+
+
+ x `rotate` i | i<0 = x `rotateR` (negate i)
+ | i>0 = x `rotateL` i
+ | otherwise = x
+
+ {-+ x `rotate` i | i<0 && isSigned x && x<0
+ = let left = i+bitSize x in
+ ((x `shift` i) .&. complement ((-1) `shift` left))
+ .|. (x `shift` left)
+ | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
+ | i==0 = x
+ | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
+ -}
+
+ zeroBits = clearBit (bit 0) 0
+ bitSize b = fromMaybe (error "bitSize is undefined") (bitSizeMaybe b)
+ x `setBit` i = x .|. bit i
+ x `clearBit` i = x .&. complement (bit i)
+ x `complementBit` i = x `xor` bit i
+
+ x `shiftL` i = x `shift` i
+ x `unsafeShiftL` i = x `shiftL` i
+ x `shiftR` i = x `shift` (negate i)
+ x `unsafeShiftR` i = x `shiftR` i
+
+ x `rotateL` i = x `rotate` i
+
+ x `rotateR` i = x `rotate` (negate i)
+
+
+class Bits b => FiniteBits b where
+ finiteBitSize :: b -> Int
+ countLeadingZeros :: b -> Int
+ countTrailingZeros :: b -> Int
+
+ countLeadingZeros x = (w - 1) - go (w - 1)
+ where
+ go i | i < 0 = i -- no bit set
+ | testBit x i = i
+ | otherwise = go (i - 1)
+
+ w = finiteBitSize x
+
+ countTrailingZeros x = go 0
+ where
+ go i | i >= w = i
+ | testBit x i = i
+ | otherwise = go (i + 1)
+
+ w = finiteBitSize x
--
⑨