{-# LANGUAGE MagicHash, TypeFamilies, FlexibleInstances, BangPatterns, CPP #-}
module Data.Interned.IntSet (
IntSet
, (\\)
, null
, size
, member
, notMember
, isSubsetOf
, isProperSubsetOf
, empty
, singleton
, insert
, delete
, union, unions
, difference
, intersection
, filter
, partition
, split
, splitMember
, findMin
, findMax
, deleteMin
, deleteMax
, deleteFindMin
, deleteFindMax
, maxView
, minView
, map
, fold
, elems
, toList
, fromList
, toAscList
, fromAscList
, fromDistinctAscList
, showTree
, showTreeWith
) where
import Prelude hiding (lookup,filter,foldr,foldl,null,map)
import qualified Data.List as List
import Data.Monoid (Monoid(..))
import Data.Maybe (fromMaybe)
#if MIN_VERSION_base(4,9,0) && !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import Data.Interned.Internal
import Data.Bits
import Data.Hashable
import Text.Read
import GHC.Exts ( Word(..), Int(..), shiftRL# )
infixl 9 \\
type Nat = Word
natFromInt :: Int -> Nat
natFromInt :: Int -> Nat
natFromInt i :: Int
i = Int -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
intFromNat :: Nat -> Int
intFromNat :: Nat -> Int
intFromNat w :: Nat
w = Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
w
shiftRL :: Nat -> Int -> Nat
shiftRL :: Nat -> Int -> Nat
shiftRL (W# x :: Word#
x) (I# i :: Int#
i) = Word# -> Nat
W# (Word# -> Int# -> Word#
shiftRL# Word#
x Int#
i)
(\\) :: IntSet -> IntSet -> IntSet
m1 :: IntSet
m1 \\ :: IntSet -> IntSet -> IntSet
\\ m2 :: IntSet
m2 = IntSet -> IntSet -> IntSet
difference IntSet
m1 IntSet
m2
data IntSet
= Nil
| Tip {-# UNPACK #-} !Id {-# UNPACK #-} !Int
| Bin {-# UNPACK #-} !Id {-# UNPACK #-} !Int {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !IntSet !IntSet
data UninternedIntSet
= UNil
| UTip !Int
| UBin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !IntSet !IntSet
tip :: Int -> IntSet
tip :: Int -> IntSet
tip n :: Int
n = Uninterned IntSet -> IntSet
forall t. Interned t => Uninterned t -> t
intern (Int -> UninternedIntSet
UTip Int
n)
bin :: Prefix -> Mask -> IntSet -> IntSet -> IntSet
bin :: Int -> Int -> IntSet -> IntSet -> IntSet
bin _ _ l :: IntSet
l Nil = IntSet
l
bin _ _ Nil r :: IntSet
r = IntSet
r
bin p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r = Uninterned IntSet -> IntSet
forall t. Interned t => Uninterned t -> t
intern (Int -> Int -> IntSet -> IntSet -> UninternedIntSet
UBin Int
p Int
m IntSet
l IntSet
r)
bin_ :: Prefix -> Mask -> IntSet -> IntSet -> IntSet
bin_ :: Int -> Int -> IntSet -> IntSet -> IntSet
bin_ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r = Uninterned IntSet -> IntSet
forall t. Interned t => Uninterned t -> t
intern (Int -> Int -> IntSet -> IntSet -> UninternedIntSet
UBin Int
p Int
m IntSet
l IntSet
r)
identity :: IntSet -> Id
identity :: IntSet -> Int
identity Nil = 0
identity (Tip i :: Int
i _) = Int
i
identity (Bin i :: Int
i _ _ _ _ _) = Int
i
instance Interned IntSet where
type Uninterned IntSet = UninternedIntSet
data Description IntSet
= DNil
| DTip {-# UNPACK #-} !Int
| DBin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask {-# UNPACK #-} !Id {-# UNPACK #-} !Id
deriving Description IntSet -> Description IntSet -> Bool
(Description IntSet -> Description IntSet -> Bool)
-> (Description IntSet -> Description IntSet -> Bool)
-> Eq (Description IntSet)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Description IntSet -> Description IntSet -> Bool
$c/= :: Description IntSet -> Description IntSet -> Bool
== :: Description IntSet -> Description IntSet -> Bool
$c== :: Description IntSet -> Description IntSet -> Bool
Eq
describe :: Uninterned IntSet -> Description IntSet
describe UNil = Description IntSet
DNil
describe (UTip j) = Int -> Description IntSet
DTip Int
j
describe (UBin p m l r) = Int -> Int -> Int -> Int -> Description IntSet
DBin Int
p Int
m (IntSet -> Int
identity IntSet
l) (IntSet -> Int
identity IntSet
r)
cacheWidth :: p IntSet -> Int
cacheWidth _ = 16384
seedIdentity :: p IntSet -> Int
seedIdentity _ = 1
identify :: Int -> Uninterned IntSet -> IntSet
identify _ UNil = IntSet
Nil
identify i :: Int
i (UTip j) = Int -> Int -> IntSet
Tip Int
i Int
j
identify i :: Int
i (UBin p m l r) = Int -> Int -> Int -> Int -> IntSet -> IntSet -> IntSet
Bin Int
i (IntSet -> Int
size IntSet
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ IntSet -> Int
size IntSet
r) Int
p Int
m IntSet
l IntSet
r
cache :: Cache IntSet
cache = Cache IntSet
intSetCache
instance Hashable (Description IntSet) where
hashWithSalt :: Int -> Description IntSet -> Int
hashWithSalt s :: Int
s DNil = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (0 :: Int)
hashWithSalt s :: Int
s (DTip n) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (1 :: Int) Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
n
hashWithSalt s :: Int
s (DBin p m l r) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (2 :: Int) Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
p Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
m Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
l Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
r
intSetCache :: Cache IntSet
intSetCache :: Cache IntSet
intSetCache = Cache IntSet
forall t. Interned t => Cache t
mkCache
{-# NOINLINE intSetCache #-}
instance Uninternable IntSet where
unintern :: IntSet -> Uninterned IntSet
unintern Nil = Uninterned IntSet
UninternedIntSet
UNil
unintern (Tip _ j :: Int
j) = Int -> UninternedIntSet
UTip Int
j
unintern (Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r) = Int -> Int -> IntSet -> IntSet -> UninternedIntSet
UBin Int
p Int
m IntSet
l IntSet
r
type Prefix = Int
type Mask = Int
#if MIN_VERSION_base(4,9,0)
instance Semigroup IntSet where
<> :: IntSet -> IntSet -> IntSet
(<>) = IntSet -> IntSet -> IntSet
union
#endif
instance Monoid IntSet where
mempty :: IntSet
mempty = IntSet
empty
#if !(MIN_VERSION_base(4,11,0))
mappend = union
#endif
mconcat :: [IntSet] -> IntSet
mconcat = [IntSet] -> IntSet
unions
null :: IntSet -> Bool
null :: IntSet -> Bool
null Nil = Bool
True
null _ = Bool
False
size :: IntSet -> Int
size :: IntSet -> Int
size t :: IntSet
t
= case IntSet
t of
Bin _ s :: Int
s _ _ _ _ -> Int
s
Tip _ _ -> 1
Nil -> 0
member :: Int -> IntSet -> Bool
member :: Int -> IntSet -> Bool
member x :: Int
x t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r
| Int -> Int -> Int -> Bool
nomatch Int
x Int
p Int
m -> Bool
False
| Int -> Int -> Bool
zero Int
x Int
m -> Int -> IntSet -> Bool
member Int
x IntSet
l
| Bool
otherwise -> Int -> IntSet -> Bool
member Int
x IntSet
r
Tip _ y :: Int
y -> (Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
y)
Nil -> Bool
False
notMember :: Int -> IntSet -> Bool
notMember :: Int -> IntSet -> Bool
notMember k :: Int
k = Bool -> Bool
not (Bool -> Bool) -> (IntSet -> Bool) -> IntSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntSet -> Bool
member Int
k
lookup :: Int -> IntSet -> Maybe Int
lookup :: Int -> IntSet -> Maybe Int
lookup k :: Int
k t :: IntSet
t
= let nk :: Nat
nk = Int -> Nat
natFromInt Int
k in Nat -> Maybe Int -> Maybe Int
forall a b. a -> b -> b
seq Nat
nk (Nat -> IntSet -> Maybe Int
lookupN Nat
nk IntSet
t)
lookupN :: Nat -> IntSet -> Maybe Int
lookupN :: Nat -> IntSet -> Maybe Int
lookupN k :: Nat
k t :: IntSet
t
= case IntSet
t of
Bin _ _ _ m :: Int
m l :: IntSet
l r :: IntSet
r
| Nat -> Nat -> Bool
zeroN Nat
k (Int -> Nat
natFromInt Int
m) -> Nat -> IntSet -> Maybe Int
lookupN Nat
k IntSet
l
| Bool
otherwise -> Nat -> IntSet -> Maybe Int
lookupN Nat
k IntSet
r
Tip _ kx :: Int
kx
| (Nat
k Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Nat
natFromInt Int
kx) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
kx
| Bool
otherwise -> Maybe Int
forall a. Maybe a
Nothing
Nil -> Maybe Int
forall a. Maybe a
Nothing
empty :: IntSet
empty :: IntSet
empty = IntSet
Nil
singleton :: Int -> IntSet
singleton :: Int -> IntSet
singleton x :: Int
x = Int -> IntSet
tip Int
x
insert :: Int -> IntSet -> IntSet
insert :: Int -> IntSet -> IntSet
insert x :: Int
x t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r
| Int -> Int -> Int -> Bool
nomatch Int
x Int
p Int
m -> Int -> IntSet -> Int -> IntSet -> IntSet
join Int
x (Int -> IntSet
tip Int
x) Int
p IntSet
t
| Int -> Int -> Bool
zero Int
x Int
m -> Int -> Int -> IntSet -> IntSet -> IntSet
bin_ Int
p Int
m (Int -> IntSet -> IntSet
insert Int
x IntSet
l) IntSet
r
| Bool
otherwise -> Int -> Int -> IntSet -> IntSet -> IntSet
bin_ Int
p Int
m IntSet
l (Int -> IntSet -> IntSet
insert Int
x IntSet
r)
Tip _ y :: Int
y
| Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
y -> Int -> IntSet
tip Int
x
| Bool
otherwise -> Int -> IntSet -> Int -> IntSet -> IntSet
join Int
x (Int -> IntSet
tip Int
x) Int
y IntSet
t
Nil -> Int -> IntSet
tip Int
x
insertR :: Int -> IntSet -> IntSet
insertR :: Int -> IntSet -> IntSet
insertR x :: Int
x t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r
| Int -> Int -> Int -> Bool
nomatch Int
x Int
p Int
m -> Int -> IntSet -> Int -> IntSet -> IntSet
join Int
x (Int -> IntSet
tip Int
x) Int
p IntSet
t
| Int -> Int -> Bool
zero Int
x Int
m -> Int -> Int -> IntSet -> IntSet -> IntSet
bin_ Int
p Int
m (Int -> IntSet -> IntSet
insert Int
x IntSet
l) IntSet
r
| Bool
otherwise -> Int -> Int -> IntSet -> IntSet -> IntSet
bin_ Int
p Int
m IntSet
l (Int -> IntSet -> IntSet
insert Int
x IntSet
r)
Tip _ y :: Int
y
| Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
y -> IntSet
t
| Bool
otherwise -> Int -> IntSet -> Int -> IntSet -> IntSet
join Int
x (Int -> IntSet
tip Int
x) Int
y IntSet
t
Nil -> Int -> IntSet
tip Int
x
delete :: Int -> IntSet -> IntSet
delete :: Int -> IntSet -> IntSet
delete x :: Int
x t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r
| Int -> Int -> Int -> Bool
nomatch Int
x Int
p Int
m -> IntSet
t
| Int -> Int -> Bool
zero Int
x Int
m -> Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p Int
m (Int -> IntSet -> IntSet
delete Int
x IntSet
l) IntSet
r
| Bool
otherwise -> Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p Int
m IntSet
l (Int -> IntSet -> IntSet
delete Int
x IntSet
r)
Tip _ y :: Int
y
| Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
y -> IntSet
Nil
| Bool
otherwise -> IntSet
t
Nil -> IntSet
Nil
unions :: [IntSet] -> IntSet
unions :: [IntSet] -> IntSet
unions xs :: [IntSet]
xs = (IntSet -> IntSet -> IntSet) -> IntSet -> [IntSet] -> IntSet
forall a b. (a -> b -> a) -> a -> [b] -> a
foldlStrict IntSet -> IntSet -> IntSet
union IntSet
empty [IntSet]
xs
union :: IntSet -> IntSet -> IntSet
union :: IntSet -> IntSet -> IntSet
union t1 :: IntSet
t1@(Bin _ _ p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: IntSet
r1) t2 :: IntSet
t2@(Bin _ _ p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: IntSet
r2)
| Int -> Int -> Bool
shorter Int
m1 Int
m2 = IntSet
union1
| Int -> Int -> Bool
shorter Int
m2 Int
m1 = IntSet
union2
| Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2 = Int -> Int -> IntSet -> IntSet -> IntSet
bin_ Int
p1 Int
m1 (IntSet -> IntSet -> IntSet
union IntSet
l1 IntSet
l2) (IntSet -> IntSet -> IntSet
union IntSet
r1 IntSet
r2)
| Bool
otherwise = Int -> IntSet -> Int -> IntSet -> IntSet
join Int
p1 IntSet
t1 Int
p2 IntSet
t2
where
union1 :: IntSet
union1 | Int -> Int -> Int -> Bool
nomatch Int
p2 Int
p1 Int
m1 = Int -> IntSet -> Int -> IntSet -> IntSet
join Int
p1 IntSet
t1 Int
p2 IntSet
t2
| Int -> Int -> Bool
zero Int
p2 Int
m1 = Int -> Int -> IntSet -> IntSet -> IntSet
bin_ Int
p1 Int
m1 (IntSet -> IntSet -> IntSet
union IntSet
l1 IntSet
t2) IntSet
r1
| Bool
otherwise = Int -> Int -> IntSet -> IntSet -> IntSet
bin_ Int
p1 Int
m1 IntSet
l1 (IntSet -> IntSet -> IntSet
union IntSet
r1 IntSet
t2)
union2 :: IntSet
union2 | Int -> Int -> Int -> Bool
nomatch Int
p1 Int
p2 Int
m2 = Int -> IntSet -> Int -> IntSet -> IntSet
join Int
p1 IntSet
t1 Int
p2 IntSet
t2
| Int -> Int -> Bool
zero Int
p1 Int
m2 = Int -> Int -> IntSet -> IntSet -> IntSet
bin_ Int
p2 Int
m2 (IntSet -> IntSet -> IntSet
union IntSet
t1 IntSet
l2) IntSet
r2
| Bool
otherwise = Int -> Int -> IntSet -> IntSet -> IntSet
bin_ Int
p2 Int
m2 IntSet
l2 (IntSet -> IntSet -> IntSet
union IntSet
t1 IntSet
r2)
union (Tip _ x :: Int
x) t :: IntSet
t = Int -> IntSet -> IntSet
insert Int
x IntSet
t
union t :: IntSet
t (Tip _ x :: Int
x) = Int -> IntSet -> IntSet
insertR Int
x IntSet
t
union Nil t :: IntSet
t = IntSet
t
union t :: IntSet
t Nil = IntSet
t
difference :: IntSet -> IntSet -> IntSet
difference :: IntSet -> IntSet -> IntSet
difference t1 :: IntSet
t1@(Bin _ _ p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: IntSet
r1) t2 :: IntSet
t2@(Bin _ _ p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: IntSet
r2)
| Int -> Int -> Bool
shorter Int
m1 Int
m2 = IntSet
difference1
| Int -> Int -> Bool
shorter Int
m2 Int
m1 = IntSet
difference2
| Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2 = Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p1 Int
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 | Int -> Int -> Int -> Bool
nomatch Int
p2 Int
p1 Int
m1 = IntSet
t1
| Int -> Int -> Bool
zero Int
p2 Int
m1 = Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p1 Int
m1 (IntSet -> IntSet -> IntSet
difference IntSet
l1 IntSet
t2) IntSet
r1
| Bool
otherwise = Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p1 Int
m1 IntSet
l1 (IntSet -> IntSet -> IntSet
difference IntSet
r1 IntSet
t2)
difference2 :: IntSet
difference2 | Int -> Int -> Int -> Bool
nomatch Int
p1 Int
p2 Int
m2 = IntSet
t1
| Int -> Int -> Bool
zero Int
p1 Int
m2 = IntSet -> IntSet -> IntSet
difference IntSet
t1 IntSet
l2
| Bool
otherwise = IntSet -> IntSet -> IntSet
difference IntSet
t1 IntSet
r2
difference t1 :: IntSet
t1@(Tip _ x :: Int
x) t2 :: IntSet
t2
| Int -> IntSet -> Bool
member Int
x IntSet
t2 = IntSet
Nil
| Bool
otherwise = IntSet
t1
difference Nil _ = IntSet
Nil
difference t :: IntSet
t (Tip _ x :: Int
x) = Int -> IntSet -> IntSet
delete Int
x IntSet
t
difference t :: IntSet
t Nil = IntSet
t
intersection :: IntSet -> IntSet -> IntSet
intersection :: IntSet -> IntSet -> IntSet
intersection t1 :: IntSet
t1@(Bin _ _ p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: IntSet
r1) t2 :: IntSet
t2@(Bin _ _ p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: IntSet
r2)
| Int -> Int -> Bool
shorter Int
m1 Int
m2 = IntSet
intersection1
| Int -> Int -> Bool
shorter Int
m2 Int
m1 = IntSet
intersection2
| Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2 = Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p1 Int
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 | Int -> Int -> Int -> Bool
nomatch Int
p2 Int
p1 Int
m1 = IntSet
Nil
| Int -> Int -> Bool
zero Int
p2 Int
m1 = IntSet -> IntSet -> IntSet
intersection IntSet
l1 IntSet
t2
| Bool
otherwise = IntSet -> IntSet -> IntSet
intersection IntSet
r1 IntSet
t2
intersection2 :: IntSet
intersection2 | Int -> Int -> Int -> Bool
nomatch Int
p1 Int
p2 Int
m2 = IntSet
Nil
| Int -> Int -> Bool
zero Int
p1 Int
m2 = IntSet -> IntSet -> IntSet
intersection IntSet
t1 IntSet
l2
| Bool
otherwise = IntSet -> IntSet -> IntSet
intersection IntSet
t1 IntSet
r2
intersection t1 :: IntSet
t1@(Tip _ x :: Int
x) t2 :: IntSet
t2
| Int -> IntSet -> Bool
member Int
x IntSet
t2 = IntSet
t1
| Bool
otherwise = IntSet
Nil
intersection t :: IntSet
t (Tip _ x :: Int
x)
= case Int -> IntSet -> Maybe Int
lookup Int
x IntSet
t of
Just y :: Int
y -> Int -> IntSet
tip Int
y
Nothing -> IntSet
Nil
intersection Nil _ = IntSet
Nil
intersection _ Nil = IntSet
Nil
isProperSubsetOf :: IntSet -> IntSet -> Bool
isProperSubsetOf :: IntSet -> IntSet -> Bool
isProperSubsetOf t1 :: IntSet
t1 t2 :: IntSet
t2
= case IntSet -> IntSet -> Ordering
subsetCmp IntSet
t1 IntSet
t2 of
LT -> Bool
True
_ -> Bool
False
subsetCmp :: IntSet -> IntSet -> Ordering
subsetCmp :: IntSet -> IntSet -> Ordering
subsetCmp t1 :: IntSet
t1@(Bin _ _ p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: IntSet
r1) (Bin _ _ p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: IntSet
r2)
| Int -> Int -> Bool
shorter Int
m1 Int
m2 = Ordering
GT
| Int -> Int -> Bool
shorter Int
m2 Int
m1 = case Ordering
subsetCmpLt of
GT -> Ordering
GT
_ -> Ordering
LT
| Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2 = Ordering
subsetCmpEq
| Bool
otherwise = Ordering
GT
where
subsetCmpLt :: Ordering
subsetCmpLt | Int -> Int -> Int -> Bool
nomatch Int
p1 Int
p2 Int
m2 = Ordering
GT
| Int -> Int -> Bool
zero Int
p1 Int
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
(GT,_ ) -> Ordering
GT
(_ ,GT) -> Ordering
GT
(EQ,EQ) -> Ordering
EQ
_ -> Ordering
LT
subsetCmp (Bin _ _ _ _ _ _) _ = Ordering
GT
subsetCmp (Tip _ x :: Int
x) (Tip _ y :: Int
y)
| Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
y = Ordering
EQ
| Bool
otherwise = Ordering
GT
subsetCmp (Tip _ x :: Int
x) t :: IntSet
t
| Int -> IntSet -> Bool
member Int
x IntSet
t = Ordering
LT
| Bool
otherwise = Ordering
GT
subsetCmp Nil Nil = Ordering
EQ
subsetCmp Nil _ = Ordering
LT
isSubsetOf :: IntSet -> IntSet -> Bool
isSubsetOf :: IntSet -> IntSet -> Bool
isSubsetOf t1 :: IntSet
t1@(Bin _ _ p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: IntSet
r1) (Bin _ _ p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: IntSet
r2)
| Int -> Int -> Bool
shorter Int
m1 Int
m2 = Bool
False
| Int -> Int -> Bool
shorter Int
m2 Int
m1 = Int -> Int -> Int -> Bool
match Int
p1 Int
p2 Int
m2 Bool -> Bool -> Bool
&& (if Int -> Int -> Bool
zero Int
p1 Int
m2 then IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
l2
else IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
r2)
| Bool
otherwise = (Int
p1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
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 _ _ _ _ _ _) _ = Bool
False
isSubsetOf (Tip _ x :: Int
x) t :: IntSet
t = Int -> IntSet -> Bool
member Int
x IntSet
t
isSubsetOf Nil _ = Bool
True
filter :: (Int -> Bool) -> IntSet -> IntSet
filter :: (Int -> Bool) -> IntSet -> IntSet
filter predicate :: Int -> Bool
predicate t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r
-> Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p Int
m ((Int -> Bool) -> IntSet -> IntSet
filter Int -> Bool
predicate IntSet
l) ((Int -> Bool) -> IntSet -> IntSet
filter Int -> Bool
predicate IntSet
r)
Tip _ x :: Int
x
| Int -> Bool
predicate Int
x -> IntSet
t
| Bool
otherwise -> IntSet
Nil
Nil -> IntSet
Nil
partition :: (Int -> Bool) -> IntSet -> (IntSet,IntSet)
partition :: (Int -> Bool) -> IntSet -> (IntSet, IntSet)
partition predicate :: Int -> Bool
predicate t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r
-> let (l1 :: IntSet
l1,l2 :: IntSet
l2) = (Int -> Bool) -> IntSet -> (IntSet, IntSet)
partition Int -> Bool
predicate IntSet
l
(r1 :: IntSet
r1,r2 :: IntSet
r2) = (Int -> Bool) -> IntSet -> (IntSet, IntSet)
partition Int -> Bool
predicate IntSet
r
in (Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p Int
m IntSet
l1 IntSet
r1, Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p Int
m IntSet
l2 IntSet
r2)
Tip _ x :: Int
x
| Int -> Bool
predicate Int
x -> (IntSet
t,IntSet
Nil)
| Bool
otherwise -> (IntSet
Nil,IntSet
t)
Nil -> (IntSet
Nil,IntSet
Nil)
split :: Int -> IntSet -> (IntSet,IntSet)
split :: Int -> IntSet -> (IntSet, IntSet)
split x :: Int
x t :: IntSet
t
= case IntSet
t of
Bin _ _ _ m :: Int
m l :: IntSet
l r :: IntSet
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then let (lt :: IntSet
lt,gt :: IntSet
gt) = Int -> IntSet -> (IntSet, IntSet)
split' Int
x IntSet
l in (IntSet -> IntSet -> IntSet
union IntSet
r IntSet
lt, IntSet
gt)
else let (lt :: IntSet
lt,gt :: IntSet
gt) = Int -> IntSet -> (IntSet, IntSet)
split' Int
x IntSet
r in (IntSet
lt, IntSet -> IntSet -> IntSet
union IntSet
gt IntSet
l)
| Bool
otherwise -> Int -> IntSet -> (IntSet, IntSet)
split' Int
x IntSet
t
Tip _ y :: Int
y
| Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
y -> (IntSet
t,IntSet
Nil)
| Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
y -> (IntSet
Nil,IntSet
t)
| Bool
otherwise -> (IntSet
Nil,IntSet
Nil)
Nil -> (IntSet
Nil, IntSet
Nil)
split' :: Int -> IntSet -> (IntSet,IntSet)
split' :: Int -> IntSet -> (IntSet, IntSet)
split' x :: Int
x t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r
| Int -> Int -> Int -> Bool
match Int
x Int
p Int
m -> if Int -> Int -> Bool
zero Int
x Int
m then let (lt :: IntSet
lt,gt :: IntSet
gt) = Int -> IntSet -> (IntSet, IntSet)
split' Int
x IntSet
l in (IntSet
lt,IntSet -> IntSet -> IntSet
union IntSet
gt IntSet
r)
else let (lt :: IntSet
lt,gt :: IntSet
gt) = Int -> IntSet -> (IntSet, IntSet)
split' Int
x IntSet
r in (IntSet -> IntSet -> IntSet
union IntSet
l IntSet
lt,IntSet
gt)
| Bool
otherwise -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
p then (IntSet
Nil, IntSet
t)
else (IntSet
t, IntSet
Nil)
Tip _ y :: Int
y
| Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
y -> (IntSet
t,IntSet
Nil)
| Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
y -> (IntSet
Nil,IntSet
t)
| Bool
otherwise -> (IntSet
Nil,IntSet
Nil)
Nil -> (IntSet
Nil,IntSet
Nil)
splitMember :: Int -> IntSet -> (IntSet,Bool,IntSet)
splitMember :: Int -> IntSet -> (IntSet, Bool, IntSet)
splitMember x :: Int
x t :: IntSet
t
= case IntSet
t of
Bin _ _ _ m :: Int
m l :: IntSet
l r :: IntSet
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then let (lt :: IntSet
lt,found :: Bool
found,gt :: IntSet
gt) = Int -> IntSet -> (IntSet, Bool, IntSet)
splitMember' Int
x IntSet
l in (IntSet -> IntSet -> IntSet
union IntSet
r IntSet
lt, Bool
found, IntSet
gt)
else let (lt :: IntSet
lt,found :: Bool
found,gt :: IntSet
gt) = Int -> IntSet -> (IntSet, Bool, IntSet)
splitMember' Int
x IntSet
r in (IntSet
lt, Bool
found, IntSet -> IntSet -> IntSet
union IntSet
gt IntSet
l)
| Bool
otherwise -> Int -> IntSet -> (IntSet, Bool, IntSet)
splitMember' Int
x IntSet
t
Tip _ y :: Int
y
| Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
y -> (IntSet
t,Bool
False,IntSet
Nil)
| Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
y -> (IntSet
Nil,Bool
False,IntSet
t)
| Bool
otherwise -> (IntSet
Nil,Bool
True,IntSet
Nil)
Nil -> (IntSet
Nil,Bool
False,IntSet
Nil)
splitMember' :: Int -> IntSet -> (IntSet,Bool,IntSet)
splitMember' :: Int -> IntSet -> (IntSet, Bool, IntSet)
splitMember' x :: Int
x t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r
| Int -> Int -> Int -> Bool
match Int
x Int
p Int
m -> if Int -> Int -> Bool
zero Int
x Int
m then let (lt :: IntSet
lt,found :: Bool
found,gt :: IntSet
gt) = Int -> IntSet -> (IntSet, Bool, IntSet)
splitMember Int
x IntSet
l in (IntSet
lt,Bool
found,IntSet -> IntSet -> IntSet
union IntSet
gt IntSet
r)
else let (lt :: IntSet
lt,found :: Bool
found,gt :: IntSet
gt) = Int -> IntSet -> (IntSet, Bool, IntSet)
splitMember Int
x IntSet
r in (IntSet -> IntSet -> IntSet
union IntSet
l IntSet
lt,Bool
found,IntSet
gt)
| Bool
otherwise -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
p then (IntSet
Nil, Bool
False, IntSet
t)
else (IntSet
t, Bool
False, IntSet
Nil)
Tip _ y :: Int
y
| Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
y -> (IntSet
t,Bool
False,IntSet
Nil)
| Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
y -> (IntSet
Nil,Bool
False,IntSet
t)
| Bool
otherwise -> (IntSet
Nil,Bool
True,IntSet
Nil)
Nil -> (IntSet
Nil,Bool
False,IntSet
Nil)
maxView :: IntSet -> Maybe (Int, IntSet)
maxView :: IntSet -> Maybe (Int, IntSet)
maxView t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> let (result :: Int
result,t' :: IntSet
t') = IntSet -> (Int, IntSet)
maxViewUnsigned IntSet
l in (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (Int
result, Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p Int
m IntSet
t' IntSet
r)
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r -> let (result :: Int
result,t' :: IntSet
t') = IntSet -> (Int, IntSet)
maxViewUnsigned IntSet
r in (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (Int
result, Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p Int
m IntSet
l IntSet
t')
Tip _ y :: Int
y -> (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (Int
y,IntSet
Nil)
Nil -> Maybe (Int, IntSet)
forall a. Maybe a
Nothing
maxViewUnsigned :: IntSet -> (Int, IntSet)
maxViewUnsigned :: IntSet -> (Int, IntSet)
maxViewUnsigned t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r -> let (result :: Int
result,t' :: IntSet
t') = IntSet -> (Int, IntSet)
maxViewUnsigned IntSet
r in (Int
result, Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p Int
m IntSet
l IntSet
t')
Tip _ y :: Int
y -> (Int
y, IntSet
Nil)
Nil -> [Char] -> (Int, IntSet)
forall a. HasCallStack => [Char] -> a
error "maxViewUnsigned Nil"
minView :: IntSet -> Maybe (Int, IntSet)
minView :: IntSet -> Maybe (Int, IntSet)
minView t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> let (result :: Int
result,t' :: IntSet
t') = IntSet -> (Int, IntSet)
minViewUnsigned IntSet
r in (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (Int
result, Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p Int
m IntSet
l IntSet
t')
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r -> let (result :: Int
result,t' :: IntSet
t') = IntSet -> (Int, IntSet)
minViewUnsigned IntSet
l in (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (Int
result, Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p Int
m IntSet
t' IntSet
r)
Tip _ y :: Int
y -> (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (Int
y, IntSet
Nil)
Nil -> Maybe (Int, IntSet)
forall a. Maybe a
Nothing
minViewUnsigned :: IntSet -> (Int, IntSet)
minViewUnsigned :: IntSet -> (Int, IntSet)
minViewUnsigned t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r -> let (result :: Int
result,t' :: IntSet
t') = IntSet -> (Int, IntSet)
minViewUnsigned IntSet
l in (Int
result, Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p Int
m IntSet
t' IntSet
r)
Tip _ y :: Int
y -> (Int
y, IntSet
Nil)
Nil -> [Char] -> (Int, IntSet)
forall a. HasCallStack => [Char] -> a
error "minViewUnsigned Nil"
deleteFindMin :: IntSet -> (Int, IntSet)
deleteFindMin :: IntSet -> (Int, IntSet)
deleteFindMin = (Int, IntSet) -> Maybe (Int, IntSet) -> (Int, IntSet)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (Int, IntSet)
forall a. HasCallStack => [Char] -> a
error "deleteFindMin: empty set has no minimal element") (Maybe (Int, IntSet) -> (Int, IntSet))
-> (IntSet -> Maybe (Int, IntSet)) -> IntSet -> (Int, IntSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Int, IntSet)
minView
deleteFindMax :: IntSet -> (Int, IntSet)
deleteFindMax :: IntSet -> (Int, IntSet)
deleteFindMax = (Int, IntSet) -> Maybe (Int, IntSet) -> (Int, IntSet)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (Int, IntSet)
forall a. HasCallStack => [Char] -> a
error "deleteFindMax: empty set has no maximal element") (Maybe (Int, IntSet) -> (Int, IntSet))
-> (IntSet -> Maybe (Int, IntSet)) -> IntSet -> (Int, IntSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Int, IntSet)
maxView
findMin :: IntSet -> Int
findMin :: IntSet -> Int
findMin Nil = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error "findMin: empty set has no minimal element"
findMin (Tip _ x :: Int
x) = Int
x
findMin (Bin _ _ _ m :: Int
m l :: IntSet
l r :: IntSet
r)
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = IntSet -> Int
find IntSet
r
| Bool
otherwise = IntSet -> Int
find IntSet
l
where find :: IntSet -> Int
find (Tip _ x :: Int
x) = Int
x
find (Bin _ _ _ _ l' :: IntSet
l' _) = IntSet -> Int
find IntSet
l'
find Nil = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error "findMin Nil"
findMax :: IntSet -> Int
findMax :: IntSet -> Int
findMax Nil = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error "findMax: empty set has no maximal element"
findMax (Tip _ x :: Int
x) = Int
x
findMax (Bin _ _ _ m :: Int
m l :: IntSet
l r :: IntSet
r)
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = IntSet -> Int
find IntSet
l
| Bool
otherwise = IntSet -> Int
find IntSet
r
where find :: IntSet -> Int
find (Tip _ x :: Int
x) = Int
x
find (Bin _ _ _ _ _ r' :: IntSet
r') = IntSet -> Int
find IntSet
r'
find Nil = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error "findMax Nil"
deleteMin :: IntSet -> IntSet
deleteMin :: IntSet -> IntSet
deleteMin = IntSet
-> ((Int, IntSet) -> IntSet) -> Maybe (Int, IntSet) -> IntSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> IntSet
forall a. HasCallStack => [Char] -> a
error "deleteMin: empty set has no minimal element") (Int, IntSet) -> IntSet
forall a b. (a, b) -> b
snd (Maybe (Int, IntSet) -> IntSet)
-> (IntSet -> Maybe (Int, IntSet)) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Int, IntSet)
minView
deleteMax :: IntSet -> IntSet
deleteMax :: IntSet -> IntSet
deleteMax = IntSet
-> ((Int, IntSet) -> IntSet) -> Maybe (Int, IntSet) -> IntSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> IntSet
forall a. HasCallStack => [Char] -> a
error "deleteMax: empty set has no maximal element") (Int, IntSet) -> IntSet
forall a b. (a, b) -> b
snd (Maybe (Int, IntSet) -> IntSet)
-> (IntSet -> Maybe (Int, IntSet)) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Int, IntSet)
maxView
map :: (Int->Int) -> IntSet -> IntSet
map :: (Int -> Int) -> IntSet -> IntSet
map f :: Int -> Int
f = [Int] -> IntSet
fromList ([Int] -> IntSet) -> (IntSet -> [Int]) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
List.map Int -> Int
f ([Int] -> [Int]) -> (IntSet -> [Int]) -> IntSet -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
toList
fold :: (Int -> b -> b) -> b -> IntSet -> b
fold :: (Int -> b -> b) -> b -> IntSet -> b
fold f :: Int -> b -> b
f z :: b
z t :: IntSet
t
= case IntSet
t of
Bin _ _ 0 m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> (Int -> b -> b) -> b -> IntSet -> b
forall b. (Int -> b -> b) -> b -> IntSet -> b
foldr Int -> b -> b
f ((Int -> b -> b) -> b -> IntSet -> b
forall b. (Int -> b -> b) -> b -> IntSet -> b
foldr Int -> b -> b
f b
z IntSet
l) IntSet
r
Bin _ _ _ _ _ _ -> (Int -> b -> b) -> b -> IntSet -> b
forall b. (Int -> b -> b) -> b -> IntSet -> b
foldr Int -> b -> b
f b
z IntSet
t
Tip _ x :: Int
x -> Int -> b -> b
f Int
x b
z
Nil -> b
z
foldr :: (Int -> b -> b) -> b -> IntSet -> b
foldr :: (Int -> b -> b) -> b -> IntSet -> b
foldr f :: Int -> b -> b
f z :: b
z t :: IntSet
t
= case IntSet
t of
Bin _ _ _ _ l :: IntSet
l r :: IntSet
r -> (Int -> b -> b) -> b -> IntSet -> b
forall b. (Int -> b -> b) -> b -> IntSet -> b
foldr Int -> b -> b
f ((Int -> b -> b) -> b -> IntSet -> b
forall b. (Int -> b -> b) -> b -> IntSet -> b
foldr Int -> b -> b
f b
z IntSet
r) IntSet
l
Tip _ x :: Int
x -> Int -> b -> b
f Int
x b
z
Nil -> b
z
elems :: IntSet -> [Int]
elems :: IntSet -> [Int]
elems s :: IntSet
s = IntSet -> [Int]
toList IntSet
s
toList :: IntSet -> [Int]
toList :: IntSet -> [Int]
toList t :: IntSet
t = (Int -> [Int] -> [Int]) -> [Int] -> IntSet -> [Int]
forall b. (Int -> b -> b) -> b -> IntSet -> b
fold (:) [] IntSet
t
toAscList :: IntSet -> [Int]
toAscList :: IntSet -> [Int]
toAscList t :: IntSet
t = IntSet -> [Int]
toList IntSet
t
fromList :: [Int] -> IntSet
fromList :: [Int] -> IntSet
fromList xs :: [Int]
xs = (IntSet -> Int -> IntSet) -> IntSet -> [Int] -> IntSet
forall a b. (a -> b -> a) -> a -> [b] -> a
foldlStrict IntSet -> Int -> IntSet
ins IntSet
empty [Int]
xs
where
ins :: IntSet -> Int -> IntSet
ins t :: IntSet
t x :: Int
x = Int -> IntSet -> IntSet
insert Int
x IntSet
t
fromAscList :: [Int] -> IntSet
fromAscList :: [Int] -> IntSet
fromAscList [] = IntSet
Nil
fromAscList (x0 :: Int
x0 : xs0 :: [Int]
xs0) = [Int] -> IntSet
fromDistinctAscList (Int -> [Int] -> [Int]
forall a. Eq a => a -> [a] -> [a]
combineEq Int
x0 [Int]
xs0)
where
combineEq :: a -> [a] -> [a]
combineEq x' :: a
x' [] = [a
x']
combineEq x' :: a
x' (x :: a
x:xs :: [a]
xs)
| a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x' = a -> [a] -> [a]
combineEq a
x' [a]
xs
| Bool
otherwise = a
x' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
combineEq a
x [a]
xs
fromDistinctAscList :: [Int] -> IntSet
fromDistinctAscList :: [Int] -> IntSet
fromDistinctAscList [] = IntSet
Nil
fromDistinctAscList (z0 :: Int
z0 : zs0 :: [Int]
zs0) = Int -> [Int] -> Stack -> IntSet
work Int
z0 [Int]
zs0 Stack
Nada
where
work :: Int -> [Int] -> Stack -> IntSet
work x :: Int
x [] stk :: Stack
stk = Int -> IntSet -> Stack -> IntSet
finish Int
x (Int -> IntSet
tip Int
x) Stack
stk
work x :: Int
x (z :: Int
z:zs :: [Int]
zs) stk :: Stack
stk = Int -> [Int] -> Int -> Int -> IntSet -> Stack -> IntSet
reduce Int
z [Int]
zs (Int -> Int -> Int
branchMask Int
z Int
x) Int
x (Int -> IntSet
tip Int
x) Stack
stk
reduce :: Int -> [Int] -> Int -> Int -> IntSet -> Stack -> IntSet
reduce z :: Int
z zs :: [Int]
zs _ px :: Int
px tx :: IntSet
tx Nada = Int -> [Int] -> Stack -> IntSet
work Int
z [Int]
zs (Int -> IntSet -> Stack -> Stack
Push Int
px IntSet
tx Stack
Nada)
reduce z :: Int
z zs :: [Int]
zs m :: Int
m px :: Int
px tx :: IntSet
tx stk :: Stack
stk@(Push py :: Int
py ty :: IntSet
ty stk' :: Stack
stk') =
let mxy :: Int
mxy = Int -> Int -> Int
branchMask Int
px Int
py
pxy :: Int
pxy = Int -> Int -> Int
mask Int
px Int
mxy
in if Int -> Int -> Bool
shorter Int
m Int
mxy
then Int -> [Int] -> Int -> Int -> IntSet -> Stack -> IntSet
reduce Int
z [Int]
zs Int
m Int
pxy (Int -> Int -> IntSet -> IntSet -> IntSet
bin_ Int
pxy Int
mxy IntSet
ty IntSet
tx) Stack
stk'
else Int -> [Int] -> Stack -> IntSet
work Int
z [Int]
zs (Int -> IntSet -> Stack -> Stack
Push Int
px IntSet
tx Stack
stk)
finish :: Int -> IntSet -> Stack -> IntSet
finish _ t :: IntSet
t Nada = IntSet
t
finish px :: Int
px tx :: IntSet
tx (Push py :: Int
py ty :: IntSet
ty stk :: Stack
stk) = Int -> IntSet -> Stack -> IntSet
finish Int
p (Int -> IntSet -> Int -> IntSet -> IntSet
join Int
py IntSet
ty Int
px IntSet
tx) Stack
stk
where m :: Int
m = Int -> Int -> Int
branchMask Int
px Int
py
p :: Int
p = Int -> Int -> Int
mask Int
px Int
m
data Stack = Push {-# UNPACK #-} !Prefix !IntSet !Stack | Nada
showTree :: IntSet -> String
showTree :: IntSet -> [Char]
showTree s :: IntSet
s
= Bool -> Bool -> IntSet -> [Char]
showTreeWith Bool
True Bool
False IntSet
s
showTreeWith :: Bool -> Bool -> IntSet -> String
showTreeWith :: Bool -> Bool -> IntSet -> [Char]
showTreeWith hang :: Bool
hang wide :: Bool
wide t :: IntSet
t
| Bool
hang = (Bool -> [[Char]] -> IntSet -> ShowS
showsTreeHang Bool
wide [] IntSet
t) ""
| Bool
otherwise = (Bool -> [[Char]] -> [[Char]] -> IntSet -> ShowS
showsTree Bool
wide [] [] IntSet
t) ""
showsTree :: Bool -> [String] -> [String] -> IntSet -> ShowS
showsTree :: Bool -> [[Char]] -> [[Char]] -> IntSet -> ShowS
showsTree wide :: Bool
wide lbars :: [[Char]]
lbars rbars :: [[Char]]
rbars t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: 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 (Int -> Int -> [Char]
showBin Int
p Int
m) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString "\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 _ x :: Int
x
-> [[Char]] -> ShowS
showsBars [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString " " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString "\n"
Nil -> [[Char]] -> ShowS
showsBars [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString "|\n"
showsTreeHang :: Bool -> [String] -> IntSet -> ShowS
showsTreeHang :: Bool -> [[Char]] -> IntSet -> ShowS
showsTreeHang wide :: Bool
wide bars :: [[Char]]
bars t :: IntSet
t
= case IntSet
t of
Bin _ _ p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r
-> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString (Int -> Int -> [Char]
showBin Int
p Int
m) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString "\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 _ x :: Int
x
-> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString " " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString "\n"
Nil -> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString "|\n"
showBin :: Prefix -> Mask -> String
showBin :: Int -> Int -> [Char]
showBin _ _
= "*"
showWide :: Bool -> [String] -> String -> String
showWide :: Bool -> [[Char]] -> ShowS
showWide wide :: Bool
wide bars :: [[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 "|\n"
| Bool
otherwise = ShowS
forall a. a -> a
id
showsBars :: [String] -> ShowS
showsBars :: [[Char]] -> ShowS
showsBars bars :: [[Char]]
bars
= case [[Char]]
bars of
[] -> ShowS
forall a. a -> a
id
_ -> [Char] -> ShowS
showString ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]]
forall a. [a] -> [a]
tail [[Char]]
bars))) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
node
node :: String
node :: [Char]
node = "+--"
withBar, withEmpty :: [String] -> [String]
withBar :: [[Char]] -> [[Char]]
withBar bars :: [[Char]]
bars = "| "[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
bars
withEmpty :: [[Char]] -> [[Char]]
withEmpty bars :: [[Char]]
bars = " "[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
bars
instance Eq IntSet where
Nil == :: IntSet -> IntSet -> Bool
== Nil = Bool
True
Tip i :: Int
i _ == Tip j :: Int
j _ = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j
Bin i :: Int
i _ _ _ _ _ == Bin j :: Int
j _ _ _ _ _ = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j
_ == _ = Bool
False
instance Ord IntSet where
Nil compare :: IntSet -> IntSet -> Ordering
`compare` Nil = Ordering
EQ
Nil `compare` Tip _ _ = Ordering
LT
Nil `compare` Bin _ _ _ _ _ _ = Ordering
LT
Tip _ _ `compare` Nil = Ordering
GT
Tip i :: Int
i _ `compare` Tip j :: Int
j _ = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
Tip i :: Int
i _ `compare` Bin j :: Int
j _ _ _ _ _ = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
Bin _ _ _ _ _ _ `compare` Nil = Ordering
GT
Bin i :: Int
i _ _ _ _ _ `compare` Tip j :: Int
j _ = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
Bin i :: Int
i _ _ _ _ _ `compare` Bin j :: Int
j _ _ _ _ _ = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
instance Show IntSet where
showsPrec :: Int -> IntSet -> ShowS
showsPrec p :: Int
p xs :: IntSet
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
[Char] -> ShowS
showString "fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (IntSet -> [Int]
toList IntSet
xs)
instance Read IntSet where
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
$ Int -> ReadPrec IntSet -> ReadPrec IntSet
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (ReadPrec IntSet -> ReadPrec IntSet)
-> ReadPrec IntSet -> ReadPrec IntSet
forall a b. (a -> b) -> a -> b
$ do
Ident "fromList" <- ReadPrec Lexeme
lexP
[Int]
xs <- ReadPrec [Int]
forall a. Read a => ReadPrec a
readPrec
IntSet -> ReadPrec IntSet
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> IntSet
fromList [Int]
xs)
readListPrec :: ReadPrec [IntSet]
readListPrec = ReadPrec [IntSet]
forall a. Read a => ReadPrec [a]
readListPrecDefault
join :: Prefix -> IntSet -> Prefix -> IntSet -> IntSet
join :: Int -> IntSet -> Int -> IntSet -> IntSet
join p1 :: Int
p1 t1 :: IntSet
t1 p2 :: Int
p2 t2 :: IntSet
t2
| Int -> Int -> Bool
zero Int
p1 Int
m = Int -> Int -> IntSet -> IntSet -> IntSet
bin_ Int
p Int
m IntSet
t1 IntSet
t2
| Bool
otherwise = Int -> Int -> IntSet -> IntSet -> IntSet
bin_ Int
p Int
m IntSet
t2 IntSet
t1
where
m :: Int
m = Int -> Int -> Int
branchMask Int
p1 Int
p2
p :: Int
p = Int -> Int -> Int
mask Int
p1 Int
m
zero :: Int -> Mask -> Bool
zero :: Int -> Int -> Bool
zero i :: Int
i m :: Int
m
= (Int -> Nat
natFromInt Int
i) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. (Int -> Nat
natFromInt Int
m) Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== 0
nomatch,match :: Int -> Prefix -> Mask -> Bool
nomatch :: Int -> Int -> Int -> Bool
nomatch i :: Int
i p :: Int
p m :: Int
m
= (Int -> Int -> Int
mask Int
i Int
m) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
p
match :: Int -> Int -> Int -> Bool
match i :: Int
i p :: Int
p m :: Int
m
= (Int -> Int -> Int
mask Int
i Int
m) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p
mask :: Int -> Mask -> Prefix
mask :: Int -> Int -> Int
mask i :: Int
i m :: Int
m
= Nat -> Nat -> Int
maskW (Int -> Nat
natFromInt Int
i) (Int -> Nat
natFromInt Int
m)
zeroN :: Nat -> Nat -> Bool
zeroN :: Nat -> Nat -> Bool
zeroN i :: Nat
i m :: Nat
m = (Nat
i Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
m) Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== 0
maskW :: Nat -> Nat -> Prefix
maskW :: Nat -> Nat -> Int
maskW i :: Nat
i m :: Nat
m
= Nat -> Int
intFromNat (Nat
i Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. (Nat -> Nat
forall a. Bits a => a -> a
complement (Nat
mNat -> Nat -> Nat
forall a. Num a => a -> a -> a
-1) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Nat
m))
shorter :: Mask -> Mask -> Bool
shorter :: Int -> Int -> Bool
shorter m1 :: Int
m1 m2 :: Int
m2
= (Int -> Nat
natFromInt Int
m1) Nat -> Nat -> Bool
forall a. Ord a => a -> a -> Bool
> (Int -> Nat
natFromInt Int
m2)
branchMask :: Prefix -> Prefix -> Mask
branchMask :: Int -> Int -> Int
branchMask p1 :: Int
p1 p2 :: Int
p2
= Nat -> Int
intFromNat (Nat -> Nat
highestBitMask (Int -> Nat
natFromInt Int
p1 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Int -> Nat
natFromInt Int
p2))
highestBitMask :: Nat -> Nat
highestBitMask :: Nat -> Nat
highestBitMask x0 :: Nat
x0
= case (Nat
x0 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Nat -> Int -> Nat
shiftRL Nat
x0 1) of
x1 :: Nat
x1 -> case (Nat
x1 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Nat -> Int -> Nat
shiftRL Nat
x1 2) of
x2 :: Nat
x2 -> case (Nat
x2 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Nat -> Int -> Nat
shiftRL Nat
x2 4) of
x3 :: Nat
x3 -> case (Nat
x3 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Nat -> Int -> Nat
shiftRL Nat
x3 8) of
x4 :: Nat
x4 -> case (Nat
x4 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Nat -> Int -> Nat
shiftRL Nat
x4 16) of
x5 :: Nat
x5 -> case (Nat
x5 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Nat -> Int -> Nat
shiftRL Nat
x5 32) of
x6 :: Nat
x6 -> (Nat
x6 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` (Nat -> Int -> Nat
shiftRL Nat
x6 1))
foldlStrict :: (a -> b -> a) -> a -> [b] -> a
foldlStrict :: (a -> b -> a) -> a -> [b] -> a
foldlStrict f :: a -> b -> a
f z :: a
z xs :: [b]
xs
= case [b]
xs of
[] -> a
z
(x :: b
x:xx :: [b]
xx) -> let z' :: a
z' = a -> b -> a
f a
z b
x in a -> a -> a
forall a b. a -> b -> b
seq a
z' ((a -> b -> a) -> a -> [b] -> a
forall a b. (a -> b -> a) -> a -> [b] -> a
foldlStrict a -> b -> a
f a
z' [b]
xx)