{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
#endif
#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)
{-# LANGUAGE Trustworthy #-}
#endif
{-# OPTIONS_HADDOCK not-home #-}
#include "containers.h"
module Data.IntSet.Internal (
IntSet(..), Key
, Prefix, Mask, BitMap
, (\\)
, null
, size
, member
, notMember
, lookupLT
, lookupGT
, lookupLE
, lookupGE
, isSubsetOf
, isProperSubsetOf
, disjoint
, empty
, singleton
, insert
, delete
, alterF
, union
, unions
, difference
, intersection
, filter
, partition
, takeWhileAntitone
, dropWhileAntitone
, spanAntitone
, split
, splitMember
, splitRoot
, map
, mapMonotonic
, foldr
, foldl
, foldr'
, foldl'
, fold
, findMin
, findMax
, deleteMin
, deleteMax
, deleteFindMin
, deleteFindMax
, maxView
, minView
, elems
, toList
, fromList
, toAscList
, toDescList
, fromAscList
, fromDistinctAscList
, showTree
, showTreeWith
, match
, suffixBitMask
, prefixBitMask
, bitmapOf
, zero
) where
import Control.Applicative (Const(..))
import Control.DeepSeq (NFData(rnf))
import Data.Bits
import qualified Data.List as List
import Data.Maybe (fromMaybe)
import Data.Semigroup (Semigroup(stimes))
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup((<>)))
#endif
import Data.Semigroup (stimesIdempotentMonoid)
import Utils.Containers.Internal.Prelude hiding
(filter, foldr, foldl, null, map)
import Prelude ()
import Utils.Containers.Internal.BitUtil
import Utils.Containers.Internal.StrictPair
#if __GLASGOW_HASKELL__
import Data.Data (Data(..), Constr, mkConstr, constrIndex, DataType, mkDataType)
import qualified Data.Data
import Text.Read
#endif
#if __GLASGOW_HASKELL__
import qualified GHC.Exts
# if !(WORD_SIZE_IN_BITS==64)
import qualified GHC.Int
# endif
import Language.Haskell.TH.Syntax (Lift)
import Language.Haskell.TH ()
#endif
import qualified Data.Foldable as Foldable
import Data.Functor.Identity (Identity(..))
infixl 9 \\
type Nat = Word
natFromInt :: Int -> Nat
natFromInt :: Mask -> Word
natFromInt Mask
i = Mask -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Mask
i
{-# INLINE natFromInt #-}
intFromNat :: Nat -> Int
intFromNat :: Word -> Mask
intFromNat Word
w = Word -> Mask
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w
{-# INLINE intFromNat #-}
(\\) :: IntSet -> IntSet -> IntSet
IntSet
m1 \\ :: IntSet -> IntSet -> IntSet
\\ IntSet
m2 = IntSet -> IntSet -> IntSet
difference IntSet
m1 IntSet
m2
data IntSet = Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !IntSet !IntSet
| Tip {-# UNPACK #-} !Prefix {-# UNPACK #-} !BitMap
| Nil
type Prefix = Int
type Mask = Int
type BitMap = Word
type Key = Int
#ifdef __GLASGOW_HASKELL__
deriving instance Lift IntSet
#endif
instance Monoid IntSet where
mempty :: IntSet
mempty = IntSet
empty
mconcat :: [IntSet] -> IntSet
mconcat = [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
unions
mappend :: IntSet -> IntSet -> IntSet
mappend = IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup IntSet where
<> :: IntSet -> IntSet -> IntSet
(<>) = IntSet -> IntSet -> IntSet
union
stimes :: forall b. Integral b => b -> IntSet -> IntSet
stimes = b -> IntSet -> IntSet
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid
#if __GLASGOW_HASKELL__
instance Data IntSet where
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntSet -> c IntSet
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z IntSet
is = ([Mask] -> IntSet) -> c ([Mask] -> IntSet)
forall g. g -> c g
z [Mask] -> IntSet
fromList c ([Mask] -> IntSet) -> [Mask] -> c IntSet
forall d b. Data d => c (d -> b) -> d -> c b
`f` (IntSet -> [Mask]
toList IntSet
is)
toConstr :: IntSet -> Constr
toConstr IntSet
_ = Constr
fromListConstr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntSet
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Mask
constrIndex Constr
c of
Mask
1 -> c ([Mask] -> IntSet) -> c IntSet
forall b r. Data b => c (b -> r) -> c r
k (([Mask] -> IntSet) -> c ([Mask] -> IntSet)
forall r. r -> c r
z [Mask] -> IntSet
fromList)
Mask
_ -> [Char] -> c IntSet
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
dataTypeOf :: IntSet -> DataType
dataTypeOf IntSet
_ = DataType
intSetDataType
fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
intSetDataType [Char]
"fromList" [] Fixity
Data.Data.Prefix
intSetDataType :: DataType
intSetDataType :: DataType
intSetDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.IntSet.Internal.IntSet" [Constr
fromListConstr]
#endif
null :: IntSet -> Bool
null :: IntSet -> Bool
null IntSet
Nil = Bool
True
null IntSet
_ = Bool
False
{-# INLINE null #-}
size :: IntSet -> Int
size :: IntSet -> Mask
size = Mask -> IntSet -> Mask
go Mask
0
where
go :: Mask -> IntSet -> Mask
go !Mask
acc (Bin Mask
_ Mask
_ IntSet
l IntSet
r) = Mask -> IntSet -> Mask
go (Mask -> IntSet -> Mask
go Mask
acc IntSet
l) IntSet
r
go Mask
acc (Tip Mask
_ Word
bm) = Mask
acc Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Word -> Mask
bitcount Mask
0 Word
bm
go Mask
acc IntSet
Nil = Mask
acc
member :: Key -> IntSet -> Bool
member :: Mask -> IntSet -> Bool
member !Mask
x = IntSet -> Bool
go
where
go :: IntSet -> Bool
go (Bin Mask
p Mask
m IntSet
l IntSet
r)
| Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = Bool
False
| Mask -> Mask -> Bool
zero Mask
x Mask
m = IntSet -> Bool
go IntSet
l
| Bool
otherwise = IntSet -> Bool
go IntSet
r
go (Tip Mask
y Word
bm) = Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
y Bool -> Bool -> Bool
&& Mask -> Word
bitmapOf Mask
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0
go IntSet
Nil = Bool
False
notMember :: Key -> IntSet -> Bool
notMember :: Mask -> IntSet -> Bool
notMember Mask
k = Bool -> Bool
not (Bool -> Bool) -> (IntSet -> Bool) -> IntSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mask -> IntSet -> Bool
member Mask
k
lookupLT :: Key -> IntSet -> Maybe Key
lookupLT :: Mask -> IntSet -> Maybe Mask
lookupLT !Mask
x IntSet
t = case IntSet
t of
Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0 then IntSet -> IntSet -> Maybe Mask
go IntSet
r IntSet
l else IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
r
IntSet
_ -> IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
t
where
go :: IntSet -> IntSet -> Maybe Mask
go IntSet
def (Bin Mask
p Mask
m IntSet
l IntSet
r) | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then IntSet -> Maybe Mask
unsafeFindMax IntSet
def else IntSet -> Maybe Mask
unsafeFindMax IntSet
r
| Mask -> Mask -> Bool
zero Mask
x Mask
m = IntSet -> IntSet -> Maybe Mask
go IntSet
def IntSet
l
| Bool
otherwise = IntSet -> IntSet -> Maybe Mask
go IntSet
l IntSet
r
go IntSet
def (Tip Mask
kx Word
bm) | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
kx = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
highestBitSet Word
bm
| Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx Bool -> Bool -> Bool
&& Word
maskLT Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
highestBitSet Word
maskLT
| Bool
otherwise = IntSet -> Maybe Mask
unsafeFindMax IntSet
def
where maskLT :: Word
maskLT = (Mask -> Word
bitmapOf Mask
x Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm
go IntSet
def IntSet
Nil = IntSet -> Maybe Mask
unsafeFindMax IntSet
def
lookupGT :: Key -> IntSet -> Maybe Key
lookupGT :: Mask -> IntSet -> Maybe Mask
lookupGT !Mask
x IntSet
t = case IntSet
t of
Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0 then IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
l else IntSet -> IntSet -> Maybe Mask
go IntSet
l IntSet
r
IntSet
_ -> IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
t
where
go :: IntSet -> IntSet -> Maybe Mask
go IntSet
def (Bin Mask
p Mask
m IntSet
l IntSet
r) | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then IntSet -> Maybe Mask
unsafeFindMin IntSet
l else IntSet -> Maybe Mask
unsafeFindMin IntSet
def
| Mask -> Mask -> Bool
zero Mask
x Mask
m = IntSet -> IntSet -> Maybe Mask
go IntSet
r IntSet
l
| Bool
otherwise = IntSet -> IntSet -> Maybe Mask
go IntSet
def IntSet
r
go IntSet
def (Tip Mask
kx Word
bm) | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
kx = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
lowestBitSet Word
bm
| Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx Bool -> Bool -> Bool
&& Word
maskGT Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
lowestBitSet Word
maskGT
| Bool
otherwise = IntSet -> Maybe Mask
unsafeFindMin IntSet
def
where maskGT :: Word
maskGT = (- ((Mask -> Word
bitmapOf Mask
x) Word -> Mask -> Word
`shiftLL` Mask
1)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm
go IntSet
def IntSet
Nil = IntSet -> Maybe Mask
unsafeFindMin IntSet
def
lookupLE :: Key -> IntSet -> Maybe Key
lookupLE :: Mask -> IntSet -> Maybe Mask
lookupLE !Mask
x IntSet
t = case IntSet
t of
Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0 then IntSet -> IntSet -> Maybe Mask
go IntSet
r IntSet
l else IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
r
IntSet
_ -> IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
t
where
go :: IntSet -> IntSet -> Maybe Mask
go IntSet
def (Bin Mask
p Mask
m IntSet
l IntSet
r) | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then IntSet -> Maybe Mask
unsafeFindMax IntSet
def else IntSet -> Maybe Mask
unsafeFindMax IntSet
r
| Mask -> Mask -> Bool
zero Mask
x Mask
m = IntSet -> IntSet -> Maybe Mask
go IntSet
def IntSet
l
| Bool
otherwise = IntSet -> IntSet -> Maybe Mask
go IntSet
l IntSet
r
go IntSet
def (Tip Mask
kx Word
bm) | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
kx = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
highestBitSet Word
bm
| Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx Bool -> Bool -> Bool
&& Word
maskLE Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
highestBitSet Word
maskLE
| Bool
otherwise = IntSet -> Maybe Mask
unsafeFindMax IntSet
def
where maskLE :: Word
maskLE = (((Mask -> Word
bitmapOf Mask
x) Word -> Mask -> Word
`shiftLL` Mask
1) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm
go IntSet
def IntSet
Nil = IntSet -> Maybe Mask
unsafeFindMax IntSet
def
lookupGE :: Key -> IntSet -> Maybe Key
lookupGE :: Mask -> IntSet -> Maybe Mask
lookupGE !Mask
x IntSet
t = case IntSet
t of
Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0 then IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
l else IntSet -> IntSet -> Maybe Mask
go IntSet
l IntSet
r
IntSet
_ -> IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
t
where
go :: IntSet -> IntSet -> Maybe Mask
go IntSet
def (Bin Mask
p Mask
m IntSet
l IntSet
r) | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then IntSet -> Maybe Mask
unsafeFindMin IntSet
l else IntSet -> Maybe Mask
unsafeFindMin IntSet
def
| Mask -> Mask -> Bool
zero Mask
x Mask
m = IntSet -> IntSet -> Maybe Mask
go IntSet
r IntSet
l
| Bool
otherwise = IntSet -> IntSet -> Maybe Mask
go IntSet
def IntSet
r
go IntSet
def (Tip Mask
kx Word
bm) | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
kx = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
lowestBitSet Word
bm
| Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx Bool -> Bool -> Bool
&& Word
maskGE Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
lowestBitSet Word
maskGE
| Bool
otherwise = IntSet -> Maybe Mask
unsafeFindMin IntSet
def
where maskGE :: Word
maskGE = (- (Mask -> Word
bitmapOf Mask
x)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm
go IntSet
def IntSet
Nil = IntSet -> Maybe Mask
unsafeFindMin IntSet
def
unsafeFindMin :: IntSet -> Maybe Key
unsafeFindMin :: IntSet -> Maybe Mask
unsafeFindMin IntSet
Nil = Maybe Mask
forall a. Maybe a
Nothing
unsafeFindMin (Tip Mask
kx Word
bm) = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
lowestBitSet Word
bm
unsafeFindMin (Bin Mask
_ Mask
_ IntSet
l IntSet
_) = IntSet -> Maybe Mask
unsafeFindMin IntSet
l
unsafeFindMax :: IntSet -> Maybe Key
unsafeFindMax :: IntSet -> Maybe Mask
unsafeFindMax IntSet
Nil = Maybe Mask
forall a. Maybe a
Nothing
unsafeFindMax (Tip Mask
kx Word
bm) = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
highestBitSet Word
bm
unsafeFindMax (Bin Mask
_ Mask
_ IntSet
_ IntSet
r) = IntSet -> Maybe Mask
unsafeFindMax IntSet
r
empty :: IntSet
empty :: IntSet
empty
= IntSet
Nil
{-# INLINE empty #-}
singleton :: Key -> IntSet
singleton :: Mask -> IntSet
singleton Mask
x
= Mask -> Word -> IntSet
Tip (Mask -> Mask
prefixOf Mask
x) (Mask -> Word
bitmapOf Mask
x)
{-# INLINE singleton #-}
insert :: Key -> IntSet -> IntSet
insert :: Mask -> IntSet -> IntSet
insert !Mask
x = Mask -> Word -> IntSet -> IntSet
insertBM (Mask -> Mask
prefixOf Mask
x) (Mask -> Word
bitmapOf Mask
x)
insertBM :: Prefix -> BitMap -> IntSet -> IntSet
insertBM :: Mask -> Word -> IntSet -> IntSet
insertBM !Mask
kx !Word
bm t :: IntSet
t@(Bin Mask
p Mask
m IntSet
l IntSet
r)
| Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p Mask
m = Mask -> IntSet -> Mask -> IntSet -> IntSet
link Mask
kx (Mask -> Word -> IntSet
Tip Mask
kx Word
bm) Mask
p IntSet
t
| Mask -> Mask -> Bool
zero Mask
kx Mask
m = Mask -> Mask -> IntSet -> IntSet -> IntSet
Bin Mask
p Mask
m (Mask -> Word -> IntSet -> IntSet
insertBM Mask
kx Word
bm IntSet
l) IntSet
r
| Bool
otherwise = Mask -> Mask -> IntSet -> IntSet -> IntSet
Bin Mask
p Mask
m IntSet
l (Mask -> Word -> IntSet -> IntSet
insertBM Mask
kx Word
bm IntSet
r)
insertBM Mask
kx Word
bm t :: IntSet
t@(Tip Mask
kx' Word
bm')
| Mask
kx' Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx = Mask -> Word -> IntSet
Tip Mask
kx' (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
bm')
| Bool
otherwise = Mask -> IntSet -> Mask -> IntSet -> IntSet
link Mask
kx (Mask -> Word -> IntSet
Tip Mask
kx Word
bm) Mask
kx' IntSet
t
insertBM Mask
kx Word
bm IntSet
Nil = Mask -> Word -> IntSet
Tip Mask
kx Word
bm
delete :: Key -> IntSet -> IntSet
delete :: Mask -> IntSet -> IntSet
delete !Mask
x = Mask -> Word -> IntSet -> IntSet
deleteBM (Mask -> Mask
prefixOf Mask
x) (Mask -> Word
bitmapOf Mask
x)
deleteBM :: Prefix -> BitMap -> IntSet -> IntSet
deleteBM :: Mask -> Word -> IntSet -> IntSet
deleteBM !Mask
kx !Word
bm t :: IntSet
t@(Bin Mask
p Mask
m IntSet
l IntSet
r)
| Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p Mask
m = IntSet
t
| Mask -> Mask -> Bool
zero Mask
kx Mask
m = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m (Mask -> Word -> IntSet -> IntSet
deleteBM Mask
kx Word
bm IntSet
l) IntSet
r
| Bool
otherwise = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l (Mask -> Word -> IntSet -> IntSet
deleteBM Mask
kx Word
bm IntSet
r)
deleteBM Mask
kx Word
bm t :: IntSet
t@(Tip Mask
kx' Word
bm')
| Mask
kx' Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx = Mask -> Word -> IntSet
tip Mask
kx (Word
bm' Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
bm)
| Bool
otherwise = IntSet
t
deleteBM Mask
_ Word
_ IntSet
Nil = IntSet
Nil
alterF :: Functor f => (Bool -> f Bool) -> Key -> IntSet -> f IntSet
alterF :: forall (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Mask -> IntSet -> f IntSet
alterF Bool -> f Bool
f Mask
k IntSet
s = (Bool -> IntSet) -> f Bool -> f IntSet
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> IntSet
choose (Bool -> f Bool
f Bool
member_)
where
member_ :: Bool
member_ = Mask -> IntSet -> Bool
member Mask
k IntSet
s
(IntSet
inserted, IntSet
deleted)
| Bool
member_ = (IntSet
s , Mask -> IntSet -> IntSet
delete Mask
k IntSet
s)
| Bool
otherwise = (Mask -> IntSet -> IntSet
insert Mask
k IntSet
s, IntSet
s )
choose :: Bool -> IntSet
choose Bool
True = IntSet
inserted
choose Bool
False = IntSet
deleted
#ifndef __GLASGOW_HASKELL__
{-# INLINE alterF #-}
#else
{-# INLINABLE [2] alterF #-}
{-# RULES
"alterF/Const" forall k (f :: Bool -> Const a Bool) . alterF f k = \s -> Const . getConst . f $ member k s
#-}
#endif
{-# SPECIALIZE alterF :: (Bool -> Identity Bool) -> Key -> IntSet -> Identity IntSet #-}
unions :: Foldable f => f IntSet -> IntSet
unions :: forall (f :: * -> *). Foldable f => f IntSet -> IntSet
unions f IntSet
xs
= (IntSet -> IntSet -> IntSet) -> IntSet -> f IntSet -> IntSet
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' IntSet -> IntSet -> IntSet
union IntSet
empty f IntSet
xs
union :: IntSet -> IntSet -> IntSet
union :: IntSet -> IntSet -> IntSet
union t1 :: IntSet
t1@(Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2)
| Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2 = IntSet
union1
| Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1 = IntSet
union2
| Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2 = Mask -> Mask -> IntSet -> IntSet -> IntSet
Bin Mask
p1 Mask
m1 (IntSet -> IntSet -> IntSet
union IntSet
l1 IntSet
l2) (IntSet -> IntSet -> IntSet
union IntSet
r1 IntSet
r2)
| Bool
otherwise = Mask -> IntSet -> Mask -> IntSet -> IntSet
link Mask
p1 IntSet
t1 Mask
p2 IntSet
t2
where
union1 :: IntSet
union1 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p2 Mask
p1 Mask
m1 = Mask -> IntSet -> Mask -> IntSet -> IntSet
link Mask
p1 IntSet
t1 Mask
p2 IntSet
t2
| Mask -> Mask -> Bool
zero Mask
p2 Mask
m1 = Mask -> Mask -> IntSet -> IntSet -> IntSet
Bin Mask
p1 Mask
m1 (IntSet -> IntSet -> IntSet
union IntSet
l1 IntSet
t2) IntSet
r1
| Bool
otherwise = Mask -> Mask -> IntSet -> IntSet -> IntSet
Bin Mask
p1 Mask
m1 IntSet
l1 (IntSet -> IntSet -> IntSet
union IntSet
r1 IntSet
t2)
union2 :: IntSet
union2 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p1 Mask
p2 Mask
m2 = Mask -> IntSet -> Mask -> IntSet -> IntSet
link Mask
p1 IntSet
t1 Mask
p2 IntSet
t2
| Mask -> Mask -> Bool
zero Mask
p1 Mask
m2 = Mask -> Mask -> IntSet -> IntSet -> IntSet
Bin Mask
p2 Mask
m2 (IntSet -> IntSet -> IntSet
union IntSet
t1 IntSet
l2) IntSet
r2
| Bool
otherwise = Mask -> Mask -> IntSet -> IntSet -> IntSet
Bin Mask
p2 Mask
m2 IntSet
l2 (IntSet -> IntSet -> IntSet
union IntSet
t1 IntSet
r2)
union t :: IntSet
t@(Bin Mask
_ Mask
_ IntSet
_ IntSet
_) (Tip Mask
kx Word
bm) = Mask -> Word -> IntSet -> IntSet
insertBM Mask
kx Word
bm IntSet
t
union t :: IntSet
t@(Bin Mask
_ Mask
_ IntSet
_ IntSet
_) IntSet
Nil = IntSet
t
union (Tip Mask
kx Word
bm) IntSet
t = Mask -> Word -> IntSet -> IntSet
insertBM Mask
kx Word
bm IntSet
t
union IntSet
Nil IntSet
t = IntSet
t
difference :: IntSet -> IntSet -> IntSet
difference :: IntSet -> IntSet -> IntSet
difference t1 :: IntSet
t1@(Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2)
| Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2 = IntSet
difference1
| Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1 = IntSet
difference2
| Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2 = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p1 Mask
m1 (IntSet -> IntSet -> IntSet
difference IntSet
l1 IntSet
l2) (IntSet -> IntSet -> IntSet
difference IntSet
r1 IntSet
r2)
| Bool
otherwise = IntSet
t1
where
difference1 :: IntSet
difference1 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p2 Mask
p1 Mask
m1 = IntSet
t1
| Mask -> Mask -> Bool
zero Mask
p2 Mask
m1 = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p1 Mask
m1 (IntSet -> IntSet -> IntSet
difference IntSet
l1 IntSet
t2) IntSet
r1
| Bool
otherwise = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p1 Mask
m1 IntSet
l1 (IntSet -> IntSet -> IntSet
difference IntSet
r1 IntSet
t2)
difference2 :: IntSet
difference2 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p1 Mask
p2 Mask
m2 = IntSet
t1
| Mask -> Mask -> Bool
zero Mask
p1 Mask
m2 = IntSet -> IntSet -> IntSet
difference IntSet
t1 IntSet
l2
| Bool
otherwise = IntSet -> IntSet -> IntSet
difference IntSet
t1 IntSet
r2
difference t :: IntSet
t@(Bin Mask
_ Mask
_ IntSet
_ IntSet
_) (Tip Mask
kx Word
bm) = Mask -> Word -> IntSet -> IntSet
deleteBM Mask
kx Word
bm IntSet
t
difference t :: IntSet
t@(Bin Mask
_ Mask
_ IntSet
_ IntSet
_) IntSet
Nil = IntSet
t
difference t1 :: IntSet
t1@(Tip Mask
kx Word
bm) IntSet
t2 = IntSet -> IntSet
differenceTip IntSet
t2
where differenceTip :: IntSet -> IntSet
differenceTip (Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p2 Mask
m2 = IntSet
t1
| Mask -> Mask -> Bool
zero Mask
kx Mask
m2 = IntSet -> IntSet
differenceTip IntSet
l2
| Bool
otherwise = IntSet -> IntSet
differenceTip IntSet
r2
differenceTip (Tip Mask
kx2 Word
bm2) | Mask
kx Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 = Mask -> Word -> IntSet
tip Mask
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
bm2)
| Bool
otherwise = IntSet
t1
differenceTip IntSet
Nil = IntSet
t1
difference IntSet
Nil IntSet
_ = IntSet
Nil
intersection :: IntSet -> IntSet -> IntSet
intersection :: IntSet -> IntSet -> IntSet
intersection t1 :: IntSet
t1@(Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2)
| Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2 = IntSet
intersection1
| Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1 = IntSet
intersection2
| Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2 = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p1 Mask
m1 (IntSet -> IntSet -> IntSet
intersection IntSet
l1 IntSet
l2) (IntSet -> IntSet -> IntSet
intersection IntSet
r1 IntSet
r2)
| Bool
otherwise = IntSet
Nil
where
intersection1 :: IntSet
intersection1 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p2 Mask
p1 Mask
m1 = IntSet
Nil
| Mask -> Mask -> Bool
zero Mask
p2 Mask
m1 = IntSet -> IntSet -> IntSet
intersection IntSet
l1 IntSet
t2
| Bool
otherwise = IntSet -> IntSet -> IntSet
intersection IntSet
r1 IntSet
t2
intersection2 :: IntSet
intersection2 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p1 Mask
p2 Mask
m2 = IntSet
Nil
| Mask -> Mask -> Bool
zero Mask
p1 Mask
m2 = IntSet -> IntSet -> IntSet
intersection IntSet
t1 IntSet
l2
| Bool
otherwise = IntSet -> IntSet -> IntSet
intersection IntSet
t1 IntSet
r2
intersection t1 :: IntSet
t1@(Bin Mask
_ Mask
_ IntSet
_ IntSet
_) (Tip Mask
kx2 Word
bm2) = IntSet -> IntSet
intersectBM IntSet
t1
where intersectBM :: IntSet -> IntSet
intersectBM (Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx2 Mask
p1 Mask
m1 = IntSet
Nil
| Mask -> Mask -> Bool
zero Mask
kx2 Mask
m1 = IntSet -> IntSet
intersectBM IntSet
l1
| Bool
otherwise = IntSet -> IntSet
intersectBM IntSet
r1
intersectBM (Tip Mask
kx1 Word
bm1) | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 = Mask -> Word -> IntSet
tip Mask
kx1 (Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm2)
| Bool
otherwise = IntSet
Nil
intersectBM IntSet
Nil = IntSet
Nil
intersection (Bin Mask
_ Mask
_ IntSet
_ IntSet
_) IntSet
Nil = IntSet
Nil
intersection (Tip Mask
kx1 Word
bm1) IntSet
t2 = IntSet -> IntSet
intersectBM IntSet
t2
where intersectBM :: IntSet -> IntSet
intersectBM (Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx1 Mask
p2 Mask
m2 = IntSet
Nil
| Mask -> Mask -> Bool
zero Mask
kx1 Mask
m2 = IntSet -> IntSet
intersectBM IntSet
l2
| Bool
otherwise = IntSet -> IntSet
intersectBM IntSet
r2
intersectBM (Tip Mask
kx2 Word
bm2) | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 = Mask -> Word -> IntSet
tip Mask
kx1 (Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm2)
| Bool
otherwise = IntSet
Nil
intersectBM IntSet
Nil = IntSet
Nil
intersection IntSet
Nil IntSet
_ = IntSet
Nil
isProperSubsetOf :: IntSet -> IntSet -> Bool
isProperSubsetOf :: IntSet -> IntSet -> Bool
isProperSubsetOf IntSet
t1 IntSet
t2
= case IntSet -> IntSet -> Ordering
subsetCmp IntSet
t1 IntSet
t2 of
Ordering
LT -> Bool
True
Ordering
_ -> Bool
False
subsetCmp :: IntSet -> IntSet -> Ordering
subsetCmp :: IntSet -> IntSet -> Ordering
subsetCmp t1 :: IntSet
t1@(Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) (Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2)
| Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2 = Ordering
GT
| Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1 = case Ordering
subsetCmpLt of
Ordering
GT -> Ordering
GT
Ordering
_ -> Ordering
LT
| Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2 = Ordering
subsetCmpEq
| Bool
otherwise = Ordering
GT
where
subsetCmpLt :: Ordering
subsetCmpLt | Mask -> Mask -> Mask -> Bool
nomatch Mask
p1 Mask
p2 Mask
m2 = Ordering
GT
| Mask -> Mask -> Bool
zero Mask
p1 Mask
m2 = IntSet -> IntSet -> Ordering
subsetCmp IntSet
t1 IntSet
l2
| Bool
otherwise = IntSet -> IntSet -> Ordering
subsetCmp IntSet
t1 IntSet
r2
subsetCmpEq :: Ordering
subsetCmpEq = case (IntSet -> IntSet -> Ordering
subsetCmp IntSet
l1 IntSet
l2, IntSet -> IntSet -> Ordering
subsetCmp IntSet
r1 IntSet
r2) of
(Ordering
GT,Ordering
_ ) -> Ordering
GT
(Ordering
_ ,Ordering
GT) -> Ordering
GT
(Ordering
EQ,Ordering
EQ) -> Ordering
EQ
(Ordering, Ordering)
_ -> Ordering
LT
subsetCmp (Bin Mask
_ Mask
_ IntSet
_ IntSet
_) IntSet
_ = Ordering
GT
subsetCmp (Tip Mask
kx1 Word
bm1) (Tip Mask
kx2 Word
bm2)
| Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
kx2 = Ordering
GT
| Word
bm1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
bm2 = Ordering
EQ
| Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
bm2 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = Ordering
LT
| Bool
otherwise = Ordering
GT
subsetCmp t1 :: IntSet
t1@(Tip Mask
kx Word
_) (Bin Mask
p Mask
m IntSet
l IntSet
r)
| Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p Mask
m = Ordering
GT
| Mask -> Mask -> Bool
zero Mask
kx Mask
m = case IntSet -> IntSet -> Ordering
subsetCmp IntSet
t1 IntSet
l of Ordering
GT -> Ordering
GT ; Ordering
_ -> Ordering
LT
| Bool
otherwise = case IntSet -> IntSet -> Ordering
subsetCmp IntSet
t1 IntSet
r of Ordering
GT -> Ordering
GT ; Ordering
_ -> Ordering
LT
subsetCmp (Tip Mask
_ Word
_) IntSet
Nil = Ordering
GT
subsetCmp IntSet
Nil IntSet
Nil = Ordering
EQ
subsetCmp IntSet
Nil IntSet
_ = Ordering
LT
isSubsetOf :: IntSet -> IntSet -> Bool
isSubsetOf :: IntSet -> IntSet -> Bool
isSubsetOf t1 :: IntSet
t1@(Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) (Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2)
| Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2 = Bool
False
| Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1 = Mask -> Mask -> Mask -> Bool
match Mask
p1 Mask
p2 Mask
m2 Bool -> Bool -> Bool
&& (if Mask -> Mask -> Bool
zero Mask
p1 Mask
m2 then IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
l2
else IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
r2)
| Bool
otherwise = (Mask
p1Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
==Mask
p2) Bool -> Bool -> Bool
&& IntSet -> IntSet -> Bool
isSubsetOf IntSet
l1 IntSet
l2 Bool -> Bool -> Bool
&& IntSet -> IntSet -> Bool
isSubsetOf IntSet
r1 IntSet
r2
isSubsetOf (Bin Mask
_ Mask
_ IntSet
_ IntSet
_) IntSet
_ = Bool
False
isSubsetOf (Tip Mask
kx1 Word
bm1) (Tip Mask
kx2 Word
bm2) = Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 Bool -> Bool -> Bool
&& Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
bm2 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
isSubsetOf t1 :: IntSet
t1@(Tip Mask
kx Word
_) (Bin Mask
p Mask
m IntSet
l IntSet
r)
| Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p Mask
m = Bool
False
| Mask -> Mask -> Bool
zero Mask
kx Mask
m = IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
l
| Bool
otherwise = IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
r
isSubsetOf (Tip Mask
_ Word
_) IntSet
Nil = Bool
False
isSubsetOf IntSet
Nil IntSet
_ = Bool
True
disjoint :: IntSet -> IntSet -> Bool
disjoint :: IntSet -> IntSet -> Bool
disjoint t1 :: IntSet
t1@(Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2)
| Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2 = Bool
disjoint1
| Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1 = Bool
disjoint2
| Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2 = IntSet -> IntSet -> Bool
disjoint IntSet
l1 IntSet
l2 Bool -> Bool -> Bool
&& IntSet -> IntSet -> Bool
disjoint IntSet
r1 IntSet
r2
| Bool
otherwise = Bool
True
where
disjoint1 :: Bool
disjoint1 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p2 Mask
p1 Mask
m1 = Bool
True
| Mask -> Mask -> Bool
zero Mask
p2 Mask
m1 = IntSet -> IntSet -> Bool
disjoint IntSet
l1 IntSet
t2
| Bool
otherwise = IntSet -> IntSet -> Bool
disjoint IntSet
r1 IntSet
t2
disjoint2 :: Bool
disjoint2 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p1 Mask
p2 Mask
m2 = Bool
True
| Mask -> Mask -> Bool
zero Mask
p1 Mask
m2 = IntSet -> IntSet -> Bool
disjoint IntSet
t1 IntSet
l2
| Bool
otherwise = IntSet -> IntSet -> Bool
disjoint IntSet
t1 IntSet
r2
disjoint t1 :: IntSet
t1@(Bin Mask
_ Mask
_ IntSet
_ IntSet
_) (Tip Mask
kx2 Word
bm2) = IntSet -> Bool
disjointBM IntSet
t1
where disjointBM :: IntSet -> Bool
disjointBM (Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx2 Mask
p1 Mask
m1 = Bool
True
| Mask -> Mask -> Bool
zero Mask
kx2 Mask
m1 = IntSet -> Bool
disjointBM IntSet
l1
| Bool
otherwise = IntSet -> Bool
disjointBM IntSet
r1
disjointBM (Tip Mask
kx1 Word
bm1) | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 = (Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm2) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
| Bool
otherwise = Bool
True
disjointBM IntSet
Nil = Bool
True
disjoint (Bin Mask
_ Mask
_ IntSet
_ IntSet
_) IntSet
Nil = Bool
True
disjoint (Tip Mask
kx1 Word
bm1) IntSet
t2 = IntSet -> Bool
disjointBM IntSet
t2
where disjointBM :: IntSet -> Bool
disjointBM (Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx1 Mask
p2 Mask
m2 = Bool
True
| Mask -> Mask -> Bool
zero Mask
kx1 Mask
m2 = IntSet -> Bool
disjointBM IntSet
l2
| Bool
otherwise = IntSet -> Bool
disjointBM IntSet
r2
disjointBM (Tip Mask
kx2 Word
bm2) | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 = (Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm2) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
| Bool
otherwise = Bool
True
disjointBM IntSet
Nil = Bool
True
disjoint IntSet
Nil IntSet
_ = Bool
True
filter :: (Key -> Bool) -> IntSet -> IntSet
filter :: (Mask -> Bool) -> IntSet -> IntSet
filter Mask -> Bool
predicate IntSet
t
= case IntSet
t of
Bin Mask
p Mask
m IntSet
l IntSet
r
-> Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m ((Mask -> Bool) -> IntSet -> IntSet
filter Mask -> Bool
predicate IntSet
l) ((Mask -> Bool) -> IntSet -> IntSet
filter Mask -> Bool
predicate IntSet
r)
Tip Mask
kx Word
bm
-> Mask -> Word -> IntSet
tip Mask
kx (Mask -> (Word -> Mask -> Word) -> Word -> Word -> Word
forall a. Mask -> (a -> Mask -> a) -> a -> Word -> a
foldl'Bits Mask
0 (Mask -> Word -> Mask -> Word
bitPred Mask
kx) Word
0 Word
bm)
IntSet
Nil -> IntSet
Nil
where bitPred :: Mask -> Word -> Mask -> Word
bitPred Mask
kx Word
bm Mask
bi | Mask -> Bool
predicate (Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask
bi) = Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Mask -> Word
bitmapOfSuffix Mask
bi
| Bool
otherwise = Word
bm
{-# INLINE bitPred #-}
partition :: (Key -> Bool) -> IntSet -> (IntSet,IntSet)
partition :: (Mask -> Bool) -> IntSet -> (IntSet, IntSet)
partition Mask -> Bool
predicate0 IntSet
t0 = StrictPair IntSet IntSet -> (IntSet, IntSet)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair IntSet IntSet -> (IntSet, IntSet))
-> StrictPair IntSet IntSet -> (IntSet, IntSet)
forall a b. (a -> b) -> a -> b
$ (Mask -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Mask -> Bool
predicate0 IntSet
t0
where
go :: (Mask -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Mask -> Bool
predicate IntSet
t
= case IntSet
t of
Bin Mask
p Mask
m IntSet
l IntSet
r
-> let (IntSet
l1 :*: IntSet
l2) = (Mask -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Mask -> Bool
predicate IntSet
l
(IntSet
r1 :*: IntSet
r2) = (Mask -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Mask -> Bool
predicate IntSet
r
in Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l1 IntSet
r1 IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l2 IntSet
r2
Tip Mask
kx Word
bm
-> let bm1 :: Word
bm1 = Mask -> (Word -> Mask -> Word) -> Word -> Word -> Word
forall a. Mask -> (a -> Mask -> a) -> a -> Word -> a
foldl'Bits Mask
0 (Mask -> Word -> Mask -> Word
bitPred Mask
kx) Word
0 Word
bm
in Mask -> Word -> IntSet
tip Mask
kx Word
bm1 IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: Mask -> Word -> IntSet
tip Mask
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
bm1)
IntSet
Nil -> (IntSet
Nil IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
Nil)
where bitPred :: Mask -> Word -> Mask -> Word
bitPred Mask
kx Word
bm Mask
bi | Mask -> Bool
predicate (Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask
bi) = Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Mask -> Word
bitmapOfSuffix Mask
bi
| Bool
otherwise = Word
bm
{-# INLINE bitPred #-}
takeWhileAntitone :: (Key -> Bool) -> IntSet -> IntSet
takeWhileAntitone :: (Mask -> Bool) -> IntSet -> IntSet
takeWhileAntitone Mask -> Bool
predicate IntSet
t =
case IntSet
t of
Bin Mask
p Mask
m IntSet
l IntSet
r
| Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 ->
if Mask -> Bool
predicate Mask
0
then Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m ((Mask -> Bool) -> IntSet -> IntSet
go Mask -> Bool
predicate IntSet
l) IntSet
r
else (Mask -> Bool) -> IntSet -> IntSet
go Mask -> Bool
predicate IntSet
r
IntSet
_ -> (Mask -> Bool) -> IntSet -> IntSet
go Mask -> Bool
predicate IntSet
t
where
go :: (Mask -> Bool) -> IntSet -> IntSet
go Mask -> Bool
predicate' (Bin Mask
p Mask
m IntSet
l IntSet
r)
| Mask -> Bool
predicate' (Mask -> Bool) -> Mask -> Bool
forall a b. (a -> b) -> a -> b
$! Mask
pMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
m = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l ((Mask -> Bool) -> IntSet -> IntSet
go Mask -> Bool
predicate' IntSet
r)
| Bool
otherwise = (Mask -> Bool) -> IntSet -> IntSet
go Mask -> Bool
predicate' IntSet
l
go Mask -> Bool
predicate' (Tip Mask
kx Word
bm) = Mask -> Word -> IntSet
tip Mask
kx (Mask -> (Mask -> Bool) -> Word -> Word
takeWhileAntitoneBits Mask
kx Mask -> Bool
predicate' Word
bm)
go Mask -> Bool
_ IntSet
Nil = IntSet
Nil
dropWhileAntitone :: (Key -> Bool) -> IntSet -> IntSet
dropWhileAntitone :: (Mask -> Bool) -> IntSet -> IntSet
dropWhileAntitone Mask -> Bool
predicate IntSet
t =
case IntSet
t of
Bin Mask
p Mask
m IntSet
l IntSet
r
| Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 ->
if Mask -> Bool
predicate Mask
0
then (Mask -> Bool) -> IntSet -> IntSet
go Mask -> Bool
predicate IntSet
l
else Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l ((Mask -> Bool) -> IntSet -> IntSet
go Mask -> Bool
predicate IntSet
r)
IntSet
_ -> (Mask -> Bool) -> IntSet -> IntSet
go Mask -> Bool
predicate IntSet
t
where
go :: (Mask -> Bool) -> IntSet -> IntSet
go Mask -> Bool
predicate' (Bin Mask
p Mask
m IntSet
l IntSet
r)
| Mask -> Bool
predicate' (Mask -> Bool) -> Mask -> Bool
forall a b. (a -> b) -> a -> b
$! Mask
pMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
m = (Mask -> Bool) -> IntSet -> IntSet
go Mask -> Bool
predicate' IntSet
r
| Bool
otherwise = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m ((Mask -> Bool) -> IntSet -> IntSet
go Mask -> Bool
predicate' IntSet
l) IntSet
r
go Mask -> Bool
predicate' (Tip Mask
kx Word
bm) = Mask -> Word -> IntSet
tip Mask
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Mask -> (Mask -> Bool) -> Word -> Word
takeWhileAntitoneBits Mask
kx Mask -> Bool
predicate' Word
bm)
go Mask -> Bool
_ IntSet
Nil = IntSet
Nil
spanAntitone :: (Key -> Bool) -> IntSet -> (IntSet, IntSet)
spanAntitone :: (Mask -> Bool) -> IntSet -> (IntSet, IntSet)
spanAntitone Mask -> Bool
predicate IntSet
t =
case IntSet
t of
Bin Mask
p Mask
m IntSet
l IntSet
r
| Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 ->
if Mask -> Bool
predicate Mask
0
then
case (Mask -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Mask -> Bool
predicate IntSet
l of
(IntSet
lt :*: IntSet
gt) ->
let !lt' :: IntSet
lt' = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
lt IntSet
r
in (IntSet
lt', IntSet
gt)
else
case (Mask -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Mask -> Bool
predicate IntSet
r of
(IntSet
lt :*: IntSet
gt) ->
let !gt' :: IntSet
gt' = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l IntSet
gt
in (IntSet
lt, IntSet
gt')
IntSet
_ -> case (Mask -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Mask -> Bool
predicate IntSet
t of
(IntSet
lt :*: IntSet
gt) -> (IntSet
lt, IntSet
gt)
where
go :: (Mask -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Mask -> Bool
predicate' (Bin Mask
p Mask
m IntSet
l IntSet
r)
| Mask -> Bool
predicate' (Mask -> Bool) -> Mask -> Bool
forall a b. (a -> b) -> a -> b
$! Mask
pMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
m = case (Mask -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Mask -> Bool
predicate' IntSet
r of (IntSet
lt :*: IntSet
gt) -> Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l IntSet
lt IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
gt
| Bool
otherwise = case (Mask -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Mask -> Bool
predicate' IntSet
l of (IntSet
lt :*: IntSet
gt) -> IntSet
lt IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
gt IntSet
r
go Mask -> Bool
predicate' (Tip Mask
kx Word
bm) = let bm' :: Word
bm' = Mask -> (Mask -> Bool) -> Word -> Word
takeWhileAntitoneBits Mask
kx Mask -> Bool
predicate' Word
bm
in (Mask -> Word -> IntSet
tip Mask
kx Word
bm' IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: Mask -> Word -> IntSet
tip Mask
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
bm'))
go Mask -> Bool
_ IntSet
Nil = (IntSet
Nil IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
Nil)
split :: Key -> IntSet -> (IntSet,IntSet)
split :: Mask -> IntSet -> (IntSet, IntSet)
split Mask
x IntSet
t =
case IntSet
t of
Bin Mask
p Mask
m IntSet
l IntSet
r
| Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 ->
if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0
then
case Mask -> IntSet -> StrictPair IntSet IntSet
go Mask
x IntSet
l of
(IntSet
lt :*: IntSet
gt) ->
let !lt' :: IntSet
lt' = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
lt IntSet
r
in (IntSet
lt', IntSet
gt)
else
case Mask -> IntSet -> StrictPair IntSet IntSet
go Mask
x IntSet
r of
(IntSet
lt :*: IntSet
gt) ->
let !gt' :: IntSet
gt' = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l IntSet
gt
in (IntSet
lt, IntSet
gt')
IntSet
_ -> case Mask -> IntSet -> StrictPair IntSet IntSet
go Mask
x IntSet
t of
(IntSet
lt :*: IntSet
gt) -> (IntSet
lt, IntSet
gt)
where
go :: Mask -> IntSet -> StrictPair IntSet IntSet
go !Mask
x' t' :: IntSet
t'@(Bin Mask
p Mask
m IntSet
l IntSet
r)
| Mask -> Mask -> Mask -> Bool
nomatch Mask
x' Mask
p Mask
m = if Mask
x' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then (IntSet
Nil IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
t') else (IntSet
t' IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
Nil)
| Mask -> Mask -> Bool
zero Mask
x' Mask
m = case Mask -> IntSet -> StrictPair IntSet IntSet
go Mask
x' IntSet
l of (IntSet
lt :*: IntSet
gt) -> IntSet
lt IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
gt IntSet
r
| Bool
otherwise = case Mask -> IntSet -> StrictPair IntSet IntSet
go Mask
x' IntSet
r of (IntSet
lt :*: IntSet
gt) -> Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l IntSet
lt IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
gt
go Mask
x' t' :: IntSet
t'@(Tip Mask
kx' Word
bm)
| Mask
kx' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
x' = (IntSet
Nil IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
t')
| Mask
kx' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask -> Mask
prefixOf Mask
x' = (IntSet
t' IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
Nil)
| Bool
otherwise = Mask -> Word -> IntSet
tip Mask
kx' (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
lowerBitmap) IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: Mask -> Word -> IntSet
tip Mask
kx' (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
higherBitmap)
where lowerBitmap :: Word
lowerBitmap = Mask -> Word
bitmapOf Mask
x' Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
higherBitmap :: Word
higherBitmap = Word -> Word
forall a. Bits a => a -> a
complement (Word
lowerBitmap Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Mask -> Word
bitmapOf Mask
x')
go Mask
_ IntSet
Nil = (IntSet
Nil IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
Nil)
splitMember :: Key -> IntSet -> (IntSet,Bool,IntSet)
splitMember :: Mask -> IntSet -> (IntSet, Bool, IntSet)
splitMember Mask
x IntSet
t =
case IntSet
t of
Bin Mask
p Mask
m IntSet
l IntSet
r
| Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 ->
if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0
then
case Mask -> IntSet -> (IntSet, Bool, IntSet)
go Mask
x IntSet
l of
(IntSet
lt, Bool
fnd, IntSet
gt) ->
let !lt' :: IntSet
lt' = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
lt IntSet
r
in (IntSet
lt', Bool
fnd, IntSet
gt)
else
case Mask -> IntSet -> (IntSet, Bool, IntSet)
go Mask
x IntSet
r of
(IntSet
lt, Bool
fnd, IntSet
gt) ->
let !gt' :: IntSet
gt' = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l IntSet
gt
in (IntSet
lt, Bool
fnd, IntSet
gt')
IntSet
_ -> Mask -> IntSet -> (IntSet, Bool, IntSet)
go Mask
x IntSet
t
where
go :: Mask -> IntSet -> (IntSet, Bool, IntSet)
go Mask
x' t' :: IntSet
t'@(Bin Mask
p Mask
m IntSet
l IntSet
r)
| Mask -> Mask -> Mask -> Bool
nomatch Mask
x' Mask
p Mask
m = if Mask
x' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then (IntSet
Nil, Bool
False, IntSet
t') else (IntSet
t', Bool
False, IntSet
Nil)
| Mask -> Mask -> Bool
zero Mask
x' Mask
m =
case Mask -> IntSet -> (IntSet, Bool, IntSet)
go Mask
x' IntSet
l of
(IntSet
lt, Bool
fnd, IntSet
gt) ->
let !gt' :: IntSet
gt' = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
gt IntSet
r
in (IntSet
lt, Bool
fnd, IntSet
gt')
| Bool
otherwise =
case Mask -> IntSet -> (IntSet, Bool, IntSet)
go Mask
x' IntSet
r of
(IntSet
lt, Bool
fnd, IntSet
gt) ->
let !lt' :: IntSet
lt' = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l IntSet
lt
in (IntSet
lt', Bool
fnd, IntSet
gt)
go Mask
x' t' :: IntSet
t'@(Tip Mask
kx' Word
bm)
| Mask
kx' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
x' = (IntSet
Nil, Bool
False, IntSet
t')
| Mask
kx' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask -> Mask
prefixOf Mask
x' = (IntSet
t', Bool
False, IntSet
Nil)
| Bool
otherwise = let !lt :: IntSet
lt = Mask -> Word -> IntSet
tip Mask
kx' (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
lowerBitmap)
!found :: Bool
found = (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bitmapOfx') Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0
!gt :: IntSet
gt = Mask -> Word -> IntSet
tip Mask
kx' (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
higherBitmap)
in (IntSet
lt, Bool
found, IntSet
gt)
where bitmapOfx' :: Word
bitmapOfx' = Mask -> Word
bitmapOf Mask
x'
lowerBitmap :: Word
lowerBitmap = Word
bitmapOfx' Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
higherBitmap :: Word
higherBitmap = Word -> Word
forall a. Bits a => a -> a
complement (Word
lowerBitmap Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
bitmapOfx')
go Mask
_ IntSet
Nil = (IntSet
Nil, Bool
False, IntSet
Nil)
maxView :: IntSet -> Maybe (Key, IntSet)
maxView :: IntSet -> Maybe (Mask, IntSet)
maxView IntSet
t =
case IntSet
t of IntSet
Nil -> Maybe (Mask, IntSet)
forall a. Maybe a
Nothing
Bin Mask
p Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> case IntSet -> (Mask, IntSet)
go IntSet
l of (Mask
result, IntSet
l') -> (Mask, IntSet) -> Maybe (Mask, IntSet)
forall a. a -> Maybe a
Just (Mask
result, Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l' IntSet
r)
IntSet
_ -> (Mask, IntSet) -> Maybe (Mask, IntSet)
forall a. a -> Maybe a
Just (IntSet -> (Mask, IntSet)
go IntSet
t)
where
go :: IntSet -> (Mask, IntSet)
go (Bin Mask
p Mask
m IntSet
l IntSet
r) = case IntSet -> (Mask, IntSet)
go IntSet
r of (Mask
result, IntSet
r') -> (Mask
result, Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l IntSet
r')
go (Tip Mask
kx Word
bm) = case Word -> Mask
highestBitSet Word
bm of Mask
bi -> (Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask
bi, Mask -> Word -> IntSet
tip Mask
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement (Mask -> Word
bitmapOfSuffix Mask
bi)))
go IntSet
Nil = [Char] -> (Mask, IntSet)
forall a. HasCallStack => [Char] -> a
error [Char]
"maxView Nil"
minView :: IntSet -> Maybe (Key, IntSet)
minView :: IntSet -> Maybe (Mask, IntSet)
minView IntSet
t =
case IntSet
t of IntSet
Nil -> Maybe (Mask, IntSet)
forall a. Maybe a
Nothing
Bin Mask
p Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> case IntSet -> (Mask, IntSet)
go IntSet
r of (Mask
result, IntSet
r') -> (Mask, IntSet) -> Maybe (Mask, IntSet)
forall a. a -> Maybe a
Just (Mask
result, Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l IntSet
r')
IntSet
_ -> (Mask, IntSet) -> Maybe (Mask, IntSet)
forall a. a -> Maybe a
Just (IntSet -> (Mask, IntSet)
go IntSet
t)
where
go :: IntSet -> (Mask, IntSet)
go (Bin Mask
p Mask
m IntSet
l IntSet
r) = case IntSet -> (Mask, IntSet)
go IntSet
l of (Mask
result, IntSet
l') -> (Mask
result, Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l' IntSet
r)
go (Tip Mask
kx Word
bm) = case Word -> Mask
lowestBitSet Word
bm of Mask
bi -> (Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask
bi, Mask -> Word -> IntSet
tip Mask
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement (Mask -> Word
bitmapOfSuffix Mask
bi)))
go IntSet
Nil = [Char] -> (Mask, IntSet)
forall a. HasCallStack => [Char] -> a
error [Char]
"minView Nil"
deleteFindMin :: IntSet -> (Key, IntSet)
deleteFindMin :: IntSet -> (Mask, IntSet)
deleteFindMin = (Mask, IntSet) -> Maybe (Mask, IntSet) -> (Mask, IntSet)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (Mask, IntSet)
forall a. HasCallStack => [Char] -> a
error [Char]
"deleteFindMin: empty set has no minimal element") (Maybe (Mask, IntSet) -> (Mask, IntSet))
-> (IntSet -> Maybe (Mask, IntSet)) -> IntSet -> (Mask, IntSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Mask, IntSet)
minView
deleteFindMax :: IntSet -> (Key, IntSet)
deleteFindMax :: IntSet -> (Mask, IntSet)
deleteFindMax = (Mask, IntSet) -> Maybe (Mask, IntSet) -> (Mask, IntSet)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (Mask, IntSet)
forall a. HasCallStack => [Char] -> a
error [Char]
"deleteFindMax: empty set has no maximal element") (Maybe (Mask, IntSet) -> (Mask, IntSet))
-> (IntSet -> Maybe (Mask, IntSet)) -> IntSet -> (Mask, IntSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Mask, IntSet)
maxView
findMin :: IntSet -> Key
findMin :: IntSet -> Mask
findMin IntSet
Nil = [Char] -> Mask
forall a. HasCallStack => [Char] -> a
error [Char]
"findMin: empty set has no minimal element"
findMin (Tip Mask
kx Word
bm) = Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
lowestBitSet Word
bm
findMin (Bin Mask
_ Mask
m IntSet
l IntSet
r)
| Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 = IntSet -> Mask
find IntSet
r
| Bool
otherwise = IntSet -> Mask
find IntSet
l
where find :: IntSet -> Mask
find (Tip Mask
kx Word
bm) = Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
lowestBitSet Word
bm
find (Bin Mask
_ Mask
_ IntSet
l' IntSet
_) = IntSet -> Mask
find IntSet
l'
find IntSet
Nil = [Char] -> Mask
forall a. HasCallStack => [Char] -> a
error [Char]
"findMin Nil"
findMax :: IntSet -> Key
findMax :: IntSet -> Mask
findMax IntSet
Nil = [Char] -> Mask
forall a. HasCallStack => [Char] -> a
error [Char]
"findMax: empty set has no maximal element"
findMax (Tip Mask
kx Word
bm) = Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
highestBitSet Word
bm
findMax (Bin Mask
_ Mask
m IntSet
l IntSet
r)
| Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 = IntSet -> Mask
find IntSet
l
| Bool
otherwise = IntSet -> Mask
find IntSet
r
where find :: IntSet -> Mask
find (Tip Mask
kx Word
bm) = Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
highestBitSet Word
bm
find (Bin Mask
_ Mask
_ IntSet
_ IntSet
r') = IntSet -> Mask
find IntSet
r'
find IntSet
Nil = [Char] -> Mask
forall a. HasCallStack => [Char] -> a
error [Char]
"findMax Nil"
deleteMin :: IntSet -> IntSet
deleteMin :: IntSet -> IntSet
deleteMin = IntSet
-> ((Mask, IntSet) -> IntSet) -> Maybe (Mask, IntSet) -> IntSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntSet
Nil (Mask, IntSet) -> IntSet
forall a b. (a, b) -> b
snd (Maybe (Mask, IntSet) -> IntSet)
-> (IntSet -> Maybe (Mask, IntSet)) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Mask, IntSet)
minView
deleteMax :: IntSet -> IntSet
deleteMax :: IntSet -> IntSet
deleteMax = IntSet
-> ((Mask, IntSet) -> IntSet) -> Maybe (Mask, IntSet) -> IntSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntSet
Nil (Mask, IntSet) -> IntSet
forall a b. (a, b) -> b
snd (Maybe (Mask, IntSet) -> IntSet)
-> (IntSet -> Maybe (Mask, IntSet)) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Mask, IntSet)
maxView
map :: (Key -> Key) -> IntSet -> IntSet
map :: (Mask -> Mask) -> IntSet -> IntSet
map Mask -> Mask
f = [Mask] -> IntSet
fromList ([Mask] -> IntSet) -> (IntSet -> [Mask]) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mask -> Mask) -> [Mask] -> [Mask]
forall a b. (a -> b) -> [a] -> [b]
List.map Mask -> Mask
f ([Mask] -> [Mask]) -> (IntSet -> [Mask]) -> IntSet -> [Mask]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Mask]
toList
mapMonotonic :: (Key -> Key) -> IntSet -> IntSet
mapMonotonic :: (Mask -> Mask) -> IntSet -> IntSet
mapMonotonic Mask -> Mask
f = [Mask] -> IntSet
fromDistinctAscList ([Mask] -> IntSet) -> (IntSet -> [Mask]) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mask -> Mask) -> [Mask] -> [Mask]
forall a b. (a -> b) -> [a] -> [b]
List.map Mask -> Mask
f ([Mask] -> [Mask]) -> (IntSet -> [Mask]) -> IntSet -> [Mask]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Mask]
toAscList
fold :: (Key -> b -> b) -> b -> IntSet -> b
fold :: forall b. (Mask -> b -> b) -> b -> IntSet -> b
fold = (Mask -> b -> b) -> b -> IntSet -> b
forall b. (Mask -> b -> b) -> b -> IntSet -> b
foldr
{-# INLINE fold #-}
foldr :: (Key -> b -> b) -> b -> IntSet -> b
foldr :: forall b. (Mask -> b -> b) -> b -> IntSet -> b
foldr Mask -> b -> b
f b
z = \IntSet
t ->
case IntSet
t of Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> b -> IntSet -> b
go (b -> IntSet -> b
go b
z IntSet
l) IntSet
r
| Bool
otherwise -> b -> IntSet -> b
go (b -> IntSet -> b
go b
z IntSet
r) IntSet
l
IntSet
_ -> b -> IntSet -> b
go b
z IntSet
t
where
go :: b -> IntSet -> b
go b
z' IntSet
Nil = b
z'
go b
z' (Tip Mask
kx Word
bm) = Mask -> (Mask -> b -> b) -> b -> Word -> b
forall a. Mask -> (Mask -> a -> a) -> a -> Word -> a
foldrBits Mask
kx Mask -> b -> b
f b
z' Word
bm
go b
z' (Bin Mask
_ Mask
_ IntSet
l IntSet
r) = b -> IntSet -> b
go (b -> IntSet -> b
go b
z' IntSet
r) IntSet
l
{-# INLINE foldr #-}
foldr' :: (Key -> b -> b) -> b -> IntSet -> b
foldr' :: forall b. (Mask -> b -> b) -> b -> IntSet -> b
foldr' Mask -> b -> b
f b
z = \IntSet
t ->
case IntSet
t of Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> b -> IntSet -> b
go (b -> IntSet -> b
go b
z IntSet
l) IntSet
r
| Bool
otherwise -> b -> IntSet -> b
go (b -> IntSet -> b
go b
z IntSet
r) IntSet
l
IntSet
_ -> b -> IntSet -> b
go b
z IntSet
t
where
go :: b -> IntSet -> b
go !b
z' IntSet
Nil = b
z'
go b
z' (Tip Mask
kx Word
bm) = Mask -> (Mask -> b -> b) -> b -> Word -> b
forall a. Mask -> (Mask -> a -> a) -> a -> Word -> a
foldr'Bits Mask
kx Mask -> b -> b
f b
z' Word
bm
go b
z' (Bin Mask
_ Mask
_ IntSet
l IntSet
r) = b -> IntSet -> b
go (b -> IntSet -> b
go b
z' IntSet
r) IntSet
l
{-# INLINE foldr' #-}
foldl :: (a -> Key -> a) -> a -> IntSet -> a
foldl :: forall a. (a -> Mask -> a) -> a -> IntSet -> a
foldl a -> Mask -> a
f a
z = \IntSet
t ->
case IntSet
t of Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> a -> IntSet -> a
go (a -> IntSet -> a
go a
z IntSet
r) IntSet
l
| Bool
otherwise -> a -> IntSet -> a
go (a -> IntSet -> a
go a
z IntSet
l) IntSet
r
IntSet
_ -> a -> IntSet -> a
go a
z IntSet
t
where
go :: a -> IntSet -> a
go a
z' IntSet
Nil = a
z'
go a
z' (Tip Mask
kx Word
bm) = Mask -> (a -> Mask -> a) -> a -> Word -> a
forall a. Mask -> (a -> Mask -> a) -> a -> Word -> a
foldlBits Mask
kx a -> Mask -> a
f a
z' Word
bm
go a
z' (Bin Mask
_ Mask
_ IntSet
l IntSet
r) = a -> IntSet -> a
go (a -> IntSet -> a
go a
z' IntSet
l) IntSet
r
{-# INLINE foldl #-}
foldl' :: (a -> Key -> a) -> a -> IntSet -> a
foldl' :: forall a. (a -> Mask -> a) -> a -> IntSet -> a
foldl' a -> Mask -> a
f a
z = \IntSet
t ->
case IntSet
t of Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> a -> IntSet -> a
go (a -> IntSet -> a
go a
z IntSet
r) IntSet
l
| Bool
otherwise -> a -> IntSet -> a
go (a -> IntSet -> a
go a
z IntSet
l) IntSet
r
IntSet
_ -> a -> IntSet -> a
go a
z IntSet
t
where
go :: a -> IntSet -> a
go !a
z' IntSet
Nil = a
z'
go a
z' (Tip Mask
kx Word
bm) = Mask -> (a -> Mask -> a) -> a -> Word -> a
forall a. Mask -> (a -> Mask -> a) -> a -> Word -> a
foldl'Bits Mask
kx a -> Mask -> a
f a
z' Word
bm
go a
z' (Bin Mask
_ Mask
_ IntSet
l IntSet
r) = a -> IntSet -> a
go (a -> IntSet -> a
go a
z' IntSet
l) IntSet
r
{-# INLINE foldl' #-}
elems :: IntSet -> [Key]
elems :: IntSet -> [Mask]
elems
= IntSet -> [Mask]
toAscList
#ifdef __GLASGOW_HASKELL__
instance GHC.Exts.IsList IntSet where
type Item IntSet = Key
fromList :: [Item IntSet] -> IntSet
fromList = [Mask] -> IntSet
[Item IntSet] -> IntSet
fromList
toList :: IntSet -> [Item IntSet]
toList = IntSet -> [Mask]
IntSet -> [Item IntSet]
toList
#endif
toList :: IntSet -> [Key]
toList :: IntSet -> [Mask]
toList
= IntSet -> [Mask]
toAscList
toAscList :: IntSet -> [Key]
toAscList :: IntSet -> [Mask]
toAscList = (Mask -> [Mask] -> [Mask]) -> [Mask] -> IntSet -> [Mask]
forall b. (Mask -> b -> b) -> b -> IntSet -> b
foldr (:) []
toDescList :: IntSet -> [Key]
toDescList :: IntSet -> [Mask]
toDescList = ([Mask] -> Mask -> [Mask]) -> [Mask] -> IntSet -> [Mask]
forall a. (a -> Mask -> a) -> a -> IntSet -> a
foldl ((Mask -> [Mask] -> [Mask]) -> [Mask] -> Mask -> [Mask]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []
#if __GLASGOW_HASKELL__
foldrFB :: (Key -> b -> b) -> b -> IntSet -> b
foldrFB :: forall b. (Mask -> b -> b) -> b -> IntSet -> b
foldrFB = (Mask -> b -> b) -> b -> IntSet -> b
forall b. (Mask -> b -> b) -> b -> IntSet -> b
foldr
{-# INLINE[0] foldrFB #-}
foldlFB :: (a -> Key -> a) -> a -> IntSet -> a
foldlFB :: forall a. (a -> Mask -> a) -> a -> IntSet -> a
foldlFB = (a -> Mask -> a) -> a -> IntSet -> a
forall a. (a -> Mask -> a) -> a -> IntSet -> a
foldl
{-# INLINE[0] foldlFB #-}
{-# INLINE elems #-}
{-# INLINE toList #-}
{-# NOINLINE[0] toAscList #-}
{-# NOINLINE[0] toDescList #-}
{-# RULES "IntSet.toAscList" [~1] forall s . toAscList s = GHC.Exts.build (\c n -> foldrFB c n s) #-}
{-# RULES "IntSet.toAscListBack" [1] foldrFB (:) [] = toAscList #-}
{-# RULES "IntSet.toDescList" [~1] forall s . toDescList s = GHC.Exts.build (\c n -> foldlFB (\xs x -> c x xs) n s) #-}
{-# RULES "IntSet.toDescListBack" [1] foldlFB (\xs x -> x : xs) [] = toDescList #-}
#endif
fromList :: [Key] -> IntSet
fromList :: [Mask] -> IntSet
fromList [Mask]
xs
= (IntSet -> Mask -> IntSet) -> IntSet -> [Mask] -> IntSet
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' IntSet -> Mask -> IntSet
ins IntSet
empty [Mask]
xs
where
ins :: IntSet -> Mask -> IntSet
ins IntSet
t Mask
x = Mask -> IntSet -> IntSet
insert Mask
x IntSet
t
fromAscList :: [Key] -> IntSet
fromAscList :: [Mask] -> IntSet
fromAscList = [Mask] -> IntSet
fromMonoList
{-# NOINLINE fromAscList #-}
fromDistinctAscList :: [Key] -> IntSet
fromDistinctAscList :: [Mask] -> IntSet
fromDistinctAscList = [Mask] -> IntSet
fromAscList
{-# INLINE fromDistinctAscList #-}
fromMonoList :: [Key] -> IntSet
fromMonoList :: [Mask] -> IntSet
fromMonoList [] = IntSet
Nil
fromMonoList (Mask
kx : [Mask]
zs1) = Mask -> Word -> [Mask] -> IntSet
addAll' (Mask -> Mask
prefixOf Mask
kx) (Mask -> Word
bitmapOf Mask
kx) [Mask]
zs1
where
addAll' :: Mask -> Word -> [Mask] -> IntSet
addAll' !Mask
px !Word
bm []
= Mask -> Word -> IntSet
Tip Mask
px Word
bm
addAll' !Mask
px !Word
bm (Mask
ky : [Mask]
zs)
| Mask
px Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask -> Mask
prefixOf Mask
ky
= Mask -> Word -> [Mask] -> IntSet
addAll' Mask
px (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Mask -> Word
bitmapOf Mask
ky) [Mask]
zs
| Mask
py <- Mask -> Mask
prefixOf Mask
ky
, Mask
m <- Mask -> Mask -> Mask
branchMask Mask
px Mask
py
, Inserted IntSet
ty [Mask]
zs' <- Mask -> Mask -> Word -> [Mask] -> Inserted
addMany' Mask
m Mask
py (Mask -> Word
bitmapOf Mask
ky) [Mask]
zs
= Mask -> IntSet -> [Mask] -> IntSet
addAll Mask
px (Mask -> Mask -> IntSet -> IntSet -> IntSet
linkWithMask Mask
m Mask
py IntSet
ty (Mask -> Word -> IntSet
Tip Mask
px Word
bm)) [Mask]
zs'
addAll :: Mask -> IntSet -> [Mask] -> IntSet
addAll !Mask
_px !IntSet
tx []
= IntSet
tx
addAll !Mask
px !IntSet
tx (Mask
ky : [Mask]
zs)
| Mask
py <- Mask -> Mask
prefixOf Mask
ky
, Mask
m <- Mask -> Mask -> Mask
branchMask Mask
px Mask
py
, Inserted IntSet
ty [Mask]
zs' <- Mask -> Mask -> Word -> [Mask] -> Inserted
addMany' Mask
m Mask
py (Mask -> Word
bitmapOf Mask
ky) [Mask]
zs
= Mask -> IntSet -> [Mask] -> IntSet
addAll Mask
px (Mask -> Mask -> IntSet -> IntSet -> IntSet
linkWithMask Mask
m Mask
py IntSet
ty IntSet
tx) [Mask]
zs'
addMany' :: Mask -> Mask -> Word -> [Mask] -> Inserted
addMany' !Mask
_m !Mask
px !Word
bm []
= IntSet -> [Mask] -> Inserted
Inserted (Mask -> Word -> IntSet
Tip Mask
px Word
bm) []
addMany' !Mask
m !Mask
px !Word
bm zs0 :: [Mask]
zs0@(Mask
ky : [Mask]
zs)
| Mask
px Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask -> Mask
prefixOf Mask
ky
= Mask -> Mask -> Word -> [Mask] -> Inserted
addMany' Mask
m Mask
px (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Mask -> Word
bitmapOf Mask
ky) [Mask]
zs
| Mask -> Mask -> Mask
mask Mask
px Mask
m Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask -> Mask -> Mask
mask Mask
ky Mask
m
= IntSet -> [Mask] -> Inserted
Inserted (Mask -> Word -> IntSet
Tip (Mask -> Mask
prefixOf Mask
px) Word
bm) [Mask]
zs0
| Mask
py <- Mask -> Mask
prefixOf Mask
ky
, Mask
mxy <- Mask -> Mask -> Mask
branchMask Mask
px Mask
py
, Inserted IntSet
ty [Mask]
zs' <- Mask -> Mask -> Word -> [Mask] -> Inserted
addMany' Mask
mxy Mask
py (Mask -> Word
bitmapOf Mask
ky) [Mask]
zs
= Mask -> Mask -> IntSet -> [Mask] -> Inserted
addMany Mask
m Mask
px (Mask -> Mask -> IntSet -> IntSet -> IntSet
linkWithMask Mask
mxy Mask
py IntSet
ty (Mask -> Word -> IntSet
Tip Mask
px Word
bm)) [Mask]
zs'
addMany :: Mask -> Mask -> IntSet -> [Mask] -> Inserted
addMany !Mask
_m !Mask
_px IntSet
tx []
= IntSet -> [Mask] -> Inserted
Inserted IntSet
tx []
addMany !Mask
m !Mask
px IntSet
tx zs0 :: [Mask]
zs0@(Mask
ky : [Mask]
zs)
| Mask -> Mask -> Mask
mask Mask
px Mask
m Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask -> Mask -> Mask
mask Mask
ky Mask
m
= IntSet -> [Mask] -> Inserted
Inserted IntSet
tx [Mask]
zs0
| Mask
py <- Mask -> Mask
prefixOf Mask
ky
, Mask
mxy <- Mask -> Mask -> Mask
branchMask Mask
px Mask
py
, Inserted IntSet
ty [Mask]
zs' <- Mask -> Mask -> Word -> [Mask] -> Inserted
addMany' Mask
mxy Mask
py (Mask -> Word
bitmapOf Mask
ky) [Mask]
zs
= Mask -> Mask -> IntSet -> [Mask] -> Inserted
addMany Mask
m Mask
px (Mask -> Mask -> IntSet -> IntSet -> IntSet
linkWithMask Mask
mxy Mask
py IntSet
ty IntSet
tx) [Mask]
zs'
{-# INLINE fromMonoList #-}
data Inserted = Inserted !IntSet ![Key]
instance Eq IntSet where
IntSet
t1 == :: IntSet -> IntSet -> Bool
== IntSet
t2 = IntSet -> IntSet -> Bool
equal IntSet
t1 IntSet
t2
IntSet
t1 /= :: IntSet -> IntSet -> Bool
/= IntSet
t2 = IntSet -> IntSet -> Bool
nequal IntSet
t1 IntSet
t2
equal :: IntSet -> IntSet -> Bool
equal :: IntSet -> IntSet -> Bool
equal (Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) (Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2)
= (Mask
m1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
m2) Bool -> Bool -> Bool
&& (Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2) Bool -> Bool -> Bool
&& (IntSet -> IntSet -> Bool
equal IntSet
l1 IntSet
l2) Bool -> Bool -> Bool
&& (IntSet -> IntSet -> Bool
equal IntSet
r1 IntSet
r2)
equal (Tip Mask
kx1 Word
bm1) (Tip Mask
kx2 Word
bm2)
= Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 Bool -> Bool -> Bool
&& Word
bm1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
bm2
equal IntSet
Nil IntSet
Nil = Bool
True
equal IntSet
_ IntSet
_ = Bool
False
nequal :: IntSet -> IntSet -> Bool
nequal :: IntSet -> IntSet -> Bool
nequal (Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) (Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2)
= (Mask
m1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
m2) Bool -> Bool -> Bool
|| (Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
p2) Bool -> Bool -> Bool
|| (IntSet -> IntSet -> Bool
nequal IntSet
l1 IntSet
l2) Bool -> Bool -> Bool
|| (IntSet -> IntSet -> Bool
nequal IntSet
r1 IntSet
r2)
nequal (Tip Mask
kx1 Word
bm1) (Tip Mask
kx2 Word
bm2)
= Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
kx2 Bool -> Bool -> Bool
|| Word
bm1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
bm2
nequal IntSet
Nil IntSet
Nil = Bool
False
nequal IntSet
_ IntSet
_ = Bool
True
instance Ord IntSet where
compare :: IntSet -> IntSet -> Ordering
compare IntSet
s1 IntSet
s2 = [Mask] -> [Mask] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (IntSet -> [Mask]
toAscList IntSet
s1) (IntSet -> [Mask]
toAscList IntSet
s2)
instance Show IntSet where
showsPrec :: Mask -> IntSet -> ShowS
showsPrec Mask
p IntSet
xs = Bool -> ShowS -> ShowS
showParen (Mask
p Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
[Char] -> ShowS
showString [Char]
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mask] -> ShowS
forall a. Show a => a -> ShowS
shows (IntSet -> [Mask]
toList IntSet
xs)
instance Read IntSet where
#ifdef __GLASGOW_HASKELL__
readPrec :: ReadPrec IntSet
readPrec = ReadPrec IntSet -> ReadPrec IntSet
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec IntSet -> ReadPrec IntSet)
-> ReadPrec IntSet -> ReadPrec IntSet
forall a b. (a -> b) -> a -> b
$ Mask -> ReadPrec IntSet -> ReadPrec IntSet
forall a. Mask -> ReadPrec a -> ReadPrec a
prec Mask
10 (ReadPrec IntSet -> ReadPrec IntSet)
-> ReadPrec IntSet -> ReadPrec IntSet
forall a b. (a -> b) -> a -> b
$ do
Ident [Char]
"fromList" <- ReadPrec Lexeme
lexP
[Mask]
xs <- ReadPrec [Mask]
forall a. Read a => ReadPrec a
readPrec
IntSet -> ReadPrec IntSet
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Mask] -> IntSet
fromList [Mask]
xs)
readListPrec :: ReadPrec [IntSet]
readListPrec = ReadPrec [IntSet]
forall a. Read a => ReadPrec [a]
readListPrecDefault
#else
readsPrec p = readParen (p > 10) $ \ r -> do
("fromList",s) <- lex r
(xs,t) <- reads s
return (fromList xs,t)
#endif
instance NFData IntSet where rnf :: IntSet -> ()
rnf IntSet
x = IntSet -> () -> ()
forall a b. a -> b -> b
seq IntSet
x ()
showTree :: IntSet -> String
showTree :: IntSet -> [Char]
showTree IntSet
s
= Bool -> Bool -> IntSet -> [Char]
showTreeWith Bool
True Bool
False IntSet
s
showTreeWith :: Bool -> Bool -> IntSet -> String
showTreeWith :: Bool -> Bool -> IntSet -> [Char]
showTreeWith Bool
hang Bool
wide IntSet
t
| Bool
hang = (Bool -> [[Char]] -> IntSet -> ShowS
showsTreeHang Bool
wide [] IntSet
t) [Char]
""
| Bool
otherwise = (Bool -> [[Char]] -> [[Char]] -> IntSet -> ShowS
showsTree Bool
wide [] [] IntSet
t) [Char]
""
showsTree :: Bool -> [String] -> [String] -> IntSet -> ShowS
showsTree :: Bool -> [[Char]] -> [[Char]] -> IntSet -> ShowS
showsTree Bool
wide [[Char]]
lbars [[Char]]
rbars IntSet
t
= case IntSet
t of
Bin Mask
p Mask
m IntSet
l IntSet
r
-> Bool -> [[Char]] -> [[Char]] -> IntSet -> ShowS
showsTree Bool
wide ([[Char]] -> [[Char]]
withBar [[Char]]
rbars) ([[Char]] -> [[Char]]
withEmpty [[Char]]
rbars) IntSet
r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
rbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[[Char]] -> ShowS
showsBars [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString (Mask -> Mask -> [Char]
showBin Mask
p Mask
m) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> [[Char]] -> IntSet -> ShowS
showsTree Bool
wide ([[Char]] -> [[Char]]
withEmpty [[Char]]
lbars) ([[Char]] -> [[Char]]
withBar [[Char]]
lbars) IntSet
l
Tip Mask
kx Word
bm
-> [[Char]] -> ShowS
showsBars [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mask -> ShowS
forall a. Show a => a -> ShowS
shows Mask
kx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" + " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Word -> ShowS
showsBitMap Word
bm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
IntSet
Nil -> [[Char]] -> ShowS
showsBars [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"|\n"
showsTreeHang :: Bool -> [String] -> IntSet -> ShowS
showsTreeHang :: Bool -> [[Char]] -> IntSet -> ShowS
showsTreeHang Bool
wide [[Char]]
bars IntSet
t
= case IntSet
t of
Bin Mask
p Mask
m IntSet
l IntSet
r
-> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString (Mask -> Mask -> [Char]
showBin Mask
p Mask
m) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> IntSet -> ShowS
showsTreeHang Bool
wide ([[Char]] -> [[Char]]
withBar [[Char]]
bars) IntSet
l ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> IntSet -> ShowS
showsTreeHang Bool
wide ([[Char]] -> [[Char]]
withEmpty [[Char]]
bars) IntSet
r
Tip Mask
kx Word
bm
-> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mask -> ShowS
forall a. Show a => a -> ShowS
shows Mask
kx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" + " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Word -> ShowS
showsBitMap Word
bm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
IntSet
Nil -> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"|\n"
showBin :: Prefix -> Mask -> String
showBin :: Mask -> Mask -> [Char]
showBin Mask
_ Mask
_
= [Char]
"*"
showWide :: Bool -> [String] -> String -> String
showWide :: Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
bars
| Bool
wide = [Char] -> ShowS
showString ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
bars)) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"|\n"
| Bool
otherwise = ShowS
forall a. a -> a
id
showsBars :: [String] -> ShowS
showsBars :: [[Char]] -> ShowS
showsBars [] = ShowS
forall a. a -> a
id
showsBars ([Char]
_ : [[Char]]
tl) = [Char] -> ShowS
showString ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
tl)) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
node
showsBitMap :: Word -> ShowS
showsBitMap :: Word -> ShowS
showsBitMap = [Char] -> ShowS
showString ([Char] -> ShowS) -> (Word -> [Char]) -> Word -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> [Char]
showBitMap
showBitMap :: Word -> String
showBitMap :: Word -> [Char]
showBitMap Word
w = [Mask] -> [Char]
forall a. Show a => a -> [Char]
show ([Mask] -> [Char]) -> [Mask] -> [Char]
forall a b. (a -> b) -> a -> b
$ Mask -> (Mask -> [Mask] -> [Mask]) -> [Mask] -> Word -> [Mask]
forall a. Mask -> (Mask -> a -> a) -> a -> Word -> a
foldrBits Mask
0 (:) [] Word
w
node :: String
node :: [Char]
node = [Char]
"+--"
withBar, withEmpty :: [String] -> [String]
withBar :: [[Char]] -> [[Char]]
withBar [[Char]]
bars = [Char]
"| "[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
bars
withEmpty :: [[Char]] -> [[Char]]
withEmpty [[Char]]
bars = [Char]
" "[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
bars
link :: Prefix -> IntSet -> Prefix -> IntSet -> IntSet
link :: Mask -> IntSet -> Mask -> IntSet -> IntSet
link Mask
p1 IntSet
t1 Mask
p2 IntSet
t2 = Mask -> Mask -> IntSet -> IntSet -> IntSet
linkWithMask (Mask -> Mask -> Mask
branchMask Mask
p1 Mask
p2) Mask
p1 IntSet
t1 IntSet
t2
{-# INLINE link #-}
linkWithMask :: Mask -> Prefix -> IntSet -> IntSet -> IntSet
linkWithMask :: Mask -> Mask -> IntSet -> IntSet -> IntSet
linkWithMask Mask
m Mask
p1 IntSet
t1 IntSet
t2
| Mask -> Mask -> Bool
zero Mask
p1 Mask
m = Mask -> Mask -> IntSet -> IntSet -> IntSet
Bin Mask
p Mask
m IntSet
t1 IntSet
t2
| Bool
otherwise = Mask -> Mask -> IntSet -> IntSet -> IntSet
Bin Mask
p Mask
m IntSet
t2 IntSet
t1
where
p :: Mask
p = Mask -> Mask -> Mask
mask Mask
p1 Mask
m
{-# INLINE linkWithMask #-}
bin :: Prefix -> Mask -> IntSet -> IntSet -> IntSet
bin :: Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
_ Mask
_ IntSet
l IntSet
Nil = IntSet
l
bin Mask
_ Mask
_ IntSet
Nil IntSet
r = IntSet
r
bin Mask
p Mask
m IntSet
l IntSet
r = Mask -> Mask -> IntSet -> IntSet -> IntSet
Bin Mask
p Mask
m IntSet
l IntSet
r
{-# INLINE bin #-}
tip :: Prefix -> BitMap -> IntSet
tip :: Mask -> Word -> IntSet
tip Mask
_ Word
0 = IntSet
Nil
tip Mask
kx Word
bm = Mask -> Word -> IntSet
Tip Mask
kx Word
bm
{-# INLINE tip #-}
suffixBitMask :: Int
suffixBitMask :: Mask
suffixBitMask = Word -> Mask
forall b. FiniteBits b => b -> Mask
finiteBitSize (Word
forall a. HasCallStack => a
undefined::Word) Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1
{-# INLINE suffixBitMask #-}
prefixBitMask :: Int
prefixBitMask :: Mask
prefixBitMask = Mask -> Mask
forall a. Bits a => a -> a
complement Mask
suffixBitMask
{-# INLINE prefixBitMask #-}
prefixOf :: Int -> Prefix
prefixOf :: Mask -> Mask
prefixOf Mask
x = Mask
x Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
prefixBitMask
{-# INLINE prefixOf #-}
suffixOf :: Int -> Int
suffixOf :: Mask -> Mask
suffixOf Mask
x = Mask
x Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
suffixBitMask
{-# INLINE suffixOf #-}
bitmapOfSuffix :: Int -> BitMap
bitmapOfSuffix :: Mask -> Word
bitmapOfSuffix Mask
s = Word
1 Word -> Mask -> Word
`shiftLL` Mask
s
{-# INLINE bitmapOfSuffix #-}
bitmapOf :: Int -> BitMap
bitmapOf :: Mask -> Word
bitmapOf Mask
x = Mask -> Word
bitmapOfSuffix (Mask -> Mask
suffixOf Mask
x)
{-# INLINE bitmapOf #-}
zero :: Int -> Mask -> Bool
zero :: Mask -> Mask -> Bool
zero Mask
i Mask
m
= (Mask -> Word
natFromInt Mask
i) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Mask -> Word
natFromInt Mask
m) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
{-# INLINE zero #-}
nomatch,match :: Int -> Prefix -> Mask -> Bool
nomatch :: Mask -> Mask -> Mask -> Bool
nomatch Mask
i Mask
p Mask
m
= (Mask -> Mask -> Mask
mask Mask
i Mask
m) Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
p
{-# INLINE nomatch #-}
match :: Mask -> Mask -> Mask -> Bool
match Mask
i Mask
p Mask
m
= (Mask -> Mask -> Mask
mask Mask
i Mask
m) Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p
{-# INLINE match #-}
mask :: Int -> Mask -> Prefix
mask :: Mask -> Mask -> Mask
mask Mask
i Mask
m
= Word -> Word -> Mask
maskW (Mask -> Word
natFromInt Mask
i) (Mask -> Word
natFromInt Mask
m)
{-# INLINE mask #-}
maskW :: Nat -> Nat -> Prefix
maskW :: Word -> Word -> Mask
maskW Word
i Word
m
= Word -> Mask
intFromNat (Word
i Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word -> Word
forall a. Bits a => a -> a
complement (Word
mWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
m))
{-# INLINE maskW #-}
shorter :: Mask -> Mask -> Bool
shorter :: Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2
= (Mask -> Word
natFromInt Mask
m1) Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> (Mask -> Word
natFromInt Mask
m2)
{-# INLINE shorter #-}
branchMask :: Prefix -> Prefix -> Mask
branchMask :: Mask -> Mask -> Mask
branchMask Mask
p1 Mask
p2
= Word -> Mask
intFromNat (Word -> Word
highestBitMask (Mask -> Word
natFromInt Mask
p1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Mask -> Word
natFromInt Mask
p2))
{-# INLINE branchMask #-}
lowestBitSet :: Nat -> Int
highestBitSet :: Nat -> Int
foldlBits :: Int -> (a -> Int -> a) -> a -> Nat -> a
foldl'Bits :: Int -> (a -> Int -> a) -> a -> Nat -> a
foldrBits :: Int -> (Int -> a -> a) -> a -> Nat -> a
foldr'Bits :: Int -> (Int -> a -> a) -> a -> Nat -> a
takeWhileAntitoneBits :: Int -> (Int -> Bool) -> Nat -> Nat
{-# INLINE lowestBitSet #-}
{-# INLINE highestBitSet #-}
{-# INLINE foldlBits #-}
{-# INLINE foldl'Bits #-}
{-# INLINE foldrBits #-}
{-# INLINE foldr'Bits #-}
{-# INLINE takeWhileAntitoneBits #-}
#if defined(__GLASGOW_HASKELL__) && (WORD_SIZE_IN_BITS==32 || WORD_SIZE_IN_BITS==64)
indexOfTheOnlyBit :: Nat -> Int
{-# INLINE indexOfTheOnlyBit #-}
#if WORD_SIZE_IN_BITS==64
indexOfTheOnlyBit :: Word -> Mask
indexOfTheOnlyBit Word
bitmask = Word -> Mask
forall b. FiniteBits b => b -> Mask
countTrailingZeros Word
bitmask
lowestBitSet :: Word -> Mask
lowestBitSet Word
x = Word -> Mask
forall b. FiniteBits b => b -> Mask
countTrailingZeros Word
x
highestBitSet :: Word -> Mask
highestBitSet Word
x = WORD_SIZE_IN_BITS - 1 - countLeadingZeros x
#else
indexOfTheOnlyBit bitmask =
fromIntegral (GHC.Int.I8# (lsbArray `GHC.Exts.indexInt8OffAddr#` unboxInt (intFromNat ((bitmask * magic) `shiftRL` offset))))
where unboxInt (GHC.Exts.I# i) = i
#if WORD_SIZE_IN_BITS==32
magic = 0x077CB531
offset = 27
!lsbArray = "\0\1\28\2\29\14\24\3\30\22\20\15\25\17\4\8\31\27\13\23\21\19\16\7\26\12\18\6\11\5\10\9"#
#else
magic = 0x07EDD5E59A4E28C2
offset = 58
!lsbArray = "\63\0\58\1\59\47\53\2\60\39\48\27\54\33\42\3\61\51\37\40\49\18\28\20\55\30\34\11\43\14\22\4\62\57\46\52\38\26\32\41\50\36\17\19\29\10\13\21\56\45\25\31\35\16\9\12\44\24\15\8\23\7\6\5"#
#endif
lowestBitSet x = indexOfTheOnlyBit (lowestBitMask x)
highestBitSet x = indexOfTheOnlyBit (highestBitMask x)
#endif
lowestBitMask :: Nat -> Nat
lowestBitMask :: Word -> Word
lowestBitMask Word
x = Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Num a => a -> a
negate Word
x
{-# INLINE lowestBitMask #-}
revNat :: Nat -> Nat
#if WORD_SIZE_IN_BITS==32
revNat x1 = case ((x1 `shiftRL` 1) .&. 0x55555555) .|. ((x1 .&. 0x55555555) `shiftLL` 1) of
x2 -> case ((x2 `shiftRL` 2) .&. 0x33333333) .|. ((x2 .&. 0x33333333) `shiftLL` 2) of
x3 -> case ((x3 `shiftRL` 4) .&. 0x0F0F0F0F) .|. ((x3 .&. 0x0F0F0F0F) `shiftLL` 4) of
x4 -> case ((x4 `shiftRL` 8) .&. 0x00FF00FF) .|. ((x4 .&. 0x00FF00FF) `shiftLL` 8) of
x5 -> ( x5 `shiftRL` 16 ) .|. ( x5 `shiftLL` 16);
#else
revNat :: Word -> Word
revNat Word
x1 = case ((Word
x1 Word -> Mask -> Word
`shiftRL` Mask
1) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x5555555555555555) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ((Word
x1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x5555555555555555) Word -> Mask -> Word
`shiftLL` Mask
1) of
Word
x2 -> case ((Word
x2 Word -> Mask -> Word
`shiftRL` Mask
2) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x3333333333333333) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ((Word
x2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x3333333333333333) Word -> Mask -> Word
`shiftLL` Mask
2) of
Word
x3 -> case ((Word
x3 Word -> Mask -> Word
`shiftRL` Mask
4) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x0F0F0F0F0F0F0F0F) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ((Word
x3 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x0F0F0F0F0F0F0F0F) Word -> Mask -> Word
`shiftLL` Mask
4) of
Word
x4 -> case ((Word
x4 Word -> Mask -> Word
`shiftRL` Mask
8) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x00FF00FF00FF00FF) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ((Word
x4 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x00FF00FF00FF00FF) Word -> Mask -> Word
`shiftLL` Mask
8) of
Word
x5 -> case ((Word
x5 Word -> Mask -> Word
`shiftRL` Mask
16) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x0000FFFF0000FFFF) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ((Word
x5 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x0000FFFF0000FFFF) Word -> Mask -> Word
`shiftLL` Mask
16) of
Word
x6 -> ( Word
x6 Word -> Mask -> Word
`shiftRL` Mask
32 ) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ( Word
x6 Word -> Mask -> Word
`shiftLL` Mask
32);
#endif
foldlBits :: forall a. Mask -> (a -> Mask -> a) -> a -> Word -> a
foldlBits Mask
prefix a -> Mask -> a
f a
z Word
bitmap = Word -> a -> a
go Word
bitmap a
z
where go :: Word -> a -> a
go Word
0 a
acc = a
acc
go Word
bm a
acc = Word -> a -> a
go (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
bitmask) ((a -> Mask -> a
f a
acc) (Mask -> a) -> Mask -> a
forall a b. (a -> b) -> a -> b
$! (Mask
prefixMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
bi))
where
!bitmask :: Word
bitmask = Word -> Word
lowestBitMask Word
bm
!bi :: Mask
bi = Word -> Mask
indexOfTheOnlyBit Word
bitmask
foldl'Bits :: forall a. Mask -> (a -> Mask -> a) -> a -> Word -> a
foldl'Bits Mask
prefix a -> Mask -> a
f a
z Word
bitmap = Word -> a -> a
go Word
bitmap a
z
where go :: Word -> a -> a
go Word
0 a
acc = a
acc
go Word
bm !a
acc = Word -> a -> a
go (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
bitmask) ((a -> Mask -> a
f a
acc) (Mask -> a) -> Mask -> a
forall a b. (a -> b) -> a -> b
$! (Mask
prefixMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
bi))
where !bitmask :: Word
bitmask = Word -> Word
lowestBitMask Word
bm
!bi :: Mask
bi = Word -> Mask
indexOfTheOnlyBit Word
bitmask
foldrBits :: forall a. Mask -> (Mask -> a -> a) -> a -> Word -> a
foldrBits Mask
prefix Mask -> a -> a
f a
z Word
bitmap = Word -> a -> a
go (Word -> Word
revNat Word
bitmap) a
z
where go :: Word -> a -> a
go Word
0 a
acc = a
acc
go Word
bm a
acc = Word -> a -> a
go (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
bitmask) ((Mask -> a -> a
f (Mask -> a -> a) -> Mask -> a -> a
forall a b. (a -> b) -> a -> b
$! (Mask
prefixMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+(WORD_SIZE_IN_BITS-1)-bi)) acc)
where !bitmask :: Word
bitmask = Word -> Word
lowestBitMask Word
bm
!bi :: Mask
bi = Word -> Mask
indexOfTheOnlyBit Word
bitmask
foldr'Bits :: forall a. Mask -> (Mask -> a -> a) -> a -> Word -> a
foldr'Bits Mask
prefix Mask -> a -> a
f a
z Word
bitmap = Word -> a -> a
go (Word -> Word
revNat Word
bitmap) a
z
where go :: Word -> a -> a
go Word
0 a
acc = a
acc
go Word
bm !a
acc = Word -> a -> a
go (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
bitmask) ((Mask -> a -> a
f (Mask -> a -> a) -> Mask -> a -> a
forall a b. (a -> b) -> a -> b
$! (Mask
prefixMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+(WORD_SIZE_IN_BITS-1)-bi)) acc)
where !bitmask :: Word
bitmask = Word -> Word
lowestBitMask Word
bm
!bi :: Mask
bi = Word -> Mask
indexOfTheOnlyBit Word
bitmask
takeWhileAntitoneBits :: Mask -> (Mask -> Bool) -> Word -> Word
takeWhileAntitoneBits Mask
prefix Mask -> Bool
predicate Word
bitmap =
let next :: Mask -> Word -> (Word, Mask) -> (Word, Mask)
next Mask
d Word
h (Word
n',Mask
b') =
if Word
n' Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
h Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 Bool -> Bool -> Bool
&& (Mask -> Bool
predicate (Mask -> Bool) -> Mask -> Bool
forall a b. (a -> b) -> a -> b
$! Mask
prefixMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
b'Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
d) then (Word
n' Word -> Mask -> Word
`shiftRL` Mask
d, Mask
b'Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
d) else (Word
n',Mask
b')
{-# INLINE next #-}
(Word
_,Mask
b) = Mask -> Word -> (Word, Mask) -> (Word, Mask)
next Mask
1 Word
0x2 ((Word, Mask) -> (Word, Mask)) -> (Word, Mask) -> (Word, Mask)
forall a b. (a -> b) -> a -> b
$
Mask -> Word -> (Word, Mask) -> (Word, Mask)
next Mask
2 Word
0xC ((Word, Mask) -> (Word, Mask)) -> (Word, Mask) -> (Word, Mask)
forall a b. (a -> b) -> a -> b
$
Mask -> Word -> (Word, Mask) -> (Word, Mask)
next Mask
4 Word
0xF0 ((Word, Mask) -> (Word, Mask)) -> (Word, Mask) -> (Word, Mask)
forall a b. (a -> b) -> a -> b
$
Mask -> Word -> (Word, Mask) -> (Word, Mask)
next Mask
8 Word
0xFF00 ((Word, Mask) -> (Word, Mask)) -> (Word, Mask) -> (Word, Mask)
forall a b. (a -> b) -> a -> b
$
Mask -> Word -> (Word, Mask) -> (Word, Mask)
next Mask
16 Word
0xFFFF0000 ((Word, Mask) -> (Word, Mask)) -> (Word, Mask) -> (Word, Mask)
forall a b. (a -> b) -> a -> b
$
#if WORD_SIZE_IN_BITS==64
Mask -> Word -> (Word, Mask) -> (Word, Mask)
next Mask
32 Word
0xFFFFFFFF00000000 ((Word, Mask) -> (Word, Mask)) -> (Word, Mask) -> (Word, Mask)
forall a b. (a -> b) -> a -> b
$
#endif
(Word
bitmap,Mask
0)
m :: Word
m = if Mask
b Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
0 Bool -> Bool -> Bool
|| (Word
bitmap Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 Bool -> Bool -> Bool
&& Mask -> Bool
predicate Mask
prefix)
then ((Word
2 Word -> Mask -> Word
`shiftLL` Mask
b) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)
else ((Word
1 Word -> Mask -> Word
`shiftLL` Mask
b) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)
in Word
bitmap Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m
#else
lowestBitSet n0 =
let (n1,b1) = if n0 .&. 0xFFFFFFFF /= 0 then (n0,0) else (n0 `shiftRL` 32, 32)
(n2,b2) = if n1 .&. 0xFFFF /= 0 then (n1,b1) else (n1 `shiftRL` 16, 16+b1)
(n3,b3) = if n2 .&. 0xFF /= 0 then (n2,b2) else (n2 `shiftRL` 8, 8+b2)
(n4,b4) = if n3 .&. 0xF /= 0 then (n3,b3) else (n3 `shiftRL` 4, 4+b3)
(n5,b5) = if n4 .&. 0x3 /= 0 then (n4,b4) else (n4 `shiftRL` 2, 2+b4)
b6 = if n5 .&. 0x1 /= 0 then b5 else 1+b5
in b6
highestBitSet n0 =
let (n1,b1) = if n0 .&. 0xFFFFFFFF00000000 /= 0 then (n0 `shiftRL` 32, 32) else (n0,0)
(n2,b2) = if n1 .&. 0xFFFF0000 /= 0 then (n1 `shiftRL` 16, 16+b1) else (n1,b1)
(n3,b3) = if n2 .&. 0xFF00 /= 0 then (n2 `shiftRL` 8, 8+b2) else (n2,b2)
(n4,b4) = if n3 .&. 0xF0 /= 0 then (n3 `shiftRL` 4, 4+b3) else (n3,b3)
(n5,b5) = if n4 .&. 0xC /= 0 then (n4 `shiftRL` 2, 2+b4) else (n4,b4)
b6 = if n5 .&. 0x2 /= 0 then 1+b5 else b5
in b6
foldlBits prefix f z bm = let lb