module Data.Poker.Enumerate
( enumerateFiveCards
) where
import Data.Poker.Deck
import Data.Bits
enumerateFiveCards :: Monad m => CardSet -> (CardSet -> m ()) -> m ()
enumerateFiveCards !deadCards action = simpleFive deadCards done step
where
done = return ()
step !i1 !i2 !i3 !i4 !i5 continue = do
let !newMask = i1 `union` i2 `union` i3 `union` i4 `union` i5
action newMask
continue
simpleFive :: CardSet -> t -> (CardSet -> CardSet -> CardSet -> CardSet -> CardSet -> t -> t) -> t
simpleFive !deadCards done step = simpleIteratee deadCards maxSingleCardSet done next_1 step_1
where
maxSingleCardSet = CardSet 0x1000000000000000
next_1 !i1 = simpleIteratee deadCards (p i1) done next_1 step_1
step_1 !i1 = simpleIteratee deadCards (p i1) done (next_2 i1) (step_2 i1)
next_2 !i1 !i2 = simpleIteratee deadCards (p i2) (next_1 i1) (next_2 i1) (step_2 i1)
step_2 !i1 !i2 = simpleIteratee deadCards (p i2) (next_1 i1) (next_3 i1 i2) (step_3 i1 i2)
next_3 !i1 !i2 !i3 = simpleIteratee deadCards (p i3) (next_2 i1 i2) (next_3 i1 i2) (step_3 i1 i2)
step_3 !i1 !i2 !i3 = simpleIteratee deadCards (p i3) (next_2 i1 i2) (next_4 i1 i2 i3) (step_4 i1 i2 i3)
next_4 !i1 !i2 !i3 !i4 = simpleIteratee deadCards (p i4) (next_3 i1 i2 i3) (next_4 i1 i2 i3) (step_4 i1 i2 i3)
step_4 !i1 !i2 !i3 !i4 = simpleIteratee deadCards (p i4) (next_3 i1 i2 i3) (next_5 i1 i2 i3 i4) (step_5 i1 i2 i3 i4)
next_5 !i1 !i2 !i3 !i4 !i5 =
simpleIteratee deadCards (p i5) (next_4 i1 i2 i3 i4) (next_5 i1 i2 i3 i4) (step_5 i1 i2 i3 i4)
step_5 !i1 !i2 !i3 !i4 !i5 = step i1 i2 i3 i4 i5 (next_5 i1 i2 i3 i4 i5)
p = predCardSet
predCardSet (CardSet 0x10000) = CardSet 0x1000
predCardSet (CardSet 0x100000000) = CardSet 0x10000000
predCardSet (CardSet 0x1000000000000) = CardSet 0x100000000000
predCardSet (CardSet mask) = CardSet (mask `unsafeShiftR` 1)
simpleIteratee :: CardSet -> CardSet -> t -> (CardSet -> t) -> (CardSet -> t) -> t
simpleIteratee !deadCards !i1 done next step
| isEmpty i1 = done
| overlap i1 deadCards = next i1
| otherwise = step i1
overlap :: CardSet -> CardSet -> Bool
overlap a b = not (isEmpty (a `intersection` b))