bitwise-enum 1.0.0.1 → 1.0.0.2

raw patch · 4 files changed

+58/−28 lines, 4 filesdep ~aesonPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

Data/Enum/Set/Base.hs +18/−21
README.md +2/−0
bitwise-enum.cabal +6/−6
tests/set-properties.hs +32/−1

Data/Enum/Set/Base.hs view

@@ -157,7 +157,7 @@     deriving (Eq, Ord, Data, Storable, NFData, P.Prim, Unbox)
 
 newtype instance MVector s (EnumSet word a) = MV_EnumSet (P.MVector s (EnumSet word a))
-newtype instance Vector    (EnumSet word a) = V_EnumSet (P.Vector (EnumSet word a))
+newtype instance Vector    (EnumSet word a) = V_EnumSet  (P.Vector    (EnumSet word a))
 
 instance P.Prim word => M.MVector MVector (EnumSet word a) where
     basicLength (MV_EnumSet v) = M.basicLength v
@@ -566,13 +566,13 @@ -- | /O(1)/. The minimal element of a non-empty set.
 minimum :: ∀ w a. (FiniteBits w, Num w, Enum a)
         => EnumSet w a -> a
-minimum (EnumSet 0) = error "empty EnumSet"
+minimum (EnumSet 0) = errorEmpty
 minimum (EnumSet w) = toEnum $ lsb w
 
 -- | /O(1)/. The maximal element of a non-empty set.
 maximum :: ∀ w a. (FiniteBits w, Num w, Enum a)
         => EnumSet w a -> a
-maximum (EnumSet 0) = error "empty EnumSet"
+maximum (EnumSet 0) = errorEmpty
 maximum (EnumSet w) = toEnum $ msb w
 
 -- | /O(1)/. Delete the minimal element.
@@ -623,30 +623,21 @@   Utility functions
 --------------------------------------------------------------------}
 
+-- | Least significant bit. 
 lsb :: ∀ w. (FiniteBits w, Num w) => w -> Int
-lsb n0 = go 0 n0 $ finiteBitSize n0 `quot` 2
-  where
-    go b n 1 = case n .&. 1 of
-        0 -> 1 + b
-        _ -> b
-    go b n i = case n .&. (bit i - 1) of
-        0 -> go (i + b) (n `unsafeShiftR` i) (i `quot` 2)
-        _ -> go b       n                    (i `quot` 2)
+lsb = countTrailingZeros
 {-# INLINE lsb #-}
 
+-- | Most significant bit.
 msb :: ∀ w. (FiniteBits w, Num w) => w -> Int
-msb n0 = go 0 n0 $ finiteBitSize n0 `quot` 2
-  where
-    go b n 1 = case n .&. 2 of
-        0 -> b
-        _ -> 1 + b
-    go b n i = case n .&. (bit (i * 2) - bit i) of
-        0 -> go b       n                    (i `quot` 2)
-        _ -> go (i + b) (n `unsafeShiftR` i) (i `quot` 2)
+msb w = finiteBitSize w - 1 - countLeadingZeros w
 {-# INLINE msb #-}
 
+-- These folding algorithms are similar to those of [IntSet](https://hackage.haskell.org/package/containers-0.6.0.1/docs/src/Data.IntSet.Internal.html), but generalized to work with any FiniteBits type.
+
+-- | Left fold over bits.
 foldlBits :: ∀ w a. (FiniteBits w, Num w) => (a -> Int -> a) -> a -> w -> a
-foldlBits  f z w = let lb = lsb w in go lb z (w `unsafeShiftR` lb)
+foldlBits f z w = let lb = lsb w in go lb z (w `unsafeShiftR` lb)
   where
     go !_ acc 0 = acc
     go bi acc n
@@ -654,6 +645,7 @@       | otherwise     = go (bi + 1)    acc     (n `unsafeShiftR` 1)
 {-# INLINE foldlBits #-}
 
+-- | Left fold over bits. The accumulator is evaluated to WHNF at every step.
 foldlBits' :: ∀ w a. (FiniteBits w, Num w) => (a -> Int -> a) -> a -> w -> a
 foldlBits' f z w = let lb = lsb w in go lb z (w `unsafeShiftR` lb)
   where
@@ -663,6 +655,7 @@       | otherwise     = go (bi + 1)    acc     (n `unsafeShiftR` 1)
 {-# INLINE foldlBits' #-}
 
+-- | Right fold over bits.
 foldrBits :: ∀ w a. (FiniteBits w, Num w) => (Int -> a -> a) -> a -> w -> a
 foldrBits f z w = let lb = lsb w in go lb (w `unsafeShiftR` lb)
   where
@@ -672,6 +665,7 @@       | otherwise     =       go (bi + 1) (n `unsafeShiftR` 1)
 {-# INLINE foldrBits #-}
 
+-- | Right fold over bits. The accumulator is evaluated to WHNF at every step.
 foldrBits' :: ∀ w a. (FiniteBits w, Num w) => (Int -> a -> a) -> a -> w -> a
 foldrBits' f z w = let lb = lsb w in go lb (w `unsafeShiftR` lb)
   where
@@ -683,8 +677,11 @@ 
 fold1Aux :: ∀ w a. (Bits w, Num w, Enum a)
          => (w -> Int) -> (a -> w -> a) -> EnumSet w a -> a
-fold1Aux _      _ (EnumSet 0) = error "empty EnumSet"
+fold1Aux _      _ (EnumSet 0) = errorEmpty
 fold1Aux getBit f (EnumSet w) = f (toEnum gotBit) (clearBit w gotBit)
   where
     gotBit = getBit w
 {-# INLINE fold1Aux #-}
+
+errorEmpty :: a
+errorEmpty = error "Data.Enum.Set: empty EnumSet"

+ README.md view

@@ -0,0 +1,2 @@+# bitwise-enum+Bitwise operations on bounded enumerations.

bitwise-enum.cabal view

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 9b82c027b0aa45bb8bc26748d7718c70bcdfee8ba5cd2f213ea3af492e424074+-- hash: 9237fd9d9cd252842f0b67b2fd19ebd650593bdbba3be2567dee83b5ff6288f2  name:           bitwise-enum-version:        1.0.0.1+version:        1.0.0.2 synopsis:       Bitwise operations on bounded enumerations description:    Bitwise operations on bounded enumerations.                 .@@ -38,7 +38,7 @@       ./   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-uni-patterns -Wincomplete-record-updates -ferror-spans -funbox-small-strict-fields -O2   build-depends:-      aeson >=0.11 && <1.4.8+      aeson >=0.11 && <1.5.5     , array >=0.5.1 && <0.5.5     , base >=4.5 && <5     , deepseq >=1.1 && <1.4.5@@ -56,7 +56,7 @@   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-uni-patterns -Wincomplete-record-updates -ferror-spans -funbox-small-strict-fields   build-depends:       QuickCheck >=2.13.2-    , aeson >=0.11 && <1.4.8+    , aeson >=0.11 && <1.5.5     , array >=0.5.1 && <0.5.5     , base     , bitwise-enum@@ -76,7 +76,7 @@       benchmarks   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-uni-patterns -Wincomplete-record-updates -ferror-spans -funbox-small-strict-fields -rtsopts -threaded -with-rtsopts=-N -O2   build-depends:-      aeson >=0.11 && <1.4.8+      aeson >=0.11 && <1.5.5     , array >=0.5.1 && <0.5.5     , base     , bitwise-enum

tests/set-properties.hs view

@@ -1,9 +1,13 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE BlockArguments             #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MonadComprehensions        #-}
 
 import Prelude
 
-import Data.List ((\\), foldl', nub, sort)
+import Control.Applicative ((<|>))
+import Data.Foldable (foldl', foldr')
+import Data.List ((\\), nub, sort)
 import Data.Bits
 import Test.Framework
 import Test.Framework.Providers.QuickCheck2
@@ -42,6 +46,10 @@     , testProperty "foldl'" prop_foldl'
     , testProperty "foldr" prop_foldr
     , testProperty "foldr'" prop_foldr'
+    , testProperty "foldl_origin" prop_foldl_origin
+    , testProperty "foldl'_origin" prop_foldl'_origin
+    , testProperty "foldr_origin" prop_foldr_origin
+    , testProperty "foldr'_origin" prop_foldr'_origin
       -- Special folds
     , testProperty "foldMap" prop_foldMap
     , testProperty "traverse" prop_traverse
@@ -192,6 +200,18 @@ prop_foldr' :: ES -> Bool
 prop_foldr' s = E.foldr' (:) [] s == E.toList s
 
+prop_foldl_origin :: Fun Key Bool -> ES -> Bool
+prop_foldl_origin = originHelper id E.foldl foldl
+
+prop_foldl'_origin :: Fun Key Bool -> ES -> Bool
+prop_foldl'_origin = originHelper id E.foldl' foldl'
+
+prop_foldr_origin :: Fun Key Bool -> ES -> Bool
+prop_foldr_origin = originHelper flip E.foldr foldr
+
+prop_foldr'_origin :: Fun Key Bool -> ES -> Bool
+prop_foldr'_origin = originHelper flip E.foldr' foldr'
+
 -- * Special folds
 
 prop_all :: Fun Key Bool -> ES -> Property
@@ -234,3 +254,14 @@ 
 prop_readShow :: ES -> Bool
 prop_readShow s = s == read (show s)
+
+-- * Utility functions
+
+originHelper :: ((Maybe Key -> Key -> Maybe Key) -> f)
+             -> (f -> Maybe Key -> ES -> Maybe Key)
+             -> (f -> Maybe Key -> [Key] -> Maybe Key)
+             -> Fun Key Bool -> ES -> Bool
+originHelper reorder fSet fList p s = 
+    fSet f Nothing s == fList f Nothing (E.toList s)
+  where
+    f = reorder \acc x -> acc <|> [x | apply p x]