{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveLift                 #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TypeFamilies               #-}
module Game.Chess.Internal.QuadBitboard (
  -- * The QuadBitboard data type
  QuadBitboard
, occupied, black, white
, 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
  -- * 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           Control.DeepSeq
import           Control.Lens                (view, (^.))
import           Control.Lens.Iso            (from)
import           Data.Binary                 (Binary)
import           Data.Bits                   (Bits (clearBit, complement, popCount, setBit, testBit, unsafeShiftL, unsafeShiftR, xor, (.&.), (.|.)),
                                              FiniteBits (..))
import           Data.Char                   (ord, toLower)
import           Data.Hashable
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         (MVector, Unbox, Vector)
import           Data.Word                   (Word64, Word8)
import           Foreign.Storable
import           GHC.Enum                    (boundedEnumFrom,
                                              boundedEnumFromThen, predError,
                                              succError, toEnumError)
import           GHC.Exts                    (IsList (Item, fromList, toList))
import           GHC.Generics                (Generic)
import           GHC.Ptr                     (castPtr, plusPtr)
import           Game.Chess.Internal.Square
import           Language.Haskell.TH.Syntax  (Lift)
import           Numeric                     (showHex)

data QuadBitboard = QBB { QuadBitboard -> Word64
black, QuadBitboard -> Word64
pbq, QuadBitboard -> Word64
nbk, QuadBitboard -> Word64
rqk :: {-# UNPACK #-} !Word64 }
                    deriving (QuadBitboard -> QuadBitboard -> Bool
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, forall x. Rep QuadBitboard x -> QuadBitboard
forall x. QuadBitboard -> Rep QuadBitboard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QuadBitboard x -> QuadBitboard
$cfrom :: forall x. QuadBitboard -> Rep QuadBitboard x
Generic, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => QuadBitboard -> m Exp
forall (m :: * -> *).
Quote m =>
QuadBitboard -> Code m QuadBitboard
liftTyped :: forall (m :: * -> *).
Quote m =>
QuadBitboard -> Code m QuadBitboard
$cliftTyped :: forall (m :: * -> *).
Quote m =>
QuadBitboard -> Code m QuadBitboard
lift :: forall (m :: * -> *). Quote m => QuadBitboard -> m Exp
$clift :: forall (m :: * -> *). Quote m => QuadBitboard -> m Exp
Lift, Eq QuadBitboard
QuadBitboard -> QuadBitboard -> Bool
QuadBitboard -> QuadBitboard -> Ordering
QuadBitboard -> QuadBitboard -> QuadBitboard
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 :: QuadBitboard -> QuadBitboard -> QuadBitboard
$cmin :: QuadBitboard -> QuadBitboard -> QuadBitboard
max :: QuadBitboard -> QuadBitboard -> QuadBitboard
$cmax :: QuadBitboard -> QuadBitboard -> QuadBitboard
>= :: QuadBitboard -> QuadBitboard -> Bool
$c>= :: QuadBitboard -> QuadBitboard -> Bool
> :: QuadBitboard -> QuadBitboard -> Bool
$c> :: QuadBitboard -> QuadBitboard -> Bool
<= :: QuadBitboard -> QuadBitboard -> Bool
$c<= :: QuadBitboard -> QuadBitboard -> Bool
< :: QuadBitboard -> QuadBitboard -> Bool
$c< :: QuadBitboard -> QuadBitboard -> Bool
compare :: QuadBitboard -> QuadBitboard -> Ordering
$ccompare :: QuadBitboard -> QuadBitboard -> Ordering
Ord)

instance NFData QuadBitboard

occupied, pnr, white, pawns, knights, bishops, rooks, queens, kings :: QuadBitboard -> Word64
occupied :: QuadBitboard -> Word64
occupied = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.|.) QuadBitboard -> Word64
pbq forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.|.) QuadBitboard -> Word64
nbk QuadBitboard -> Word64
rqk
pnr :: QuadBitboard -> Word64
pnr      = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2  forall a. Bits a => a -> a -> a
xor  QuadBitboard -> Word64
pbq forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2  forall a. Bits a => a -> a -> a
xor  QuadBitboard -> Word64
nbk QuadBitboard -> Word64
rqk
white :: QuadBitboard -> Word64
white    = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2  forall a. Bits a => a -> a -> a
xor  QuadBitboard -> Word64
occupied QuadBitboard -> Word64
black
pawns :: QuadBitboard -> Word64
pawns    = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pnr QuadBitboard -> Word64
pbq
knights :: QuadBitboard -> Word64
knights  = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pnr QuadBitboard -> Word64
nbk
bishops :: QuadBitboard -> Word64
bishops  = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pbq QuadBitboard -> Word64
nbk
rooks :: QuadBitboard -> Word64
rooks    = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pnr QuadBitboard -> Word64
rqk
queens :: QuadBitboard -> Word64
queens   = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pbq QuadBitboard -> Word64
rqk
kings :: QuadBitboard -> Word64
kings    = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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   = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pawns (forall a. Bits a => a -> a
complement forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBitboard -> Word64
black)
wKnights :: QuadBitboard -> Word64
wKnights = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
knights (forall a. Bits a => a -> a
complement forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBitboard -> Word64
black)
wBishops :: QuadBitboard -> Word64
wBishops = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
bishops (forall a. Bits a => a -> a
complement forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBitboard -> Word64
black)
wRooks :: QuadBitboard -> Word64
wRooks   = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
rooks (forall a. Bits a => a -> a
complement forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBitboard -> Word64
black)
wQueens :: QuadBitboard -> Word64
wQueens  = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
queens (forall a. Bits a => a -> a
complement forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadBitboard -> Word64
black)
wKings :: QuadBitboard -> Word64
wKings   = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
kings (forall a. Bits a => a -> a
complement 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   = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
pawns QuadBitboard -> Word64
black
bKnights :: QuadBitboard -> Word64
bKnights = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
knights QuadBitboard -> Word64
black
bBishops :: QuadBitboard -> Word64
bBishops = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
bishops QuadBitboard -> Word64
black
bRooks :: QuadBitboard -> Word64
bRooks   = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
rooks QuadBitboard -> Word64
black
bQueens :: QuadBitboard -> Word64
bQueens  = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Bits a => a -> a -> a
(.&.) QuadBitboard -> Word64
queens QuadBitboard -> Word64
black
bKings :: QuadBitboard -> Word64
bKings   = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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 #-}

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

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

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

instance IsList QuadBitboard where
  type Item QuadBitboard = (Square, Word4)
  fromList :: [Item QuadBitboard] -> QuadBitboard
fromList = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Square -> Word4 -> QuadBitboard
singleton)
  toList :: QuadBitboard -> [Item QuadBitboard]
toList QuadBitboard
qbb = Square -> [(Square, Word4)] -> [(Square, Word4)]
go forall a. Bounded a => a
maxBound [] where
    go :: Square -> [(Square, Word4)] -> [(Square, Word4)]
go Square
sq [(Square, Word4)]
xs
      | Square
sq forall a. Eq a => a -> a -> Bool
/= forall a. Bounded a => a
minBound = Square -> [(Square, Word4)] -> [(Square, Word4)]
go (forall a. Enum a => a -> a
pred Square
sq) [(Square, Word4)]
xs'
      | Bool
otherwise      = [(Square, Word4)]
xs'
     where nb :: Word4
nb = QuadBitboard
qbb QuadBitboard -> Square -> Word4
! Square
sq
           xs' :: [(Square, Word4)]
xs' | Word4
nb forall a. Eq a => a -> a -> Bool
/= Word4
NoPiece = (Square
sq, Word4
nb) forall a. a -> [a] -> [a]
: [(Square, Word4)]
xs
               | Bool
otherwise     = [(Square, Word4)]
xs

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"

-- | 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 forall a. Bits a => a -> a -> a
`xor` Word64
b0') (Word64
b1 forall a. Bits a => a -> a -> a
`xor` Word64
b1') (Word64
b2 forall a. Bits a => a -> a -> a
`xor` Word64
b2') (Word64
b3 forall a. Bits a => a -> a -> a
`xor` Word64
b3')

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

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 = forall a. Bits a => a -> Int
popCount (QuadBitboard -> Word64
wKings QuadBitboard
qbb) forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& forall a. Bits a => a -> Int
popCount (QuadBitboard -> Word64
bKings QuadBitboard
qbb) forall a. Eq a => a -> a -> Bool
== Int
1
  noPawnsNorQueens :: Bool
noPawnsNorQueens = Word64
pbq forall a. Bits a => a -> a -> a
`xor` QuadBitboard -> Word64
bishops QuadBitboard
qbb forall a. Eq a => a -> a -> Bool
== Word64
0
  noRooks :: Bool
noRooks = forall a. Bits a => a -> Int
popCount Word64
rqk forall a. Eq a => a -> a -> Bool
== Int
2
  oneSideHasAtMostOneMinorPiece :: Bool
oneSideHasAtMostOneMinorPiece =
    (forall a. Bits a => a -> Int
popCount (Word64
nbk forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Word64
black) forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Word64 -> Bool
atMostOneMinorPiece Word64
black) Bool -> Bool -> Bool
||
    (forall a. Bits a => a -> Int
popCount (Word64
nbk forall a. Bits a => a -> a -> a
.&. Word64
black) forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Word64 -> Bool
atMostOneMinorPiece (forall a. Bits a => a -> a
complement Word64
black))
  opposingBishopsOnEquallyColoredSquares :: Bool
opposingBishopsOnEquallyColoredSquares =
    forall a. Bits a => a -> Int
popCount (QuadBitboard -> Word64
knights QuadBitboard
qbb) forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&&
    forall a. Bits a => a -> Int
popCount (Word64
nbk forall a. Bits a => a -> a -> a
.&. Word64
black) forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&& forall a. Bits a => a -> Int
popCount (Word64
nbk forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Word64
black) forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&&
    forall a. Integral a => a -> Bool
even (forall b. FiniteBits b => b -> Int
countTrailingZeros (QuadBitboard -> Word64
wBishops QuadBitboard
qbb)) forall a. Eq a => a -> a -> Bool
==
    forall a. Integral a => a -> Bool
even (forall b. FiniteBits b => b -> Int
countTrailingZeros (QuadBitboard -> Word64
bBishops QuadBitboard
qbb))
  atMostOneMinorPiece :: Word64 -> Bool
atMostOneMinorPiece Word64
mask = forall a. Bits a => a -> Int
popCount (Word64
nbk forall a. Bits a => a -> a -> a
.&. Word64
mask) 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr QuadBitboard
p) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ Ptr QuadBitboard
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ Ptr QuadBitboard
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ Ptr QuadBitboard
p 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
    forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr QuadBitboard
p) Word64
black
    forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ Ptr QuadBitboard
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) Word64
pbq
    forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ Ptr QuadBitboard
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) Word64
nbk
    forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ Ptr QuadBitboard
p 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 :: forall s. MVector s QuadBitboard -> Int
basicLength (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v) = forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
M.basicLength MVector s (Word64, Word64, Word64, Word64)
v
  basicUnsafeSlice :: forall s.
Int -> Int -> MVector s QuadBitboard -> MVector s QuadBitboard
basicUnsafeSlice Int
i Int
n (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v) = forall s.
MVector s (Word64, Word64, Word64, Word64)
-> MVector s QuadBitboard
MV_QuadBitboard forall a b. (a -> b) -> a -> b
$ 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 :: forall s. MVector s QuadBitboard -> MVector s QuadBitboard -> Bool
basicOverlaps (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v1) (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v2) = 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 :: forall s. Int -> ST s (MVector s QuadBitboard)
basicUnsafeNew Int
n = forall s.
MVector s (Word64, Word64, Word64, Word64)
-> MVector s QuadBitboard
MV_QuadBitboard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
M.basicUnsafeNew Int
n
  basicInitialize :: forall s. MVector s QuadBitboard -> ST s ()
basicInitialize (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v) = forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
M.basicInitialize MVector s (Word64, Word64, Word64, Word64)
v
  basicUnsafeReplicate :: forall s. Int -> QuadBitboard -> ST s (MVector s QuadBitboard)
basicUnsafeReplicate Int
n (QBB Word64
b0 Word64
b1 Word64
b2 Word64
b3) = forall s.
MVector s (Word64, Word64, Word64, Word64)
-> MVector s QuadBitboard
MV_QuadBitboard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> a -> ST s (v s a)
M.basicUnsafeReplicate Int
n (Word64
b0, Word64
b1, Word64
b2, Word64
b3)
  basicUnsafeRead :: forall s. MVector s QuadBitboard -> Int -> ST s QuadBitboard
basicUnsafeRead (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v) Int
i = (Word64, Word64, Word64, Word64) -> QuadBitboard
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
M.basicUnsafeRead MVector s (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 :: forall s. MVector s QuadBitboard -> Int -> QuadBitboard -> ST s ()
basicUnsafeWrite (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v) Int
i (QBB Word64
b0 Word64
b1 Word64
b2 Word64
b3) = forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
M.basicUnsafeWrite MVector s (Word64, Word64, Word64, Word64)
v Int
i (Word64
b0, Word64
b1, Word64
b2, Word64
b3)
  basicClear :: forall s. MVector s QuadBitboard -> ST s ()
basicClear (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v) = forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
M.basicClear MVector s (Word64, Word64, Word64, Word64)
v
  basicSet :: forall s. MVector s QuadBitboard -> QuadBitboard -> ST s ()
basicSet (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v) (QBB Word64
b0 Word64
b1 Word64
b2 Word64
b3) = forall (v :: * -> * -> *) a s. MVector v a => v s a -> a -> ST s ()
M.basicSet MVector s (Word64, Word64, Word64, Word64)
v (Word64
b0, Word64
b1, Word64
b2, Word64
b3)
  basicUnsafeCopy :: forall s.
MVector s QuadBitboard -> MVector s QuadBitboard -> ST s ()
basicUnsafeCopy (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v1) (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v2) = forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
M.basicUnsafeCopy MVector s (Word64, Word64, Word64, Word64)
v1 MVector s (Word64, Word64, Word64, Word64)
v2
  basicUnsafeMove :: forall s.
MVector s QuadBitboard -> MVector s QuadBitboard -> ST s ()
basicUnsafeMove (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v1) (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v2) = forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
M.basicUnsafeMove MVector s (Word64, Word64, Word64, Word64)
v1 MVector s (Word64, Word64, Word64, Word64)
v2
  basicUnsafeGrow :: forall s.
MVector s QuadBitboard -> Int -> ST s (MVector s QuadBitboard)
basicUnsafeGrow (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v) Int
n = forall s.
MVector s (Word64, Word64, Word64, Word64)
-> MVector s QuadBitboard
MV_QuadBitboard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
M.basicUnsafeGrow MVector s (Word64, Word64, Word64, Word64)
v Int
n

instance G.Vector Vector QuadBitboard where
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeFreeze :: forall s.
Mutable Vector s QuadBitboard -> ST s (Vector QuadBitboard)
basicUnsafeFreeze (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
v) = Vector (Word64, Word64, Word64, Word64) -> Vector QuadBitboard
V_QuadBitboard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
G.basicUnsafeFreeze MVector s (Word64, Word64, Word64, Word64)
v
  basicUnsafeThaw :: forall s.
Vector QuadBitboard -> ST s (Mutable Vector s QuadBitboard)
basicUnsafeThaw (V_QuadBitboard Vector (Word64, Word64, Word64, Word64)
v) = forall s.
MVector s (Word64, Word64, Word64, Word64)
-> MVector s QuadBitboard
MV_QuadBitboard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
G.basicUnsafeThaw Vector (Word64, Word64, Word64, Word64)
v
  basicLength :: Vector QuadBitboard -> Int
basicLength (V_QuadBitboard Vector (Word64, Word64, Word64, Word64)
v) = 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 Vector (Word64, Word64, Word64, Word64)
v) = Vector (Word64, Word64, Word64, Word64) -> Vector QuadBitboard
V_QuadBitboard forall a b. (a -> b) -> a -> b
$ 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 -> Box QuadBitboard
basicUnsafeIndexM (V_QuadBitboard Vector (Word64, Word64, Word64, Word64)
v) Int
i
    = (Word64, Word64, Word64, Word64) -> QuadBitboard
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> *) a. Vector v a => v a -> Int -> Box 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 :: forall s.
Mutable Vector s QuadBitboard -> Vector QuadBitboard -> ST s ()
basicUnsafeCopy (MV_QuadBitboard MVector s (Word64, Word64, Word64, Word64)
mv) (V_QuadBitboard Vector (Word64, Word64, Word64, Word64)
v) = forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
G.basicUnsafeCopy MVector s (Word64, Word64, Word64, Word64)
mv Vector (Word64, Word64, Word64, Word64)
v
  elemseq :: forall b. Vector QuadBitboard -> QuadBitboard -> b -> b
elemseq Vector QuadBitboard
_ (QBB Word64
b0 Word64
b1 Word64
b2 Word64
b3) b
z
    = forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. HasCallStack => a
undefined :: Vector a) Word64
b0
    forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. HasCallStack => a
undefined :: Vector a) Word64
b1
    forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. HasCallStack => a
undefined :: Vector a) Word64
b2
    forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. HasCallStack => a
undefined :: Vector a) Word64
b3
    b
z

newtype Word4 = W4 Word8
              deriving (Eq Word4
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
Bits, Word4 -> Word4 -> Bool
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
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
Integral, Ord 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]
Ix, Integer -> Word4
Word4 -> Word4
Word4 -> Word4 -> 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
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
Ord, ReadPrec [Word4]
ReadPrec Word4
Int -> ReadS Word4
ReadS [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
Word4 -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Word4 -> Rational
$ctoRational :: Word4 -> Rational
Real)

instance Show Word4 where
  show :: Word4 -> [Char]
show Word4
NoPiece     = [Char]
"NoPiece"
  show Word4
WhiteKing   = [Char]
"WhiteKing"
  show Word4
WhitePawn   = [Char]
"WhitePawn"
  show Word4
WhiteKnight = [Char]
"WhiteKnight"
  show Word4
WhiteBishop = [Char]
"WhiteBishop"
  show Word4
WhiteRook   = [Char]
"WhiteRook"
  show Word4
WhiteQueen  = [Char]
"WhiteQueen"
  show Word4
BlackKing   = [Char]
"BlackKing"
  show Word4
BlackPawn   = [Char]
"BlackPawn"
  show Word4
BlackKnight = [Char]
"BlackKnight"
  show Word4
BlackBishop = [Char]
"BlackBishop"
  show Word4
BlackRook   = [Char]
"BlackRook"
  show Word4
BlackQueen  = [Char]
"BlackQueen"
  show (W4 Word8
n)      = [Char]
"W4 " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Word8
n

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 forall a. Eq a => a -> a -> Bool
/= forall a. Bounded a => a
maxBound = Word4
x forall a. Num a => a -> a -> a
+ Word4
1
         | Bool
otherwise     = forall a. [Char] -> a
succError [Char]
"Word4"
  pred :: Word4 -> Word4
pred Word4
x | Word4
x forall a. Eq a => a -> a -> Bool
/= forall a. Bounded a => a
minBound = Word4
x forall a. Num a => a -> a -> a
- Word4
1
         | Bool
otherwise     = forall a. [Char] -> a
predError [Char]
"Word4"
  toEnum :: Int -> Word4
toEnum Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound::Word4) = Word8 -> Word4
W4 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
           | Bool
otherwise     = forall a b. Show a => [Char] -> Int -> (a, a) -> b
toEnumError [Char]
"Word4" Int
i (forall a. Bounded a => a
minBound::Word4, forall a. Bounded a => a
maxBound::Word4)
  fromEnum :: Word4 -> Int
fromEnum (W4 Word8
x) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x
  enumFrom :: Word4 -> [Word4]
enumFrom        = forall a. (Enum a, Bounded a) => a -> [a]
boundedEnumFrom
  enumFromThen :: Word4 -> Word4 -> [Word4]
enumFromThen    = 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) = forall b. FiniteBits b => b -> Int
countLeadingZeros Word8
x forall a. Num a => a -> a -> a
- Int
4
  countTrailingZeros :: Word4 -> Int
countTrailingZeros (W4 Word8
x) = forall b. FiniteBits b => b -> Int
countTrailingZeros Word8
x

-- | law: singleton i x ! i = x where inRange (0,63) i && inRange (0,15) x
{-# INLINE singleton #-}
singleton :: Square -> Word4 -> QuadBitboard
singleton :: Square -> Word4 -> QuadBitboard
singleton (Sq 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 = Word64
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
sq
  f :: Int -> Word64
f !Int
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word4
nb forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
n) forall a. Bits a => a -> a -> a
.&. Word4
1) forall a. Num a => a -> a -> a
* Word64
b

(!) :: QuadBitboard -> Square -> Word4
! :: QuadBitboard -> Square -> Word4
(!) QBB{Word64
rqk :: Word64
nbk :: Word64
pbq :: Word64
black :: Word64
rqk :: QuadBitboard -> Word64
nbk :: QuadBitboard -> Word64
pbq :: QuadBitboard -> Word64
black :: QuadBitboard -> Word64
..} (Sq Int
sq) = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> Word64
f Word64
black Int
0 forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
f Word64
pbq Int
1 forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
f Word64
nbk Int
2 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 forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
sq) forall a. Bits a => a -> a -> a
.&. Word64
1) forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
n

{-# INLINE (!) #-}

setNibble :: Bits nibble => QuadBitboard -> Int -> nibble -> QuadBitboard
setNibble :: forall nibble.
Bits nibble =>
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 forall a. Bits a => a -> Int -> Bool
`testBit` Int
n = (forall a. Bits a => a -> Int -> a
`setBit` Int
sq)
      | Bool
otherwise      = (forall a. Bits a => a -> Int -> a
`clearBit` Int
sq)

instance Binary QuadBitboard

instance IsString QuadBitboard where
  fromString :: [Char] -> QuadBitboard
fromString = (Rank, File) -> QuadBitboard -> [Char] -> QuadBitboard
go (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' Square (Rank, File)
rankFile Square
A8) forall a. Monoid a => a
mempty where
    go :: (Rank, File) -> QuadBitboard -> [Char] -> QuadBitboard
go (Rank, File)
_ !QuadBitboard
qbb [Char]
"" = QuadBitboard
qbb
    go (Rank
r, File
_) QuadBitboard
qbb (Char
'/':[Char]
xs) = (Rank, File) -> QuadBitboard -> [Char] -> QuadBitboard
go (forall a. Enum a => a -> a
pred Rank
r, File
FileA) QuadBitboard
qbb [Char]
xs
    go rf :: (Rank, File)
rf@(Rank
r, File
f) !QuadBitboard
qbb (Char
x:[Char]
xs)
      | forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'1',Char
'8') Char
x = (Rank, File) -> QuadBitboard -> [Char] -> QuadBitboard
go (Rank
r, HasCallStack => Int -> File
mkFile forall a b. (a -> b) -> a -> b
$ File -> Int
unFile File
f forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
x forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0') QuadBitboard
qbb [Char]
xs
      | Bool
otherwise = (Rank, File) -> QuadBitboard -> [Char] -> QuadBitboard
go (Rank
r, forall a. Enum a => a -> a
succ File
f) (QuadBitboard
qbb forall a. Semigroup a => a -> a -> a
<> Square -> Word4 -> QuadBitboard
singleton Square
sq Word4
nb) [Char]
xs where
        sq :: Square
sq = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall s t a b. AnIso s t a b -> Iso b a t s
from Iso' Square (Rank, File)
rankFile) (Rank, File)
rf
        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
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"QuadBitBoard.fromString: Illegal FEN character " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Char
x

instance Hashable QuadBitboard where
  hashWithSalt :: Int -> QuadBitboard -> Int
hashWithSalt Int
s 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} =
    Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
black forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
pbq forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
nbk forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
rqk

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

toString :: QuadBitboard -> String
toString :: QuadBitboard -> [Char]
toString QuadBitboard
qbb = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" forall a b. (a -> b) -> a -> b
$ Rank -> [Char]
rnk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rank
Rank8, Rank
Rank7 .. Rank
Rank1] where
  rnk :: Rank -> [Char]
rnk Rank
r = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ShowS
countEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Char -> Char -> Bool
spaces forall a b. (a -> b) -> a -> b
$ Rank -> File -> Char
charAt Rank
r forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [File
FileA .. File
FileH]
  countEmpty :: ShowS
countEmpty [Char]
xs | forall a. [a] -> a
head [Char]
xs forall a. Eq a => a -> a -> Bool
== Char
spc = forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
xs
                | Bool
otherwise      = [Char]
xs
  spaces :: Char -> Char -> Bool
spaces Char
x Char
y = Char
x forall a. Eq a => a -> a -> Bool
== Char
spc Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
== Char
y
  charAt :: Rank -> File -> Char
charAt Rank
r File
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Char
spc (if forall a. Integral a => a -> Bool
odd Word4
nb then Char -> Char
toLower else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Word4
nb forall a. Integral a => a -> a -> a
`div` Word4
2) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Word4
1..] [Char]
"PNBRQK"
   where nb :: Word4
nb = QuadBitboard
qbb QuadBitboard -> Square -> Word4
! ((Rank
r, File
f) forall s a. s -> Getting a s a -> a
^. forall s t a b. AnIso s t a b -> Iso b a t s
from Iso' Square (Rank, File)
rankFile)
  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 -> Square -> Square -> QuadBitboard
move :: QuadBitboard -> Square -> Square -> QuadBitboard
move QuadBitboard
qbb Square
fromSq Square
toSq = QuadBitboard
qbb forall a. Semigroup a => a -> a -> a
<> Square -> Word4 -> Square -> Word4 -> QuadBitboard
move' Square
fromSq (QuadBitboard
qbb QuadBitboard -> Square -> Word4
! Square
fromSq) Square
toSq (QuadBitboard
qbb QuadBitboard -> Square -> Word4
! Square
toSq)

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

{-# INLINE move' #-}

whiteKingsideCastle, whiteQueensideCastle, blackKingsideCastle, blackQueensideCastle
  :: QuadBitboard
whiteKingsideCastle :: QuadBitboard
whiteKingsideCastle  = Square -> Word4 -> Square -> Word4 -> QuadBitboard
move' Square
E1 Word4
WhiteKing Square
G1 Word4
NoPiece forall a. Semigroup a => a -> a -> a
<> Square -> Word4 -> Square -> Word4 -> QuadBitboard
move' Square
H1 Word4
WhiteRook Square
F1 Word4
NoPiece
whiteQueensideCastle :: QuadBitboard
whiteQueensideCastle = Square -> Word4 -> Square -> Word4 -> QuadBitboard
move' Square
E1 Word4
WhiteKing Square
C1 Word4
NoPiece forall a. Semigroup a => a -> a -> a
<> Square -> Word4 -> Square -> Word4 -> QuadBitboard
move' Square
A1 Word4
WhiteRook Square
D1 Word4
NoPiece
blackKingsideCastle :: QuadBitboard
blackKingsideCastle  = Square -> Word4 -> Square -> Word4 -> QuadBitboard
move' Square
E8 Word4
BlackKing Square
G8 Word4
NoPiece forall a. Semigroup a => a -> a -> a
<> Square -> Word4 -> Square -> Word4 -> QuadBitboard
move' Square
H8 Word4
BlackRook Square
F8 Word4
NoPiece
blackQueensideCastle :: QuadBitboard
blackQueensideCastle = Square -> Word4 -> Square -> Word4 -> QuadBitboard
move' Square
E8 Word4
BlackKing Square
C8 Word4
NoPiece forall a. Semigroup a => a -> a -> a
<> Square -> Word4 -> Square -> Word4 -> QuadBitboard
move' Square
A8 Word4
BlackRook Square
D8 Word4
NoPiece

enPassant :: Square -> Square -> QuadBitboard
enPassant :: Square -> Square -> QuadBitboard
enPassant Square
fromSq Square
toSq
  | Square -> Int
unSquare Square
fromSq forall a. Ord a => a -> a -> Bool
< Square -> Int
unSquare Square
toSq
  = Square -> Word4 -> Square -> Word4 -> QuadBitboard
move' Square
fromSq Word4
WhitePawn Square
toSq Word4
NoPiece forall a. Semigroup a => a -> a -> a
<> Square -> Word4 -> QuadBitboard
singleton (HasCallStack => Int -> Square
mkSq forall a b. (a -> b) -> a -> b
$ Square -> Int
unSquare Square
toSq forall a. Num a => a -> a -> a
- Int
8) Word4
BlackPawn
  | Bool
otherwise
  = Square -> Word4 -> Square -> Word4 -> QuadBitboard
move' Square
fromSq Word4
BlackPawn Square
toSq Word4
NoPiece forall a. Semigroup a => a -> a -> a
<> Square -> Word4 -> QuadBitboard
singleton (HasCallStack => Int -> Square
mkSq forall a b. (a -> b) -> a -> b
$ Square -> Int
unSquare Square
toSq forall a. Num a => a -> a -> a
+ Int
8) Word4
WhitePawn

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

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