module Game.Chess.QuadBitboard (
  -- * The QuadBitboard data type
  QuadBitboard(..)
, white, occupied, pnr
, pawns, knights, bishops, rooks, queens, kings
, wPawns, wKnights, wBishops, wRooks, wQueens, wKings
, bPawns, bKnights, bBishops, bRooks, bQueens, bKings
, insufficientMaterial
, toString
  -- * Square codes
, Word4(..)
, pattern NoPiece
, pattern WhitePawn, pattern WhiteKnight, pattern WhiteBishop
, pattern WhiteRook, pattern WhiteQueen, pattern WhiteKing
, pattern BlackPawn, pattern BlackKnight, pattern BlackBishop
, pattern BlackRook, pattern BlackQueen, pattern BlackKing
  -- * Construction
, empty, standard, square
  -- * Access
, (!), setNibble
  -- * Transformations
  -- ** Normal moves
, move, move'
  -- ** Castling
, whiteKingsideCastle, whiteQueensideCastle
, blackKingsideCastle, blackQueensideCastle
  -- ** En passant
, enPassant
  -- ** Promotion
, whitePromotion, blackPromotion, whitePromotion', blackPromotion'
) where

import Control.Applicative (liftA2)
import Data.Binary ( Word8, Word64, Binary(put, get) )
import Data.Bits
    ( Bits(xor, complement, bit, unsafeShiftR, (.&.), unsafeShiftL,
           (.|.), testBit, setBit, clearBit, popCount),
      FiniteBits(..) )
import Data.Char (ord, toLower)
import Data.Ix ( Ix(inRange) )
import Data.List (groupBy, intercalate)
import Data.String (IsString(..))
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as M
import Data.Vector.Unboxed (Vector, MVector, Unbox)
import Foreign.Storable
import GHC.Enum
    ( boundedEnumFrom,
      boundedEnumFromThen,
      predError,
      succError,
      toEnumError )
import GHC.Ptr (castPtr, plusPtr)
import Numeric (showHex)

data QuadBitboard = QBB { QuadBitboard -> Word64
black :: {-# UNPACK #-} !Word64
                        , QuadBitboard -> Word64
pbq :: {-# UNPACK #-} !Word64
                        , QuadBitboard -> Word64
nbk :: {-# UNPACK #-} !Word64
                        , QuadBitboard -> Word64
rqk :: {-# UNPACK #-} !Word64
                        } deriving (QuadBitboard -> QuadBitboard -> Bool
(QuadBitboard -> QuadBitboard -> Bool)
-> (QuadBitboard -> QuadBitboard -> Bool) -> Eq QuadBitboard
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuadBitboard -> QuadBitboard -> Bool
$c/= :: QuadBitboard -> QuadBitboard -> Bool
== :: QuadBitboard -> QuadBitboard -> Bool
$c== :: QuadBitboard -> QuadBitboard -> Bool
Eq)

insufficientMaterial :: QuadBitboard -> Bool
insufficientMaterial :: QuadBitboard -> Bool
insufficientMaterial qbb :: QuadBitboard
qbb@QBB{Word64
black :: Word64
black :: QuadBitboard -> Word64
black, Word64
pbq :: Word64
pbq :: QuadBitboard -> Word64
pbq, Word64
nbk :: Word64
nbk :: QuadBitboard -> Word64
nbk, Word64
rqk :: Word64
rqk :: QuadBitboard -> Word64
rqk} =
  Bool
noPawnsNorQueens Bool -> Bool -> Bool
&& Bool
eachSideHasOneKing Bool -> Bool -> Bool
&& Bool
noRooks Bool -> Bool -> Bool
&&
  (Bool
oneSideHasAtMostOneMinorPiece Bool -> Bool -> Bool
|| Bool
opposingBishopsOnEquallyColoredSquares)
 where
  eachSideHasOneKing :: Bool
eachSideHasOneKing = Word64 -> Int
forall a. Bits a => a -> Int
popCount (QuadBitboard -> Word64
wKings QuadBitboard
qbb) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Word64 -> Int
forall a. Bits a => a -> Int
popCount (QuadBitboard -> Word64
bKings QuadBitboard
qbb) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
  noPawnsNorQueens :: Bool
noPawnsNorQueens = Word64
pbq Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` QuadBitboard -> Word64
bishops QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
  noRooks :: Bool
noRooks = Word64 -> Int
forall a. Bits a => a -> Int
popCount Word64
rqk Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
  oneSideHasAtMostOneMinorPiece :: Bool
oneSideHasAtMostOneMinorPiece =
    (Word64 -> Int
forall a. Bits a => a -> Int
popCount (Word64
nbk Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
black) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Word64 -> Bool
atMostOneMinorPiece Word64
black) Bool -> Bool -> Bool
||
    (Word64 -> Int
forall a. Bits a => a -> Int
popCount (Word64
nbk Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
black) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Word64 -> Bool
atMostOneMinorPiece (Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
black))
  opposingBishopsOnEquallyColoredSquares :: Bool
opposingBishopsOnEquallyColoredSquares =
    Word64 -> Int
forall a. Bits a => a -> Int
popCount (QuadBitboard -> Word64
knights QuadBitboard
qbb) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&&
    Word64 -> Int
forall a. Bits a => a -> Int
popCount (Word64
nbk Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
black) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&& Word64 -> Int
forall a. Bits a => a -> Int
popCount (Word64
nbk Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
black) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&&
    Int -> Bool
forall a. Integral a => a -> Bool
even (Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (QuadBitboard -> Word64
wBishops QuadBitboard
qbb)) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==
    Int -> Bool
forall a. Integral a => a -> Bool
even (Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (QuadBitboard -> Word64
bBishops QuadBitboard
qbb))
  atMostOneMinorPiece :: Word64 -> Bool
atMostOneMinorPiece Word64
mask = Word64 -> Int
forall a. Bits a => a -> Int
popCount (Word64
nbk Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
mask) Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1,Int
2]

instance Storable QuadBitboard where
  sizeOf :: QuadBitboard -> Int
sizeOf QuadBitboard
_ = Int
32
  alignment :: QuadBitboard -> Int
alignment QuadBitboard
_ = Int
8
  peek :: Ptr QuadBitboard -> IO QuadBitboard
peek Ptr QuadBitboard
p = Word64 -> Word64 -> Word64 -> Word64 -> QuadBitboard
QBB (Word64 -> Word64 -> Word64 -> Word64 -> QuadBitboard)
-> IO Word64 -> IO (Word64 -> Word64 -> Word64 -> QuadBitboard)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr QuadBitboard -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr QuadBitboard
p) IO (Word64 -> Word64 -> Word64 -> QuadBitboard)
-> IO Word64 -> IO (Word64 -> Word64 -> QuadBitboard)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Any -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr Word64) -> Ptr Any -> Ptr Word64
forall a b. (a -> b) -> a -> b
$ Ptr QuadBitboard
p Ptr QuadBitboard -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) IO (Word64 -> Word64 -> QuadBitboard)
-> IO Word64 -> IO (Word64 -> QuadBitboard)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Any -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr Word64) -> Ptr Any -> Ptr Word64
forall a b. (a -> b) -> a -> b
$ Ptr QuadBitboard
p Ptr QuadBitboard -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) IO (Word64 -> QuadBitboard) -> IO Word64 -> IO QuadBitboard
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Any -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr Word64) -> Ptr Any -> Ptr Word64
forall a b. (a -> b) -> a -> b
$ Ptr QuadBitboard
p Ptr QuadBitboard -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24)
  poke :: Ptr QuadBitboard -> QuadBitboard -> IO ()
poke Ptr QuadBitboard
p QBB{Word64
black :: Word64
black :: QuadBitboard -> Word64
black, Word64
pbq :: Word64
pbq :: QuadBitboard -> Word64
pbq, Word64
nbk :: Word64
nbk :: QuadBitboard -> Word64
nbk, Word64
rqk :: Word64
rqk :: QuadBitboard -> Word64
rqk} = do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr QuadBitboard -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr (Ptr QuadBitboard -> Ptr Word64) -> Ptr QuadBitboard -> Ptr Word64
forall a b. (a -> b) -> a -> b
$ Ptr QuadBitboard
p) Word64
black
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Any -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr Word64) -> Ptr Any -> Ptr Word64
forall a b. (a -> b) -> a -> b
$ Ptr QuadBitboard
p Ptr QuadBitboard -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) Word64
pbq
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Any -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr Word64) -> Ptr Any -> Ptr Word64
forall a b. (a -> b) -> a -> b
$ Ptr QuadBitboard
p Ptr QuadBitboard -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) Word64
nbk
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Any -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr Word64) -> Ptr Any -> Ptr Word64
forall a b. (a -> b) -> a -> b
$ Ptr QuadBitboard
p Ptr QuadBitboard -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) Word64
rqk

newtype instance MVector s QuadBitboard = MV_QuadBitboard (MVector s (Word64, Word64, Word64, Word64))
newtype instance Vector    QuadBitboard = V_QuadBitboard (Vector (Word64, Word64, Word64, Word64))
instance Unbox QuadBitboard

instance M.MVector MVector QuadBitboard where
  basicLength :: MVector s QuadBitboard -> Int
basicLength (MV_QuadBitboard v) = MVector s (Word64, Word64, Word64, Word64) -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
M.basicLength MVector s (Word64, Word64, Word64, Word64)
v
  basicUnsafeSlice :: Int -> Int -> MVector s QuadBitboard -> MVector s QuadBitboard
basicUnsafeSlice Int
i Int
n (MV_QuadBitboard v) = MVector s (Word64, Word64, Word64, Word64)
-> MVector s QuadBitboard
forall s.
MVector s (Word64, Word64, Word64, Word64)
-> MVector s QuadBitboard
MV_QuadBitboard (MVector s (Word64, Word64, Word64, Word64)
 -> MVector s QuadBitboard)
-> MVector s (Word64, Word64, Word64, Word64)
-> MVector s QuadBitboard
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> MVector s (Word64, Word64, Word64, Word64)
-> MVector s (Word64, Word64, Word64, Word64)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
M.basicUnsafeSlice Int
i Int
n MVector s (Word64, Word64, Word64, Word64)
v
  basicOverlaps :: MVector s QuadBitboard -> MVector s QuadBitboard -> Bool
basicOverlaps (MV_QuadBitboard v1) (MV_QuadBitboard v2) = MVector s (Word64, Word64, Word64, Word64)
-> MVector s (Word64, Word64, Word64, Word64) -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
M.basicOverlaps MVector s (Word64, Word64, Word64, Word64)
v1 MVector s (Word64, Word64, Word64, Word64)
v2
  basicUnsafeNew :: Int -> m (MVector (PrimState m) QuadBitboard)
basicUnsafeNew Int
n = MVector (PrimState m) (Word64, Word64, Word64, Word64)
-> MVector (PrimState m) QuadBitboard
forall s.
MVector s (Word64, Word64, Word64, Word64)
-> MVector s QuadBitboard
MV_QuadBitboard (MVector (PrimState m) (Word64, Word64, Word64, Word64)
 -> MVector (PrimState m) QuadBitboard)
-> m (MVector (PrimState m) (Word64, Word64, Word64, Word64))
-> m (MVector (PrimState m) QuadBitboard)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) (Word64, Word64, Word64, Word64))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
M.basicUnsafeNew Int
n
  basicInitialize :: MVector (PrimState m) QuadBitboard -> m ()
basicInitialize (MV_QuadBitboard v) = MVector (PrimState m) (Word64, Word64, Word64, Word64) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicInitialize MVector (PrimState m) (Word64, Word64, Word64, Word64)
v
  basicUnsafeReplicate :: Int -> QuadBitboard -> m (MVector (PrimState m) QuadBitboard)
basicUnsafeReplicate Int
n (QBB Word64
b0 Word64
b1 Word64
b2 Word64
b3) = MVector (PrimState m) (Word64, Word64, Word64, Word64)
-> MVector (PrimState m) QuadBitboard
forall s.
MVector s (Word64, Word64, Word64, Word64)
-> MVector s QuadBitboard
MV_QuadBitboard (MVector (PrimState m) (Word64, Word64, Word64, Word64)
 -> MVector (PrimState m) QuadBitboard)
-> m (MVector (PrimState m) (Word64, Word64, Word64, Word64))
-> m (MVector (PrimState m) QuadBitboard)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> (Word64, Word64, Word64, Word64)
-> m (MVector (PrimState m) (Word64, Word64, Word64, Word64))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
M.basicUnsafeReplicate Int
n (Word64
b0, Word64
b1, Word64
b2, Word64
b3)
  basicUnsafeRead :: MVector (PrimState m) QuadBitboard -> Int -> m QuadBitboard
basicUnsafeRead (MV_QuadBitboard v) Int
i = (Word64, Word64, Word64, Word64) -> QuadBitboard
f ((Word64, Word64, Word64, Word64) -> QuadBitboard)
-> m (Word64, Word64, Word64, Word64) -> m QuadBitboard
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) (Word64, Word64, Word64, Word64)
-> Int -> m (Word64, Word64, Word64, Word64)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
M.basicUnsafeRead MVector (PrimState m) (Word64, Word64, Word64, Word64)
v Int
i where
    f :: (Word64, Word64, Word64, Word64) -> QuadBitboard
f (Word64
b0, Word64
b1, Word64
b2, Word64
b3) = Word64 -> Word64 -> Word64 -> Word64 -> QuadBitboard
QBB Word64
b0 Word64
b1 Word64
b2 Word64
b3
  basicUnsafeWrite :: MVector (PrimState m) QuadBitboard -> Int -> QuadBitboard -> m ()
basicUnsafeWrite (MV_QuadBitboard v) Int
i (QBB Word64
b0 Word64
b1 Word64
b2 Word64
b3) = MVector (PrimState m) (Word64, Word64, Word64, Word64)
-> Int -> (Word64, Word64, Word64, Word64) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
M.basicUnsafeWrite MVector (PrimState m) (Word64, Word64, Word64, Word64)
v Int
i (Word64
b0, Word64
b1, Word64
b2, Word64
b3)
  basicClear :: MVector (PrimState m) QuadBitboard -> m ()
basicClear (MV_QuadBitboard v) = MVector (PrimState m) (Word64, Word64, Word64, Word64) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicClear MVector (PrimState m) (Word64, Word64, Word64, Word64)
v
  basicSet :: MVector (PrimState m) QuadBitboard -> QuadBitboard -> m ()
basicSet (MV_QuadBitboard v) (QBB Word64
b0 Word64
b1 Word64
b2 Word64
b3) = MVector (PrimState m) (Word64, Word64, Word64, Word64)
-> (Word64, Word64, Word64, Word64) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
M.basicSet MVector (PrimState m) (Word64, Word64, Word64, Word64)
v (Word64
b0, Word64
b1, Word64
b2, Word64
b3)
  basicUnsafeCopy :: MVector (PrimState m) QuadBitboard
-> MVector (PrimState m) QuadBitboard -> m ()
basicUnsafeCopy (MV_QuadBitboard v1) (MV_QuadBitboard v2) = MVector (PrimState m) (Word64, Word64, Word64, Word64)
-> MVector (PrimState m) (Word64, Word64, Word64, Word64) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeCopy MVector (PrimState m) (Word64, Word64, Word64, Word64)
v1 MVector (PrimState m) (Word64, Word64, Word64, Word64)
v2
  basicUnsafeMove :: MVector (PrimState m) QuadBitboard
-> MVector (PrimState m) QuadBitboard -> m ()
basicUnsafeMove (MV_QuadBitboard v1) (MV_QuadBitboard v2) = MVector (PrimState m) (Word64, Word64, Word64, Word64)
-> MVector (PrimState m) (Word64, Word64, Word64, Word64) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeMove MVector (PrimState m) (Word64, Word64, Word64, Word64)
v1 MVector (PrimState m) (Word64, Word64, Word64, Word64)
v2
  basicUnsafeGrow :: MVector (PrimState m) QuadBitboard
-> Int -> m (MVector (PrimState m) QuadBitboard)
basicUnsafeGrow (MV_QuadBitboard v) Int
n = MVector (PrimState m) (Word64, Word64, Word64, Word64)
-> MVector (PrimState m) QuadBitboard
forall s.
MVector s (Word64, Word64, Word64, Word64)
-> MVector s QuadBitboard
MV_QuadBitboard (MVector (PrimState m) (Word64, Word64, Word64, Word64)
 -> MVector (PrimState m) QuadBitboard)
-> m (MVector (PrimState m) (Word64, Word64, Word64, Word64))
-> m (MVector (PrimState m) QuadBitboard)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) (Word64, Word64, Word64, Word64)
-> Int
-> m (MVector (PrimState m) (Word64, Word64, Word64, Word64))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
M.basicUnsafeGrow MVector (PrimState m) (Word64, Word64, Word64, Word64)
v Int
n

instance G.Vector Vector QuadBitboard where
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeFreeze :: Mutable Vector (PrimState m) QuadBitboard
-> m (Vector QuadBitboard)
basicUnsafeFreeze (MV_QuadBitboard v) = Vector (Word64, Word64, Word64, Word64) -> Vector QuadBitboard
V_QuadBitboard (Vector (Word64, Word64, Word64, Word64) -> Vector QuadBitboard)
-> m (Vector (Word64, Word64, Word64, Word64))
-> m (Vector QuadBitboard)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector (PrimState m) (Word64, Word64, Word64, Word64)
-> m (Vector (Word64, Word64, Word64, Word64))
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
G.basicUnsafeFreeze MVector (PrimState m) (Word64, Word64, Word64, Word64)
Mutable Vector (PrimState m) (Word64, Word64, Word64, Word64)
v
  basicUnsafeThaw :: Vector QuadBitboard
-> m (Mutable Vector (PrimState m) QuadBitboard)
basicUnsafeThaw (V_QuadBitboard v) = MVector (PrimState m) (Word64, Word64, Word64, Word64)
-> MVector (PrimState m) QuadBitboard
forall s.
MVector s (Word64, Word64, Word64, Word64)
-> MVector s QuadBitboard
MV_QuadBitboard (MVector (PrimState m) (Word64, Word64, Word64, Word64)
 -> MVector (PrimState m) QuadBitboard)
-> m (MVector (PrimState m) (Word64, Word64, Word64, Word64))
-> m (MVector (PrimState m) QuadBitboard)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (Word64, Word64, Word64, Word64)
-> m (Mutable
        Vector (PrimState m) (Word64, Word64, Word64, Word64))
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
G.basicUnsafeThaw Vector (Word64, Word64, Word64, Word64)
v
  basicLength :: Vector QuadBitboard -> Int
basicLength (V_QuadBitboard v) = Vector (Word64, Word64, Word64, Word64) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.basicLength Vector (Word64, Word64, Word64, Word64)
v
  basicUnsafeSlice :: Int -> Int -> Vector QuadBitboard -> Vector QuadBitboard
basicUnsafeSlice Int
i Int
n (V_QuadBitboard v) = Vector (Word64, Word64, Word64, Word64) -> Vector QuadBitboard
V_QuadBitboard (Vector (Word64, Word64, Word64, Word64) -> Vector QuadBitboard)
-> Vector (Word64, Word64, Word64, Word64) -> Vector QuadBitboard
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Vector (Word64, Word64, Word64, Word64)
-> Vector (Word64, Word64, Word64, Word64)
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice  Int
i Int
n Vector (Word64, Word64, Word64, Word64)
v
  basicUnsafeIndexM :: Vector QuadBitboard -> Int -> m QuadBitboard
basicUnsafeIndexM (V_QuadBitboard v) Int
i
    = (Word64, Word64, Word64, Word64) -> QuadBitboard
f ((Word64, Word64, Word64, Word64) -> QuadBitboard)
-> m (Word64, Word64, Word64, Word64) -> m QuadBitboard
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (Word64, Word64, Word64, Word64)
-> Int -> m (Word64, Word64, Word64, Word64)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
G.basicUnsafeIndexM Vector (Word64, Word64, Word64, Word64)
v Int
i where
    f :: (Word64, Word64, Word64, Word64) -> QuadBitboard
f (Word64
b0, Word64
b1, Word64
b2, Word64
b3) = Word64 -> Word64 -> Word64 -> Word64 -> QuadBitboard
QBB Word64
b0 Word64
b1 Word64
b2 Word64
b3
  basicUnsafeCopy :: Mutable Vector (PrimState m) QuadBitboard
-> Vector QuadBitboard -> m ()
basicUnsafeCopy (MV_QuadBitboard mv) (V_QuadBitboard v) = Mutable Vector (PrimState m) (Word64, Word64, Word64, Word64)
-> Vector (Word64, Word64, Word64, Word64) -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
G.basicUnsafeCopy MVector (PrimState m) (Word64, Word64, Word64, Word64)
Mutable Vector (PrimState m) (Word64, Word64, Word64, Word64)
mv Vector (Word64, Word64, Word64, Word64)
v
  elemseq :: Vector QuadBitboard -> QuadBitboard -> b -> b
elemseq Vector QuadBitboard
_ (QBB Word64
b0 Word64
b1 Word64
b2 Word64
b3) b
z
    = Vector Word64 -> Word64 -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: Vector a) Word64
b0
    (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Vector Word64 -> Word64 -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: Vector a) Word64
b1
    (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Vector Word64 -> Word64 -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: Vector a) Word64
b2
    (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Vector Word64 -> Word64 -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: Vector a) Word64
b3
    b
z

occupied, pnr, white :: QuadBitboard -> Word64
occupied :: QuadBitboard -> Word64
occupied QBB{Word64
pbq :: Word64
pbq :: QuadBitboard -> Word64
pbq, Word64
nbk :: Word64
nbk :: QuadBitboard -> Word64
nbk, Word64
rqk :: Word64
rqk :: QuadBitboard -> Word64
rqk} = Word64
pbq  Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.  Word64
nbk  Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.  Word64
rqk
pnr :: QuadBitboard -> Word64
pnr      QBB{Word64
pbq :: Word64
pbq :: QuadBitboard -> Word64
pbq, Word64
nbk :: Word64
nbk :: QuadBitboard -> Word64
nbk, Word64
rqk :: Word64
rqk :: QuadBitboard -> Word64
rqk} = Word64
pbq Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
nbk Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
rqk
white :: QuadBitboard -> Word64
white                       = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
xor QuadBitboard -> Word64
occupied QuadBitboard -> Word64
black

pawns, knights, bishops, rooks, queens, kings :: QuadBitboard -> Word64
pawns :: QuadBitboard -> Word64
pawns   = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pnr QuadBitboard -> Word64
pbq
knights :: QuadBitboard -> Word64
knights = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pnr QuadBitboard -> Word64
nbk
bishops :: QuadBitboard -> Word64
bishops = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pbq QuadBitboard -> Word64
nbk
rooks :: QuadBitboard -> Word64
rooks   = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pnr QuadBitboard -> Word64
rqk
queens :: QuadBitboard -> Word64
queens  = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pbq QuadBitboard -> Word64
rqk
kings :: QuadBitboard -> Word64
kings   = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
nbk QuadBitboard -> Word64
rqk

wPawns, wKnights, wBishops, wRooks, wQueens, wKings :: QuadBitboard -> Word64
wPawns :: QuadBitboard -> Word64
wPawns   = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pawns (Word64 -> Word64
forall a. Bits a => a -> a
complement (Word64 -> Word64)
-> (QuadBitboard -> Word64) -> QuadBitboard -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBitboard -> Word64
black)
wKnights :: QuadBitboard -> Word64
wKnights = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
knights (Word64 -> Word64
forall a. Bits a => a -> a
complement (Word64 -> Word64)
-> (QuadBitboard -> Word64) -> QuadBitboard -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBitboard -> Word64
black)
wBishops :: QuadBitboard -> Word64
wBishops = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
bishops (Word64 -> Word64
forall a. Bits a => a -> a
complement (Word64 -> Word64)
-> (QuadBitboard -> Word64) -> QuadBitboard -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBitboard -> Word64
black)
wRooks :: QuadBitboard -> Word64
wRooks   = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
rooks (Word64 -> Word64
forall a. Bits a => a -> a
complement (Word64 -> Word64)
-> (QuadBitboard -> Word64) -> QuadBitboard -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBitboard -> Word64
black)
wQueens :: QuadBitboard -> Word64
wQueens  = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
queens (Word64 -> Word64
forall a. Bits a => a -> a
complement (Word64 -> Word64)
-> (QuadBitboard -> Word64) -> QuadBitboard -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBitboard -> Word64
black)
wKings :: QuadBitboard -> Word64
wKings   = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
kings (Word64 -> Word64
forall a. Bits a => a -> a
complement (Word64 -> Word64)
-> (QuadBitboard -> Word64) -> QuadBitboard -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBitboard -> Word64
black)

bPawns, bKnights, bBishops, bRooks, bQueens, bKings :: QuadBitboard -> Word64
bPawns :: QuadBitboard -> Word64
bPawns   = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pawns QuadBitboard -> Word64
black
bKnights :: QuadBitboard -> Word64
bKnights = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
knights QuadBitboard -> Word64
black
bBishops :: QuadBitboard -> Word64
bBishops = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
bishops QuadBitboard -> Word64
black
bRooks :: QuadBitboard -> Word64
bRooks   = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
rooks QuadBitboard -> Word64
black
bQueens :: QuadBitboard -> Word64
bQueens  = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
queens QuadBitboard -> Word64
black
bKings :: QuadBitboard -> Word64
bKings   = (Word64 -> Word64 -> Word64)
-> (QuadBitboard -> Word64)
-> (QuadBitboard -> Word64)
-> QuadBitboard
-> Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
kings QuadBitboard -> Word64
black

{-# INLINE pnr #-}
{-# INLINE occupied #-}
{-# INLINE white #-}
{-# INLINE pawns #-}
{-# INLINE knights #-}
{-# INLINE bishops #-}
{-# INLINE rooks #-}
{-# INLINE queens #-}
{-# INLINE kings #-}
{-# INLINE wPawns #-}
{-# INLINE wKnights #-}
{-# INLINE wBishops #-}
{-# INLINE wRooks #-}
{-# INLINE wQueens #-}
{-# INLINE wKings #-}
{-# INLINE bPawns #-}
{-# INLINE bKnights #-}
{-# INLINE bBishops #-}
{-# INLINE bRooks #-}
{-# INLINE bQueens #-}
{-# INLINE bKings #-}

empty, standard :: QuadBitboard
empty :: QuadBitboard
empty = Word64 -> Word64 -> Word64 -> Word64 -> QuadBitboard
QBB Word64
0 Word64
0 Word64
0 Word64
0
standard :: QuadBitboard
standard = QuadBitboard
"rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR"

newtype Word4 = W4 Word8
              deriving (Eq Word4
Word4
Eq Word4
-> (Word4 -> Word4 -> Word4)
-> (Word4 -> Word4 -> Word4)
-> (Word4 -> Word4 -> Word4)
-> (Word4 -> Word4)
-> (Word4 -> Int -> Word4)
-> (Word4 -> Int -> Word4)
-> Word4
-> (Int -> Word4)
-> (Word4 -> Int -> Word4)
-> (Word4 -> Int -> Word4)
-> (Word4 -> Int -> Word4)
-> (Word4 -> Int -> Bool)
-> (Word4 -> Maybe Int)
-> (Word4 -> Int)
-> (Word4 -> Bool)
-> (Word4 -> Int -> Word4)
-> (Word4 -> Int -> Word4)
-> (Word4 -> Int -> Word4)
-> (Word4 -> Int -> Word4)
-> (Word4 -> Int -> Word4)
-> (Word4 -> Int -> Word4)
-> (Word4 -> Int)
-> Bits Word4
Int -> Word4
Word4 -> Bool
Word4 -> Int
Word4 -> Maybe Int
Word4 -> Word4
Word4 -> Int -> Bool
Word4 -> Int -> Word4
Word4 -> Word4 -> Word4
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Word4 -> Int
$cpopCount :: Word4 -> Int
rotateR :: Word4 -> Int -> Word4
$crotateR :: Word4 -> Int -> Word4
rotateL :: Word4 -> Int -> Word4
$crotateL :: Word4 -> Int -> Word4
unsafeShiftR :: Word4 -> Int -> Word4
$cunsafeShiftR :: Word4 -> Int -> Word4
shiftR :: Word4 -> Int -> Word4
$cshiftR :: Word4 -> Int -> Word4
unsafeShiftL :: Word4 -> Int -> Word4
$cunsafeShiftL :: Word4 -> Int -> Word4
shiftL :: Word4 -> Int -> Word4
$cshiftL :: Word4 -> Int -> Word4
isSigned :: Word4 -> Bool
$cisSigned :: Word4 -> Bool
bitSize :: Word4 -> Int
$cbitSize :: Word4 -> Int
bitSizeMaybe :: Word4 -> Maybe Int
$cbitSizeMaybe :: Word4 -> Maybe Int
testBit :: Word4 -> Int -> Bool
$ctestBit :: Word4 -> Int -> Bool
complementBit :: Word4 -> Int -> Word4
$ccomplementBit :: Word4 -> Int -> Word4
clearBit :: Word4 -> Int -> Word4
$cclearBit :: Word4 -> Int -> Word4
setBit :: Word4 -> Int -> Word4
$csetBit :: Word4 -> Int -> Word4
bit :: Int -> Word4
$cbit :: Int -> Word4
zeroBits :: Word4
$czeroBits :: Word4
rotate :: Word4 -> Int -> Word4
$crotate :: Word4 -> Int -> Word4
shift :: Word4 -> Int -> Word4
$cshift :: Word4 -> Int -> Word4
complement :: Word4 -> Word4
$ccomplement :: Word4 -> Word4
xor :: Word4 -> Word4 -> Word4
$cxor :: Word4 -> Word4 -> Word4
.|. :: Word4 -> Word4 -> Word4
$c.|. :: Word4 -> Word4 -> Word4
.&. :: Word4 -> Word4 -> Word4
$c.&. :: Word4 -> Word4 -> Word4
$cp1Bits :: Eq Word4
Bits, Word4 -> Word4 -> Bool
(Word4 -> Word4 -> Bool) -> (Word4 -> Word4 -> Bool) -> Eq Word4
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Word4 -> Word4 -> Bool
$c/= :: Word4 -> Word4 -> Bool
== :: Word4 -> Word4 -> Bool
$c== :: Word4 -> Word4 -> Bool
Eq, Enum Word4
Real Word4
Real Word4
-> Enum Word4
-> (Word4 -> Word4 -> Word4)
-> (Word4 -> Word4 -> Word4)
-> (Word4 -> Word4 -> Word4)
-> (Word4 -> Word4 -> Word4)
-> (Word4 -> Word4 -> (Word4, Word4))
-> (Word4 -> Word4 -> (Word4, Word4))
-> (Word4 -> Integer)
-> Integral Word4
Word4 -> Integer
Word4 -> Word4 -> (Word4, Word4)
Word4 -> Word4 -> Word4
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Word4 -> Integer
$ctoInteger :: Word4 -> Integer
divMod :: Word4 -> Word4 -> (Word4, Word4)
$cdivMod :: Word4 -> Word4 -> (Word4, Word4)
quotRem :: Word4 -> Word4 -> (Word4, Word4)
$cquotRem :: Word4 -> Word4 -> (Word4, Word4)
mod :: Word4 -> Word4 -> Word4
$cmod :: Word4 -> Word4 -> Word4
div :: Word4 -> Word4 -> Word4
$cdiv :: Word4 -> Word4 -> Word4
rem :: Word4 -> Word4 -> Word4
$crem :: Word4 -> Word4 -> Word4
quot :: Word4 -> Word4 -> Word4
$cquot :: Word4 -> Word4 -> Word4
$cp2Integral :: Enum Word4
$cp1Integral :: Real Word4
Integral, Ord Word4
Ord Word4
-> ((Word4, Word4) -> [Word4])
-> ((Word4, Word4) -> Word4 -> Int)
-> ((Word4, Word4) -> Word4 -> Int)
-> ((Word4, Word4) -> Word4 -> Bool)
-> ((Word4, Word4) -> Int)
-> ((Word4, Word4) -> Int)
-> Ix Word4
(Word4, Word4) -> Int
(Word4, Word4) -> [Word4]
(Word4, Word4) -> Word4 -> Bool
(Word4, Word4) -> Word4 -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Word4, Word4) -> Int
$cunsafeRangeSize :: (Word4, Word4) -> Int
rangeSize :: (Word4, Word4) -> Int
$crangeSize :: (Word4, Word4) -> Int
inRange :: (Word4, Word4) -> Word4 -> Bool
$cinRange :: (Word4, Word4) -> Word4 -> Bool
unsafeIndex :: (Word4, Word4) -> Word4 -> Int
$cunsafeIndex :: (Word4, Word4) -> Word4 -> Int
index :: (Word4, Word4) -> Word4 -> Int
$cindex :: (Word4, Word4) -> Word4 -> Int
range :: (Word4, Word4) -> [Word4]
$crange :: (Word4, Word4) -> [Word4]
$cp1Ix :: Ord Word4
Ix, Integer -> Word4
Word4 -> Word4
Word4 -> Word4 -> Word4
(Word4 -> Word4 -> Word4)
-> (Word4 -> Word4 -> Word4)
-> (Word4 -> Word4 -> Word4)
-> (Word4 -> Word4)
-> (Word4 -> Word4)
-> (Word4 -> Word4)
-> (Integer -> Word4)
-> Num Word4
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Word4
$cfromInteger :: Integer -> Word4
signum :: Word4 -> Word4
$csignum :: Word4 -> Word4
abs :: Word4 -> Word4
$cabs :: Word4 -> Word4
negate :: Word4 -> Word4
$cnegate :: Word4 -> Word4
* :: Word4 -> Word4 -> Word4
$c* :: Word4 -> Word4 -> Word4
- :: Word4 -> Word4 -> Word4
$c- :: Word4 -> Word4 -> Word4
+ :: Word4 -> Word4 -> Word4
$c+ :: Word4 -> Word4 -> Word4
Num, Eq Word4
Eq Word4
-> (Word4 -> Word4 -> Ordering)
-> (Word4 -> Word4 -> Bool)
-> (Word4 -> Word4 -> Bool)
-> (Word4 -> Word4 -> Bool)
-> (Word4 -> Word4 -> Bool)
-> (Word4 -> Word4 -> Word4)
-> (Word4 -> Word4 -> Word4)
-> Ord Word4
Word4 -> Word4 -> Bool
Word4 -> Word4 -> Ordering
Word4 -> Word4 -> Word4
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
min :: Word4 -> Word4 -> Word4
$cmin :: Word4 -> Word4 -> Word4
max :: Word4 -> Word4 -> Word4
$cmax :: Word4 -> Word4 -> Word4
>= :: Word4 -> Word4 -> Bool
$c>= :: Word4 -> Word4 -> Bool
> :: Word4 -> Word4 -> Bool
$c> :: Word4 -> Word4 -> Bool
<= :: Word4 -> Word4 -> Bool
$c<= :: Word4 -> Word4 -> Bool
< :: Word4 -> Word4 -> Bool
$c< :: Word4 -> Word4 -> Bool
compare :: Word4 -> Word4 -> Ordering
$ccompare :: Word4 -> Word4 -> Ordering
$cp1Ord :: Eq Word4
Ord, ReadPrec [Word4]
ReadPrec Word4
Int -> ReadS Word4
ReadS [Word4]
(Int -> ReadS Word4)
-> ReadS [Word4]
-> ReadPrec Word4
-> ReadPrec [Word4]
-> Read Word4
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Word4]
$creadListPrec :: ReadPrec [Word4]
readPrec :: ReadPrec Word4
$creadPrec :: ReadPrec Word4
readList :: ReadS [Word4]
$creadList :: ReadS [Word4]
readsPrec :: Int -> ReadS Word4
$creadsPrec :: Int -> ReadS Word4
Read, Num Word4
Ord Word4
Num Word4 -> Ord Word4 -> (Word4 -> Rational) -> Real Word4
Word4 -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Word4 -> Rational
$ctoRational :: Word4 -> Rational
$cp2Real :: Ord Word4
$cp1Real :: Num Word4
Real, Int -> Word4 -> ShowS
[Word4] -> ShowS
Word4 -> String
(Int -> Word4 -> ShowS)
-> (Word4 -> String) -> ([Word4] -> ShowS) -> Show Word4
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Word4] -> ShowS
$cshowList :: [Word4] -> ShowS
show :: Word4 -> String
$cshow :: Word4 -> String
showsPrec :: Int -> Word4 -> ShowS
$cshowsPrec :: Int -> Word4 -> ShowS
Show)

instance Bounded Word4 where
  minBound :: Word4
minBound = Word4
0
  maxBound :: Word4
maxBound = Word4
0xF

instance Enum Word4 where
  succ :: Word4 -> Word4
succ Word4
x | Word4
x Word4 -> Word4 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word4
forall a. Bounded a => a
maxBound = Word4
x Word4 -> Word4 -> Word4
forall a. Num a => a -> a -> a
+ Word4
1
         | Bool
otherwise     = String -> Word4
forall a. String -> a
succError String
"Word4"
  pred :: Word4 -> Word4
pred Word4
x | Word4
x Word4 -> Word4 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word4
forall a. Bounded a => a
minBound = Word4
x Word4 -> Word4 -> Word4
forall a. Num a => a -> a -> a
- Word4
1
         | Bool
otherwise     = String -> Word4
forall a. String -> a
predError String
"Word4"
  toEnum :: Int -> Word4
toEnum Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Word4 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word4
forall a. Bounded a => a
maxBound::Word4) = Word8 -> Word4
W4 (Word8 -> Word4) -> Word8 -> Word4
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
           | Bool
otherwise     = String -> Int -> (Word4, Word4) -> Word4
forall a b. Show a => String -> Int -> (a, a) -> b
toEnumError String
"Word4" Int
i (Word4
forall a. Bounded a => a
minBound::Word4, Word4
forall a. Bounded a => a
maxBound::Word4)
  fromEnum :: Word4 -> Int
fromEnum (W4 Word8
x) = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x
  enumFrom :: Word4 -> [Word4]
enumFrom        = Word4 -> [Word4]
forall a. (Enum a, Bounded a) => a -> [a]
boundedEnumFrom
  enumFromThen :: Word4 -> Word4 -> [Word4]
enumFromThen    = Word4 -> Word4 -> [Word4]
forall a. (Enum a, Bounded a) => a -> a -> [a]
boundedEnumFromThen

instance FiniteBits Word4 where
  finiteBitSize :: Word4 -> Int
finiteBitSize Word4
_ = Int
4
  countLeadingZeros :: Word4 -> Int
countLeadingZeros (W4 Word8
x) = Word8 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word8
x
  countTrailingZeros :: Word4 -> Int
countTrailingZeros (W4 Word8
x) = Word8 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word8
x

pattern NoPiece :: Word4
pattern $bNoPiece :: Word4
$mNoPiece :: forall r. Word4 -> (Void# -> r) -> (Void# -> r) -> r
NoPiece     = 0

pattern WhitePawn, WhiteKnight, WhiteBishop, WhiteRook, WhiteQueen, WhiteKing
  :: Word4
pattern $bWhitePawn :: Word4
$mWhitePawn :: forall r. Word4 -> (Void# -> r) -> (Void# -> r) -> r
WhitePawn   = 2
pattern $bWhiteKnight :: Word4
$mWhiteKnight :: forall r. Word4 -> (Void# -> r) -> (Void# -> r) -> r
WhiteKnight = 4
pattern $bWhiteBishop :: Word4
$mWhiteBishop :: forall r. Word4 -> (Void# -> r) -> (Void# -> r) -> r
WhiteBishop = 6
pattern $bWhiteRook :: Word4
$mWhiteRook :: forall r. Word4 -> (Void# -> r) -> (Void# -> r) -> r
WhiteRook   = 8
pattern $bWhiteQueen :: Word4
$mWhiteQueen :: forall r. Word4 -> (Void# -> r) -> (Void# -> r) -> r
WhiteQueen  = 10
pattern $bWhiteKing :: Word4
$mWhiteKing :: forall r. Word4 -> (Void# -> r) -> (Void# -> r) -> r
WhiteKing   = 12

pattern BlackPawn, BlackKnight, BlackBishop, BlackRook, BlackQueen, BlackKing
  :: Word4
pattern $bBlackPawn :: Word4
$mBlackPawn :: forall r. Word4 -> (Void# -> r) -> (Void# -> r) -> r
BlackPawn   = 3
pattern $bBlackKnight :: Word4
$mBlackKnight :: forall r. Word4 -> (Void# -> r) -> (Void# -> r) -> r
BlackKnight = 5
pattern $bBlackBishop :: Word4
$mBlackBishop :: forall r. Word4 -> (Void# -> r) -> (Void# -> r) -> r
BlackBishop = 7
pattern $bBlackRook :: Word4
$mBlackRook :: forall r. Word4 -> (Void# -> r) -> (Void# -> r) -> r
BlackRook   = 9
pattern $bBlackQueen :: Word4
$mBlackQueen :: forall r. Word4 -> (Void# -> r) -> (Void# -> r) -> r
BlackQueen  = 11
pattern $bBlackKing :: Word4
$mBlackKing :: forall r. Word4 -> (Void# -> r) -> (Void# -> r) -> r
BlackKing   = 13

-- | law: square i x ! i = x where inRange (0,63) i && inRange (0,15) x
{-# INLINE square #-}
square :: Int -> Word4 -> QuadBitboard
square :: Int -> Word4 -> QuadBitboard
square !Int
sq !Word4
nb = Word64 -> Word64 -> Word64 -> Word64 -> QuadBitboard
QBB (Int -> Word64
f Int
0) (Int -> Word64
f Int
1) (Int -> Word64
f Int
2) (Int -> Word64
f Int
3) where
  !b :: Word64
b = Int -> Word64
forall a. Bits a => Int -> a
bit Int
sq
  f :: Int -> Word64
f !Int
n = Word4 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word4
nb Word4 -> Int -> Word4
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
n) Word4 -> Word4 -> Word4
forall a. Bits a => a -> a -> a
.&. Word4
1) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
b

(!) :: QuadBitboard -> Int -> Word4
(!) QBB{Word64
rqk :: Word64
nbk :: Word64
pbq :: Word64
black :: Word64
rqk :: QuadBitboard -> Word64
nbk :: QuadBitboard -> Word64
pbq :: QuadBitboard -> Word64
black :: QuadBitboard -> Word64
..} Int
sq = Word64 -> Word4
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word4) -> Word64 -> Word4
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> Word64
f Word64
black Int
0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
f Word64
pbq Int
1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
f Word64
nbk Int
2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
f Word64
rqk Int
3 where
  f :: Word64 -> Int -> Word64
f !Word64
bb !Int
n = ((Word64
bb Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
1) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
n

setNibble :: Bits nibble => QuadBitboard -> Int -> nibble -> QuadBitboard
setNibble :: QuadBitboard -> Int -> nibble -> QuadBitboard
setNibble QBB{Word64
rqk :: Word64
nbk :: Word64
pbq :: Word64
black :: Word64
rqk :: QuadBitboard -> Word64
nbk :: QuadBitboard -> Word64
pbq :: QuadBitboard -> Word64
black :: QuadBitboard -> Word64
..} Int
sq nibble
nb = Word64 -> Word64 -> Word64 -> Word64 -> QuadBitboard
QBB (Int -> Word64 -> Word64
f Int
0 Word64
black) (Int -> Word64 -> Word64
f Int
1 Word64
pbq) (Int -> Word64 -> Word64
f Int
2 Word64
nbk) (Int -> Word64 -> Word64
f Int
3 Word64
rqk) where
  f :: Int -> Word64 -> Word64
f Int
n | nibble
nb nibble -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
n = (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`setBit` Int
sq)
      | Bool
otherwise      = (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`clearBit` Int
sq)

instance Binary QuadBitboard where
  get :: Get QuadBitboard
get = Word64 -> Word64 -> Word64 -> Word64 -> QuadBitboard
QBB (Word64 -> Word64 -> Word64 -> Word64 -> QuadBitboard)
-> Get Word64 -> Get (Word64 -> Word64 -> Word64 -> QuadBitboard)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
forall t. Binary t => Get t
get Get (Word64 -> Word64 -> Word64 -> QuadBitboard)
-> Get Word64 -> Get (Word64 -> Word64 -> QuadBitboard)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
forall t. Binary t => Get t
get Get (Word64 -> Word64 -> QuadBitboard)
-> Get Word64 -> Get (Word64 -> QuadBitboard)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
forall t. Binary t => Get t
get Get (Word64 -> QuadBitboard) -> Get Word64 -> Get QuadBitboard
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
forall t. Binary t => Get t
get
  put :: QuadBitboard -> Put
put QBB{Word64
rqk :: Word64
nbk :: Word64
pbq :: Word64
black :: Word64
rqk :: QuadBitboard -> Word64
nbk :: QuadBitboard -> Word64
pbq :: QuadBitboard -> Word64
black :: QuadBitboard -> Word64
..} = Word64 -> Put
forall t. Binary t => t -> Put
put Word64
black Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> Put
forall t. Binary t => t -> Put
put Word64
pbq Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> Put
forall t. Binary t => t -> Put
put Word64
nbk Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> Put
forall t. Binary t => t -> Put
put Word64
rqk

instance IsString QuadBitboard where
  fromString :: String -> QuadBitboard
fromString = (Int, Int) -> QuadBitboard -> String -> QuadBitboard
go (Int
7, Int
0) QuadBitboard
forall a. Monoid a => a
mempty where
    go :: (Int, Int) -> QuadBitboard -> String -> QuadBitboard
go (Int, Int)
_ !QuadBitboard
qbb String
"" = QuadBitboard
qbb
    go (!Int
r,Int
_) QuadBitboard
qbb (Char
'/':String
xs) = (Int, Int) -> QuadBitboard -> String -> QuadBitboard
go (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
0) QuadBitboard
qbb String
xs
    go (!Int
r,!Int
f) !QuadBitboard
qbb (Char
x:String
xs)
      | (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'1',Char
'8') Char
x = (Int, Int) -> QuadBitboard -> String -> QuadBitboard
go (Int
r, Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')) QuadBitboard
qbb String
xs
      | Bool
otherwise = (Int, Int) -> QuadBitboard -> String -> QuadBitboard
go (Int
r, Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Word4 -> QuadBitboard
square (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
f) Word4
nb) String
xs where
        nb :: Word4
nb = case Char
x of
          Char
'P' -> Word4
WhitePawn
          Char
'N' -> Word4
WhiteKnight
          Char
'B' -> Word4
WhiteBishop
          Char
'R' -> Word4
WhiteRook
          Char
'Q' -> Word4
WhiteQueen
          Char
'K' -> Word4
WhiteKing
          Char
'p' -> Word4
BlackPawn
          Char
'n' -> Word4
BlackKnight
          Char
'b' -> Word4
BlackBishop
          Char
'r' -> Word4
BlackRook
          Char
'q' -> Word4
BlackQueen
          Char
'k' -> Word4
BlackKing
          Char
_ -> String -> Word4
forall a. HasCallStack => String -> a
error (String -> Word4) -> String -> Word4
forall a b. (a -> b) -> a -> b
$ String
"QuadBitBoard.fromString: Illegal FEN character " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
x

-- | bitwise XOR
instance Semigroup QuadBitboard where
  {-# INLINE (<>) #-}
  QBB Word64
b0 Word64
b1 Word64
b2 Word64
b3 <> :: QuadBitboard -> QuadBitboard -> QuadBitboard
<> QBB Word64
b0' Word64
b1' Word64
b2' Word64
b3' =
    Word64 -> Word64 -> Word64 -> Word64 -> QuadBitboard
QBB (Word64
b0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
b0') (Word64
b1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
b1') (Word64
b2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
b2') (Word64
b3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
b3')

instance Monoid QuadBitboard where
  mempty :: QuadBitboard
mempty = QuadBitboard
empty

instance Show QuadBitboard where
  show :: QuadBitboard -> String
show QBB{Word64
rqk :: Word64
nbk :: Word64
pbq :: Word64
black :: Word64
rqk :: QuadBitboard -> Word64
nbk :: QuadBitboard -> Word64
pbq :: QuadBitboard -> Word64
black :: QuadBitboard -> Word64
..} =
     String
"QBB {black = 0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word64
black
    (String
", pbq = 0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word64
pbq
    (String
", nbk = 0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word64
nbk
    (String
", rqk = 0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word64
rqk String
"}")))

toString :: QuadBitboard -> String
toString :: QuadBitboard -> String
toString QuadBitboard
qbb = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String
rank (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
7, Int
6..Int
0] where
  rank :: Int -> String
rank Int
r = ShowS -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ShowS
countEmpty ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> String -> [String]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Char -> Char -> Bool
spaces ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Char
charAt Int
r (Int -> Char) -> [Int] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0..Int
7]
  countEmpty :: ShowS
countEmpty String
xs | String -> Char
forall a. [a] -> a
head String
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
spc = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xs
                | Bool
otherwise      = String
xs
  spaces :: Char -> Char -> Bool
spaces Char
x Char
y = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
spc
  charAt :: Int -> Int -> Char
charAt Int
r Int
f = Char -> (Char -> Char) -> Maybe Char -> Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Char
spc (if Word4 -> Bool
forall a. Integral a => a -> Bool
odd Word4
nb then Char -> Char
toLower else Char -> Char
forall a. a -> a
id) (Maybe Char -> Char) -> Maybe Char -> Char
forall a b. (a -> b) -> a -> b
$
    Word4 -> [(Word4, Char)] -> Maybe Char
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Word4
nb Word4 -> Word4 -> Word4
forall a. Integral a => a -> a -> a
`div` Word4
2) ([(Word4, Char)] -> Maybe Char) -> [(Word4, Char)] -> Maybe Char
forall a b. (a -> b) -> a -> b
$ [Word4] -> String -> [(Word4, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word4
1..] String
"PNBRQK"
   where nb :: Word4
nb = QuadBitboard
qbb QuadBitboard -> Int -> Word4
! (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
f)
  spc :: Char
spc = Char
' '

-- | Move a nibble.  Note that this function, while convenient, isn't very
-- fast as it needs to lookup the source nibble value.
move :: QuadBitboard -> Int -> Int -> QuadBitboard
move :: QuadBitboard -> Int -> Int -> QuadBitboard
move QuadBitboard
qbb Int
fromSq Int
toSq = QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Word4 -> Int -> Word4 -> QuadBitboard
move' Int
fromSq (QuadBitboard
qbb QuadBitboard -> Int -> Word4
! Int
fromSq) Int
toSq (QuadBitboard
qbb QuadBitboard -> Int -> Word4
! Int
toSq)

move' :: Int -> Word4 -> Int -> Word4 -> QuadBitboard
move' :: Int -> Word4 -> Int -> Word4 -> QuadBitboard
move' Int
fromSq Word4
fromCode Int
toSq Word4
toCode =
  Int -> Word4 -> QuadBitboard
square Int
fromSq Word4
fromCode QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Word4 -> QuadBitboard
square Int
toSq (Word4
fromCode Word4 -> Word4 -> Word4
forall a. Bits a => a -> a -> a
`xor` Word4
toCode)

whiteKingsideCastle, whiteQueensideCastle, blackKingsideCastle, blackQueensideCastle
  :: QuadBitboard
whiteKingsideCastle :: QuadBitboard
whiteKingsideCastle  = Int -> Word4 -> Int -> Word4 -> QuadBitboard
move' Int
4 Word4
WhiteKing Int
6 Word4
NoPiece QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Word4 -> Int -> Word4 -> QuadBitboard
move' Int
7 Word4
WhiteRook Int
5 Word4
NoPiece
whiteQueensideCastle :: QuadBitboard
whiteQueensideCastle = Int -> Word4 -> Int -> Word4 -> QuadBitboard
move' Int
4 Word4
WhiteKing Int
2 Word4
NoPiece QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Word4 -> Int -> Word4 -> QuadBitboard
move' Int
0 Word4
WhiteRook Int
3 Word4
NoPiece
blackKingsideCastle :: QuadBitboard
blackKingsideCastle  = Int -> Word4 -> Int -> Word4 -> QuadBitboard
move' Int
60 Word4
BlackKing Int
62 Word4
NoPiece QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Word4 -> Int -> Word4 -> QuadBitboard
move' Int
63 Word4
BlackRook Int
61 Word4
NoPiece
blackQueensideCastle :: QuadBitboard
blackQueensideCastle = Int -> Word4 -> Int -> Word4 -> QuadBitboard
move' Int
60 Word4
BlackKing Int
58 Word4
NoPiece QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Word4 -> Int -> Word4 -> QuadBitboard
move' Int
56 Word4
BlackRook Int
59 Word4
NoPiece

enPassant :: Int -> Int -> QuadBitboard
enPassant :: Int -> Int -> QuadBitboard
enPassant Int
fromSq Int
toSq
  | Int
fromSq Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
toSq
  = Int -> Word4 -> Int -> Word4 -> QuadBitboard
move' Int
fromSq Word4
WhitePawn Int
toSq Word4
NoPiece QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Word4 -> QuadBitboard
square (Int
toSqInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8) Word4
BlackPawn
  | Bool
otherwise
  = Int -> Word4 -> Int -> Word4 -> QuadBitboard
move' Int
fromSq Word4
BlackPawn Int
toSq Word4
NoPiece QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Word4 -> QuadBitboard
square (Int
toSqInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8) Word4
WhitePawn

whitePromotion, blackPromotion :: QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
whitePromotion :: QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
whitePromotion QuadBitboard
qbb Int
fromSq Int
toSq Word4
promoCode =
  QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Word4 -> Word4 -> QuadBitboard
whitePromotion' Int
fromSq Int
toSq (QuadBitboard
qbb QuadBitboard -> Int -> Word4
! Int
toSq) Word4
promoCode
blackPromotion :: QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
blackPromotion QuadBitboard
qbb Int
fromSq Int
toSq Word4
promoCode =
  QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Word4 -> Word4 -> QuadBitboard
blackPromotion' Int
fromSq Int
toSq (QuadBitboard
qbb QuadBitboard -> Int -> Word4
! Int
toSq) Word4
promoCode

whitePromotion', blackPromotion' :: Int -> Int -> Word4 -> Word4 -> QuadBitboard
whitePromotion' :: Int -> Int -> Word4 -> Word4 -> QuadBitboard
whitePromotion' Int
fromSq Int
toSq Word4
toCode Word4
promoCode =
  Int -> Word4 -> QuadBitboard
square Int
fromSq Word4
WhitePawn QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Word4 -> QuadBitboard
square Int
toSq (Word4
toCode Word4 -> Word4 -> Word4
forall a. Bits a => a -> a -> a
`xor` Word4
promoCode)
blackPromotion' :: Int -> Int -> Word4 -> Word4 -> QuadBitboard
blackPromotion' Int
fromSq Int
toSq Word4
toCode Word4
promoCode =
  Int -> Word4 -> QuadBitboard
square Int
fromSq Word4
BlackPawn QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Word4 -> QuadBitboard
square Int
toSq (Word4
toCode Word4 -> Word4 -> Word4
forall a. Bits a => a -> a -> a
`xor` Word4
promoCode)