summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHenningThielemann <>2019-08-13 10:48:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-08-13 10:48:00 (GMT)
commite07eb9facabf4c457ce50c19e60e46a68840bbd7 (patch)
treebba27b910e68f6fbf883e54772d3840963db5936
parent74e373fd7b0796d10ebb44fad2e78a3072c8e15b (diff)
version 0.0.5HEAD0.0.5master
-rw-r--r--enumset.cabal9
-rw-r--r--src/Data/EnumBitSet.hs198
-rw-r--r--src/Data/EnumSet.hs202
-rw-r--r--src/Data/EnumSet/PackedEnum.hs2
4 files changed, 211 insertions, 200 deletions
diff --git a/enumset.cabal b/enumset.cabal
index 8139405..6a8f34d 100644
--- a/enumset.cabal
+++ b/enumset.cabal
@@ -1,5 +1,5 @@
Name: enumset
-Version: 0.0.4.1
+Version: 0.0.5
License: BSD3
License-File: LICENSE
Author: Henning Thielemann <haskell@henning-thielemann.de>
@@ -21,11 +21,11 @@ Description:
.
See also @data-flags@ and @Data.EnumSet@ in @enummapset@.
Cabal-Version: >=1.10
-Tested-With: GHC==7.4.2, GHC==7.6.3, GHC==8.4.1
+Tested-With: GHC==7.4.2, GHC==7.6.3, GHC==8.4.4, GHC==8.6.5
Build-Type: Simple
Source-Repository this
- Tag: 0.0.4.1
+ Tag: 0.0.5
Type: darcs
Location: http://code.haskell.org/~thielema/enumset/
@@ -39,11 +39,12 @@ Library
data-accessor >=0.2.1 && <0.3,
storable-record >=0.0.1 && <0.1,
semigroups >=0.1 && <1.0,
- base >= 4 && <5
+ base >=4 && <5
GHC-Options: -Wall
Hs-Source-Dirs: src
Exposed-Modules:
+ Data.EnumBitSet
Data.EnumSet
Data.EnumSet.PackedEnum
Data.FlagSet
diff --git a/src/Data/EnumBitSet.hs b/src/Data/EnumBitSet.hs
new file mode 100644
index 0000000..2d685b1
--- /dev/null
+++ b/src/Data/EnumBitSet.hs
@@ -0,0 +1,198 @@
+{- |
+Similar to Data.Edison.Coll.EnumSet
+but it allows to choose the underlying type for bit storage.
+This is really a low-level module for type-safe foreign function interfaces.
+
+The integer representation of the enumeration type
+is the bit position of the flag within the bitvector.
+-}
+module Data.EnumBitSet (
+ T(Cons, decons),
+ fromEnum,
+ fromEnums,
+ toEnums,
+ intToEnums,
+ mostSignificantPosition,
+ singletonByPosition,
+ null,
+ empty,
+ singleton,
+ disjoint,
+ subset,
+ (.&.),
+ (.-.),
+ (.|.),
+ xor,
+ unions,
+ get,
+ put,
+ accessor,
+ set,
+ clear,
+ flip,
+ fromBool,
+ ) where
+
+import qualified Data.EnumSet.Utility as U
+import qualified Data.Bits as B
+import Data.Bits (Bits, )
+
+import Data.Monoid (Monoid(mempty, mappend), )
+import Data.Semigroup (Semigroup((<>)), )
+
+import qualified Foreign.Storable.Newtype as Store
+import Foreign.Storable (Storable(sizeOf, alignment, peek, poke), )
+
+import qualified Data.Accessor.Basic as Acc
+
+import qualified Prelude as P
+import Prelude hiding (fromEnum, toEnum, null, flip, )
+
+
+newtype T word index = Cons {decons :: word}
+ deriving (Eq)
+
+instance (Enum a, Storable w) => Storable (T w a) where
+ sizeOf = Store.sizeOf decons
+ alignment = Store.alignment decons
+ peek = Store.peek Cons
+ poke = Store.poke decons
+
+
+instance (Enum a, Bits w) => Semigroup (T w a) where
+ (<>) = (.|.)
+
+{- |
+Since this data type is intended for constructing flags,
+we choose the set union as 'mappend'.
+For intersection we would also not have a canonical identity element.
+-}
+instance (Enum a, Bits w) => Monoid (T w a) where
+ mempty = empty
+ mappend = (.|.)
+
+
+fromEnum :: (Enum a, Bits w) => a -> T w a
+fromEnum = Cons . B.bit . P.fromEnum
+
+fromEnums :: (Enum a, Bits w) => [a] -> T w a
+fromEnums = Cons . foldl B.setBit U.empty . map P.fromEnum
+
+toEnums :: (Enum a, Bits w) => T w a -> [a]
+toEnums =
+ map fst . filter (P.flip B.testBit 0 . snd) .
+ zip [P.toEnum 0 ..] .
+ takeWhile (U.empty /= ) . iterate (P.flip B.shiftR 1) .
+ decons
+
+intToEnums :: (Enum a, Integral w) => T w a -> [a]
+intToEnums =
+ map fst . filter (odd . snd) .
+ zip [P.toEnum 0 ..] .
+ takeWhile (0/=) . iterate (P.flip div 2) .
+ decons
+
+
+{- |
+floor of binary logarithm -
+Intended for getting the position of a single set bit.
+This in turn is intended for implementing an 'Enum' instance
+if you only know masks but no bit positions.
+-}
+{-# INLINE mostSignificantPosition #-}
+mostSignificantPosition :: (Bits w, Storable w) => T w a -> Int
+mostSignificantPosition (Cons x) =
+ snd $
+ foldl
+ (\(x0,pos) testPos ->
+ let x1 = B.shiftR x0 testPos
+ in if x1 == U.empty
+ then (x0, pos)
+ else (x1, pos+testPos))
+ (x,0) $
+ reverse $
+ takeWhile (< sizeOf x * 8) $
+ iterate (2*) 1
+
+{- |
+set a bit -
+Intended for implementing an 'Enum' instance
+if you only know masks but no bit positions.
+-}
+{-# INLINE singletonByPosition #-}
+singletonByPosition :: (Bits w) => Int -> T w a
+singletonByPosition = Cons . B.setBit U.empty
+
+
+null :: (Enum a, Bits w) => T w a -> Bool
+null (Cons x) = x==U.empty
+
+empty :: (Enum a, Bits w) => T w a
+empty = Cons U.empty
+
+disjoint :: (Enum a, Bits w) => T w a -> T w a -> Bool
+disjoint x y = null (x .&. y)
+
+{- |
+@subset a b@ is 'True' if @a@ is a subset of @b@.
+-}
+subset :: (Enum a, Bits w) => T w a -> T w a -> Bool
+subset x y = null (x .-. y)
+
+
+{-# INLINE lift2 #-}
+lift2 :: (w -> w -> w) -> (T w a -> T w a -> T w a)
+lift2 f (Cons x) (Cons y) = Cons (f x y)
+
+-- fixities like in Data.Bits
+infixl 7 .&., .-.
+infixl 5 .|.
+
+(.&.), (.-.), (.|.), xor :: (Enum a, Bits w) => T w a -> T w a -> T w a
+(.&.) = lift2 (B..&.)
+(.|.) = lift2 (B..|.)
+(.-.) = lift2 (\x y -> x B..&. B.complement y)
+xor = lift2 B.xor
+
+unions :: (Enum a, Bits w) => [T w a] -> T w a
+unions = foldl (.|.) empty
+
+
+-- | could also be named @member@ like in @Set@ or @elem@ as in '[]'
+get :: (Enum a, Bits w) => a -> T w a -> Bool
+get n = P.flip B.testBit (P.fromEnum n) . decons
+
+put :: (Enum a, Bits w) => a -> Bool -> T w a -> T w a
+put n b s =
+ fromBool n b .|. clear n s
+
+accessor :: (Enum a, Bits w) => a -> Acc.T (T w a) Bool
+accessor x = Acc.fromSetGet (put x) (get x)
+
+
+{-# INLINE lift1 #-}
+lift1 ::
+ (Enum a, Bits w) =>
+ (w -> Int -> w) -> (a -> T w a -> T w a)
+lift1 f n (Cons vec) = Cons (f vec (P.fromEnum n))
+
+singleton :: (Enum a, Bits w) => a -> T w a
+singleton = P.flip set empty
+
+-- | could also be named @insert@ like in @Set@
+set :: (Enum a, Bits w) => a -> T w a -> T w a
+set = lift1 B.setBit
+
+-- | could also be named @delete@ like in @Set@
+clear :: (Enum a, Bits w) => a -> T w a -> T w a
+clear = lift1 B.clearBit
+
+flip :: (Enum a, Bits w) => a -> T w a -> T w a
+flip = lift1 B.complementBit
+
+fromBool :: (Enum a, Bits w) => a -> Bool -> T w a
+fromBool n b =
+ Cons $ if b then B.bit (P.fromEnum n) else U.empty
+{- requires Num instance
+ Cons (B.shiftL (fromIntegral $ P.fromEnum b) (P.fromEnum n))
+-}
diff --git a/src/Data/EnumSet.hs b/src/Data/EnumSet.hs
index 1e62899..6dd9ec6 100644
--- a/src/Data/EnumSet.hs
+++ b/src/Data/EnumSet.hs
@@ -1,198 +1,10 @@
{- |
-Similar to Data.Edison.Coll.EnumSet
-but it allows to choose the underlying type for bit storage.
-This is really a low-level module for type-safe foreign function interfaces.
-
-The integer representation of the enumeration type
-is the bit position of the flag within the bitvector.
+The module name clashes with a module from the package @enummapset@.
+Thus we will remove this module in favor of "Data.EnumBitSet".
-}
-module Data.EnumSet (
- T(Cons, decons),
- fromEnum,
- fromEnums,
- toEnums,
- intToEnums,
- mostSignificantPosition,
- singletonByPosition,
- null,
- empty,
- singleton,
- disjoint,
- subset,
- (.&.),
- (.-.),
- (.|.),
- xor,
- unions,
- get,
- put,
- accessor,
- set,
- clear,
- flip,
- fromBool,
- ) where
-
-import qualified Data.Bits as B
-import Data.Bits (Bits, )
-import qualified Data.EnumSet.Utility as U
-
-import Data.Monoid (Monoid(mempty, mappend), )
-import Data.Semigroup (Semigroup((<>)), )
-
-import qualified Foreign.Storable.Newtype as Store
-import Foreign.Storable (Storable(sizeOf, alignment, peek, poke), )
-
-import qualified Data.Accessor.Basic as Acc
-
-import qualified Prelude as P
-import Prelude hiding (fromEnum, toEnum, null, flip, )
-
+module Data.EnumSet
+ {-# DEPRECATED "use Data.EnumBitSet instead" #-}
+ (module Data.EnumBitSet)
+ where
-newtype T word index = Cons {decons :: word}
- deriving (Eq)
-
-instance (Enum a, Storable w) => Storable (T w a) where
- sizeOf = Store.sizeOf decons
- alignment = Store.alignment decons
- peek = Store.peek Cons
- poke = Store.poke decons
-
-
-instance (Enum a, Bits w) => Semigroup (T w a) where
- (<>) = (.|.)
-
-{- |
-Since this data type is intended for constructing flags,
-we choose the set union as 'mappend'.
-For intersection we would also not have a canonical identity element.
--}
-instance (Enum a, Bits w) => Monoid (T w a) where
- mempty = empty
- mappend = (.|.)
-
-
-fromEnum :: (Enum a, Bits w) => a -> T w a
-fromEnum = Cons . B.bit . P.fromEnum
-
-fromEnums :: (Enum a, Bits w) => [a] -> T w a
-fromEnums = Cons . foldl B.setBit U.empty . map P.fromEnum
-
-toEnums :: (Enum a, Bits w) => T w a -> [a]
-toEnums =
- map fst . filter (P.flip B.testBit 0 . snd) .
- zip [P.toEnum 0 ..] .
- takeWhile (U.empty /= ) . iterate (P.flip B.shiftR 1) .
- decons
-
-intToEnums :: (Enum a, Integral w) => T w a -> [a]
-intToEnums =
- map fst . filter (odd . snd) .
- zip [P.toEnum 0 ..] .
- takeWhile (0/=) . iterate (P.flip div 2) .
- decons
-
-
-{- |
-floor of binary logarithm -
-Intended for getting the position of a single set bit.
-This in turn is intended for implementing an 'Enum' instance
-if you only know masks but no bit positions.
--}
-{-# INLINE mostSignificantPosition #-}
-mostSignificantPosition :: (Bits w, Storable w) => T w a -> Int
-mostSignificantPosition (Cons x) =
- snd $
- foldl
- (\(x0,pos) testPos ->
- let x1 = B.shiftR x0 testPos
- in if x1 == U.empty
- then (x0, pos)
- else (x1, pos+testPos))
- (x,0) $
- reverse $
- takeWhile (< sizeOf x * 8) $
- iterate (2*) 1
-
-{- |
-set a bit -
-Intended for implementing an 'Enum' instance
-if you only know masks but no bit positions.
--}
-{-# INLINE singletonByPosition #-}
-singletonByPosition :: (Bits w) => Int -> T w a
-singletonByPosition = Cons . B.setBit U.empty
-
-
-null :: (Enum a, Bits w) => T w a -> Bool
-null (Cons x) = x==U.empty
-
-empty :: (Enum a, Bits w) => T w a
-empty = Cons U.empty
-
-disjoint :: (Enum a, Bits w) => T w a -> T w a -> Bool
-disjoint x y = null (x .&. y)
-
-{- |
-@subset a b@ is 'True' if @a@ is a subset of @b@.
--}
-subset :: (Enum a, Bits w) => T w a -> T w a -> Bool
-subset x y = null (x .-. y)
-
-
-{-# INLINE lift2 #-}
-lift2 :: (w -> w -> w) -> (T w a -> T w a -> T w a)
-lift2 f (Cons x) (Cons y) = Cons (f x y)
-
--- fixities like in Data.Bits
-infixl 7 .&., .-.
-infixl 5 .|.
-
-(.&.), (.-.), (.|.), xor :: (Enum a, Bits w) => T w a -> T w a -> T w a
-(.&.) = lift2 (B..&.)
-(.|.) = lift2 (B..|.)
-(.-.) = lift2 (\x y -> x B..&. B.complement y)
-xor = lift2 B.xor
-
-unions :: (Enum a, Bits w) => [T w a] -> T w a
-unions = foldl (.|.) empty
-
-
--- | could also be named @member@ like in @Set@ or @elem@ as in '[]'
-get :: (Enum a, Bits w) => a -> T w a -> Bool
-get n = P.flip B.testBit (P.fromEnum n) . decons
-
-put :: (Enum a, Bits w) => a -> Bool -> T w a -> T w a
-put n b s =
- fromBool n b .|. clear n s
-
-accessor :: (Enum a, Bits w) => a -> Acc.T (T w a) Bool
-accessor x = Acc.fromSetGet (put x) (get x)
-
-
-{-# INLINE lift1 #-}
-lift1 ::
- (Enum a, Bits w) =>
- (w -> Int -> w) -> (a -> T w a -> T w a)
-lift1 f n (Cons vec) = Cons (f vec (P.fromEnum n))
-
-singleton :: (Enum a, Bits w) => a -> T w a
-singleton = P.flip set empty
-
--- | could also be named @insert@ like in @Set@
-set :: (Enum a, Bits w) => a -> T w a -> T w a
-set = lift1 B.setBit
-
--- | could also be named @delete@ like in @Set@
-clear :: (Enum a, Bits w) => a -> T w a -> T w a
-clear = lift1 B.clearBit
-
-flip :: (Enum a, Bits w) => a -> T w a -> T w a
-flip = lift1 B.complementBit
-
-fromBool :: (Enum a, Bits w) => a -> Bool -> T w a
-fromBool n b =
- Cons $ if b then B.bit (P.fromEnum n) else U.empty
-{- requires Num instance
- Cons (B.shiftL (fromIntegral $ P.fromEnum b) (P.fromEnum n))
--}
+import Data.EnumBitSet
diff --git a/src/Data/EnumSet/PackedEnum.hs b/src/Data/EnumSet/PackedEnum.hs
index e2c7fe5..e428b8f 100644
--- a/src/Data/EnumSet/PackedEnum.hs
+++ b/src/Data/EnumSet/PackedEnum.hs
@@ -6,7 +6,7 @@ module Data.EnumSet.PackedEnum
(T(Cons), unpack, pack, clear, put, )
where
-import qualified Data.EnumSet as ES
+import qualified Data.EnumBitSet as ES
import qualified Data.Bits as B
import Data.Bits (Bits, (.&.), )