bitwise-enum (empty) → 0.1.0.0

raw patch · 9 files changed

+1694/−0 lines, 9 filesdep +QuickCheckdep +aesondep +arraysetup-changed

Dependencies added: QuickCheck, aeson, array, base, bitwise-enum, deepseq, gauge, mono-traversable, test-framework, test-framework-quickcheck2, vector, wide-word

Files

Data/Enum/Memo.hs +172/−0
Data/Enum/Set.hs +384/−0
Data/Enum/Set/Base.hs +691/−0
LICENSE +30/−0
README.md +2/−0
Setup.hs +4/−0
benchmarks/EnumSet.hs +95/−0
bitwise-enum.cabal +80/−0
tests/set-properties.hs +236/−0

+ Data/Enum/Memo.hs view

@@ -0,0 +1,172 @@+{-# LANGUAGE ExplicitForAll      #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UnicodeSyntax       #-}
+{-# LANGUAGE TypeApplications    #-}
+
+-- | Immutable lazy tables of functions over bounded enumerations.
+-- Function calls are stored as thunks and not evaluated until accessed.
+--
+-- The underlying representation is an 'Data.Array.Array' rather than a search
+-- tree. This provides /O(1)/ lookup but means that the range of keys should not
+-- be very large, as in the case of an 'Int'-like type.
+module Data.Enum.Memo
+  ( -- * Memoization
+    memoize
+    -- * Higher-order
+  , memoize2
+  , memoize3
+  , memoize4
+  , memoize5
+  ) where
+
+import Prelude hiding (lookup)
+
+import Data.Array ((!), array)
+
+-- | Memoize a function with a single argument.
+memoize :: ∀ k v. (Bounded k, Enum k) => (k -> v) -> k -> v
+memoize f = case array bounds vals of
+    memo -> \k -> memo ! fromEnum k
+  where
+    bounds = (fromEnum @k minBound, fromEnum @k maxBound)
+    vals   = [(fromEnum k, f k) | k <- [minBound..maxBound]]
+
+-- | Memoize a function with two arguments.
+memoize2 :: ∀ k1 k2 v.
+            ( Bounded k1, Enum k1
+            , Bounded k2, Enum k2
+            )
+         => (k1 -> k2 -> v) -> k1 -> k2 -> v
+memoize2 f = case array bounds vals of
+    memo -> \k1 k2 -> memo !
+            ( fromEnum k1
+            , fromEnum k2
+            )
+  where
+    bounds = ( ( fromEnum @k1 minBound
+               , fromEnum @k2 minBound
+               )
+             , ( fromEnum @k1 maxBound
+               , fromEnum @k2 maxBound
+               )
+             )
+    vals   = [( ( fromEnum k1
+                , fromEnum k2
+                )
+              , f k1 k2
+              ) | k1 <- [minBound..maxBound]
+                , k2 <- [minBound..maxBound]]
+
+-- | Memoize a function with three arguments.
+memoize3 :: ∀ k1 k2 k3 v.
+            ( Bounded k1, Enum k1
+            , Bounded k2, Enum k2
+            , Bounded k3, Enum k3
+            )
+         => (k1 -> k2 -> k3 -> v) -> k1 -> k2 -> k3 -> v
+memoize3 f = case array bounds vals of
+    memo -> \k1 k2 k3 -> memo !
+            ( fromEnum k1
+            , fromEnum k2
+            , fromEnum k3
+            )
+  where
+    bounds = ( ( fromEnum @k1 minBound
+               , fromEnum @k2 minBound
+               , fromEnum @k3 minBound
+               )
+             , ( fromEnum @k1 maxBound
+               , fromEnum @k2 maxBound
+               , fromEnum @k3 maxBound
+               )
+             )
+    vals   = [( ( fromEnum k1
+                , fromEnum k2
+                , fromEnum k3
+                )
+              , f k1 k2 k3
+              ) | k1 <- [minBound..maxBound]
+                , k2 <- [minBound..maxBound]
+                , k3 <- [minBound..maxBound]]
+
+-- | Memoize a function with four arguments.
+memoize4 :: ∀ k1 k2 k3 k4 v.
+            ( Bounded k1, Enum k1
+            , Bounded k2, Enum k2
+            , Bounded k3, Enum k3
+            , Bounded k4, Enum k4
+            )
+         => (k1 -> k2 -> k3 -> k4 -> v) -> k1 -> k2 -> k3 -> k4 -> v
+memoize4 f = case array bounds vals of
+    memo -> \k1 k2 k3 k4 -> memo !
+            ( fromEnum k1
+            , fromEnum k2
+            , fromEnum k3
+            , fromEnum k4
+            )
+  where
+    bounds = ( ( fromEnum @k1 minBound
+               , fromEnum @k2 minBound
+               , fromEnum @k3 minBound
+               , fromEnum @k4 minBound
+               )
+             , ( fromEnum @k1 maxBound
+               , fromEnum @k2 maxBound
+               , fromEnum @k3 maxBound
+               , fromEnum @k4 maxBound
+               )
+             )
+    vals   = [( ( fromEnum k1
+                , fromEnum k2
+                , fromEnum k3
+                , fromEnum k4
+                )
+              , f k1 k2 k3 k4
+              ) | k1 <- [minBound..maxBound]
+                , k2 <- [minBound..maxBound]
+                , k3 <- [minBound..maxBound]
+                , k4 <- [minBound..maxBound]]
+
+-- | Memoize a function with five arguments.
+memoize5 :: ∀ k1 k2 k3 k4 k5 v.
+            ( Bounded k1, Enum k1
+            , Bounded k2, Enum k2
+            , Bounded k3, Enum k3
+            , Bounded k4, Enum k4
+            , Bounded k5, Enum k5
+            )
+         => (k1 -> k2 -> k3 -> k4 -> k5 -> v) -> k1 -> k2 -> k3 -> k4 -> k5 -> v
+memoize5 f = case array bounds vals of
+    memo -> \k1 k2 k3 k4 k5 -> memo !
+            ( fromEnum k1
+            , fromEnum k2
+            , fromEnum k3
+            , fromEnum k4
+            , fromEnum k5
+            )
+  where
+    bounds = ( ( fromEnum @k1 minBound
+               , fromEnum @k2 minBound
+               , fromEnum @k3 minBound
+               , fromEnum @k4 minBound
+               , fromEnum @k5 minBound
+               )
+             , ( fromEnum @k1 maxBound
+               , fromEnum @k2 maxBound
+               , fromEnum @k3 maxBound
+               , fromEnum @k4 maxBound
+               , fromEnum @k5 maxBound
+               )
+             )
+    vals   = [( ( fromEnum k1
+                , fromEnum k2
+                , fromEnum k3
+                , fromEnum k4
+                , fromEnum k5
+                )
+              , f k1 k2 k3 k4 k5
+              ) | k1 <- [minBound..maxBound]
+                , k2 <- [minBound..maxBound]
+                , k3 <- [minBound..maxBound]
+                , k4 <- [minBound..maxBound]
+                , k5 <- [minBound..maxBound]]

+ Data/Enum/Set.hs view

@@ -0,0 +1,384 @@+{-# LANGUAGE ExplicitForAll   #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies     #-}
+{-# LANGUAGE UnicodeSyntax    #-}
+
+-- | Efficient sets over bounded enumerations, using bitwise operations based on
+-- [containers](https://hackage.haskell.org/package/containers-0.6.0.1/docs/src/Data.IntSet.Internal.html)
+-- and
+-- [EdisonCore](https://hackage.haskell.org/package/EdisonCore-1.3.2.1/docs/src/Data-Edison-Coll-EnumSet.html).
+-- In many cases, @EnumSet@s may be optimised away entirely by constant folding
+-- at compile-time. For example, in the following code:
+--
+-- @
+-- import Data.Enum.Set as E
+--
+-- data Foo = A | B | C | D | E | F | G | H deriving (Bounded, Enum, Eq, Ord)
+--
+-- instance E.AsEnumSet Foo
+--
+-- addFoos :: E.EnumSet Foo -> E.EnumSet Foo
+-- addFoos = E.delete A . E.insert B
+--
+-- bar :: E.EnumSet Foo
+-- bar = addFoos $ E.fromFoldable [A, C, E]
+--
+-- barHasA :: Bool
+-- barHasA = E.member A bar
+-- @
+--
+-- With @-O@ or @-O2@, @bar@ will compile to @GHC.Types.W\# 22\#\#@ and
+-- @barHasA@ will compile to @GHC.Types.False@.
+--
+-- By default, 'Word's are used as the representation. Other representations may
+-- be chosen in the class instance:
+--
+-- @
+-- {-\# LANGUAGE TypeFamilies \#-}
+--
+-- import Data.Enum.Set as E
+-- import Data.Word (Word64)
+--
+-- data Foo = A | B | C | D | E | F | G | H deriving (Bounded, Enum, Eq, Ord, Show)
+--
+-- instance E.AsEnumSet Foo where
+--     type EnumSetRep Foo = Word64
+--
+-- @
+--
+-- For type @EnumSet E@, @EnumSetRep E@ should be a @Word@-like type that
+-- implements 'Bits' and 'Num', and @E@ should be a type that implements 'Eq'
+-- and 'Enum' equivalently and is a bijection to 'Int'.
+-- @EnumSet E@ can only store a value of @E@ if the result of applying
+-- 'fromEnum' to the value is positive and less than the number of bits in
+-- @EnumSetRep E@. For this reason, it is preferable for @E@ to be a type that
+-- derives @Eq@ and @Enum@, and for @EnumSetRep E@ to have more bits than the
+-- number of constructors of @E@.
+--
+-- If the highest @fromEnum@ value of @E@ is 29, @EnumSetRep E@ should be
+-- 'Word', because it always has at least 30 bits. This is the
+-- default implementation.
+-- Otherwise, options include 'Data.Word.Word32', 'Data.Word.Word64', and the
+-- [wide-word](https://hackage.haskell.org/package/wide-word-0.1.0.8/) package's
+-- [Data.WideWord.Word128](https://hackage.haskell.org/package/wide-word-0.1.0.8/docs/Data-WideWord-Word128.html).
+-- Foreign types may also be used.
+--
+-- Note: complexity calculations assume that @EnumSetRep E@ implements 'Bits'
+-- with constant-time functions, as is the case with @Word@ etc. Otherwise, the
+-- complexity of those operations should be added to the complexity of @EnumSet@
+-- functions.
+module Data.Enum.Set
+  ( AsEnumSet(..)
+  -- * Set type
+  , EnumSet
+    -- * Construction
+  , empty
+  , singleton
+  , fromFoldable
+
+  -- * Insertion
+  , insert
+
+  -- * Deletion
+  , delete
+
+  -- * Query
+  , member
+  , notMember
+  , null
+  , size
+  , isSubsetOf
+
+  -- * Combine
+  , union
+  , difference
+  , (\\)
+  , symmetricDifference
+  , intersection
+
+  -- * Filter
+  , filter
+  , partition
+
+  -- * Map
+  , map
+
+  -- * Folds
+  , foldl, foldl', foldr, foldr'
+  , foldl1, foldl1', foldr1, foldr1'
+
+  -- ** Special folds
+  , foldMap
+  , traverse
+  , any
+  , all
+
+   -- * Min/Max
+  , minimum
+  , maximum
+  , deleteMin
+  , deleteMax
+  , minView
+  , maxView
+
+  -- * Conversion
+  , toList
+  , fromRaw
+  ) where
+
+import Prelude hiding (all, any, filter, foldl, foldl1, foldMap, foldr, foldr1, map, maximum, minimum, null, traverse)
+
+import Data.Bits
+import Data.Monoid (Monoid(..))
+
+import qualified Data.Enum.Set.Base as E
+
+class (Enum a, FiniteBits (EnumSetRep a), Num (EnumSetRep a)) => AsEnumSet a where
+    type EnumSetRep a
+    type EnumSetRep a = Word
+
+type EnumSet a = E.EnumSet (EnumSetRep a) a
+
+{--------------------------------------------------------------------
+  Construction
+--------------------------------------------------------------------}
+
+-- | /O(1)/. The empty set.
+empty :: ∀ a. AsEnumSet a => EnumSet a
+empty = E.empty
+{-# INLINE empty #-}
+
+-- | /O(1)/. A set of one element.
+singleton :: ∀ a. AsEnumSet a => a -> EnumSet a
+singleton = E.singleton
+{-# INLINE singleton #-}
+
+-- | /O(n)/. Create a set from a finite foldable data structure.
+fromFoldable :: ∀ f a. (Foldable f, AsEnumSet a) => f a -> EnumSet a
+fromFoldable = E.fromFoldable
+{-# INLINE fromFoldable #-}
+
+{--------------------------------------------------------------------
+  Insertion
+--------------------------------------------------------------------}
+
+-- | /O(1)/. Add a value to the set.
+insert :: ∀ a. AsEnumSet a => a -> EnumSet a -> EnumSet a
+insert = E.insert
+{-# INLINE insert #-}
+
+{--------------------------------------------------------------------
+  Deletion
+--------------------------------------------------------------------}
+
+-- | /O(1)/. Delete a value in the set.
+delete :: ∀ a. AsEnumSet a => a -> EnumSet a -> EnumSet a
+delete = E.delete
+{-# INLINE delete #-}
+
+{--------------------------------------------------------------------
+  Query
+--------------------------------------------------------------------}
+
+-- | /O(1)/. Is the value a member of the set?
+member :: ∀ a. AsEnumSet a => a -> EnumSet a -> Bool
+member = E.member
+{-# INLINE member #-}
+
+-- | /O(1)/. Is the value not in the set?
+notMember :: ∀ a. AsEnumSet a => a -> EnumSet a -> Bool
+notMember = E.notMember
+{-# INLINE notMember #-}
+
+-- | /O(1)/. Is this the empty set?
+null :: ∀ a. AsEnumSet a => EnumSet a -> Bool
+null = E.null
+{-# INLINE null #-}
+
+-- | /O(1)/. The number of elements in the set.
+size :: ∀ a. AsEnumSet a => EnumSet a -> Int
+size = E.size
+{-# INLINE size #-}
+
+-- | /O(1)/. Is this a subset?
+-- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.
+isSubsetOf :: ∀ a. AsEnumSet a => EnumSet a -> EnumSet a -> Bool
+isSubsetOf = E.isSubsetOf
+{-# INLINE isSubsetOf #-}
+
+{--------------------------------------------------------------------
+  Combine
+--------------------------------------------------------------------}
+
+-- | /O(1)/. The union of two sets.
+union :: ∀ a. AsEnumSet a => EnumSet a -> EnumSet a -> EnumSet a
+union = E.union
+{-# INLINE union #-}
+
+-- | /O(1)/. Difference between two sets.
+difference :: ∀ a. AsEnumSet a => EnumSet a -> EnumSet a -> EnumSet a
+difference = E.difference
+{-# INLINE difference #-}
+
+-- | /O(1)/. See 'difference'.
+(\\) :: ∀ a. AsEnumSet a => EnumSet a -> EnumSet a -> EnumSet a
+(\\) = E.difference
+infixl 9 \\
+{-# INLINE (\\) #-}
+
+-- | /O(1)/. Elements which are in either set, but not both.
+symmetricDifference :: ∀ a. AsEnumSet a => EnumSet a -> EnumSet a -> EnumSet a
+symmetricDifference = E.symmetricDifference
+{-# INLINE symmetricDifference #-}
+
+-- | /O(1)/. The intersection of two sets.
+intersection :: ∀ a. AsEnumSet a => EnumSet a -> EnumSet a -> EnumSet a
+intersection = E.intersection
+{-# INLINE intersection #-}
+
+{--------------------------------------------------------------------
+  Filter
+--------------------------------------------------------------------}
+
+-- | /O(n)/. Filter all elements that satisfy some predicate.
+filter :: ∀ a. AsEnumSet a => (a -> Bool) -> EnumSet a -> EnumSet a
+filter = E.filter
+{-# INLINE filter #-}
+
+-- | /O(n)/. Partition the set according to some predicate.
+-- The first set contains all elements that satisfy the predicate,
+-- the second all elements that fail the predicate.
+partition :: ∀ a. AsEnumSet a
+          => (a -> Bool) -> EnumSet a -> (EnumSet a, EnumSet a)
+partition = E.partition
+{-# INLINE partition #-}
+
+{--------------------------------------------------------------------
+  Map
+--------------------------------------------------------------------}
+
+-- | /O(n)/.
+-- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.
+--
+-- It's worth noting that the size of the result may be smaller if,
+-- for some @(x,y)@, @x \/= y && f x == f y@
+map :: ∀ a b. (AsEnumSet a, AsEnumSet b) => (a -> b) -> EnumSet a -> EnumSet b
+map = E.map'
+
+{--------------------------------------------------------------------
+  Folds
+--------------------------------------------------------------------}
+
+-- | /O(n)/. Left fold.
+foldl :: ∀ a b. AsEnumSet a => (b -> a -> b) -> b -> EnumSet a -> b
+foldl = E.foldl
+{-# INLINE foldl #-}
+
+-- | /O(n)/. Left fold with strict accumulator.
+foldl' :: ∀ a b. AsEnumSet a => (b -> a -> b) -> b -> EnumSet a -> b
+foldl' = E.foldl'
+{-# INLINE foldl' #-}
+
+-- | /O(n)/. Right fold.
+foldr :: ∀ a b. AsEnumSet a => (a -> b -> b) -> b -> EnumSet a -> b
+foldr = E.foldr
+{-# INLINE foldr #-}
+
+-- | /O(n)/. Right fold with strict accumulator.
+foldr' :: ∀ a b. AsEnumSet a => (a -> b -> b) -> b -> EnumSet a -> b
+foldr' = E.foldr'
+{-# INLINE foldr' #-}
+
+-- | /O(n)/. Left fold on non-empty sets.
+foldl1 :: ∀ a. AsEnumSet a => (a -> a -> a) -> EnumSet a -> a
+foldl1 = E.foldl1
+{-# INLINE foldl1 #-}
+
+-- | /O(n)/. Left fold on non-empty sets with strict accumulator.
+foldl1' :: ∀ a. AsEnumSet a => (a -> a -> a) -> EnumSet a -> a
+foldl1' = E.foldl1'
+{-# INLINE foldl1' #-}
+
+-- | /O(n)/. Right fold on non-empty sets.
+foldr1 :: ∀ a. AsEnumSet a => (a -> a -> a) -> EnumSet a -> a
+foldr1 = E.foldr1
+{-# INLINE foldr1 #-}
+
+-- | /O(n)/. Right fold on non-empty sets with strict accumulator.
+foldr1' :: ∀ a. AsEnumSet a => (a -> a -> a) -> EnumSet a -> a
+foldr1' = E.foldr1'
+{-# INLINE foldr1'  #-}
+
+-- | /O(n)/. Map each element of the structure to a monoid, and combine the
+-- results.
+foldMap :: ∀ m a. (Monoid m, AsEnumSet a) => (a -> m) -> EnumSet a -> m
+foldMap = E.foldMap
+{-# INLINE foldMap #-}
+
+traverse :: ∀ f a. (Applicative f, AsEnumSet a)
+         => (a -> f a) -> EnumSet a -> f (EnumSet a)
+traverse = E.traverse
+{-# INLINE traverse #-}
+
+-- | /O(n)/. Check if all elements satisfy some predicate.
+all :: ∀ a. AsEnumSet a => (a -> Bool) -> EnumSet a -> Bool
+all = E.all
+{-# INLINE all #-}
+
+-- | /O(n)/. Check if any element satisfies some predicate.
+any :: ∀ a. AsEnumSet a => (a -> Bool) -> EnumSet a -> Bool
+any = E.any
+{-# INLINE any #-}
+
+{--------------------------------------------------------------------
+  Min/Max
+--------------------------------------------------------------------}
+
+-- | /O(1)/. The minimal element of a non-empty set.
+minimum :: ∀ a. AsEnumSet a => EnumSet a -> a
+minimum = E.minimum
+{-# INLINE minimum #-}
+
+-- | /O(1)/. The maximal element of a non-empty set.
+maximum :: ∀ a. AsEnumSet a => EnumSet a -> a
+maximum = E.maximum
+{-# INLINE maximum #-}
+
+-- | /O(1)/. Delete the minimal element.
+deleteMin :: ∀ a. AsEnumSet a => EnumSet a -> EnumSet a
+deleteMin = E.deleteMin
+{-# INLINE deleteMin #-}
+
+-- | /O(1)/. Delete the maximal element.
+deleteMax :: ∀ a. AsEnumSet a => EnumSet a -> EnumSet a
+deleteMax = E.deleteMax
+{-# INLINE deleteMax #-}
+
+-- | /O(1)/. Retrieves the minimal element of the set,
+-- and the set stripped of that element,
+-- or Nothing if passed an empty set.
+minView :: ∀ a. AsEnumSet a => EnumSet a -> Maybe (a, EnumSet a)
+minView = E.minView
+{-# INLINE minView #-}
+
+-- | /O(1)/. Retrieves the maximal element of the set,
+-- and the set stripped of that element,
+-- or Nothing if passed an empty set.
+maxView :: ∀ a. AsEnumSet a => EnumSet a -> Maybe (a, EnumSet a)
+maxView = E.maxView
+{-# INLINE maxView #-}
+
+{--------------------------------------------------------------------
+  Conversion
+--------------------------------------------------------------------}
+
+-- | /O(n)/. Convert the set to a list of values.
+toList :: ∀ a. AsEnumSet a => EnumSet a -> [a]
+toList = E.toList
+{-# INLINE toList #-}
+
+-- | /O(1)/. Convert a representation into an @EnumSet@.
+-- Intended for use with foreign types.
+fromRaw :: ∀ a. AsEnumSet a => EnumSetRep a -> EnumSet a
+fromRaw = E.fromRaw
+{-# INLINE fromRaw #-}

+ Data/Enum/Set/Base.hs view

@@ -0,0 +1,691 @@+{-# LANGUAGE BangPatterns               #-}
+{-# LANGUAGE BlockArguments             #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE ExplicitForAll             #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PolyKinds                  #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE UnboxedTuples              #-}
+{-# LANGUAGE UnicodeSyntax              #-}
+
+-- | Efficient sets over bounded enumerations, using bitwise operations based on
+-- [containers](https://hackage.haskell.org/package/containers-0.6.0.1/docs/src/Data.IntSet.Internal.html)
+-- and
+-- [EdisonCore](https://hackage.haskell.org/package/EdisonCore-1.3.2.1/docs/src/Data-Edison-Coll-EnumSet.html).
+-- In many cases, @EnumSet@s may be optimised away entirely by constant folding
+-- at compile-time. For example, in the following code:
+--
+-- @
+--
+-- import Data.Enum.Set.Base as E
+--
+-- data Foo = A | B | C | D | E | F | G | H deriving (Bounded, Enum, Eq, Ord, Show)
+--
+-- addFoos :: E.EnumSet Word Foo -> E.EnumSet Word Foo
+-- addFoos = E.delete A . E.insert B
+--
+-- bar :: E.EnumSet Word Foo
+-- bar = addFoos $ E.fromFoldable [A, C, E]
+--
+-- barHasB :: Bool
+-- barHasB = E.member A bar
+--
+-- @
+--
+-- With @-O@ or @-O2@, @bar@ will compile to @GHC.Types.W\# 22\#\#@ and
+-- @barHasA@ will compile to @GHC.Types.False@.
+--
+-- For type @EnumSet W E@, @W@ should be a 'Word'-like type that implements
+-- 'Bits' and 'Num', and @E@ should be a type that implements 'Eq' and 'Enum'
+-- equivalently and is a bijection to 'Int'.
+-- @EnumSet W E@ can only store a value of @E@ if the result of applying
+-- 'fromEnum' to the value is positive and less than the number of bits in @W@.
+-- For this reason, it is preferable for @E@ to be a type that derives 'Eq' and
+-- 'Enum', and for @W@ to have more bits than the number of constructors of @E@.
+--
+-- For type @EnumSet W E@, if the highest @fromEnum@ value of @E@ is 29,
+-- @W@ should be 'Data.Word.Word', because it always has at least 30 bits.
+-- Otherwise, options include 'Data.Word.Word32', 'Data.Word.Word64', and the
+-- [wide-word](https://hackage.haskell.org/package/wide-word-0.1.0.8/) package's
+-- [Data.WideWord.Word128](https://hackage.haskell.org/package/wide-word-0.1.0.8/docs/Data-WideWord-Word128.html).
+-- Foreign types may also be used.
+--
+-- "Data.Enum.Set" provides an alternate type alias that moves the underlying
+-- representation to an associated type token, so that e.g.
+-- @EnumSet Word64 MyEnum@ is replaced by @EnumSet MyEnum@, and reexports this
+-- module with adjusted type signatures.
+--
+-- Note: complexity calculations assume that @W@ implements 'Bits' with
+-- constant-time functions, as is the case with 'Data.Word.Word' etc. If this
+-- is not the case, the complexity of those operations should be added to the
+-- complexity of 'EnumSet' functions.
+module Data.Enum.Set.Base
+  ( -- * Set type
+    EnumSet
+
+    -- * Construction
+  , empty
+  , singleton
+  , fromFoldable
+
+  -- * Insertion
+  , insert
+
+  -- * Deletion
+  , delete
+
+  -- * Query
+  , member
+  , notMember
+  , null
+  , size
+  , isSubsetOf
+
+  -- * Combine
+  , union
+  , difference
+  , (\\)
+  , symmetricDifference
+  , intersection
+
+  -- * Filter
+  , filter
+  , partition
+
+  -- * Map
+  , map
+  , map'
+
+  -- * Folds
+  , foldl, foldl', foldr, foldr'
+  , foldl1, foldl1', foldr1, foldr1'
+
+  -- ** Special folds
+  , foldMap
+  , traverse
+  , any
+  , all
+
+   -- * Min/Max
+  , minimum
+  , maximum
+  , deleteMin
+  , deleteMax
+  , minView
+  , maxView
+
+  -- * Conversion
+  , toList
+  , fromRaw
+  ) where
+
+import qualified GHC.Exts
+import qualified Data.Foldable as F
+
+import Prelude hiding (all, any, filter, foldl, foldl1, foldMap, foldr, foldr1, map, maximum, minimum, null, traverse)
+
+import Control.Applicative (liftA2)
+import Control.DeepSeq (NFData)
+import Control.Monad
+import Data.Aeson (ToJSON(..))
+import Data.Bits
+import Data.Data (Data)
+import Data.Monoid (Monoid(..))
+import Data.Vector.Unboxed (Vector, MVector, Unbox)
+import Foreign.Storable (Storable)
+import GHC.Exts (IsList(Item), build)
+import Text.Read
+
+import qualified Data.Vector.Generic as G
+import qualified Data.Vector.Generic.Mutable as M
+import qualified Data.Vector.Primitive as P
+
+import qualified Data.Containers
+import           Data.Containers (SetContainer, IsSet)
+import qualified Data.MonoTraversable
+import           Data.MonoTraversable (Element, GrowingAppend, MonoFoldable, MonoFunctor, MonoPointed, MonoTraversable)
+
+{--------------------------------------------------------------------
+  Set type
+--------------------------------------------------------------------}
+
+-- | A set of values @a@ with representation @word@,
+-- implemented as bitwise operations.
+newtype EnumSet word a = EnumSet word
+    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))
+
+instance P.Prim word => M.MVector MVector (EnumSet word a) where
+    basicLength (MV_EnumSet v) = M.basicLength v
+    {-# INLINE basicLength #-}
+    basicUnsafeSlice i n (MV_EnumSet v) = MV_EnumSet $ M.basicUnsafeSlice i n v
+    {-# INLINE basicUnsafeSlice #-}
+    basicOverlaps (MV_EnumSet v1) (MV_EnumSet v2) = M.basicOverlaps v1 v2
+    {-# INLINE basicOverlaps #-}
+    basicUnsafeNew n = MV_EnumSet `liftM` M.basicUnsafeNew n
+    {-# INLINE basicUnsafeNew #-}
+    basicInitialize (MV_EnumSet v) = M.basicInitialize v
+    {-# INLINE basicInitialize #-}
+    basicUnsafeReplicate n x = MV_EnumSet `liftM` M.basicUnsafeReplicate n x
+    {-# INLINE basicUnsafeReplicate #-}
+    basicUnsafeRead (MV_EnumSet v) i = M.basicUnsafeRead v i
+    {-# INLINE basicUnsafeRead #-}
+    basicUnsafeWrite (MV_EnumSet v) i x = M.basicUnsafeWrite v i x
+    {-# INLINE basicUnsafeWrite #-}
+    basicClear (MV_EnumSet v) = M.basicClear v
+    {-# INLINE basicClear #-}
+    basicSet (MV_EnumSet v) x = M.basicSet v x
+    {-# INLINE basicSet #-}
+    basicUnsafeCopy (MV_EnumSet v1) (MV_EnumSet v2) = M.basicUnsafeCopy v1 v2
+    {-# INLINE basicUnsafeCopy #-}
+    basicUnsafeMove (MV_EnumSet v1) (MV_EnumSet v2) = M.basicUnsafeMove v1 v2
+    {-# INLINE basicUnsafeMove #-}
+    basicUnsafeGrow (MV_EnumSet v) n = MV_EnumSet `liftM` M.basicUnsafeGrow v n
+    {-# INLINE basicUnsafeGrow #-}
+
+
+instance P.Prim word => G.Vector Vector (EnumSet word a) where
+    basicUnsafeFreeze (MV_EnumSet v) = V_EnumSet `liftM` G.basicUnsafeFreeze v
+    {-# INLINE basicUnsafeFreeze #-}
+    basicUnsafeThaw (V_EnumSet v) = MV_EnumSet `liftM` G.basicUnsafeThaw v
+    {-# INLINE basicUnsafeThaw #-}
+    basicLength (V_EnumSet v) = G.basicLength v
+    {-# INLINE basicLength #-}
+    basicUnsafeSlice i n (V_EnumSet v) = V_EnumSet $ G.basicUnsafeSlice i n v
+    {-# INLINE basicUnsafeSlice #-}
+    basicUnsafeIndexM (V_EnumSet v) i = G.basicUnsafeIndexM v i
+    {-# INLINE basicUnsafeIndexM #-}
+    basicUnsafeCopy (MV_EnumSet mv) (V_EnumSet v) = G.basicUnsafeCopy mv v
+    {-# INLINE basicUnsafeCopy #-}
+    elemseq _ = seq
+    {-# INLINE elemseq #-}
+
+instance Bits w => Semigroup (EnumSet w a) where
+    (<>) = union
+    {-# INLINE (<>) #-}
+
+instance Bits w => Monoid (EnumSet w a) where
+    mempty = empty
+    {-# INLINE mempty #-}
+
+instance (Bits w, Enum a) => MonoPointed (EnumSet w a) where
+    opoint = singleton
+    {-# INLINE opoint #-}
+
+instance (FiniteBits w, Num w, Enum a) => IsList (EnumSet w a) where
+    type Item (EnumSet w a) = a
+    fromList = fromFoldable
+    {-# INLINE fromList #-}
+    toList = toList
+    {-# INLINE toList #-}
+
+instance (FiniteBits w, Num w, Enum a, ToJSON a) => ToJSON (EnumSet w a) where
+    toJSON = toJSON . toList
+    {-# INLINE toJSON #-}
+    toEncoding = toEncoding . toList
+    {-# INLINE toEncoding #-}
+
+type instance Element (EnumSet w a) = a
+
+instance (FiniteBits w, Num w, Enum a) => MonoFunctor (EnumSet w a) where
+    omap = map
+    {-# INLINE omap #-}
+
+instance (FiniteBits w, Num w, Enum a) => MonoFoldable (EnumSet w a) where
+    ofoldMap = foldMap
+    {-# INLINE ofoldMap #-}
+    ofoldr = foldr
+    {-# INLINE ofoldr #-}
+    ofoldl' = foldl'
+    {-# INLINE ofoldl' #-}
+    ofoldr1Ex = foldr1
+    {-# INLINE ofoldr1Ex #-}
+    ofoldl1Ex' = foldl1'
+    {-# INLINE ofoldl1Ex' #-}
+    otoList = toList
+    {-# INLINE otoList #-}
+    oall = all
+    {-# INLINE oall #-}
+    oany = any
+    {-# INLINE oany #-}
+    onull = null
+    {-# INLINE onull #-}
+    olength = size
+    {-# INLINE olength #-}
+    olength64 w = fromIntegral $ size w
+    {-# INLINE olength64 #-}
+    headEx = minimum
+    {-# INLINE headEx #-}
+    lastEx = maximum
+    {-# INLINE lastEx #-}
+    oelem = member
+    {-# INLINE oelem #-}
+    onotElem x = not . member x
+    {-# INLINE onotElem #-}
+
+instance (FiniteBits w, Num w, Enum a) => GrowingAppend (EnumSet w a)
+
+instance (FiniteBits w, Num w, Enum a) => MonoTraversable (EnumSet w a) where
+    otraverse = traverse
+    {-# INLINE otraverse #-}
+
+instance (FiniteBits w, Num w, Eq a, Enum a) => SetContainer (EnumSet w a) where
+    type ContainerKey (EnumSet w a) = a
+    member = member
+    {-# INLINE member #-}
+    notMember = notMember
+    {-# INLINE notMember #-}
+    union = union
+    {-# INLINE union #-}
+    difference = difference
+    {-# INLINE difference #-}
+    intersection = intersection
+    {-# INLINE intersection #-}
+    keys = toList
+    {-# INLINE keys #-}
+
+instance (FiniteBits w, Num w, Eq a, Enum a) => IsSet (EnumSet w a) where
+    insertSet = insert
+    {-# INLINE insertSet #-}
+    deleteSet = delete
+    {-# INLINE deleteSet #-}
+    singletonSet = singleton
+    {-# INLINE singletonSet #-}
+    setFromList = fromFoldable
+    {-# INLINE setFromList #-}
+    setToList = toList
+    {-# INLINE setToList #-}
+    filterSet = filter
+    {-# INLINE filterSet #-}
+
+instance (FiniteBits w, Num w, Enum x, Show x) => Show (EnumSet w x) where
+    showsPrec p xs = showParen (p > 10) $
+        showString "fromList " . shows (toList xs)
+    {-# INLINABLE showsPrec #-}
+
+instance (Bits w, Num w, Enum x, Read x) => Read (EnumSet w x) where
+    readPrec = parens $ prec 10 do
+        Ident "fromList" <- lexP
+        fromFoldable <$> (readPrec :: ReadPrec [x])
+    {-# INLINABLE readPrec #-}
+    readListPrec = readListPrecDefault
+    {-# INLINABLE readListPrec #-}
+
+{--------------------------------------------------------------------
+  Construction
+--------------------------------------------------------------------}
+
+-- | /O(1)/. The empty set.
+empty :: ∀ w a. Bits w
+      => EnumSet w a
+empty = EnumSet zeroBits
+{-# INLINE empty #-}
+
+-- | /O(1)/. A set of one element.
+singleton :: ∀ w a. (Bits w, Enum a)
+          => a -> EnumSet w a
+singleton = EnumSet . bit . fromEnum
+{-# INLINE singleton #-}
+
+-- | /O(n)/. Create a set from a finite foldable data structure.
+fromFoldable :: ∀ f w a. (Foldable f, Bits w, Enum a)
+             => f a -> EnumSet w a
+fromFoldable = EnumSet . F.foldl' (flip $ (.|.) . bit . fromEnum) zeroBits
+
+{--------------------------------------------------------------------
+  Insertion
+--------------------------------------------------------------------}
+
+-- | /O(1)/. Add a value to the set.
+insert :: ∀ w a. (Bits w, Enum a)
+       => a -> EnumSet w a -> EnumSet w a
+insert !x (EnumSet w) = EnumSet . setBit w $ fromEnum x
+
+{--------------------------------------------------------------------
+  Deletion
+--------------------------------------------------------------------}
+
+-- | /O(1)/. Delete a value in the set.
+delete :: ∀ w a. (Bits w, Enum a)
+       => a -> EnumSet w a -> EnumSet w a
+delete !x (EnumSet w) = EnumSet . clearBit w $ fromEnum x
+
+{--------------------------------------------------------------------
+  Query
+--------------------------------------------------------------------}
+
+-- | /O(1)/. Is the value a member of the set?
+member :: ∀ w a. (Bits w, Enum a)
+       => a -> EnumSet w a -> Bool
+member !x (EnumSet w) = testBit w $ fromEnum x
+
+-- | /O(1)/. Is the value not in the set?
+notMember :: ∀ w a. (Bits w, Enum a)
+          => a -> EnumSet w a -> Bool
+notMember !x = not . member x
+
+-- | /O(1)/. Is this the empty set?
+null :: ∀ w a. Bits w
+     => EnumSet w a -> Bool
+null (EnumSet w) = zeroBits == w
+{-# INLINE null #-}
+
+-- | /O(1)/. The number of elements in the set.
+size :: ∀ w a. (Bits w, Num w)
+     => EnumSet w a -> Int
+size (EnumSet !w) = popCount w
+
+-- | /O(1)/. Is this a subset?
+-- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.
+isSubsetOf :: ∀ w a. (Bits w)
+           => EnumSet w a -> EnumSet w a -> Bool
+isSubsetOf (EnumSet x) (EnumSet y) = x .|. y == y
+{-# INLINE isSubsetOf #-}
+
+{--------------------------------------------------------------------
+  Combine
+--------------------------------------------------------------------}
+
+-- | /O(1)/. The union of two sets.
+union :: ∀ w a. Bits w
+      => EnumSet w a -> EnumSet w a -> EnumSet w a
+union (EnumSet x) (EnumSet y) = EnumSet $ x .|. y
+{-# INLINE union #-}
+
+-- | /O(1)/. Difference between two sets.
+difference :: ∀ w a. Bits w
+           => EnumSet w a -> EnumSet w a -> EnumSet w a
+difference (EnumSet x) (EnumSet y) = EnumSet $ (x .|. y) `xor` y
+{-# INLINE difference #-}
+
+-- | /O(1)/. See 'difference'.
+(\\) :: ∀ w a. Bits w
+     => EnumSet w a -> EnumSet w a -> EnumSet w a
+(\\) = difference
+infixl 9 \\
+{-# INLINE (\\) #-}
+
+-- | /O(1)/. Elements which are in either set, but not both.
+symmetricDifference :: ∀ w a. Bits w
+                    => EnumSet w a -> EnumSet w a -> EnumSet w a
+symmetricDifference (EnumSet x) (EnumSet y) = EnumSet $ x `xor` y
+{-# INLINE symmetricDifference #-}
+
+-- | /O(1)/. The intersection of two sets.
+intersection :: ∀ w a. Bits w
+             => EnumSet w a -> EnumSet w a -> EnumSet w a
+intersection (EnumSet x) (EnumSet y) = EnumSet $ x .&. y
+{-# INLINE intersection #-}
+
+{--------------------------------------------------------------------
+  Filter
+--------------------------------------------------------------------}
+
+-- | /O(n)/. Filter all elements that satisfy some predicate.
+filter :: ∀ w a. (FiniteBits w, Num w, Enum a)
+       => (a -> Bool) -> EnumSet w a -> EnumSet w a
+filter p (EnumSet w) = EnumSet $ foldlBits' f 0 w
+    where
+      f z i
+        | p $ toEnum i = setBit z i
+        | otherwise    = z
+      {-# INLINE f #-}
+
+-- | /O(n)/. Partition the set according to some predicate.
+-- The first set contains all elements that satisfy the predicate,
+-- the second all elements that fail the predicate.
+partition :: ∀ w a. (FiniteBits w, Num w, Enum a)
+          => (a -> Bool) -> EnumSet w a -> (EnumSet w a, EnumSet w a)
+partition p (EnumSet w) = (EnumSet yay, EnumSet nay)
+    where
+      (yay, nay) = foldlBits' f (0, 0) w
+      f (x, y) i
+          | p $ toEnum i = (setBit x i, y)
+          | otherwise    = (x, setBit y i)
+      {-# INLINE f #-}
+
+{--------------------------------------------------------------------
+  Map
+--------------------------------------------------------------------}
+
+-- | /O(n)/.
+-- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.
+--
+-- It's worth noting that the size of the result may be smaller if,
+-- for some @(x,y)@, @x \/= y && f x == f y@.
+map :: ∀ w a b. (FiniteBits w, Num w, Enum a, Enum b)
+    => (a -> b) -> EnumSet w a -> EnumSet w b
+map = map'
+{-# INLINE map #-}
+
+-- | /O(n)/. Apply 'map' while converting the underlying representation of the
+-- set to some other representation.
+map' :: ∀ v w a b. (FiniteBits v, FiniteBits w, Num v, Num w, Enum a, Enum b)
+     => (a -> b) -> EnumSet v a -> EnumSet w b
+map' f0 (EnumSet w) = EnumSet $ foldlBits' f 0 w
+    where
+      f z i = setBit z $ fromEnum $ f0 (toEnum i)
+      {-# INLINE f #-}
+
+{--------------------------------------------------------------------
+  Folds
+--------------------------------------------------------------------}
+
+-- | /O(n)/. Left fold.
+foldl :: ∀ w a b. (FiniteBits w, Num w, Enum a)
+      => (b -> a -> b) -> b -> EnumSet w a -> b
+foldl f z (EnumSet w) = foldlBits ((. toEnum) . f) z w
+{-# INLINE foldl #-}
+
+-- | /O(n)/. Left fold with strict accumulator.
+foldl' :: ∀ w a b. (FiniteBits w, Num w, Enum a)
+       => (b -> a -> b) -> b -> EnumSet w a -> b
+foldl' f z (EnumSet w) = foldlBits' ((. toEnum) . f) z w
+{-# INLINE foldl' #-}
+
+-- | /O(n)/. Right fold.
+foldr :: ∀ w a b. (FiniteBits w, Num w, Enum a)
+      => (a -> b -> b) -> b -> EnumSet w a -> b
+foldr f z (EnumSet w) = foldrBits (f . toEnum) z w
+{-# INLINE foldr #-}
+
+-- | /O(n)/. Right fold with strict accumulator.
+foldr' :: ∀ w a b. (FiniteBits w, Num w,  Enum a)
+       => (a -> b -> b) -> b -> EnumSet w a -> b
+foldr' f z (EnumSet w) = foldrBits' (f . toEnum) z w
+{-# INLINE foldr' #-}
+
+-- | /O(n)/. Left fold on non-empty sets.
+foldl1 :: ∀ w a. (FiniteBits w, Num w, Enum a)
+       => (a -> a -> a) -> EnumSet w a -> a
+foldl1 f = fold1Aux lsb $ foldlBits ((. toEnum) . f)
+{-# INLINE foldl1 #-}
+
+-- | /O(n)/. Left fold on non-empty sets with strict accumulator.
+foldl1' :: ∀ w a. (FiniteBits w, Num w, Enum a)
+        => (a -> a -> a) -> EnumSet w a -> a
+foldl1' f = fold1Aux lsb $ foldlBits' ((.toEnum) . f)
+{-# INLINE foldl1' #-}
+
+-- | /O(n)/. Right fold on non-empty sets.
+foldr1 :: ∀ w a. (FiniteBits w, Num w, Enum a)
+       => (a -> a -> a) -> EnumSet w a -> a
+foldr1 f = fold1Aux msb $ foldrBits (f . toEnum)
+{-# INLINE foldr1 #-}
+
+-- | /O(n)/. Right fold on non-empty sets with strict accumulator.
+foldr1' :: ∀ w a. (FiniteBits w, Num w, Enum a)
+        => (a -> a -> a) -> EnumSet w a -> a
+foldr1' f = fold1Aux msb $ foldrBits' (f . toEnum)
+{-# INLINE foldr1' #-}
+
+-- | /O(n)/. Map each element of the structure to a monoid, and combine the
+-- results.
+foldMap :: ∀ m w a. (Monoid m, FiniteBits w, Num w, Enum a)
+        => (a -> m) -> EnumSet w a -> m
+foldMap f (EnumSet w) = foldrBits (mappend . f . toEnum) mempty w
+{-# INLINE foldMap #-}
+
+traverse :: ∀ f w a. (Applicative f, FiniteBits w, Num w, Enum a)
+         => (a -> f a) -> EnumSet w a -> f (EnumSet w a)
+traverse f (EnumSet w) = EnumSet <$>
+                         foldrBits
+                         (liftA2 (flip setBit) . fmap fromEnum . f . toEnum)
+                         (pure zeroBits)
+                         w
+{-# INLINE traverse #-}
+
+-- | /O(n)/. Check if all elements satisfy some predicate.
+all :: ∀ w a. (FiniteBits w, Num w, Enum a)
+    => (a -> Bool) -> EnumSet w a -> Bool
+all p (EnumSet w) = let lb = lsb w in go lb (w `unsafeShiftR` lb)
+  where
+    go !_ 0 = True
+    go bi n
+      | n `testBit` 0 && not (p $ toEnum bi) = False
+      | otherwise = go (bi + 1) (n `unsafeShiftR` 1)
+
+-- | /O(n)/. Check if any element satisfies some predicate.
+any :: ∀ w a. (FiniteBits w, Num w, Enum a)
+    => (a -> Bool) -> EnumSet w a -> Bool
+any p (EnumSet w) = let lb = lsb w in go lb (w `unsafeShiftR` lb)
+  where
+    go !_ 0 = False
+    go bi n
+      | n `testBit` 0 && p (toEnum bi) = True
+      | otherwise = go (bi + 1) (n `unsafeShiftR` 1)
+
+{--------------------------------------------------------------------
+  Min/Max
+--------------------------------------------------------------------}
+
+-- | /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 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 w) = toEnum $ msb w
+
+-- | /O(1)/. Delete the minimal element.
+deleteMin :: ∀ w a. (FiniteBits w, Num w)
+          => EnumSet w a -> EnumSet w a
+deleteMin (EnumSet 0) = EnumSet 0
+deleteMin (EnumSet w) = EnumSet $ clearBit w $ lsb w
+
+-- | /O(1)/. Delete the maximal element.
+deleteMax :: ∀ w a. (FiniteBits w, Num w)
+          => EnumSet w a -> EnumSet w a
+deleteMax (EnumSet 0) = EnumSet 0
+deleteMax (EnumSet w) = EnumSet $ clearBit w $ msb w
+
+-- | /O(1)/. Retrieves the minimal element of the set,
+-- and the set stripped of that element,
+-- or Nothing if passed an empty set.
+minView :: ∀ w a. (FiniteBits w, Num w, Enum a)
+        => EnumSet w a -> Maybe (a, EnumSet w a)
+minView (EnumSet 0) = Nothing
+minView (EnumSet w) = let i = lsb w in Just (toEnum i, EnumSet $ clearBit w i)
+
+-- | /O(1)/. Retrieves the maximal element of the set,
+-- and the set stripped of that element,
+-- or Nothing if passed an empty set.
+maxView :: ∀ w a. (FiniteBits w, Num w, Enum a)
+        => EnumSet w a -> Maybe (a, EnumSet w a)
+maxView (EnumSet 0) = Nothing
+maxView (EnumSet w) = let i = msb w in Just (toEnum i, EnumSet $ clearBit w i)
+
+{--------------------------------------------------------------------
+  Conversion
+--------------------------------------------------------------------}
+
+-- | /O(n)/. Convert the set to a list of values.
+toList :: ∀ w a. (FiniteBits w, Num w, Enum a)
+       => EnumSet w a -> [a]
+toList (EnumSet w) = build \c n -> foldrBits (c . toEnum) n w
+{-# INLINE toList #-}
+
+-- | /O(1)/. Convert a representation into an @EnumSet@.
+-- Intended for use with foreign types.
+fromRaw :: ∀ w a. w -> EnumSet w a
+fromRaw = EnumSet
+{-# INLINE fromRaw #-}
+
+{--------------------------------------------------------------------
+  Utility functions
+--------------------------------------------------------------------}
+
+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)
+{-# INLINE lsb #-}
+
+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)
+{-# INLINE msb #-}
+
+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
+    go !_ acc 0 = acc
+    go bi acc n
+      | n `testBit` 0 = go (bi + 1) (f acc bi) (n `unsafeShiftR` 1)
+      | otherwise     = go (bi + 1)    acc     (n `unsafeShiftR` 1)
+{-# INLINE foldlBits #-}
+
+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
+    go !_ !acc 0 = acc
+    go bi acc n
+      | n `testBit` 0 = go (bi + 1) (f acc bi) (n `unsafeShiftR` 1)
+      | otherwise     = go (bi + 1)    acc     (n `unsafeShiftR` 1)
+{-# INLINE foldlBits' #-}
+
+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
+    go !_ 0 = z
+    go bi n
+      | n `testBit` 0 = f bi (go (bi + 1) (n `unsafeShiftR` 1))
+      | otherwise     =       go (bi + 1) (n `unsafeShiftR` 1)
+{-# INLINE foldrBits #-}
+
+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
+    go !_ 0 = z
+    go bi n
+      | n `testBit` 0 = f bi $! go (bi + 1) (n `unsafeShiftR` 1)
+      | otherwise     =         go (bi + 1) (n `unsafeShiftR` 1)
+{-# INLINE foldrBits' #-}
+
+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 getBit f (EnumSet w) = f (toEnum gotBit) (clearBit w gotBit)
+  where
+    gotBit = getBit w
+{-# INLINE fold1Aux #-}

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2019, Joshua Booth
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Johan Tibell nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

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

+ Setup.hs view

@@ -0,0 +1,4 @@+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain

+ benchmarks/EnumSet.hs view

@@ -0,0 +1,95 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ExplicitForAll      #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE UnicodeSyntax       #-}
+
+module Main where
+
+import Prelude
+
+import Control.DeepSeq (NFData, rnf)
+import Control.Exception (evaluate)
+import Data.Bits
+import Data.List (foldl', transpose)
+import Data.WideWord (Word128)
+import Data.Word (Word16, Word64)
+import qualified Gauge as G
+import Gauge (Benchmark)
+import Type.Reflection
+
+import qualified Data.Enum.Set.Base as E
+
+main :: IO ()
+main = G.defaultMain . concat . transpose =<< sequence
+    [ benchWord @Word
+    , benchWord @Word16
+    , benchWord @Word64
+    , benchWord @Word128
+    ]
+
+benchWord :: ∀ w. (FiniteBits w, NFData w, Num w, Typeable w) => IO [Benchmark]
+benchWord = do
+    let s = E.fromFoldable elems :: E.EnumSet w Int
+        s_even = E.fromFoldable elems_even :: E.EnumSet w Int
+        s_odd = E.fromFoldable elems_odd :: E.EnumSet w Int
+    evaluate $ rnf [s, s_even, s_odd]
+    return
+      [ bench "singleton" (E.singleton :: Int -> E.EnumSet w Int) 2
+      , bench "fromFoldable" (E.fromFoldable :: [Int] -> E.EnumSet w Int) elems
+      , bench "insert" (ins elems) (E.empty :: E.EnumSet w Int)
+      , bench "delete" (del elems) s
+      , bench "member" (member elems) s
+      , bench "notMember" (notMember elems) s
+      , bench "null" E.null s
+      , bench "size" E.size s
+      , bench "isSubsetOf" (E.isSubsetOf s) s_even
+      , bench "union" (E.union s_even) s_odd
+      , bench "difference" (E.difference s) s_even
+      , bench "symmetricDifference" (E.symmetricDifference s) s_even
+      , bench "intersection" (E.intersection s) s_even
+      , bench "null.intersection:false" (E.null . E.intersection s) s_even
+      , bench "null.intersection:true" (E.null . E.intersection s_odd) s_even
+      , bench "filter" (E.filter ((== 0) . (`mod` 2))) s
+      , bench "partition" (E.partition ((== 0) . (`mod` 2))) s
+      , bench "map" (E.map (+1)) s
+      , bench "foldl" (E.foldl (flip (:)) []) s
+      , bench "foldl'" (E.foldl' (flip (:)) []) s
+      , bench "foldr" (E.foldr (:) []) s
+      , bench "foldr'" (E.foldr' (:) []) s
+      , bench "foldl1" (E.foldl1 (+)) s
+      , bench "foldl1'" (E.foldl1' (+)) s
+      , bench "foldr1" (E.foldr1 (+)) s
+      , bench "foldr1'" (E.foldr1' (+)) s
+      , bench "foldMap" (return :: ∀ a. a -> [a]) s
+      , bench "traverse" (return :: ∀ a. a -> [a]) s
+      , bench "all" (E.all (/= -1)) s
+      , bench "any" (E.any (== -1)) s
+      , bench "minimum" E.minimum s
+      , bench "maximum" E.maximum s
+      , bench "deleteMin" E.deleteMin s
+      , bench "deleteMax" E.deleteMax s
+      , bench "minView" E.minView s
+      , bench "maxView" E.maxView s
+      , bench "toList" E.toList s
+      ]
+  where
+    maxVal = 15
+    elems = [0..maxVal]
+    elems_even = [2,4..maxVal]
+    elems_odd = [1,3..maxVal]
+    prefix = show (typeRep @w) ++ " "
+    bench :: String -> (a -> b) -> a -> G.Benchmark
+    bench label f = G.bench (prefix ++ label) . G.whnf f
+
+member :: ∀ w a. (Bits w, Enum a) => [a] -> E.EnumSet w a -> Int
+member xs s = foldl' (\n x -> if E.member x s then n + 1 else n) 0 xs
+
+notMember :: ∀ w a. (Bits w, Enum a) => [a] -> E.EnumSet w a -> Int
+notMember xs s = foldl' (\n x -> if E.notMember x s then n + 1 else n) 0 xs
+
+ins :: ∀ w a. (Bits w, Enum a) => [a] -> E.EnumSet w a -> E.EnumSet w a
+ins xs s = foldl' (flip E.insert) s xs
+
+del :: ∀ w a. (Bits w, Enum a) => [a] -> E.EnumSet w a -> E.EnumSet w a
+del xs s = foldl' (flip E.delete) s xs

+ bitwise-enum.cabal view

@@ -0,0 +1,80 @@+cabal-version: 1.12++name:           bitwise-enum+version:        0.1.0.0+synopsis:       Bitwise operations on bounded enumerations+description:+    Bitwise operations on bounded enumerations.+    .+    ["Data.Enum.Set"] Constant-time sets using bit flags.+    .+    ["Data.Enum.Memo"] Constant-time lookup memoization for functions on enumerated types.+homepage:       https://github.com/jnbooth/bitwise-enum#readme+bug-reports:    https://github.com/jnbooth/bitwise-enum/issues+author:         Joshua Booth <joshua.n.booth@gmail.com>+maintainer:     Joshua Booth <joshua.n.booth@gmail.com>+license:        BSD3+license-file:   LICENSE+build-type:     Simple++source-repository head+  type: git+  location: https://github.com/jnbooth/bitwise-enum++library+  exposed-modules:+      Data.Enum.Memo+      Data.Enum.Set+      Data.Enum.Set.Base+  other-modules:+      Paths_bounded_enum+  hs-source-dirs:+      ./+  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.7+    , array >=0.5.1 && <0.5.5+    , base >=4.5 && <5+    , deepseq >=1.1 && <1.4.5+    , mono-traversable >=1.0.12 && <1.0.16+    , vector >=0.11 && <0.12.1+  default-language: Haskell2010++test-suite enumset-test-suite+  type: exitcode-stdio-1.0+  main-is: set-properties.hs+  other-modules:+      Paths_bounded_enum+  hs-source-dirs:+      tests+  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.7+    , base+    , bitwise-enum+    , deepseq >=1.1 && <1.4.5+    , mono-traversable >=1.0.12 && <1.0.16+    , test-framework >=0.8.2.0+    , test-framework-quickcheck2 >=0.3.0.5+    , vector >=0.11 && <0.12.1+  default-language: Haskell2010++benchmark enumset-benchmarks+  type: exitcode-stdio-1.0+  main-is: EnumSet.hs+  other-modules:+      Paths_bounded_enum+  hs-source-dirs:+      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.7+    , base+    , bitwise-enum+    , deepseq >=1.1 && <1.4.5+    , gauge >=0.2.5+    , mono-traversable >=1.0.12 && <1.0.16+    , vector >=0.11 && <0.12.1+    , wide-word >=0.1.0.9+  default-language: Haskell2010

+ tests/set-properties.hs view

@@ -0,0 +1,236 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+import Prelude
+
+import Data.List ((\\), foldl', nub, sort)
+import Data.Bits
+import Test.Framework
+import Test.Framework.Providers.QuickCheck2
+import Test.QuickCheck
+import Test.QuickCheck.Function
+import Unsafe.Coerce (unsafeCoerce)
+
+import qualified Data.Enum.Set.Base as E
+
+main :: IO ()
+main = defaultMain
+    [ -- Construction
+      testProperty "singleton" prop_singleton
+    , testProperty "fromFoldable" prop_fromFoldable
+      -- Insertion/Deletion
+    , testProperty "insert/delete" prop_insertDelete
+      -- Query
+    , testProperty "member" prop_member
+    , testProperty "notMember" prop_notMember
+    , testProperty "size" prop_size
+    , testProperty "isSubsetOf" prop_isSubsetOf
+      -- Combine
+    , testProperty "unionInsert" prop_unionInsert
+    , testProperty "unionAssoc" prop_unionAssoc
+    , testProperty "unionComm" prop_unionComm
+    , testProperty "difference" prop_difference
+    , testProperty "intersection" prop_intersection
+      -- Filter
+    , testProperty "filter" prop_filter
+    , testProperty "partition" prop_partition
+      -- Map
+    , testProperty "map" prop_map
+    , testProperty "map2" prop_map2
+      -- Folds
+    , testProperty "foldl" prop_foldl
+    , testProperty "foldl'" prop_foldl'
+    , testProperty "foldr" prop_foldr
+    , testProperty "foldr'" prop_foldr'
+      -- Special folds
+    , testProperty "foldMap" prop_foldMap
+    , testProperty "traverse" prop_traverse
+    , testProperty "any" prop_any
+    , testProperty "all" prop_all
+      -- Min/Max
+    , testProperty "minimum" prop_minimum
+    , testProperty "maximum" prop_maximum
+    , testProperty "minView" prop_minView
+    , testProperty "maxView" prop_maxView
+      -- Conversion
+    , testProperty "toList" prop_toList
+    , testProperty "Read/Show" prop_readShow
+    ]
+
+wordSize :: Int
+wordSize = finiteBitSize (0 :: Word) - 1
+
+newtype Key = Key Int deriving (Eq, Ord, Show, Read, Real, Integral)
+
+instance Enum Key where
+    toEnum x
+      | x < 0 || x > wordSize = error $ "Key.toEnum: bad argument " ++ show x
+      | otherwise             = Key x
+    fromEnum (Key x) = x
+
+instance Num Key where
+    (Key x) + (Key y) = Key . min wordSize $ x + y
+    (Key x) - (Key y) = Key . max 0 $ x - y
+    (Key x) * (Key y) = Key . min wordSize $ x + y
+    negate = id
+    abs = id
+    signum (Key 0) = 0
+    signum _       = 1
+    fromInteger = toEnum . max 0 . min wordSize . fromInteger
+
+instance Bounded Key where
+    minBound = 0
+    maxBound = Key $ finiteBitSize (0 :: Word) - 1
+
+instance Arbitrary Key where
+    arbitrary = arbitrarySizedBoundedIntegral
+    shrink    = shrinkIntegral
+
+instance Function Key where
+    function = functionIntegral
+
+instance CoArbitrary Key where
+    coarbitrary = coarbitraryIntegral
+
+type ES = E.EnumSet Word Key
+
+fromBits :: w -> E.EnumSet w a
+fromBits = unsafeCoerce
+
+toBits :: E.EnumSet w a -> w
+toBits = unsafeCoerce
+
+instance Arbitrary w => Arbitrary (E.EnumSet w a) where
+    arbitrary = fmap fromBits arbitrary
+    shrink = fmap fromBits . shrink . toBits
+
+-- * Construction
+
+prop_singleton :: Key -> Bool
+prop_singleton x = E.insert x (E.empty :: ES) == E.singleton x
+
+prop_fromFoldable :: [Key] -> Property
+prop_fromFoldable xs =
+    (E.fromFoldable xs :: ES) === foldr E.insert E.empty xs
+
+-- * Insertion/Deletion
+
+prop_insertDelete :: Key -> ES -> Property
+prop_insertDelete k t = not (E.member k t) ==> E.delete k (E.insert k t) == t
+
+-- * Query
+
+prop_member :: [Key] -> Key -> Bool
+prop_member xs n =
+    let m = E.fromFoldable xs :: ES
+    in all (\k -> k `E.member` m == (k `elem` xs)) (n : xs)
+
+prop_notMember :: [Key] -> Key -> Bool
+prop_notMember xs n =
+    let m = E.fromFoldable xs :: ES
+    in all (\k -> k `E.notMember` m == (k `notElem` xs)) (n : xs)
+
+prop_size :: ES -> Bool
+prop_size s = E.size s == length (E.toList s)
+
+-- TODO isSubsetOf
+
+prop_isSubsetOf :: ES -> ES -> Bool
+prop_isSubsetOf x y = x `E.isSubsetOf` y == all (`elem` E.toList y) (E.toList x)
+
+-- * Combine
+
+prop_unionInsert :: Key -> ES -> Bool
+prop_unionInsert x t = E.union t (E.singleton x) == E.insert x t
+
+prop_unionAssoc :: ES -> ES -> ES -> Bool
+prop_unionAssoc x y z = E.union x (E.union y z) == E.union (E.union x y) z
+
+prop_unionComm :: ES -> ES -> Bool
+prop_unionComm x y = E.union x y == E.union y x
+
+prop_difference :: [Key] -> [Key] -> Bool
+prop_difference xs ys =
+    (E.toList :: ES -> [Key])
+    (E.difference (E.fromFoldable xs) (E.fromFoldable ys))
+    == sort ((\\) (nub xs) (nub ys))
+
+prop_intersection :: ES -> ES -> Bool
+prop_intersection x y =
+    x `E.intersection` y == E.fromFoldable (filter (`elem` E.toList x) (E.toList y))
+
+-- * Filter
+
+prop_filter :: ES -> Bool
+prop_filter s = E.partition odd s == (E.filter odd s, E.filter even s)
+
+prop_partition :: ES -> Bool
+prop_partition s = case E.partition odd s of
+    (s1,s2) -> all odd (E.toList s1) && all even (E.toList s2)
+               && s == s1 `E.union` s2
+
+-- * Map
+
+prop_map :: ES -> Bool
+prop_map s = E.map id s == s
+
+prop_map2 :: Fun Key Key -> Fun Key Key -> ES -> Property
+prop_map2 f g s =
+    E.map (apply f) (E.map (apply g) s) === E.map (apply f . apply g) s
+
+-- * Folds
+
+prop_foldl :: ES -> Bool
+prop_foldl s = E.foldl (flip (:)) [] s == foldl (flip (:)) [] (E.toList s)
+
+prop_foldl' :: ES -> Bool
+prop_foldl' s = E.foldl' (flip (:)) [] s == foldl' (flip (:)) [] (E.toList s)
+
+prop_foldr :: ES -> Bool
+prop_foldr s = E.foldr (:) [] s == E.toList s
+
+prop_foldr' :: ES -> Bool
+prop_foldr' s = E.foldr' (:) [] s == E.toList s
+
+-- * Special folds
+
+prop_all :: Fun Key Bool -> ES -> Property
+prop_all p s = E.all (apply p) s === all (apply p) (E.toList s)
+
+prop_any :: Fun Key Bool -> ES -> Property
+prop_any p s = E.any (apply p) s === any (apply p) (E.toList s)
+
+prop_foldMap :: ES -> Bool
+prop_foldMap s = E.foldMap return s == foldMap (: []) (E.toList s)
+
+prop_traverse :: ES -> Bool
+prop_traverse s = map E.toList (E.traverse return s) == traverse (: []) (E.toList s)
+
+
+-- * Min/Max
+
+prop_minimum :: ES -> Property
+prop_minimum s = not (E.null s) ==> E.minimum s == minimum (E.toList s)
+
+prop_maximum :: ES -> Property
+prop_maximum s = not (E.null s) ==> E.maximum s == maximum (E.toList s)
+
+prop_minView :: ES -> Bool
+prop_minView s = case E.minView s of
+    Nothing -> E.null s
+    Just (m,s') -> m == minimum (E.toList s)
+                   && s == E.insert m s' && m `E.notMember` s'
+
+prop_maxView :: ES -> Bool
+prop_maxView s = case E.maxView s of
+    Nothing -> E.null s
+    Just (m,s') -> m == maximum (E.toList s)
+                   && s == E.insert m s' && m `E.notMember` s'
+
+-- * Conversion
+
+prop_toList :: [Key] -> Bool
+prop_toList xs = sort (nub xs) == E.toList (E.fromFoldable xs :: ES)
+
+prop_readShow :: ES -> Bool
+prop_readShow s = s == read (show s)