shithub: MicroHs

Download patch

ref: 1aa307355c68e60a2cfb8be104ad6f2783d7bd14
parent: cfd47722e3147d6ac70239ac5209947a12cd21a5
author: konsumlamm <konsumlamm@gmail.com>
date: Mon Jan 13 18:51:16 EST 2025

Define & use `bitDefault`, `testBitDefault`, `popCountDefault`

--- a/lib/Data/Bits.hs
+++ b/lib/Data/Bits.hs
@@ -93,6 +93,18 @@
 
       w = finiteBitSize x
 
+bitDefault :: (Bits a, Num a) => Int -> a
+bitDefault i = 1 `shiftL` i
+
+testBitDefault :: (Bits a, Num a) => a -> Int -> Bool
+testBitDefault x i = (x .&. bit i) /= 0
+
+popCountDefault :: (Bits a, Num a) => a -> Int
+popCountDefault = go 0
+  where
+    go c 0 = c
+    go c w = go (c + 1) (w .&. (w - 1)) -- clear the least significant bit
+
 _overflowError :: a
 _overflowError = error "arithmetic overflow"
 
@@ -113,7 +125,9 @@
   unsafeShiftR = primIntShr
   bitSizeMaybe _ = Just _wordSize
   bitSize _ = _wordSize
-  bit n = primIntShl 1 n
+  bit = bitDefault
+  testBit = testBitDefault
+  popCount = popCountDefault
   zeroBits = 0
 
 instance FiniteBits Int where
--- a/lib/Data/Int/Instances.hs
+++ b/lib/Data/Int/Instances.hs
@@ -106,7 +106,9 @@
   unsafeShiftR = bini8 primIntShr
   bitSizeMaybe _ = Just 8
   bitSize _ = 8
-  bit n = i8 (primIntShl 1 n)
+  bit = bitDefault
+  testBit = testBitDefault
+  popCount = popCountDefault
   zeroBits = 0
 
 instance FiniteBits Int8 where
@@ -198,7 +200,9 @@
   unsafeShiftR = bini16 primIntShr
   bitSizeMaybe _ = Just 16
   bitSize _ = 16
-  bit n = i16 (primIntShl 1 n)
+  bit = bitDefault
+  testBit = testBitDefault
+  popCount = popCountDefault
   zeroBits = 0
 
 instance FiniteBits Int16 where
@@ -290,7 +294,9 @@
   unsafeShiftR = bini32 primIntShr
   bitSizeMaybe _ = Just 32
   bitSize _ = 32
-  bit n = i32 (primIntShl 1 n)
+  bit = bitDefault
+  testBit = testBitDefault
+  popCount = popCountDefault
   zeroBits = 0
 
 instance FiniteBits Int32 where
@@ -381,7 +387,9 @@
   unsafeShiftR = bini64 primIntShr
   bitSizeMaybe _ = Just 64
   bitSize _ = 64
-  bit n = i64 (primIntShl 1 n)
+  bit = bitDefault
+  testBit = testBitDefault
+  popCount = popCountDefault
   zeroBits = 0
 
 instance FiniteBits Int64 where
--- a/lib/Data/Word.hs
+++ b/lib/Data/Word.hs
@@ -95,7 +95,9 @@
   unsafeShiftR = primWordShr
   bitSizeMaybe _ = Just _wordSize
   bitSize _ = _wordSize
-  bit n = primWordShl 1 n
+  bit = bitDefault
+  testBit = testBitDefault
+  popCount = popCountDefault
   zeroBits = 0
 
 instance FiniteBits Word where
@@ -189,7 +191,9 @@
   unsafeShiftR = bini8 primWordShr
   bitSizeMaybe _ = Just 8
   bitSize _ = 8
-  bit n = w8 (primWordShl 1 n)
+  bit = bitDefault
+  testBit = testBitDefault
+  popCount = popCountDefault
   zeroBits = 0
 
 instance FiniteBits Word8 where
@@ -282,7 +286,9 @@
   unsafeShiftR = bini16 primWordShr
   bitSizeMaybe _ = Just 16
   bitSize _ = 16
-  bit n = w16 (primWordShl 1 n)
+  bit = bitDefault
+  testBit = testBitDefault
+  popCount = popCountDefault
   zeroBits = 0
 
 instance FiniteBits Word16 where
@@ -376,7 +382,9 @@
   unsafeShiftR = bini32 primWordShr
   bitSizeMaybe _ = Just 32
   bitSize _ = 32
-  bit n = w32 (primWordShl 1 n)
+  bit = bitDefault
+  testBit = testBitDefault
+  popCount = popCountDefault
   zeroBits = 0
 
 instance FiniteBits Word32 where
@@ -470,7 +478,9 @@
   unsafeShiftR = bini64 primWordShr
   bitSizeMaybe _ = Just 64
   bitSize _ = 64
-  bit n = w64 (primWordShl 1 n)
+  bit = bitDefault
+  testBit = testBitDefault
+  popCount = popCountDefault
   zeroBits = 0
 
 instance FiniteBits Word64 where