{-# LANGUAGE MagicHash, TypeFamilies, FlexibleInstances, BangPatterns, CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Interned.IntSet
-- Copyright   :  (c) Daan Leijen 2002
--                (c) Edward Kmett 2011
-- License     :  BSD-style
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  non-portable (TypeFamilies, MagicHash)
--
-- An efficient implementation of integer sets.
--
-- Since many function names (but not the type name) clash with
-- "Prelude" names, this module is usually imported @qualified@, e.g.
--
-- >  import Data.IntSet (IntSet)
-- >  import qualified Data.IntSet as IntSet
--
-- The implementation is based on /big-endian patricia trees/.  This data
-- structure performs especially well on binary operations like 'union'
-- and 'intersection'.  However, my benchmarks show that it is also
-- (much) faster on insertions and deletions when compared to a generic
-- size-balanced set implementation (see "Data.Set").
--
--    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",
--      Workshop on ML, September 1998, pages 77-86,
--      <http://citeseer.ist.psu.edu/okasaki98fast.html>
--
--    * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve
--      Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),
--      October 1968, pages 514-534.
--
-- Many operations have a worst-case complexity of /O(min(n,W))/.
-- This means that the operation can become linear in the number of
-- elements with a maximum of /W/ -- the number of bits in an 'Int'
-- (32 or 64).
--
-- Unlike the reference implementation in Data.IntSet, Data.Interned.IntSet
-- uses hash consing to ensure that there is only ever one copy of any given
-- IntSet in memory. This is enabled by the normal form of the PATRICIA trie.
--
-- This can mean a drastic reduction in the memory footprint of a program
-- in exchange for much more costly set manipulation.
--
-----------------------------------------------------------------------------

module Data.Interned.IntSet  (
            -- * Set type
              IntSet          -- instance Eq,Show

            , identity

            -- * Operators
            , (\\)

            -- * Query
            , null
            , size
            , member
            , notMember
            , isSubsetOf
            , isProperSubsetOf

            -- * Construction
            , empty
            , singleton
            , insert
            , delete

            -- * Combine
            , union, unions
            , difference
            , intersection

            -- * Filter
            , filter
            , partition
            , split
            , splitMember

            -- * Min\/Max
            , findMin
            , findMax
            , deleteMin
            , deleteMax
            , deleteFindMin
            , deleteFindMax
            , maxView
            , minView

            -- * Map
            , map

            -- * Fold
            , fold

            -- * Conversion
            -- ** List
            , elems
            , toList
            , fromList

            -- ** Ordered list
            , toAscList
            , fromAscList
            , fromDistinctAscList

            -- * Debugging
            , showTree
            , showTreeWith
            ) where

import Prelude hiding (lookup,filter,foldr,foldl,null,map)
import qualified Data.List as List
import Data.Maybe (fromMaybe)
import Data.Interned.Internal
import Data.Bits
import Data.Hashable
import Text.Read
import GHC.Exts ( Word(..), Int(..), shiftRL# )

#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
#endif

#if MIN_VERSION_base(4,9,0) && !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif

-- import Data.Typeable
-- import Data.Data (Data(..), mkNoRepType)

infixl 9 \\{-This comment teaches CPP correct behaviour -}

-- A "Nat" is a natural machine word (an unsigned Int)
type Nat = Word

natFromInt :: Int -> Nat
natFromInt :: Int -> Nat
natFromInt Int
i = Int -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i

intFromNat :: Nat -> Int
intFromNat :: Nat -> Int
intFromNat 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# Word#
x) (I# Int#
i) = Word# -> Nat
W# (Word# -> Int# -> Word#
shiftRL# Word#
x Int#
i)

{--------------------------------------------------------------------
  Operators
--------------------------------------------------------------------}
-- | /O(n+m)/. See 'difference'.
(\\) :: IntSet -> IntSet -> IntSet
IntSet
m1 \\ :: IntSet -> IntSet -> IntSet
\\ IntSet
m2 = IntSet -> IntSet -> IntSet
difference IntSet
m1 IntSet
m2

{--------------------------------------------------------------------
  Types
--------------------------------------------------------------------}
-- | A set of integers.
data IntSet
  = Nil
  | Tip {-# UNPACK #-} !Id {-# UNPACK #-} !Int
  | Bin {-# UNPACK #-} !Id {-# UNPACK #-} !Int {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !IntSet !IntSet
-- Invariant: Nil is never found as a child of Bin.
-- Invariant: The Mask is a power of 2.  It is the largest bit position at which
--            two elements of the set differ.
-- Invariant: Prefix is the common high-order bits that all elements share to
--            the left of the Mask bit.
-- Invariant: In Bin prefix mask left right, left consists of the elements that
--            don't have the mask bit set; right is all the elements that do.

data UninternedIntSet
  = UNil
  | UTip !Int
  | UBin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !IntSet !IntSet


tip :: Int -> IntSet
tip :: Int -> IntSet
tip Int
n = Uninterned IntSet -> IntSet
forall t. Interned t => Uninterned t -> t
intern (Int -> UninternedIntSet
UTip Int
n)

{--------------------------------------------------------------------
  @bin@ assures that we never have empty trees within a tree.
--------------------------------------------------------------------}
bin :: Prefix -> Mask -> IntSet -> IntSet -> IntSet
bin :: Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
_ Int
_ IntSet
l IntSet
Nil = IntSet
l
bin Int
_ Int
_ IntSet
Nil IntSet
r = IntSet
r
bin Int
p Int
m IntSet
l 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_ Int
p Int
m IntSet
l 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)

-- | A unique integer ID associated with each interned set.
identity :: IntSet -> Id
identity :: IntSet -> Int
identity IntSet
Nil = Int
0
identity (Tip Int
i Int
_) = Int
i
identity (Bin Int
i Int
_ Int
_ Int
_ IntSet
_ IntSet
_) = 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 Uninterned IntSet
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 p IntSet
_ = Int
16384 -- a huge cache width!
  seedIdentity :: p IntSet -> Int
seedIdentity p IntSet
_ = Int
1
  identify :: Int -> Uninterned IntSet -> IntSet
identify Int
_ Uninterned IntSet
UNil = IntSet
Nil
  identify Int
i (UTip j) = Int -> Int -> IntSet
Tip Int
i Int
j
  identify 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 Int
s Description IntSet
DNil = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0 :: Int)
  hashWithSalt Int
s (DTip n) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1 :: Int) Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
n
  hashWithSalt Int
s (DBin p m l r) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
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 IntSet
Nil = Uninterned IntSet
UninternedIntSet
UNil
  unintern (Tip Int
_ Int
j) = Int -> UninternedIntSet
UTip Int
j
  unintern (Bin Int
_ Int
_ Int
p Int
m IntSet
l 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


{--------------------------------------------------------------------
  Query
--------------------------------------------------------------------}
-- | /O(1)/. Is the set empty?
null :: IntSet -> Bool
null :: IntSet -> Bool
null IntSet
Nil = Bool
True
null IntSet
_   = Bool
False

-- | /O(1)/. Cardinality of the set.
size :: IntSet -> Int
size :: IntSet -> Int
size IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
s Int
_ Int
_ IntSet
_ IntSet
_ -> Int
s
      Tip Int
_ Int
_ -> Int
1
      IntSet
Nil   -> Int
0


-- | /O(min(n,W))/. Is the value a member of the set?
member :: Int -> IntSet -> Bool
member :: Int -> IntSet -> Bool
member Int
x IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
_ Int
p Int
m IntSet
l 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 Int
_ Int
y -> (Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
y)
      IntSet
Nil     -> Bool
False

-- | /O(min(n,W))/. Is the element not in the set?
notMember :: Int -> IntSet -> Bool
notMember :: Int -> IntSet -> Bool
notMember 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' is used by 'intersection' for left-biasing
lookup :: Int -> IntSet -> Maybe Int
lookup :: Int -> IntSet -> Maybe Int
lookup Int
k IntSet
t
  = let nk :: Nat
nk = Int -> Nat
natFromInt Int
k  in Nat -> Maybe Int -> Maybe Int
seq Nat
nk (Nat -> IntSet -> Maybe Int
lookupN Nat
nk IntSet
t)

lookupN :: Nat -> IntSet -> Maybe Int
lookupN :: Nat -> IntSet -> Maybe Int
lookupN Nat
k IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
_ Int
_ Int
m IntSet
l 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 Int
_ 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
      IntSet
Nil -> Maybe Int
forall a. Maybe a
Nothing


{--------------------------------------------------------------------
  Construction
--------------------------------------------------------------------}
-- | /O(1)/. The empty set.
empty :: IntSet
empty :: IntSet
empty = IntSet
Nil

-- | /O(1)/. A set of one element.
singleton :: Int -> IntSet
singleton :: Int -> IntSet
singleton Int
x = Int -> IntSet
tip Int
x



{--------------------------------------------------------------------
  Insert
--------------------------------------------------------------------}
-- | /O(min(n,W))/. Add a value to the set. When the value is already
-- an element of the set, it is replaced by the new one, ie. 'insert'
-- is left-biased.
insert :: Int -> IntSet -> IntSet
insert :: Int -> IntSet -> IntSet
insert Int
x IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
_ Int
p Int
m IntSet
l 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 Int
_ 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
      IntSet
Nil -> Int -> IntSet
tip Int
x

-- right-biased insertion, used by 'union'
insertR :: Int -> IntSet -> IntSet
insertR :: Int -> IntSet -> IntSet
insertR Int
x IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
_ Int
p Int
m IntSet
l 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 Int
_ 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
      IntSet
Nil -> Int -> IntSet
tip Int
x

-- | /O(min(n,W))/. Delete a value in the set. Returns the
-- original set when the value was not present.
delete :: Int -> IntSet -> IntSet
delete :: Int -> IntSet -> IntSet
delete Int
x IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
_ Int
p Int
m IntSet
l 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 Int
_ Int
y
        | Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
y          -> IntSet
Nil
        | Bool
otherwise     -> IntSet
t
      IntSet
Nil -> IntSet
Nil


{--------------------------------------------------------------------
  Union
--------------------------------------------------------------------}
-- | The union of a list of sets.
unions :: [IntSet] -> IntSet
unions :: [IntSet] -> IntSet
unions [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


-- | /O(n+m)/. The union of two sets.
union :: IntSet -> IntSet -> IntSet
union :: IntSet -> IntSet -> IntSet
union t1 :: IntSet
t1@(Bin Int
_ Int
_ Int
p1 Int
m1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Int
_ Int
_ Int
p2 Int
m2 IntSet
l2 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 Int
_ Int
x) IntSet
t = Int -> IntSet -> IntSet
insert Int
x IntSet
t
union IntSet
t (Tip Int
_ Int
x) = Int -> IntSet -> IntSet
insertR Int
x IntSet
t  -- right bias
union IntSet
Nil IntSet
t       = IntSet
t
union IntSet
t IntSet
Nil       = IntSet
t


{--------------------------------------------------------------------
  Difference
--------------------------------------------------------------------}
-- | /O(n+m)/. Difference between two sets.
difference :: IntSet -> IntSet -> IntSet
difference :: IntSet -> IntSet -> IntSet
difference t1 :: IntSet
t1@(Bin Int
_ Int
_ Int
p1 Int
m1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Int
_ Int
_ Int
p2 Int
m2 IntSet
l2 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 Int
_ Int
x) IntSet
t2
  | Int -> IntSet -> Bool
member Int
x IntSet
t2  = IntSet
Nil
  | Bool
otherwise    = IntSet
t1

difference IntSet
Nil IntSet
_       = IntSet
Nil
difference IntSet
t (Tip Int
_ Int
x) = Int -> IntSet -> IntSet
delete Int
x IntSet
t
difference IntSet
t IntSet
Nil       = IntSet
t



{--------------------------------------------------------------------
  Intersection
--------------------------------------------------------------------}
-- | /O(n+m)/. The intersection of two sets.
intersection :: IntSet -> IntSet -> IntSet
intersection :: IntSet -> IntSet -> IntSet
intersection t1 :: IntSet
t1@(Bin Int
_ Int
_ Int
p1 Int
m1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Int
_ Int
_ Int
p2 Int
m2 IntSet
l2 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 Int
_ Int
x) IntSet
t2
  | Int -> IntSet -> Bool
member Int
x IntSet
t2  = IntSet
t1
  | Bool
otherwise    = IntSet
Nil
intersection IntSet
t (Tip Int
_ Int
x)
  = case Int -> IntSet -> Maybe Int
lookup Int
x IntSet
t of
      Just Int
y  -> Int -> IntSet
tip Int
y
      Maybe Int
Nothing -> IntSet
Nil
intersection IntSet
Nil IntSet
_ = IntSet
Nil
intersection IntSet
_ IntSet
Nil = IntSet
Nil


{--------------------------------------------------------------------
  Subset
--------------------------------------------------------------------}
-- | /O(n+m)/. Is this a proper subset? (ie. a subset but not equal).
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 Int
_ Int
_ Int
p1 Int
m1 IntSet
l1 IntSet
r1) (Bin Int
_ Int
_ Int
p2 Int
m2 IntSet
l2 IntSet
r2)
  | Int -> Int -> Bool
shorter Int
m1 Int
m2  = Ordering
GT
  | Int -> Int -> Bool
shorter Int
m2 Int
m1  = case Ordering
subsetCmpLt of
                       Ordering
GT -> Ordering
GT
                       Ordering
_ -> Ordering
LT
  | Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2       = Ordering
subsetCmpEq
  | Bool
otherwise      = Ordering
GT  -- disjoint
  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
                    (Ordering
GT,Ordering
_ ) -> Ordering
GT
                    (Ordering
_ ,Ordering
GT) -> Ordering
GT
                    (Ordering
EQ,Ordering
EQ) -> Ordering
EQ
                    (Ordering, Ordering)
_       -> Ordering
LT

subsetCmp (Bin Int
_ Int
_ Int
_ Int
_ IntSet
_ IntSet
_) IntSet
_  = Ordering
GT
subsetCmp (Tip Int
_ Int
x) (Tip Int
_ Int
y)
  | Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
y       = Ordering
EQ
  | Bool
otherwise  = Ordering
GT  -- disjoint
subsetCmp (Tip Int
_ Int
x) IntSet
t
  | Int -> IntSet -> Bool
member Int
x IntSet
t = Ordering
LT
  | Bool
otherwise  = Ordering
GT  -- disjoint
subsetCmp IntSet
Nil IntSet
Nil = Ordering
EQ
subsetCmp IntSet
Nil IntSet
_   = Ordering
LT

-- | /O(n+m)/. Is this a subset?
-- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.

isSubsetOf :: IntSet -> IntSet -> Bool
isSubsetOf :: IntSet -> IntSet -> Bool
isSubsetOf t1 :: IntSet
t1@(Bin Int
_ Int
_ Int
p1 Int
m1 IntSet
l1 IntSet
r1) (Bin Int
_ Int
_ Int
p2 Int
m2 IntSet
l2 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 Int
_ Int
_ Int
_ Int
_ IntSet
_ IntSet
_) IntSet
_  = Bool
False
isSubsetOf (Tip Int
_ Int
x) IntSet
t          = Int -> IntSet -> Bool
member Int
x IntSet
t
isSubsetOf IntSet
Nil IntSet
_                = Bool
True


{--------------------------------------------------------------------
  Filter
--------------------------------------------------------------------}
-- | /O(n)/. Filter all elements that satisfy some predicate.
filter :: (Int -> Bool) -> IntSet -> IntSet
filter :: (Int -> Bool) -> IntSet -> IntSet
filter Int -> Bool
predicate IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
_ Int
p Int
m IntSet
l 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 Int
_ Int
x
        | Int -> Bool
predicate Int
x -> IntSet
t
        | Bool
otherwise   -> IntSet
Nil
      IntSet
Nil -> IntSet
Nil

-- | /O(n)/. partition the set according to some predicate.
partition :: (Int -> Bool) -> IntSet -> (IntSet,IntSet)
partition :: (Int -> Bool) -> IntSet -> (IntSet, IntSet)
partition Int -> Bool
predicate IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
_ Int
p Int
m IntSet
l IntSet
r
        -> let (IntSet
l1,IntSet
l2) = (Int -> Bool) -> IntSet -> (IntSet, IntSet)
partition Int -> Bool
predicate IntSet
l
               (IntSet
r1,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 Int
_ Int
x
        | Int -> Bool
predicate Int
x -> (IntSet
t,IntSet
Nil)
        | Bool
otherwise   -> (IntSet
Nil,IntSet
t)
      IntSet
Nil -> (IntSet
Nil,IntSet
Nil)


-- | /O(min(n,W))/. The expression (@'split' x set@) is a pair @(set1,set2)@
-- where @set1@ comprises the elements of @set@ less than @x@ and @set2@
-- comprises the elements of @set@ greater than @x@.
--
-- > split 3 (fromList [1..5]) == (fromList [1,2], fromList [4,5])
split :: Int -> IntSet -> (IntSet,IntSet)
split :: Int -> IntSet -> (IntSet, IntSet)
split Int
x IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
_ Int
_ Int
m IntSet
l IntSet
r
        | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0       -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then let (IntSet
lt,IntSet
gt) = Int -> IntSet -> (IntSet, IntSet)
split' Int
x IntSet
l in (IntSet -> IntSet -> IntSet
union IntSet
r IntSet
lt, IntSet
gt)
                                   else let (IntSet
lt,IntSet
gt) = Int -> IntSet -> (IntSet, IntSet)
split' Int
x IntSet
r in (IntSet
lt, IntSet -> IntSet -> IntSet
union IntSet
gt IntSet
l)
                                   -- handle negative numbers.
        | Bool
otherwise   -> Int -> IntSet -> (IntSet, IntSet)
split' Int
x IntSet
t
      Tip Int
_ 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)
      IntSet
Nil             -> (IntSet
Nil, IntSet
Nil)

split' :: Int -> IntSet -> (IntSet,IntSet)
split' :: Int -> IntSet -> (IntSet, IntSet)
split' Int
x IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
_ Int
p Int
m IntSet
l IntSet
r
        | Int -> Int -> Int -> Bool
match Int
x Int
p Int
m -> if Int -> Int -> Bool
zero Int
x Int
m then let (IntSet
lt,IntSet
gt) = Int -> IntSet -> (IntSet, IntSet)
split' Int
x IntSet
l in (IntSet
lt,IntSet -> IntSet -> IntSet
union IntSet
gt IntSet
r)
                                     else let (IntSet
lt,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 Int
_ 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)
      IntSet
Nil -> (IntSet
Nil,IntSet
Nil)

-- | /O(min(n,W))/. Performs a 'split' but also returns whether the pivot
-- element was found in the original set.
splitMember :: Int -> IntSet -> (IntSet,Bool,IntSet)
splitMember :: Int -> IntSet -> (IntSet, Bool, IntSet)
splitMember Int
x IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
_ Int
_ Int
m IntSet
l IntSet
r
        | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0       -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then let (IntSet
lt,Bool
found,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 (IntSet
lt,Bool
found,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)
                                   -- handle negative numbers.
        | Bool
otherwise   -> Int -> IntSet -> (IntSet, Bool, IntSet)
splitMember' Int
x IntSet
t
      Tip Int
_ 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)
      IntSet
Nil -> (IntSet
Nil,Bool
False,IntSet
Nil)

splitMember' :: Int -> IntSet -> (IntSet,Bool,IntSet)
splitMember' :: Int -> IntSet -> (IntSet, Bool, IntSet)
splitMember' Int
x IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
_ Int
p Int
m IntSet
l IntSet
r
         | Int -> Int -> Int -> Bool
match Int
x Int
p Int
m ->  if Int -> Int -> Bool
zero Int
x Int
m then let (IntSet
lt,Bool
found,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 (IntSet
lt,Bool
found,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 Int
_ 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)
      IntSet
Nil -> (IntSet
Nil,Bool
False,IntSet
Nil)



{----------------------------------------------------------------------
  Min/Max
----------------------------------------------------------------------}

-- | /O(min(n,W))/. Retrieves the maximal key of the set, and the set
-- stripped of that element, or 'Nothing' if passed an empty set.
maxView :: IntSet -> Maybe (Int, IntSet)
maxView :: IntSet -> Maybe (Int, IntSet)
maxView IntSet
t
    = case IntSet
t of
        Bin Int
_ Int
_ Int
p Int
m IntSet
l IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> let (Int
result,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 Int
_ Int
_ Int
p Int
m IntSet
l IntSet
r         -> let (Int
result,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 Int
_ Int
y -> (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (Int
y,IntSet
Nil)
        IntSet
Nil -> Maybe (Int, IntSet)
forall a. Maybe a
Nothing

maxViewUnsigned :: IntSet -> (Int, IntSet)
maxViewUnsigned :: IntSet -> (Int, IntSet)
maxViewUnsigned IntSet
t
    = case IntSet
t of
        Bin Int
_ Int
_ Int
p Int
m IntSet
l IntSet
r -> let (Int
result,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 Int
_ Int
y -> (Int
y, IntSet
Nil)
        IntSet
Nil -> [Char] -> (Int, IntSet)
forall a. HasCallStack => [Char] -> a
error [Char]
"maxViewUnsigned Nil"

-- | /O(min(n,W))/. Retrieves the minimal key of the set, and the set
-- stripped of that element, or 'Nothing' if passed an empty set.
minView :: IntSet -> Maybe (Int, IntSet)
minView :: IntSet -> Maybe (Int, IntSet)
minView IntSet
t
    = case IntSet
t of
        Bin Int
_ Int
_ Int
p Int
m IntSet
l IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> let (Int
result,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 Int
_ Int
_ Int
p Int
m IntSet
l IntSet
r         -> let (Int
result,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 Int
_ Int
y -> (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (Int
y, IntSet
Nil)
        IntSet
Nil -> Maybe (Int, IntSet)
forall a. Maybe a
Nothing

minViewUnsigned :: IntSet -> (Int, IntSet)
minViewUnsigned :: IntSet -> (Int, IntSet)
minViewUnsigned IntSet
t
    = case IntSet
t of
        Bin Int
_ Int
_ Int
p Int
m IntSet
l IntSet
r -> let (Int
result,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 Int
_ Int
y -> (Int
y, IntSet
Nil)
        IntSet
Nil -> [Char] -> (Int, IntSet)
forall a. HasCallStack => [Char] -> a
error [Char]
"minViewUnsigned Nil"

-- | /O(min(n,W))/. Delete and find the minimal element.
--
-- > deleteFindMin set = (findMin set, deleteMin set)
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 [Char]
"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

-- | /O(min(n,W))/. Delete and find the maximal element.
--
-- > deleteFindMax set = (findMax set, deleteMax set)
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 [Char]
"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


-- | /O(min(n,W))/. The minimal element of the set.
findMin :: IntSet -> Int
findMin :: IntSet -> Int
findMin IntSet
Nil = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"findMin: empty set has no minimal element"
findMin (Tip Int
_ Int
x) = Int
x
findMin (Bin Int
_ Int
_ Int
_ Int
m IntSet
l IntSet
r)
  |   Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0   = IntSet -> Int
find IntSet
r
  | Bool
otherwise = IntSet -> Int
find IntSet
l
    where find :: IntSet -> Int
find (Tip Int
_ Int
x)          = Int
x
          find (Bin Int
_ Int
_ Int
_ Int
_ IntSet
l' IntSet
_) = IntSet -> Int
find IntSet
l'
          find IntSet
Nil                = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"findMin Nil"

-- | /O(min(n,W))/. The maximal element of a set.
findMax :: IntSet -> Int
findMax :: IntSet -> Int
findMax IntSet
Nil = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"findMax: empty set has no maximal element"
findMax (Tip Int
_ Int
x) = Int
x
findMax (Bin Int
_ Int
_ Int
_ Int
m IntSet
l IntSet
r)
  |   Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0   = IntSet -> Int
find IntSet
l
  | Bool
otherwise = IntSet -> Int
find IntSet
r
    where find :: IntSet -> Int
find (Tip Int
_ Int
x)          = Int
x
          find (Bin Int
_ Int
_ Int
_ Int
_ IntSet
_ IntSet
r') = IntSet -> Int
find IntSet
r'
          find IntSet
Nil                = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"findMax Nil"


-- | /O(min(n,W))/. Delete the minimal element.
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 [Char]
"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

-- | /O(min(n,W))/. Delete the maximal element.
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 [Char]
"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
----------------------------------------------------------------------}

-- | /O(n*min(n,W))/.
-- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.
--
-- It's worth noting that the size of the result may be smaller if,
-- for some @(x,y)@, @x \/= y && f x == f y@

map :: (Int->Int) -> IntSet -> IntSet
map :: (Int -> Int) -> IntSet -> IntSet
map 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
--------------------------------------------------------------------}
-- | /O(n)/. Fold over the elements of a set in an unspecified order.
--
-- > sum set   == fold (+) 0 set
-- > elems set == fold (:) [] set
fold :: (Int -> b -> b) -> b -> IntSet -> b
fold :: (Int -> b -> b) -> b -> IntSet -> b
fold Int -> b -> b
f b
z IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
_ Int
0 Int
m IntSet
l IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
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
      -- put negative numbers before.
      Bin Int
_ Int
_ Int
_ Int
_ IntSet
_ IntSet
_ -> (Int -> b -> b) -> b -> IntSet -> b
forall b. (Int -> b -> b) -> b -> IntSet -> b
foldr Int -> b -> b
f b
z IntSet
t
      Tip Int
_ Int
x         -> Int -> b -> b
f Int
x b
z
      IntSet
Nil             -> b
z

foldr :: (Int -> b -> b) -> b -> IntSet -> b
foldr :: (Int -> b -> b) -> b -> IntSet -> b
foldr Int -> b -> b
f b
z IntSet
t
  = case IntSet
t of
      Bin Int
_ Int
_ Int
_ Int
_ IntSet
l 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 Int
_ Int
x         -> Int -> b -> b
f Int
x b
z
      IntSet
Nil             -> b
z

{--------------------------------------------------------------------
  List variations
--------------------------------------------------------------------}
-- | /O(n)/. The elements of a set. (For sets, this is equivalent to toList)
elems :: IntSet -> [Int]
elems :: IntSet -> [Int]
elems IntSet
s = IntSet -> [Int]
toList IntSet
s

{--------------------------------------------------------------------
  Lists
--------------------------------------------------------------------}
-- | /O(n)/. Convert the set to a list of elements.
toList :: IntSet -> [Int]
toList :: IntSet -> [Int]
toList IntSet
t = (Int -> [Int] -> [Int]) -> [Int] -> IntSet -> [Int]
forall b. (Int -> b -> b) -> b -> IntSet -> b
fold (:) [] IntSet
t

-- | /O(n)/. Convert the set to an ascending list of elements.
toAscList :: IntSet -> [Int]
toAscList :: IntSet -> [Int]
toAscList IntSet
t = IntSet -> [Int]
toList IntSet
t

-- | /O(n*min(n,W))/. Create a set from a list of integers.
fromList :: [Int] -> IntSet
fromList :: [Int] -> IntSet
fromList [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 IntSet
t Int
x  = Int -> IntSet -> IntSet
insert Int
x IntSet
t

-- | /O(n)/. Build a set from an ascending list of elements.
-- /The precondition (input list is ascending) is not checked./
fromAscList :: [Int] -> IntSet
fromAscList :: [Int] -> IntSet
fromAscList [] = IntSet
Nil
fromAscList (Int
x0 : [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 a
x' [] = [a
x']
    combineEq a
x' (a
x:[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

-- | /O(n)/. Build a set from an ascending list of distinct elements.
-- /The precondition (input list is strictly ascending) is not checked./
fromDistinctAscList :: [Int] -> IntSet
fromDistinctAscList :: [Int] -> IntSet
fromDistinctAscList []         = IntSet
Nil
fromDistinctAscList (Int
z0 : [Int]
zs0) = Int -> [Int] -> Stack -> IntSet
work Int
z0 [Int]
zs0 Stack
Nada
  where
    work :: Int -> [Int] -> Stack -> IntSet
work Int
x []     Stack
stk = Int -> IntSet -> Stack -> IntSet
finish Int
x (Int -> IntSet
tip Int
x) Stack
stk
    work Int
x (Int
z:[Int]
zs) 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 Int
z [Int]
zs Int
_ Int
px IntSet
tx Stack
Nada = Int -> [Int] -> Stack -> IntSet
work Int
z [Int]
zs (Int -> IntSet -> Stack -> Stack
Push Int
px IntSet
tx Stack
Nada)
    reduce Int
z [Int]
zs Int
m Int
px IntSet
tx stk :: Stack
stk@(Push Int
py IntSet
ty 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 Int
_  IntSet
t  Stack
Nada = IntSet
t
    finish Int
px IntSet
tx (Push Int
py IntSet
ty 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

{--------------------------------------------------------------------
  Debugging
--------------------------------------------------------------------}
-- | /O(n)/. Show the tree that implements the set. The tree is shown
-- in a compressed, hanging format.
showTree :: IntSet -> String
showTree :: IntSet -> [Char]
showTree IntSet
s
  = Bool -> Bool -> IntSet -> [Char]
showTreeWith Bool
True Bool
False IntSet
s

{- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows
 the tree that implements the set. If @hang@ is
 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If
 @wide@ is 'True', an extra wide version is shown.
-}
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 Int
_ Int
_ Int
p Int
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 (Int -> Int -> [Char]
showBin Int
p Int
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 Int
_ Int
x
          -> [[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
. 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 [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 Int
_ Int
_ Int
p Int
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 (Int -> Int -> [Char]
showBin Int
p Int
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 Int
_ Int
x
          -> [[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
. 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 [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 :: Int -> Int -> [Char]
showBin Int
_ Int
_
  = [Char]
"*" -- ++ show (p,m)

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 [[Char]]
bars
  = case [[Char]]
bars of
      [] -> ShowS
forall a. a -> a
id
      [[Char]]
_  -> [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           = [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

{--------------------------------------------------------------------
  Eq
--------------------------------------------------------------------}

-- /O(1)/
instance Eq IntSet where
  IntSet
Nil             == :: IntSet -> IntSet -> Bool
== IntSet
Nil             = Bool
True
  Tip Int
i Int
_         == Tip Int
j Int
_         = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j
  Bin Int
i Int
_ Int
_ Int
_ IntSet
_ IntSet
_ == Bin Int
j Int
_ Int
_ Int
_ IntSet
_ IntSet
_ = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j
  IntSet
_ == IntSet
_ = Bool
False

{--------------------------------------------------------------------
  Ord
  NB: this ordering is not the ordering implied by the elements
      but is usable for comparison
--------------------------------------------------------------------}
instance Ord IntSet where
  IntSet
Nil compare :: IntSet -> IntSet -> Ordering
`compare` IntSet
Nil = Ordering
EQ
  IntSet
Nil `compare` Tip Int
_ Int
_ = Ordering
LT
  IntSet
Nil `compare` Bin Int
_ Int
_ Int
_ Int
_ IntSet
_ IntSet
_ = Ordering
LT
  Tip Int
_ Int
_ `compare` IntSet
Nil = Ordering
GT
  Tip Int
i Int
_ `compare` Tip Int
j Int
_ = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
  Tip Int
i Int
_ `compare` Bin Int
j Int
_ Int
_ Int
_ IntSet
_ IntSet
_ = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
  Bin Int
_ Int
_ Int
_ Int
_ IntSet
_ IntSet
_ `compare` IntSet
Nil = Ordering
GT
  Bin Int
i Int
_ Int
_ Int
_ IntSet
_ IntSet
_ `compare` Tip Int
j Int
_ = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
  Bin Int
i Int
_ Int
_ Int
_ IntSet
_ IntSet
_ `compare` Bin Int
j Int
_ Int
_ Int
_ IntSet
_ IntSet
_ = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
  -- compare s1 s2 = compare (toAscList s1) (toAscList s2)

{--------------------------------------------------------------------
  Show
--------------------------------------------------------------------}
instance Show IntSet where
  showsPrec :: Int -> IntSet -> ShowS
showsPrec Int
p IntSet
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (IntSet -> [Int]
toList IntSet
xs)

{--------------------------------------------------------------------
  Hashable
--------------------------------------------------------------------}
instance Hashable IntSet where
  hashWithSalt :: Int -> IntSet -> Int
hashWithSalt Int
s IntSet
x = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ IntSet -> Int
identity IntSet
x

{--------------------------------------------------------------------
  Read
--------------------------------------------------------------------}
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 Int
10 (ReadPrec IntSet -> ReadPrec IntSet)
-> ReadPrec IntSet -> ReadPrec IntSet
forall a b. (a -> b) -> a -> b
$ do
    Ident [Char]
"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


{--------------------------------------------------------------------
  Helpers
--------------------------------------------------------------------}
{--------------------------------------------------------------------
  Join
--------------------------------------------------------------------}
join :: Prefix -> IntSet -> Prefix -> IntSet -> IntSet
join :: Int -> IntSet -> Int -> IntSet -> IntSet
join Int
p1 IntSet
t1 Int
p2 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



{--------------------------------------------------------------------
  Endian independent bit twiddling
--------------------------------------------------------------------}
zero :: Int -> Mask -> Bool
zero :: Int -> Int -> Bool
zero Int
i 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
== Nat
0

nomatch,match :: Int -> Prefix -> Mask -> Bool
nomatch :: Int -> Int -> Int -> Bool
nomatch Int
i Int
p 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 Int
i Int
p Int
m
  = (Int -> Int -> Int
mask Int
i Int
m) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p

-- Suppose a is largest such that 2^a divides 2*m.
-- Then mask i m is i with the low a bits zeroed out.
mask :: Int -> Mask -> Prefix
mask :: Int -> Int -> Int
mask Int
i 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 Nat
i 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
== Nat
0

{--------------------------------------------------------------------
  Big endian operations
--------------------------------------------------------------------}
maskW :: Nat -> Nat -> Prefix
maskW :: Nat -> Nat -> Int
maskW Nat
i 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
-Nat
1) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Nat
m))

shorter :: Mask -> Mask -> Bool
shorter :: Int -> Int -> Bool
shorter Int
m1 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 Int
p1 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))

{----------------------------------------------------------------------
  Finding the highest bit (mask) in a word [x] can be done efficiently in
  three ways:
  * convert to a floating point value and the mantissa tells us the
    [log2(x)] that corresponds with the highest bit position. The mantissa
    is retrieved either via the standard C function [frexp] or by some bit
    twiddling on IEEE compatible numbers (float). Note that one needs to
    use at least [double] precision for an accurate mantissa of 32 bit
    numbers.
  * use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).
  * use processor specific assembler instruction (asm).

  The most portable way would be [bit], but is it efficient enough?
  I have measured the cycle counts of the different methods on an AMD
  Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:

  highestBitMask: method  cycles
                  --------------
                   frexp   200
                   float    33
                   bit      11
                   asm      12

  highestBit:     method  cycles
                  --------------
                   frexp   195
                   float    33
                   bit      11
                   asm      11

  Wow, the bit twiddling is on today's RISC like machines even faster
  than a single CISC instruction (BSR)!
----------------------------------------------------------------------}

{----------------------------------------------------------------------
  [highestBitMask] returns a word where only the highest bit is set.
  It is found by first setting all bits in lower positions than the
  highest bit and than taking an exclusive or with the original value.
  Although the function may look expensive, GHC compiles this into
  excellent C code that subsequently compiled into highly efficient
  machine code. The algorithm is derived from Jorg Arndt's FXT library.
----------------------------------------------------------------------}
highestBitMask :: Nat -> Nat
highestBitMask :: Nat -> Nat
highestBitMask Nat
x0
  = case (Nat
x0 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Nat -> Int -> Nat
shiftRL Nat
x0 Int
1) of
     Nat
x1 -> case (Nat
x1 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Nat -> Int -> Nat
shiftRL Nat
x1 Int
2) of
      Nat
x2 -> case (Nat
x2 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Nat -> Int -> Nat
shiftRL Nat
x2 Int
4) of
       Nat
x3 -> case (Nat
x3 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Nat -> Int -> Nat
shiftRL Nat
x3 Int
8) of
        Nat
x4 -> case (Nat
x4 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Nat -> Int -> Nat
shiftRL Nat
x4 Int
16) of
         Nat
x5 -> case (Nat
x5 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Nat -> Int -> Nat
shiftRL Nat
x5 Int
32) of   -- for 64 bit platforms
          Nat
x6 -> (Nat
x6 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` (Nat -> Int -> Nat
shiftRL Nat
x6 Int
1))


{--------------------------------------------------------------------
  Utilities
--------------------------------------------------------------------}
foldlStrict :: (a -> b -> a) -> a -> [b] -> a
foldlStrict :: (a -> b -> a) -> a -> [b] -> a
foldlStrict a -> b -> a
f a
z [b]
xs
  = case [b]
xs of
      []     -> a
z
      (b
x:[b]
xx) -> let z' :: a
z' = a -> b -> a
f a
z b
x in a -> a -> a
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)