{-# 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 (
QuadBitboard
, occupied, black, white
, pawns, knights, bishops, rooks, queens, kings
, wPawns, wKnights, wBishops, wRooks, wQueens, wKings
, bPawns, bKnights, bBishops, bRooks, bQueens, bKings
, insufficientMaterial
, toString
, 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
, empty, standard
, (!), setNibble
, move, move'
, whiteKingsideCastle, whiteQueensideCastle
, blackKingsideCastle, blackQueensideCastle
, enPassant
, 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"
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
{-# 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 :: 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)