module Math.SetCover.Bit where

import qualified Data.IntSet as IntSet; import Data.IntSet (IntSet)
import qualified Data.Bits as Bits
import Data.Bits (Bits, complement)
import Data.Word (Word8, Word16, Word32, Word64)
import Prelude hiding (null)


infixl 7 .&.
infixl 5 .|.

{- |
This class is similar to the 'Bits' class from the @base@ package
but adds 'keepMinimum' and misses the rotation stuff.
-}
class Ord bits => C bits where
   empty :: bits
   keepMinimum :: bits -> bits
   difference, xor, (.&.), (.|.) :: bits -> bits -> bits

instance C Word8 where
   empty :: Word8
empty = Word8
0
   difference :: Word8 -> Word8 -> Word8
difference Word8
xs Word8
ys = Word8
xs Word8 -> Word8 -> Word8
forall bits. C bits => bits -> bits -> bits
.&. Word8 -> Word8
forall a. Bits a => a -> a
complement Word8
ys
   keepMinimum :: Word8 -> Word8
keepMinimum Word8
xs = Word8
xs Word8 -> Word8 -> Word8
forall bits. C bits => bits -> bits -> bits
.&. (-Word8
xs)
   xor :: Word8 -> Word8 -> Word8
xor = Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits.xor
   .&. :: Word8 -> Word8 -> Word8
(.&.) = Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(Bits..&.)
   .|. :: Word8 -> Word8 -> Word8
(.|.) = Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(Bits..|.)

instance C Word16 where
   empty :: Word16
empty = Word16
0
   difference :: Word16 -> Word16 -> Word16
difference Word16
xs Word16
ys = Word16
xs Word16 -> Word16 -> Word16
forall bits. C bits => bits -> bits -> bits
.&. Word16 -> Word16
forall a. Bits a => a -> a
complement Word16
ys
   keepMinimum :: Word16 -> Word16
keepMinimum Word16
xs = Word16
xs Word16 -> Word16 -> Word16
forall bits. C bits => bits -> bits -> bits
.&. (-Word16
xs)
   xor :: Word16 -> Word16 -> Word16
xor = Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
Bits.xor
   .&. :: Word16 -> Word16 -> Word16
(.&.) = Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
(Bits..&.)
   .|. :: Word16 -> Word16 -> Word16
(.|.) = Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
(Bits..|.)

instance C Word32 where
   empty :: Word32
empty = Word32
0
   difference :: Word32 -> Word32 -> Word32
difference Word32
xs Word32
ys = Word32
xs Word32 -> Word32 -> Word32
forall bits. C bits => bits -> bits -> bits
.&. Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
ys
   keepMinimum :: Word32 -> Word32
keepMinimum Word32
xs = Word32
xs Word32 -> Word32 -> Word32
forall bits. C bits => bits -> bits -> bits
.&. (-Word32
xs)
   xor :: Word32 -> Word32 -> Word32
xor = Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
Bits.xor
   .&. :: Word32 -> Word32 -> Word32
(.&.) = Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
(Bits..&.)
   .|. :: Word32 -> Word32 -> Word32
(.|.) = Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
(Bits..|.)

instance C Word64 where
   empty :: Word64
empty = Word64
0
   difference :: Word64 -> Word64 -> Word64
difference Word64
xs Word64
ys = Word64
xs Word64 -> Word64 -> Word64
forall bits. C bits => bits -> bits -> bits
.&. Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
ys
   keepMinimum :: Word64 -> Word64
keepMinimum Word64
xs = Word64
xs Word64 -> Word64 -> Word64
forall bits. C bits => bits -> bits -> bits
.&. (-Word64
xs)
   xor :: Word64 -> Word64 -> Word64
xor = Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
Bits.xor
   .&. :: Word64 -> Word64 -> Word64
(.&.) = Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(Bits..&.)
   .|. :: Word64 -> Word64 -> Word64
(.|.) = Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(Bits..|.)

instance C Integer where
   empty :: Integer
empty = Integer
0
   difference :: Integer -> Integer -> Integer
difference Integer
xs Integer
ys = Integer
xs Integer -> Integer -> Integer
forall bits. C bits => bits -> bits -> bits
.&. Integer -> Integer
forall a. Bits a => a -> a
complement Integer
ys
   keepMinimum :: Integer -> Integer
keepMinimum Integer
xs = Integer
xs Integer -> Integer -> Integer
forall bits. C bits => bits -> bits -> bits
.&. (-Integer
xs)
   xor :: Integer -> Integer -> Integer
xor = Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
Bits.xor
   .&. :: Integer -> Integer -> Integer
(.&.) = Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(Bits..&.)
   .|. :: Integer -> Integer -> Integer
(.|.) = Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(Bits..|.)

instance C IntSet where
   empty :: IntSet
empty = IntSet
IntSet.empty
   difference :: IntSet -> IntSet -> IntSet
difference = IntSet -> IntSet -> IntSet
IntSet.difference
   keepMinimum :: IntSet -> IntSet
keepMinimum = Key -> IntSet
IntSet.singleton (Key -> IntSet) -> (IntSet -> Key) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Key
IntSet.findMin
   xor :: IntSet -> IntSet -> IntSet
xor IntSet
x IntSet
y = IntSet -> IntSet -> IntSet
IntSet.difference (IntSet -> IntSet -> IntSet
IntSet.union IntSet
x IntSet
y) (IntSet -> IntSet -> IntSet
IntSet.intersection IntSet
x IntSet
y)
   .&. :: IntSet -> IntSet -> IntSet
(.&.) = IntSet -> IntSet -> IntSet
IntSet.intersection
   .|. :: IntSet -> IntSet -> IntSet
(.|.) = IntSet -> IntSet -> IntSet
IntSet.union


{-
cf. package largeword
-}
data Sum a b = Sum !a !b
   deriving (Sum a b -> Sum a b -> Bool
(Sum a b -> Sum a b -> Bool)
-> (Sum a b -> Sum a b -> Bool) -> Eq (Sum a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Sum a b -> Sum a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Sum a b -> Sum a b -> Bool
== :: Sum a b -> Sum a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Sum a b -> Sum a b -> Bool
/= :: Sum a b -> Sum a b -> Bool
Eq, Eq (Sum a b)
Eq (Sum a b)
-> (Sum a b -> Sum a b -> Ordering)
-> (Sum a b -> Sum a b -> Bool)
-> (Sum a b -> Sum a b -> Bool)
-> (Sum a b -> Sum a b -> Bool)
-> (Sum a b -> Sum a b -> Bool)
-> (Sum a b -> Sum a b -> Sum a b)
-> (Sum a b -> Sum a b -> Sum a b)
-> Ord (Sum a b)
Sum a b -> Sum a b -> Bool
Sum a b -> Sum a b -> Ordering
Sum a b -> Sum a b -> Sum a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b}. (Ord a, Ord b) => Eq (Sum a b)
forall a b. (Ord a, Ord b) => Sum a b -> Sum a b -> Bool
forall a b. (Ord a, Ord b) => Sum a b -> Sum a b -> Ordering
forall a b. (Ord a, Ord b) => Sum a b -> Sum a b -> Sum a b
$ccompare :: forall a b. (Ord a, Ord b) => Sum a b -> Sum a b -> Ordering
compare :: Sum a b -> Sum a b -> Ordering
$c< :: forall a b. (Ord a, Ord b) => Sum a b -> Sum a b -> Bool
< :: Sum a b -> Sum a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => Sum a b -> Sum a b -> Bool
<= :: Sum a b -> Sum a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => Sum a b -> Sum a b -> Bool
> :: Sum a b -> Sum a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => Sum a b -> Sum a b -> Bool
>= :: Sum a b -> Sum a b -> Bool
$cmax :: forall a b. (Ord a, Ord b) => Sum a b -> Sum a b -> Sum a b
max :: Sum a b -> Sum a b -> Sum a b
$cmin :: forall a b. (Ord a, Ord b) => Sum a b -> Sum a b -> Sum a b
min :: Sum a b -> Sum a b -> Sum a b
Ord, Key -> Sum a b -> ShowS
[Sum a b] -> ShowS
Sum a b -> String
(Key -> Sum a b -> ShowS)
-> (Sum a b -> String) -> ([Sum a b] -> ShowS) -> Show (Sum a b)
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Key -> Sum a b -> ShowS
forall a b. (Show a, Show b) => [Sum a b] -> ShowS
forall a b. (Show a, Show b) => Sum a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Key -> Sum a b -> ShowS
showsPrec :: Key -> Sum a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => Sum a b -> String
show :: Sum a b -> String
$cshowList :: forall a b. (Show a, Show b) => [Sum a b] -> ShowS
showList :: [Sum a b] -> ShowS
Show)

instance (C a, C b) => C (Sum a b) where
   empty :: Sum a b
empty = a -> b -> Sum a b
forall a b. a -> b -> Sum a b
Sum a
forall bits. C bits => bits
empty b
forall bits. C bits => bits
empty
   difference :: Sum a b -> Sum a b -> Sum a b
difference (Sum a
xl b
xh) (Sum a
yl b
yh) =
      a -> b -> Sum a b
forall a b. a -> b -> Sum a b
Sum (a -> a -> a
forall bits. C bits => bits -> bits -> bits
difference a
xl a
yl) (b -> b -> b
forall bits. C bits => bits -> bits -> bits
difference b
xh b
yh)
   xor :: Sum a b -> Sum a b -> Sum a b
xor (Sum a
xl b
xh) (Sum a
yl b
yh) = a -> b -> Sum a b
forall a b. a -> b -> Sum a b
Sum (a -> a -> a
forall bits. C bits => bits -> bits -> bits
xor a
xl a
yl) (b -> b -> b
forall bits. C bits => bits -> bits -> bits
xor b
xh b
yh)
   Sum a
xl b
xh .&. :: Sum a b -> Sum a b -> Sum a b
.&. Sum a
yl b
yh = a -> b -> Sum a b
forall a b. a -> b -> Sum a b
Sum (a
xla -> a -> a
forall bits. C bits => bits -> bits -> bits
.&.a
yl) (b
xhb -> b -> b
forall bits. C bits => bits -> bits -> bits
.&.b
yh)
   Sum a
xl b
xh .|. :: Sum a b -> Sum a b -> Sum a b
.|. Sum a
yl b
yh = a -> b -> Sum a b
forall a b. a -> b -> Sum a b
Sum (a
xla -> a -> a
forall bits. C bits => bits -> bits -> bits
.|.a
yl) (b
xhb -> b -> b
forall bits. C bits => bits -> bits -> bits
.|.b
yh)
   keepMinimum :: Sum a b -> Sum a b
keepMinimum (Sum a
l b
h) =
      if a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall bits. C bits => bits
empty
        then a -> b -> Sum a b
forall a b. a -> b -> Sum a b
Sum a
forall bits. C bits => bits
empty (b -> b
forall bits. C bits => bits -> bits
keepMinimum b
h)
        else a -> b -> Sum a b
forall a b. a -> b -> Sum a b
Sum (a -> a
forall bits. C bits => bits -> bits
keepMinimum a
l) b
forall bits. C bits => bits
empty

bitLeft :: (Bits a, C b) => Int -> Sum a b
bitLeft :: forall a b. (Bits a, C b) => Key -> Sum a b
bitLeft Key
n = a -> b -> Sum a b
forall a b. a -> b -> Sum a b
Sum (Key -> a
forall a. Bits a => Key -> a
Bits.bit Key
n) b
forall bits. C bits => bits
empty

bitRight :: (C a, Bits b) => Int -> Sum a b
bitRight :: forall a b. (C a, Bits b) => Key -> Sum a b
bitRight Key
n = a -> b -> Sum a b
forall a b. a -> b -> Sum a b
Sum a
forall bits. C bits => bits
empty (Key -> b
forall a. Bits a => Key -> a
Bits.bit Key
n)