-----------------------------------------------------------------------------
-- |
--   Module      :  Data.Edison.Coll.EnumSet
--   Copyright   :  (c) David F. Place 2006
--   License     :  BSD
--
--   Maintainer  :  robdockins AT fastmail DOT fm
--   Stability   :  stable
--   Portability :  GHC, Hugs (MPTC and FD)
--
-- An efficient implementation of sets over small enumerations.
-- The implementation of 'EnumSet' is based on bit-wise operations.
--
-- For this implementation to work as expected at type @A@, there are a number
-- of preconditions on the @Eq@, @Enum@ and @Ord@ instances.
--
-- The @Enum A@ instance must create a bijection between the elements of type @A@ and
-- a finite subset of the naturals [0,1,2,3....].  As a corollary we must have:
--
-- > forall x y::A, fromEnum x == fromEnum y <==> x is indistinguishable from y
--
-- Also, the number of distinct elements of @A@ must be less than or equal
-- to the number of bits in @Word@.
--
-- The @Enum A@ instance must be consistent with the @Eq A@ instance.
-- That is, we must have:
--
-- > forall x y::A, x == y <==> toEnum x == toEnum y
--
-- Additionally, for operations that require an @Ord A@ context, we require that
-- toEnum be monotonic with respect to comparison.  That is, we must have:
--
-- > forall x y::A, x < y <==> toEnum x < toEnum y
--
-- Derived @Eq@, @Ord@ and @Enum@ instances will fulfill these conditions, if
-- the enumerated type has sufficiently few constructors.

{-
Copyright (c) 2006, 2008, David F. Place
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 David F. Place nor the names of its
  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.
-}

module Data.Edison.Coll.EnumSet (
            -- * Set type
            Set

            -- * CollX operations
            , empty
            , singleton
            , fromSeq
            , insert
            , insertSeq
            , union
            , unionSeq
            , delete
            , deleteAll
            , deleteSeq
            , null
            , size
            , member
            , count
            , strict

            -- * OrdCollX operations
            , deleteMin
            , deleteMax
            , unsafeInsertMin
            , unsafeInsertMax
            , unsafeFromOrdSeq
            , unsafeAppend
            , filterLT
            , filterLE
            , filterGT
            , filterGE
            , partitionLT_GE
            , partitionLE_GT
            , partitionLT_GT

            -- * SetX operations
            , intersection
            , difference
            , symmetricDifference
            , properSubset
            , subset

            -- * Coll operations
            , toSeq
            , lookup
            , lookupM
            , lookupAll
            , lookupWithDefault
            , fold, fold', fold1, fold1'
            , filter
            , partition
            , strictWith

            -- * OrdColl operations
            , minView
            , minElem
            , maxView
            , maxElem
            , foldr, foldr', foldl, foldl'
            , foldr1, foldr1', foldl1, foldl1'
            , toOrdSeq
            , unsafeMapMonotonic

            -- * Set operations
            , fromSeqWith
            , fromOrdSeq
            , insertWith
            , insertSeqWith
            , unionl
            , unionr
            , unionWith
            , unionSeqWith
            , intersectionWith

            -- * Bonus operations
            , map
            , setCoerce
            , complement
            , toBits
            , fromBits

            -- * Documentation
            , moduleName
)  where

import qualified Prelude
import Prelude hiding (filter,foldl,foldr,null,map,lookup,foldl1,foldr1)
import qualified Control.Monad.Fail as Fail
import qualified Data.Bits as Bits
import Data.Bits hiding (complement)
import Data.Word
import Data.Monoid (Monoid(..))
import Data.Semigroup as SG

import qualified Data.Edison.Seq as S
import qualified Data.Edison.Coll as C
import Data.Edison.Coll.Defaults
import Test.QuickCheck (Arbitrary(..), CoArbitrary(..))

moduleName :: String
moduleName :: String
moduleName = String
"Data.Edison.Coll.EnumSet"

{--------------------------------------------------------------------
  Sets are bit strings of width wordLength.
--------------------------------------------------------------------}
-- | A set of values @a@ implemented as bitwise operations.  Useful
-- for members of class Enum with no more elements than there are bits
-- in @Word@.
newtype Set a = Set Word deriving (Set a -> Set a -> Bool
forall a. Set a -> Set a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Set a -> Set a -> Bool
$c/= :: forall a. Set a -> Set a -> Bool
== :: Set a -> Set a -> Bool
$c== :: forall a. Set a -> Set a -> Bool
Eq)

wordLength :: Int
wordLength :: Int
wordLength =
#if MIN_VERSION_base(4,7,0)
  forall b. FiniteBits b => b -> Int
finiteBitSize
#else
  bitSize
#endif
    (Word
0::Word)

check :: String -> Int -> Int
check :: String -> Int -> Int
check String
msg Int
x
    | Int
x forall a. Ord a => a -> a -> Bool
< Int
wordLength = Int
x
    | Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"EnumSet."forall a. [a] -> [a] -> [a]
++String
msgforall a. [a] -> [a] -> [a]
++String
": element beyond word size."


-- no interesting structural invariants
structuralInvariant :: Set a -> Bool
structuralInvariant :: forall a. Set a -> Bool
structuralInvariant = forall a b. a -> b -> a
const Bool
True


----------------------------------------------------
-- bit twiddly magic

countBits :: Word -> Int
countBits :: Word -> Int
countBits Word
w = Word
w seq :: forall a b. a -> b -> b
`seq` Int -> Word -> Int
bitcount Int
0 Word
w

bitcount :: Int -> Word -> Int
bitcount :: Int -> Word -> Int
bitcount Int
a Word
0 = Int
a
bitcount Int
a Word
x = Int
a seq :: forall a b. a -> b -> b
`seq` Int -> Word -> Int
bitcount (Int
aforall a. Num a => a -> a -> a
+Int
1) (Word
x forall a. Bits a => a -> a -> a
.&. (Word
xforall a. Num a => a -> a -> a
-Word
1))

-- stolen from http://aggregate.org/MAGIC/
lsb :: Word -> Int
lsb :: Word -> Int
lsb Word
x = Word -> Int
countBits ((Word
xforall a. Num a => a -> a -> a
-Word
1) forall a. Bits a => a -> a -> a
.&. (forall a. Bits a => a -> a
Bits.complement Word
x))

msb :: Word -> Int
msb :: Word -> Int
msb Word
x0 = let
     x1 :: Word
x1 = Word
x0 forall a. Bits a => a -> a -> a
.|. (Word
x0 forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
     x2 :: Word
x2 = Word
x1 forall a. Bits a => a -> a -> a
.|. (Word
x1 forall a. Bits a => a -> Int -> a
`shiftR` Int
2)
     x3 :: Word
x3 = Word
x2 forall a. Bits a => a -> a -> a
.|. (Word
x2 forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
     x4 :: Word
x4 = Word
x3 forall a. Bits a => a -> a -> a
.|. (Word
x3 forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
     x5 :: Word
x5 = Word
x4 forall a. Bits a => a -> a -> a
.|. (Word
x4 forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
     in Word -> Int
countBits Word
x5 forall a. Num a => a -> a -> a
- Int
1


lowMask :: Int -> Word
lowMask :: Int -> Word
lowMask Int
x = forall a. Bits a => Int -> a
bit Int
x forall a. Num a => a -> a -> a
- Word
1

highMask :: Int -> Word
highMask :: Int -> Word
highMask Int
x = forall a. Bits a => a -> a
Bits.complement (Int -> Word
lowMask Int
x)

{--------------------------------------------------------------------
  Query
--------------------------------------------------------------------}
-- | /O(1)/. Is this the empty set?
null :: Set a -> Bool
null :: forall a. Set a -> Bool
null (Set Word
0) = Bool
True
null Set a
_       = Bool
False

-- | /O(1)/. The number of elements in the set.
size :: Set a -> Int
size :: forall a. Set a -> Int
size (Set Word
w) = Word -> Int
countBits Word
w

-- | /O(1)/. Is the element in the set?
member :: (Eq a, Enum a) => a -> Set a -> Bool
member :: forall a. (Eq a, Enum a) => a -> Set a -> Bool
member a
x (Set Word
w) = forall a. Bits a => a -> Int -> Bool
testBit Word
w forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum a
x

count :: (Eq a, Enum a) => a -> Set a -> Int
count :: forall a. (Eq a, Enum a) => a -> Set a -> Int
count = forall c a. SetX c a => a -> c -> Int
countUsingMember

lookup :: (Eq a, Enum a) => a -> Set a -> a
lookup :: forall a. (Eq a, Enum a) => a -> Set a -> a
lookup = forall c a. Coll c a => a -> c -> a
lookupUsingLookupAll

lookupM :: (Eq a, Enum a, Fail.MonadFail m) => a -> Set a -> m a
lookupM :: forall a (m :: * -> *).
(Eq a, Enum a, MonadFail m) =>
a -> Set a -> m a
lookupM a
x Set a
s
   | forall a. (Eq a, Enum a) => a -> Set a -> Bool
member a
x Set a
s = forall (m :: * -> *) a. Monad m => a -> m a
return a
x
   | Bool
otherwise  = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
moduleNameforall a. [a] -> [a] -> [a]
++String
".lookupM: lookup failed")

lookupAll  :: (Eq a, Enum a, S.Sequence s) => a -> Set a -> s a
lookupAll :: forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
a -> Set a -> s a
lookupAll = forall c a (seq :: * -> *).
(Set c a, Sequence seq) =>
a -> c -> seq a
lookupAllUsingLookupM

lookupWithDefault :: (Eq a, Enum a) => a -> a -> Set a -> a
lookupWithDefault :: forall a. (Eq a, Enum a) => a -> a -> Set a -> a
lookupWithDefault = forall c a. Coll c a => a -> a -> c -> a
lookupWithDefaultUsingLookupM

{--------------------------------------------------------------------
  Construction
--------------------------------------------------------------------}
-- | /O(1)/. The empty set.
empty :: Set a
empty :: forall a. Set a
empty = forall a. Word -> Set a
Set Word
0

-- | /O(1)/. Create a singleton set.
singleton :: (Eq a, Enum a) => a -> Set a
singleton :: forall a. (Eq a, Enum a) => a -> Set a
singleton a
x =
    forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
setBit Word
0 forall a b. (a -> b) -> a -> b
$ String -> Int -> Int
check String
"singleton" forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum a
x

{--------------------------------------------------------------------
  Insertion, Deletion
--------------------------------------------------------------------}
-- | /O(1)/. Insert an element in a set.
-- If the set already contains an element equal to the given value,
-- it is replaced with the new value.
insert :: (Eq a, Enum a) => a -> Set a -> Set a
insert :: forall a. (Eq a, Enum a) => a -> Set a -> Set a
insert a
x (Set Word
w) =
    forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
setBit Word
w forall a b. (a -> b) -> a -> b
$ String -> Int -> Int
check String
"insert" forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum a
x

-- given the preconditions, we can just ignore the combining function
insertWith :: (Eq a, Enum a) => (a -> a -> a) -> a -> Set a -> Set a
insertWith :: forall a. (Eq a, Enum a) => (a -> a -> a) -> a -> Set a -> Set a
insertWith a -> a -> a
_ a
x (Set Word
w) =
    forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
setBit Word
w forall a b. (a -> b) -> a -> b
$ String -> Int -> Int
check String
"insertWith" forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum a
x

-- | /O(1)/. Delete an element from a set.
delete :: (Eq a, Enum a) => a -> Set a -> Set a
delete :: forall a. (Eq a, Enum a) => a -> Set a -> Set a
delete a
x (Set Word
w) =
    forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
clearBit Word
w forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum a
x

deleteAll :: (Eq a, Enum a) => a -> Set a -> Set a
deleteAll :: forall a. (Eq a, Enum a) => a -> Set a -> Set a
deleteAll = forall a. (Eq a, Enum a) => a -> Set a -> Set a
delete

deleteSeq :: (Eq a, Enum a, S.Sequence s) => s a -> Set a -> Set a
deleteSeq :: forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
s a -> Set a -> Set a
deleteSeq = forall c a (seq :: * -> *).
(CollX c a, Sequence seq) =>
seq a -> c -> c
deleteSeqUsingDelete

{--------------------------------------------------------------------
  Subset
--------------------------------------------------------------------}
-- | /O(1)/. Is this a proper subset? (ie. a subset but not equal).
properSubset :: Set a -> Set a -> Bool
properSubset :: forall a. Set a -> Set a -> Bool
properSubset Set a
x Set a
y = (Set a
x forall a. Eq a => a -> a -> Bool
/= Set a
y) Bool -> Bool -> Bool
&& (forall a. Set a -> Set a -> Bool
subset Set a
x Set a
y)

-- | /O(1)/. Is this a subset?
-- @(s1 `subset` s2)@ tells whether @s1@ is a subset of @s2@.
subset :: Set a -> Set a -> Bool
subset :: forall a. Set a -> Set a -> Bool
subset Set a
x Set a
y = (Set a
x forall a. Set a -> Set a -> Set a
`union` Set a
y) forall a. Eq a => a -> a -> Bool
== Set a
y

{--------------------------------------------------------------------
  Minimal, Maximal
--------------------------------------------------------------------}

-- | /O(1)/. The minimal element of a set.
minElem :: (Enum a) => Set a -> a
minElem :: forall a. Enum a => Set a -> a
minElem (Set Word
w)
   | Word
w forall a. Eq a => a -> a -> Bool
== Word
0    = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
moduleNameforall a. [a] -> [a] -> [a]
++String
".minElem: empty set"
   | Bool
otherwise = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Word -> Int
lsb Word
w

-- | /O(1)/. The maximal element of a set.
maxElem :: (Enum a) => Set a -> a
maxElem :: forall a. Enum a => Set a -> a
maxElem (Set Word
w)
   | Word
w forall a. Eq a => a -> a -> Bool
== Word
0    = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
moduleNameforall a. [a] -> [a] -> [a]
++String
".maxElem: empty set"
   | Bool
otherwise = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Word -> Int
msb Word
w

-- | /O(1)/. Delete the minimal element.
deleteMin :: (Enum a) => Set a -> Set a
deleteMin :: forall a. Enum a => Set a -> Set a
deleteMin (Set Word
w)
   | Word
w forall a. Eq a => a -> a -> Bool
== Word
0    = forall a. Set a
empty
   | Bool
otherwise = forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
clearBit Word
w forall a b. (a -> b) -> a -> b
$ Word -> Int
lsb Word
w

-- | /O(1)/. Delete the maximal element.
deleteMax :: (Enum a) => Set a -> Set a
deleteMax :: forall a. Enum a => Set a -> Set a
deleteMax (Set Word
w)
   | Word
w forall a. Eq a => a -> a -> Bool
== Word
0    = forall a. Set a
empty
   | Bool
otherwise = forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
clearBit Word
w forall a b. (a -> b) -> a -> b
$ Word -> Int
msb Word
w

minView :: (Enum a, Fail.MonadFail m) => Set a -> m (a, Set a)
minView :: forall a (m :: * -> *).
(Enum a, MonadFail m) =>
Set a -> m (a, Set a)
minView (Set Word
w)
   | Word
w forall a. Eq a => a -> a -> Bool
== Word
0    = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
moduleNameforall a. [a] -> [a] -> [a]
++String
".minView: empty set")
   | Bool
otherwise = let i :: Int
i = Word -> Int
lsb Word
w in forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Enum a => Int -> a
toEnum Int
i,forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
clearBit Word
w Int
i)

maxView :: (Enum a, Fail.MonadFail m) => Set a -> m (a, Set a)
maxView :: forall a (m :: * -> *).
(Enum a, MonadFail m) =>
Set a -> m (a, Set a)
maxView (Set Word
w)
   | Word
w forall a. Eq a => a -> a -> Bool
== Word
0    = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
moduleNameforall a. [a] -> [a] -> [a]
++String
".maxView: empty set")
   | Bool
otherwise = let i :: Int
i = Word -> Int
msb Word
w in forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Enum a => Int -> a
toEnum Int
i, forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
clearBit Word
w Int
i)

unsafeInsertMin :: (Ord a, Enum a) => a -> Set a -> Set a
unsafeInsertMin :: forall a. (Ord a, Enum a) => a -> Set a -> Set a
unsafeInsertMin = forall a. (Eq a, Enum a) => a -> Set a -> Set a
insert

unsafeInsertMax :: (Ord a, Enum a) => a -> Set a -> Set a
unsafeInsertMax :: forall a. (Ord a, Enum a) => a -> Set a -> Set a
unsafeInsertMax = forall a. (Eq a, Enum a) => a -> Set a -> Set a
insert

unsafeAppend :: (Ord a, Enum a) => Set a -> Set a -> Set a
unsafeAppend :: forall a. (Ord a, Enum a) => Set a -> Set a -> Set a
unsafeAppend = forall a. Set a -> Set a -> Set a
union

unsafeFromOrdSeq :: (Ord a, Enum a, S.Sequence s) => s a -> Set a
unsafeFromOrdSeq :: forall a (s :: * -> *). (Ord a, Enum a, Sequence s) => s a -> Set a
unsafeFromOrdSeq = forall a (s :: * -> *). (Eq a, Enum a, Sequence s) => s a -> Set a
fromSeq

filterLT :: (Ord a, Enum a) => a -> Set a -> Set a
filterLT :: forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterLT a
x (Set Word
w) = forall a. Word -> Set a
Set (Word
w forall a. Bits a => a -> a -> a
.&. Int -> Word
lowMask (forall a. Enum a => a -> Int
fromEnum a
x))

filterLE :: (Ord a, Enum a) => a -> Set a -> Set a
filterLE :: forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterLE a
x (Set Word
w) = forall a. Word -> Set a
Set (Word
w forall a. Bits a => a -> a -> a
.&. Int -> Word
lowMask (forall a. Enum a => a -> Int
fromEnum a
x forall a. Num a => a -> a -> a
+ Int
1))

filterGT :: (Ord a, Enum a) => a -> Set a -> Set a
filterGT :: forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterGT a
x (Set Word
w) = forall a. Word -> Set a
Set (Word
w forall a. Bits a => a -> a -> a
.&. Int -> Word
highMask (forall a. Enum a => a -> Int
fromEnum a
x forall a. Num a => a -> a -> a
+ Int
1))

filterGE :: (Ord a, Enum a) => a -> Set a -> Set a
filterGE :: forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterGE a
x (Set Word
w) = forall a. Word -> Set a
Set (Word
w forall a. Bits a => a -> a -> a
.&. Int -> Word
highMask (forall a. Enum a => a -> Int
fromEnum a
x))

partitionLT_GE :: (Ord a, Enum a) => a -> Set a -> (Set a, Set a)
partitionLT_GE :: forall a. (Ord a, Enum a) => a -> Set a -> (Set a, Set a)
partitionLT_GE a
x Set a
s = (forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterLT a
x Set a
s,forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterGE a
x Set a
s)

partitionLE_GT :: (Ord a, Enum a) => a -> Set a -> (Set a, Set a)
partitionLE_GT :: forall a. (Ord a, Enum a) => a -> Set a -> (Set a, Set a)
partitionLE_GT a
x Set a
s = (forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterLE a
x Set a
s,forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterGT a
x Set a
s)

partitionLT_GT :: (Ord a, Enum a) => a -> Set a -> (Set a, Set a)
partitionLT_GT :: forall a. (Ord a, Enum a) => a -> Set a -> (Set a, Set a)
partitionLT_GT a
x Set a
s = (forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterLT a
x Set a
s,forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterGT a
x Set a
s)


{--------------------------------------------------------------------
  Union.
--------------------------------------------------------------------}
-- | The union of a list of sets: (@'unions' == 'foldl' 'union' 'empty'@).
unionSeq :: (Eq a, Enum a, S.Sequence s) => s (Set a) -> Set a
unionSeq :: forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
s (Set a) -> Set a
unionSeq = forall c a (seq :: * -> *). (CollX c a, Sequence seq) => seq c -> c
unionSeqUsingFoldl'

-- | /O(1)/. The union of two sets.
union :: Set a -> Set a -> Set a
union :: forall a. Set a -> Set a -> Set a
union (Set Word
x) (Set Word
y) = forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ Word
x forall a. Bits a => a -> a -> a
.|. Word
y

unionl :: Set a -> Set a -> Set a
unionl :: forall a. Set a -> Set a -> Set a
unionl = forall a. Set a -> Set a -> Set a
union

unionr :: Set a -> Set a -> Set a
unionr :: forall a. Set a -> Set a -> Set a
unionr = forall a. Set a -> Set a -> Set a
union

-- given the preconditions, we can just ignore the combining function
unionWith :: (a -> a -> a) -> Set a -> Set a -> Set a
unionWith :: forall a. (a -> a -> a) -> Set a -> Set a -> Set a
unionWith a -> a -> a
_ = forall a. Set a -> Set a -> Set a
union

unionSeqWith :: (Eq a, Enum a, S.Sequence s) => (a -> a -> a) -> s (Set a) -> Set a
unionSeqWith :: forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
(a -> a -> a) -> s (Set a) -> Set a
unionSeqWith a -> a -> a
_ = forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
s (Set a) -> Set a
unionSeq

{--------------------------------------------------------------------
  Difference
--------------------------------------------------------------------}
-- | /O(1)/. Difference of two sets.
difference :: Set a -> Set a -> Set a
difference :: forall a. Set a -> Set a -> Set a
difference (Set Word
x) (Set Word
y) = forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ (Word
x forall a. Bits a => a -> a -> a
.|. Word
y) forall a. Bits a => a -> a -> a
`xor` Word
y

symmetricDifference :: Set a -> Set a -> Set a
symmetricDifference :: forall a. Set a -> Set a -> Set a
symmetricDifference (Set Word
x) (Set Word
y) = forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ Word
x forall a. Bits a => a -> a -> a
`xor` Word
y

{--------------------------------------------------------------------
  Intersection
--------------------------------------------------------------------}
-- | /O(1)/. The intersection of two sets.
intersection :: Set a -> Set a -> Set a
intersection :: forall a. Set a -> Set a -> Set a
intersection (Set Word
x) (Set Word
y) = forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ Word
x forall a. Bits a => a -> a -> a
.&. Word
y

intersectionWith :: (a -> a -> a) -> Set a -> Set a -> Set a
intersectionWith :: forall a. (a -> a -> a) -> Set a -> Set a -> Set a
intersectionWith a -> a -> a
_ = forall a. Set a -> Set a -> Set a
intersection

{--------------------------------------------------------------------
  Complement
--------------------------------------------------------------------}
-- | /O(1)/. The complement of a set with its universe set. @complement@ can be used
--   with bounded types for which the universe set
--   will be automatically created.
complement :: (Eq a, Bounded a, Enum a) => Set a -> Set a
complement :: forall a. (Eq a, Bounded a, Enum a) => Set a -> Set a
complement Set a
x = forall a. Set a -> Set a -> Set a
symmetricDifference Set a
u Set a
x
    where u :: Set a
u = (forall a (s :: * -> *). (Eq a, Enum a, Sequence s) => s a -> Set a
fromSeq [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]) forall a. a -> a -> a
`asTypeOf` Set a
x

{--------------------------------------------------------------------
  Filter and partition
--------------------------------------------------------------------}
-- | /O(n)/. Filter all elements that satisfy the predicate.
filter :: (Eq a, Enum a) => (a -> Bool) -> Set a -> Set a
filter :: forall a. (Eq a, Enum a) => (a -> Bool) -> Set a -> Set a
filter a -> Bool
p (Set Word
w) = forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ forall a. (a -> Int -> a) -> a -> Word -> a
foldlBits' forall a. Bits a => a -> Int -> a
f Word
0 Word
w
    where
      f :: a -> Int -> a
f a
z Int
i
        | a -> Bool
p forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
i = forall a. Bits a => a -> Int -> a
setBit a
z Int
i
        | Bool
otherwise = a
z

-- | /O(n)/. Partition the set into two sets, one with all elements that satisfy
-- the predicate and one with all elements that don't satisfy the predicate.
-- See also 'split'.
partition :: (Eq a, Enum a) => (a -> Bool) -> Set a -> (Set a,Set a)
partition :: forall a. (Eq a, Enum a) => (a -> Bool) -> Set a -> (Set a, Set a)
partition a -> Bool
p (Set Word
w) = (forall a. Word -> Set a
Set Word
yay,forall a. Word -> Set a
Set Word
nay)
    where
      (Word
yay,Word
nay) = forall a. (a -> Int -> a) -> a -> Word -> a
foldlBits' forall {a} {b}. (Bits a, Bits b) => (a, b) -> Int -> (a, b)
f (Word
0,Word
0) Word
w
      f :: (a, b) -> Int -> (a, b)
f (a
x,b
y) Int
i
          | a -> Bool
p forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
i = (forall a. Bits a => a -> Int -> a
setBit a
x Int
i,b
y)
          | Bool
otherwise    = (a
x,forall a. Bits a => a -> Int -> a
setBit b
y Int
i)


{----------------------------------------------------------------------
  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 :: (Enum a,Enum b) => (a -> b) -> Set a -> Set b
map :: forall a b. (Enum a, Enum b) => (a -> b) -> Set a -> Set b
map a -> b
f0 (Set Word
w) = forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ forall a. (a -> Int -> a) -> a -> Word -> a
foldlBits' forall a. Bits a => a -> Int -> a
f Word
0 Word
w
    where
      f :: a -> Int -> a
f a
z Int
i = forall a. Bits a => a -> Int -> a
setBit a
z forall a b. (a -> b) -> a -> b
$ String -> Int -> Int
check String
"map" forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ a -> b
f0 (forall a. Enum a => Int -> a
toEnum Int
i)

unsafeMapMonotonic :: (Enum a) => (a -> a) -> Set a -> Set a
unsafeMapMonotonic :: forall a. Enum a => (a -> a) -> Set a -> Set a
unsafeMapMonotonic = forall a b. (Enum a, Enum b) => (a -> b) -> Set a -> Set b
map

-- | /O(1)/ Changes the type of the elements in the set without changing
--   the representation.  Equivalent to @map (toEnum . fromEnum)@, and
--   to @(fromBits . toBits)@.  This method is operationally a no-op.
setCoerce :: (Enum a, Enum b) => Set a -> Set b
setCoerce :: forall a b. (Enum a, Enum b) => Set a -> Set b
setCoerce (Set Word
w) = forall a. Word -> Set a
Set Word
w

-- | /O(1)/ Get the underlying bit-encoded representation.
--   This method is operationally a no-op.
toBits :: Set a -> Word
toBits :: forall a. Set a -> Word
toBits (Set Word
w) = Word
w

-- | /O(1)/ Create an EnumSet from a bit-encoded representation.
--   This method is operationally a no-op.
fromBits :: Word -> Set a
fromBits :: forall a. Word -> Set a
fromBits Word
w = forall a. Word -> Set a
Set Word
w


{--------------------------------------------------------------------
  Fold
--------------------------------------------------------------------}

fold :: (Eq a, Enum a) => (a -> c -> c) -> c -> Set a -> c
fold :: forall a c. (Eq a, Enum a) => (a -> c -> c) -> c -> Set a -> c
fold a -> c -> c
f c
z (Set Word
w) = forall a. (Int -> a -> a) -> a -> Word -> a
foldrBits Int -> c -> c
folder c
z Word
w
  where folder :: Int -> c -> c
folder Int
i = a -> c -> c
f (forall a. Enum a => Int -> a
toEnum Int
i)

fold' :: (Eq a, Enum a) => (a -> c -> c) -> c -> Set a -> c
fold' :: forall a c. (Eq a, Enum a) => (a -> c -> c) -> c -> Set a -> c
fold' a -> c -> c
f c
z (Set Word
w) = forall a. (Int -> a -> a) -> a -> Word -> a
foldrBits' Int -> c -> c
folder c
z Word
w
  where folder :: Int -> c -> c
folder Int
i = a -> c -> c
f (forall a. Enum a => Int -> a
toEnum Int
i)

fold1 :: (Eq a, Enum a) => (a -> a -> a) -> Set a -> a
fold1 :: forall a. (Eq a, Enum a) => (a -> a -> a) -> Set a -> a
fold1 a -> a -> a
_ (Set Word
0) = forall a. HasCallStack => String -> a
error (String
moduleNameforall a. [a] -> [a] -> [a]
++String
".fold1: empty set")
fold1 a -> a -> a
f (Set Word
w) = forall a. (Int -> a -> a) -> a -> Word -> a
foldrBits Int -> a -> a
folder (forall a. Enum a => Int -> a
toEnum Int
maxi) (forall a. Bits a => a -> Int -> a
clearBit Word
w Int
maxi)
    where
      maxi :: Int
maxi = Word -> Int
msb Word
w
      folder :: Int -> a -> a
folder Int
i a
z = a -> a -> a
f (forall a. Enum a => Int -> a
toEnum Int
i) a
z

fold1' :: (Eq a, Enum a) => (a -> a -> a) -> Set a -> a
fold1' :: forall a. (Eq a, Enum a) => (a -> a -> a) -> Set a -> a
fold1' a -> a -> a
_ (Set Word
0) = forall a. HasCallStack => String -> a
error (String
moduleNameforall a. [a] -> [a] -> [a]
++String
".fold1': empty set")
fold1' a -> a -> a
f (Set Word
w) = forall a. (Int -> a -> a) -> a -> Word -> a
foldrBits Int -> a -> a
folder (forall a. Enum a => Int -> a
toEnum Int
maxi) (forall a. Bits a => a -> Int -> a
clearBit Word
w Int
maxi)
    where
      maxi :: Int
maxi = Word -> Int
msb Word
w
      folder :: Int -> a -> a
folder Int
i a
z = a -> a -> a
f (forall a. Enum a => Int -> a
toEnum Int
i) a
z

foldr :: (Ord a, Enum a) => (a -> b -> b) -> b -> Set a -> b
foldr :: forall a b. (Ord a, Enum a) => (a -> b -> b) -> b -> Set a -> b
foldr a -> b -> b
f b
z (Set Word
w) = forall a. (Int -> a -> a) -> a -> Word -> a
foldrBits Int -> b -> b
folder b
z Word
w
  where folder :: Int -> b -> b
folder Int
i = a -> b -> b
f (forall a. Enum a => Int -> a
toEnum Int
i)

foldr' :: (Ord a, Enum a) => (a -> b -> b) -> b -> Set a -> b
foldr' :: forall a b. (Ord a, Enum a) => (a -> b -> b) -> b -> Set a -> b
foldr' a -> b -> b
f b
z (Set Word
w) = forall a. (Int -> a -> a) -> a -> Word -> a
foldrBits' Int -> b -> b
folder b
z Word
w
  where folder :: Int -> b -> b
folder Int
i b
j = a -> b -> b
f (forall a. Enum a => Int -> a
toEnum Int
i) b
j

foldr1 :: (Ord a, Enum a) => (a -> a -> a) -> Set a -> a
foldr1 :: forall a. (Ord a, Enum a) => (a -> a -> a) -> Set a -> a
foldr1 a -> a -> a
_ (Set Word
0) = forall a. HasCallStack => String -> a
error (String
moduleName forall a. [a] -> [a] -> [a]
++ String
".foldr1: empty set")
foldr1 a -> a -> a
f (Set Word
w) = forall a. (Int -> a -> a) -> a -> Word -> a
foldrBits Int -> a -> a
folder (forall a. Enum a => Int -> a
toEnum Int
maxi) (forall a. Bits a => a -> Int -> a
clearBit Word
w Int
maxi)
    where
      maxi :: Int
maxi = Word -> Int
msb Word
w
      folder :: Int -> a -> a
folder Int
i a
z = a -> a -> a
f (forall a. Enum a => Int -> a
toEnum Int
i) a
z

foldr1' :: (Ord a, Enum a) => (a -> a -> a) -> Set a -> a
foldr1' :: forall a. (Ord a, Enum a) => (a -> a -> a) -> Set a -> a
foldr1' a -> a -> a
_ (Set Word
0) = forall a. HasCallStack => String -> a
error (String
moduleNameforall a. [a] -> [a] -> [a]
++String
".foldr1': empty set")
foldr1' a -> a -> a
f (Set Word
w) = forall a. (Int -> a -> a) -> a -> Word -> a
foldrBits Int -> a -> a
folder (forall a. Enum a => Int -> a
toEnum Int
maxi) (forall a. Bits a => a -> Int -> a
clearBit Word
w Int
maxi)
    where
      maxi :: Int
maxi = Word -> Int
msb Word
w
      folder :: Int -> a -> a
folder Int
i a
z = a -> a -> a
f (forall a. Enum a => Int -> a
toEnum Int
i) a
z

foldl :: (Ord a, Enum a) => (c -> a -> c) -> c -> Set a -> c
foldl :: forall a c. (Ord a, Enum a) => (c -> a -> c) -> c -> Set a -> c
foldl c -> a -> c
f c
z (Set Word
w) = forall a. (a -> Int -> a) -> a -> Word -> a
foldlBits c -> Int -> c
folder c
z Word
w
  where folder :: c -> Int -> c
folder c
h Int
i = c -> a -> c
f c
h (forall a. Enum a => Int -> a
toEnum Int
i)

foldl' :: (Ord a, Enum a) => (c -> a -> c) -> c -> Set a -> c
foldl' :: forall a c. (Ord a, Enum a) => (c -> a -> c) -> c -> Set a -> c
foldl' c -> a -> c
f c
z (Set Word
w) = forall a. (a -> Int -> a) -> a -> Word -> a
foldlBits' c -> Int -> c
folder c
z Word
w
  where folder :: c -> Int -> c
folder c
h Int
i = c -> a -> c
f c
h (forall a. Enum a => Int -> a
toEnum Int
i)

foldl1 :: (Ord a, Enum a) => (a -> a -> a) -> Set a -> a
foldl1 :: forall a. (Ord a, Enum a) => (a -> a -> a) -> Set a -> a
foldl1 a -> a -> a
_ (Set Word
0) = forall a. HasCallStack => String -> a
error (String
moduleNameforall a. [a] -> [a] -> [a]
++String
".foldl1: empty set")
foldl1 a -> a -> a
f (Set Word
w) = forall a. (a -> Int -> a) -> a -> Word -> a
foldlBits a -> Int -> a
folder (forall a. Enum a => Int -> a
toEnum Int
minimum) (forall a. Bits a => a -> Int -> a
clearBit Word
w Int
minimum)
  where
    minimum :: Int
minimum = Word -> Int
lsb Word
w
    folder :: a -> Int -> a
folder a
z Int
i = a -> a -> a
f a
z (forall a. Enum a => Int -> a
toEnum Int
i)

foldl1' :: (Ord a, Enum a) => (a -> a -> a) -> Set a -> a
foldl1' :: forall a. (Ord a, Enum a) => (a -> a -> a) -> Set a -> a
foldl1' a -> a -> a
_ (Set Word
0) = forall a. HasCallStack => String -> a
error (String
moduleNameforall a. [a] -> [a] -> [a]
++String
".foldl1': empty set")
foldl1' a -> a -> a
f (Set Word
w) = forall a. (a -> Int -> a) -> a -> Word -> a
foldlBits' a -> Int -> a
folder (forall a. Enum a => Int -> a
toEnum Int
minimum) (forall a. Bits a => a -> Int -> a
clearBit Word
w Int
minimum)
  where
    minimum :: Int
minimum = Word -> Int
lsb Word
w
    folder :: a -> Int -> a
folder a
z Int
i = a -> a -> a
f a
z (forall a. Enum a => Int -> a
toEnum Int
i)

{--------------------------------------------------------------------
  Lists
--------------------------------------------------------------------}
fromSeq :: (Eq a, Enum a, S.Sequence s) => s a -> Set a
fromSeq :: forall a (s :: * -> *). (Eq a, Enum a, Sequence s) => s a -> Set a
fromSeq s a
xs = forall a. Word -> Set a
Set forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) a b.
Sequence s =>
(a -> b -> b) -> b -> s a -> b
S.fold' forall {a} {a}. (Bits a, Enum a) => a -> a -> a
f Word
0 s a
xs
  where f :: a -> a -> a
f a
x a
z = forall a. Bits a => a -> Int -> a
setBit a
z forall a b. (a -> b) -> a -> b
$ String -> Int -> Int
check String
"fromSeq" forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum a
x

fromOrdSeq :: (Ord a, Enum a, S.Sequence s) => s a -> Set a
fromOrdSeq :: forall a (s :: * -> *). (Ord a, Enum a, Sequence s) => s a -> Set a
fromOrdSeq = forall a (s :: * -> *). (Eq a, Enum a, Sequence s) => s a -> Set a
fromSeq

insertSeq :: (Eq a, Enum a, S.Sequence s) => s a -> Set a -> Set a
insertSeq :: forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
s a -> Set a -> Set a
insertSeq = forall c a (seq :: * -> *).
(CollX c a, Sequence seq) =>
seq a -> c -> c
insertSeqUsingUnion

-- given the preconditions, we can just ignore the combining function
insertSeqWith :: (Eq a, Enum a, S.Sequence s) => (a -> a -> a) -> s a -> Set a -> Set a
insertSeqWith :: forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
(a -> a -> a) -> s a -> Set a -> Set a
insertSeqWith a -> a -> a
_ = forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
s a -> Set a -> Set a
insertSeq

toSeq :: (Eq a, Enum a, S.Sequence s) => Set a -> s a
toSeq :: forall a (s :: * -> *). (Eq a, Enum a, Sequence s) => Set a -> s a
toSeq (Set Word
w) = forall a. (Int -> a -> a) -> a -> Word -> a
foldrBits forall {s :: * -> *} {a}. (Sequence s, Enum a) => Int -> s a -> s a
f forall (s :: * -> *) a. Sequence s => s a
S.empty Word
w
  where f :: Int -> s a -> s a
f Int
i s a
z = forall (s :: * -> *) a. Sequence s => a -> s a -> s a
S.lcons (forall a. Enum a => Int -> a
toEnum Int
i) s a
z

toOrdSeq :: (Ord a, Enum a, S.Sequence s) => Set a -> s a
toOrdSeq :: forall a (s :: * -> *). (Ord a, Enum a, Sequence s) => Set a -> s a
toOrdSeq = forall a (s :: * -> *). (Eq a, Enum a, Sequence s) => Set a -> s a
toSeq

fromSeqWith :: (Eq a, Enum a, S.Sequence s) => (a -> a -> a) -> s a -> Set a
fromSeqWith :: forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
(a -> a -> a) -> s a -> Set a
fromSeqWith = forall c a (seq :: * -> *).
(Set c a, Sequence seq) =>
(a -> a -> a) -> seq a -> c
fromSeqWithUsingInsertWith


{--------------------------------------------------------------------
  Split
--------------------------------------------------------------------}
{-
splitMember :: (Ord a, Enum a) => a -> Set a -> (Set a,Bool,Set a)
splitMember x (Set w) = (Set lesser,isMember,Set greater)
    where
      (lesser,isMember,greater) = foldrBits f (0,False,0) w
      f i (lesser,isMember,greater) =
        case compare (toEnum i) x of
          GT -> (lesser,isMember,setBit greater i)
          LT -> (setBit lesser i,isMember,greater)
          EQ -> (lesser,True,greater)
-}


{----------------------------------------------------------------
  Strictness enhancement
----------------------------------------------------------------}

strict :: Set a -> Set a
strict :: forall a. Set a -> Set a
strict s :: Set a
s@(Set Word
w) = Word
w seq :: forall a b. a -> b -> b
`seq` Set a
s

strictWith :: (a -> b) -> Set a -> Set a
strictWith :: forall a b. (a -> b) -> Set a -> Set a
strictWith a -> b
_ s :: Set a
s@(Set Word
w) = Word
w seq :: forall a b. a -> b -> b
`seq` Set a
s

{--------------------------------------------------------------------
  Utility functions.
--------------------------------------------------------------------}

foldrBits :: (Int -> a -> a) -> a -> Word -> a
foldrBits :: forall a. (Int -> a -> a) -> a -> Word -> a
foldrBits Int -> a -> a
f a
z Word
w = forall a. (Int -> a -> a) -> a -> Int -> Word -> a
foldrBits_aux Int -> a -> a
f a
z Int
0 Word
w

foldrBits_aux :: (Int -> a -> a) -> a -> Int -> Word -> a
foldrBits_aux :: forall a. (Int -> a -> a) -> a -> Int -> Word -> a
foldrBits_aux Int -> a -> a
_ a
z Int
_ Word
0 = a
z
foldrBits_aux Int -> a -> a
f a
z Int
i Word
w
   | Int
i seq :: forall a b. a -> b -> b
`seq` Word
w seq :: forall a b. a -> b -> b
`seq` Bool
False = forall a. HasCallStack => a
undefined
   | Bool
otherwise =
   case Word
w forall a. Bits a => a -> a -> a
.&. Word
0x0F of
     Word
0x00 -> a
a
     Word
0x01 -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x02 -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x03 -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x04 -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x05 -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x06 -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x07 -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x08 -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x09 -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x0A -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x0B -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x0C -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x0D -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x0E -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$ a
a
     Word
0x0F -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$ a
a
     Word
_ -> forall a. HasCallStack => String -> a
error String
"bug in foldrBits_aux"

 where a :: a
a = forall a. (Int -> a -> a) -> a -> Int -> Word -> a
foldrBits_aux Int -> a -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
4) (forall a. Bits a => a -> Int -> a
Bits.shiftR Word
w Int
4)


foldrBits' :: (Int -> a -> a) -> a -> Word -> a
foldrBits' :: forall a. (Int -> a -> a) -> a -> Word -> a
foldrBits' Int -> a -> a
f a
z Word
w = forall a. (Int -> a -> a) -> a -> Int -> Word -> a
foldrBits_aux' Int -> a -> a
f a
z Int
0 Word
w

foldrBits_aux' :: (Int -> a -> a) -> a -> Int -> Word -> a
foldrBits_aux' :: forall a. (Int -> a -> a) -> a -> Int -> Word -> a
foldrBits_aux' Int -> a -> a
_ a
z Int
_ Word
0 = a
z
foldrBits_aux' Int -> a -> a
f a
z Int
i Word
w
   | Int
i seq :: forall a b. a -> b -> b
`seq` Word
w seq :: forall a b. a -> b -> b
`seq` Bool
False = forall a. HasCallStack => a
undefined
   | Bool
otherwise =
   case Word
w forall a. Bits a => a -> a -> a
.&. Word
0x0F of
     Word
0x00 -> a
a
     Word
0x01 -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x02 -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x03 -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x04 -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x05 -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x06 -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x07 -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x08 -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x09 -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x0A -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x0B -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x0C -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x0D -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x0E -> Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$! a
a
     Word
0x0F -> Int -> a -> a
f Int
i forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
2) forall a b. (a -> b) -> a -> b
$! Int -> a -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
3) forall a b. (a -> b) -> a -> b
$! a
a
     Word
_ -> forall a. HasCallStack => String -> a
error String
"bug in foldrBits_aux'"

 where a :: a
a = forall a. (Int -> a -> a) -> a -> Int -> Word -> a
foldrBits_aux' Int -> a -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
4) (forall a. Bits a => a -> Int -> a
Bits.shiftR Word
w Int
4)


foldlBits :: (a -> Int -> a) -> a -> Word -> a
foldlBits :: forall a. (a -> Int -> a) -> a -> Word -> a
foldlBits a -> Int -> a
f a
z Word
w = forall a. (a -> Int -> a) -> a -> Int -> Word -> a
foldlBits_aux a -> Int -> a
f a
z Int
0 Word
w

foldlBits_aux :: (a -> Int -> a) -> a -> Int -> Word -> a
foldlBits_aux :: forall a. (a -> Int -> a) -> a -> Int -> Word -> a
foldlBits_aux a -> Int -> a
_ a
z Int
_ Word
0 = a
z
foldlBits_aux a -> Int -> a
f a
z Int
i Word
w
   | Int
i seq :: forall a b. a -> b -> b
`seq` Word
w seq :: forall a b. a -> b -> b
`seq` Bool
False = forall a. HasCallStack => a
undefined
   | Bool
otherwise =
   case Word
w forall a. Bits a => a -> a -> a
.&. Word
0x0F of
     Word
0x00 -> a -> a
a forall a b. (a -> b) -> a -> b
$ a
z
     Word
0x01 -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f a
z Int
i
     Word
0x02 -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
1)
     Word
0x03 -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
1)
     Word
0x04 -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
2)
     Word
0x05 -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
2)
     Word
0x06 -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f (a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
1)) (Int
iforall a. Num a => a -> a -> a
+Int
2)
     Word
0x07 -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f (a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
1)) (Int
iforall a. Num a => a -> a -> a
+Int
2)
     Word
0x08 -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x09 -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x0A -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f (a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
1)) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x0B -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f (a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
1)) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x0C -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f (a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
2)) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x0D -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f (a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
2)) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x0E -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f (a -> Int -> a
f (a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
1)) (Int
iforall a. Num a => a -> a -> a
+Int
2)) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x0F -> a -> a
a forall a b. (a -> b) -> a -> b
$ a -> Int -> a
f (a -> Int -> a
f (a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
1)) (Int
iforall a. Num a => a -> a -> a
+Int
2)) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
_ -> forall a. HasCallStack => String -> a
error String
"bug in foldlBits_aux"

 where a :: a -> a
a a
b = forall a. (a -> Int -> a) -> a -> Int -> Word -> a
foldlBits_aux a -> Int -> a
f a
b (Int
i forall a. Num a => a -> a -> a
+ Int
4) (forall a. Bits a => a -> Int -> a
Bits.shiftR Word
w Int
4)

foldlBits' :: (a -> Int -> a) -> a -> Word -> a
foldlBits' :: forall a. (a -> Int -> a) -> a -> Word -> a
foldlBits' a -> Int -> a
f a
z Word
w = forall a. (a -> Int -> a) -> a -> Int -> Word -> a
foldlBits_aux' (\a
x Int
i -> a
x seq :: forall a b. a -> b -> b
`seq` a -> Int -> a
f a
x Int
i) a
z Int
0 Word
w

foldlBits_aux' :: (a -> Int -> a) -> a -> Int -> Word -> a
foldlBits_aux' :: forall a. (a -> Int -> a) -> a -> Int -> Word -> a
foldlBits_aux' a -> Int -> a
_ a
z Int
_ Word
0 = a
z
foldlBits_aux' a -> Int -> a
f a
z Int
i Word
w
   | Int
i seq :: forall a b. a -> b -> b
`seq` Word
w seq :: forall a b. a -> b -> b
`seq` Bool
False = forall a. HasCallStack => a
undefined
   | Bool
otherwise =
   case Word
w forall a. Bits a => a -> a -> a
.&. Word
0x0F of
     Word
0x00 -> a -> a
a forall a b. (a -> b) -> a -> b
$! a
z
     Word
0x01 -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f a
z Int
i
     Word
0x02 -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
1)
     Word
0x03 -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
1)
     Word
0x04 -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
2)
     Word
0x05 -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
2)
     Word
0x06 -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f (a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
1)) (Int
iforall a. Num a => a -> a -> a
+Int
2)
     Word
0x07 -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f (a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
1)) (Int
iforall a. Num a => a -> a -> a
+Int
2)
     Word
0x08 -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x09 -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x0A -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f (a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
1)) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x0B -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f (a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
1)) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x0C -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f (a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
2)) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x0D -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f (a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
2)) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x0E -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f (a -> Int -> a
f (a -> Int -> a
f a
z (Int
iforall a. Num a => a -> a -> a
+Int
1)) (Int
iforall a. Num a => a -> a -> a
+Int
2)) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
0x0F -> a -> a
a forall a b. (a -> b) -> a -> b
$! a -> Int -> a
f (a -> Int -> a
f (a -> Int -> a
f (a -> Int -> a
f a
z Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
1)) (Int
iforall a. Num a => a -> a -> a
+Int
2)) (Int
iforall a. Num a => a -> a -> a
+Int
3)
     Word
_ -> forall a. HasCallStack => String -> a
error String
"bug in foldlBits_aux"

 where a :: a -> a
a a
b = forall a. (a -> Int -> a) -> a -> Int -> Word -> a
foldlBits_aux' a -> Int -> a
f a
b (Int
i forall a. Num a => a -> a -> a
+ Int
4) (forall a. Bits a => a -> Int -> a
Bits.shiftR Word
w Int
4)

instance (Eq a, Enum a) => C.CollX (Set a) a where
  {singleton :: a -> Set a
singleton = forall a. (Eq a, Enum a) => a -> Set a
singleton; fromSeq :: forall (seq :: * -> *). Sequence seq => seq a -> Set a
fromSeq = forall a (s :: * -> *). (Eq a, Enum a, Sequence s) => s a -> Set a
fromSeq; insert :: a -> Set a -> Set a
insert = forall a. (Eq a, Enum a) => a -> Set a -> Set a
insert;
   insertSeq :: forall (seq :: * -> *). Sequence seq => seq a -> Set a -> Set a
insertSeq = forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
s a -> Set a -> Set a
insertSeq; unionSeq :: forall (seq :: * -> *). Sequence seq => seq (Set a) -> Set a
unionSeq = forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
s (Set a) -> Set a
unionSeq;
   delete :: a -> Set a -> Set a
delete = forall a. (Eq a, Enum a) => a -> Set a -> Set a
delete; deleteAll :: a -> Set a -> Set a
deleteAll = forall a. (Eq a, Enum a) => a -> Set a -> Set a
deleteAll; deleteSeq :: forall (seq :: * -> *). Sequence seq => seq a -> Set a -> Set a
deleteSeq = forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
s a -> Set a -> Set a
deleteSeq;
   null :: Set a -> Bool
null = forall a. Set a -> Bool
null; size :: Set a -> Int
size = forall a. Set a -> Int
size; member :: a -> Set a -> Bool
member = forall a. (Eq a, Enum a) => a -> Set a -> Bool
member; count :: a -> Set a -> Int
count = forall a. (Eq a, Enum a) => a -> Set a -> Int
count;
   strict :: Set a -> Set a
strict = forall a. Set a -> Set a
strict;
   structuralInvariant :: Set a -> Bool
structuralInvariant = forall a. Set a -> Bool
structuralInvariant; instanceName :: Set a -> String
instanceName Set a
_ = String
moduleName}

instance (Ord a, Enum a) => C.OrdCollX (Set a) a where
  {deleteMin :: Set a -> Set a
deleteMin = forall a. Enum a => Set a -> Set a
deleteMin; deleteMax :: Set a -> Set a
deleteMax = forall a. Enum a => Set a -> Set a
deleteMax;
   unsafeInsertMin :: a -> Set a -> Set a
unsafeInsertMin = forall a. (Ord a, Enum a) => a -> Set a -> Set a
unsafeInsertMin; unsafeInsertMax :: a -> Set a -> Set a
unsafeInsertMax = forall a. (Ord a, Enum a) => a -> Set a -> Set a
unsafeInsertMax;
   unsafeFromOrdSeq :: forall (seq :: * -> *). Sequence seq => seq a -> Set a
unsafeFromOrdSeq = forall a (s :: * -> *). (Ord a, Enum a, Sequence s) => s a -> Set a
unsafeFromOrdSeq; unsafeAppend :: Set a -> Set a -> Set a
unsafeAppend = forall a. (Ord a, Enum a) => Set a -> Set a -> Set a
unsafeAppend;
   filterLT :: a -> Set a -> Set a
filterLT = forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterLT; filterLE :: a -> Set a -> Set a
filterLE = forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterLE; filterGT :: a -> Set a -> Set a
filterGT = forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterGT;
   filterGE :: a -> Set a -> Set a
filterGE = forall a. (Ord a, Enum a) => a -> Set a -> Set a
filterGE; partitionLT_GE :: a -> Set a -> (Set a, Set a)
partitionLT_GE = forall a. (Ord a, Enum a) => a -> Set a -> (Set a, Set a)
partitionLT_GE;
   partitionLE_GT :: a -> Set a -> (Set a, Set a)
partitionLE_GT = forall a. (Ord a, Enum a) => a -> Set a -> (Set a, Set a)
partitionLE_GT; partitionLT_GT :: a -> Set a -> (Set a, Set a)
partitionLT_GT = forall a. (Ord a, Enum a) => a -> Set a -> (Set a, Set a)
partitionLT_GT}

instance (Eq a, Enum a) => C.SetX (Set a) a where
  {intersection :: Set a -> Set a -> Set a
intersection = forall a. Set a -> Set a -> Set a
intersection; difference :: Set a -> Set a -> Set a
difference = forall a. Set a -> Set a -> Set a
difference;
   symmetricDifference :: Set a -> Set a -> Set a
symmetricDifference = forall a. Set a -> Set a -> Set a
symmetricDifference;
   properSubset :: Set a -> Set a -> Bool
properSubset = forall a. Set a -> Set a -> Bool
properSubset; subset :: Set a -> Set a -> Bool
subset = forall a. Set a -> Set a -> Bool
subset}

instance (Eq a, Enum a) => C.Coll (Set a) a where
  {toSeq :: forall (seq :: * -> *). Sequence seq => Set a -> seq a
toSeq = forall a (s :: * -> *). (Eq a, Enum a, Sequence s) => Set a -> s a
toSeq; lookup :: a -> Set a -> a
lookup = forall a. (Eq a, Enum a) => a -> Set a -> a
lookup; lookupM :: forall (m :: * -> *). MonadFail m => a -> Set a -> m a
lookupM = forall a (m :: * -> *).
(Eq a, Enum a, MonadFail m) =>
a -> Set a -> m a
lookupM;
   lookupAll :: forall (seq :: * -> *). Sequence seq => a -> Set a -> seq a
lookupAll = forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
a -> Set a -> s a
lookupAll; lookupWithDefault :: a -> a -> Set a -> a
lookupWithDefault = forall a. (Eq a, Enum a) => a -> a -> Set a -> a
lookupWithDefault;
   fold :: forall b. (a -> b -> b) -> b -> Set a -> b
fold = forall a c. (Eq a, Enum a) => (a -> c -> c) -> c -> Set a -> c
fold; fold' :: forall b. (a -> b -> b) -> b -> Set a -> b
fold' = forall a c. (Eq a, Enum a) => (a -> c -> c) -> c -> Set a -> c
fold'; fold1 :: (a -> a -> a) -> Set a -> a
fold1 = forall a. (Eq a, Enum a) => (a -> a -> a) -> Set a -> a
fold1; fold1' :: (a -> a -> a) -> Set a -> a
fold1' = forall a. (Eq a, Enum a) => (a -> a -> a) -> Set a -> a
fold1';
   filter :: (a -> Bool) -> Set a -> Set a
filter = forall a. (Eq a, Enum a) => (a -> Bool) -> Set a -> Set a
filter; partition :: (a -> Bool) -> Set a -> (Set a, Set a)
partition = forall a. (Eq a, Enum a) => (a -> Bool) -> Set a -> (Set a, Set a)
partition; strictWith :: forall b. (a -> b) -> Set a -> Set a
strictWith = forall a b. (a -> b) -> Set a -> Set a
strictWith}

instance (Ord a, Enum a) => C.OrdColl (Set a) a where
  {minView :: forall (m :: * -> *). MonadFail m => Set a -> m (a, Set a)
minView = forall a (m :: * -> *).
(Enum a, MonadFail m) =>
Set a -> m (a, Set a)
minView; minElem :: Set a -> a
minElem = forall a. Enum a => Set a -> a
minElem; maxView :: forall (m :: * -> *). MonadFail m => Set a -> m (a, Set a)
maxView = forall a (m :: * -> *).
(Enum a, MonadFail m) =>
Set a -> m (a, Set a)
maxView;
   maxElem :: Set a -> a
maxElem = forall a. Enum a => Set a -> a
maxElem; foldr :: forall b. (a -> b -> b) -> b -> Set a -> b
foldr = forall a b. (Ord a, Enum a) => (a -> b -> b) -> b -> Set a -> b
foldr; foldr' :: forall b. (a -> b -> b) -> b -> Set a -> b
foldr' = forall a b. (Ord a, Enum a) => (a -> b -> b) -> b -> Set a -> b
foldr';
   foldl :: forall b. (b -> a -> b) -> b -> Set a -> b
foldl = forall a c. (Ord a, Enum a) => (c -> a -> c) -> c -> Set a -> c
foldl; foldl' :: forall b. (b -> a -> b) -> b -> Set a -> b
foldl' = forall a c. (Ord a, Enum a) => (c -> a -> c) -> c -> Set a -> c
foldl'; foldr1 :: (a -> a -> a) -> Set a -> a
foldr1 = forall a. (Ord a, Enum a) => (a -> a -> a) -> Set a -> a
foldr1; foldr1' :: (a -> a -> a) -> Set a -> a
foldr1' = forall a. (Ord a, Enum a) => (a -> a -> a) -> Set a -> a
foldr1';
   foldl1 :: (a -> a -> a) -> Set a -> a
foldl1 = forall a. (Ord a, Enum a) => (a -> a -> a) -> Set a -> a
foldl1; foldl1' :: (a -> a -> a) -> Set a -> a
foldl1' = forall a. (Ord a, Enum a) => (a -> a -> a) -> Set a -> a
foldl1'; toOrdSeq :: forall (seq :: * -> *). Sequence seq => Set a -> seq a
toOrdSeq = forall a (s :: * -> *). (Ord a, Enum a, Sequence s) => Set a -> s a
toOrdSeq;
   unsafeMapMonotonic :: (a -> a) -> Set a -> Set a
unsafeMapMonotonic = forall a. Enum a => (a -> a) -> Set a -> Set a
unsafeMapMonotonic}

instance (Eq a, Enum a) => C.Set (Set a) a where
  {fromSeqWith :: forall (seq :: * -> *).
Sequence seq =>
(a -> a -> a) -> seq a -> Set a
fromSeqWith = forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
(a -> a -> a) -> s a -> Set a
fromSeqWith; insertWith :: (a -> a -> a) -> a -> Set a -> Set a
insertWith = forall a. (Eq a, Enum a) => (a -> a -> a) -> a -> Set a -> Set a
insertWith;
   insertSeqWith :: forall (seq :: * -> *).
Sequence seq =>
(a -> a -> a) -> seq a -> Set a -> Set a
insertSeqWith = forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
(a -> a -> a) -> s a -> Set a -> Set a
insertSeqWith; unionl :: Set a -> Set a -> Set a
unionl = forall a. Set a -> Set a -> Set a
unionl; unionr :: Set a -> Set a -> Set a
unionr = forall a. Set a -> Set a -> Set a
unionr;
   unionWith :: (a -> a -> a) -> Set a -> Set a -> Set a
unionWith = forall a. (a -> a -> a) -> Set a -> Set a -> Set a
unionWith; unionSeqWith :: forall (seq :: * -> *).
Sequence seq =>
(a -> a -> a) -> seq (Set a) -> Set a
unionSeqWith = forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
(a -> a -> a) -> s (Set a) -> Set a
unionSeqWith;
   intersectionWith :: (a -> a -> a) -> Set a -> Set a -> Set a
intersectionWith = forall a. (a -> a -> a) -> Set a -> Set a -> Set a
intersectionWith}

instance (Ord a, Enum a) => C.OrdSetX (Set a) a
instance (Ord a, Enum a) => C.OrdSet (Set a) a

instance (Eq a, Enum a, Show a) => Show (Set a) where
   showsPrec :: Int -> Set a -> ShowS
showsPrec = forall c a. (Coll c a, Show a) => Int -> c -> ShowS
showsPrecUsingToList

instance (Eq a, Enum a, Read a) => Read (Set a) where
   readsPrec :: Int -> ReadS (Set a)
readsPrec = forall c a. (Coll c a, Read a) => Int -> ReadS c
readsPrecUsingFromList

instance (Eq a, Enum a, Arbitrary a) => Arbitrary (Set a) where
  arbitrary :: Gen (Set a)
arbitrary = do (Int
w::Int) <- forall a. Arbitrary a => Gen a
arbitrary
                 forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Word -> Set a
Set (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w))

instance (Eq a, Enum a, CoArbitrary a) => CoArbitrary (Set a) where
  coarbitrary :: forall b. Set a -> Gen b -> Gen b
coarbitrary (Set Word
w) = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w :: Int)

instance (Eq a, Enum a) => Semigroup (Set a) where
    <> :: Set a -> Set a -> Set a
(<>) = forall a. Set a -> Set a -> Set a
union
instance (Eq a, Enum a) => Monoid (Set a) where
    mempty :: Set a
mempty  = forall a. Set a
empty
    mappend :: Set a -> Set a -> Set a
mappend = forall a. Semigroup a => a -> a -> a
(SG.<>)
    mconcat :: [Set a] -> Set a
mconcat = forall a (s :: * -> *).
(Eq a, Enum a, Sequence s) =>
s (Set a) -> Set a
unionSeq

instance (Ord a, Enum a) => Ord (Set a) where
    compare :: Set a -> Set a -> Ordering
compare = forall c a. OrdColl c a => c -> c -> Ordering
compareUsingToOrdList