{-# 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
(QuadBitboard -> QuadBitboard -> Bool)
-> (QuadBitboard -> QuadBitboard -> Bool) -> Eq QuadBitboard
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuadBitboard -> QuadBitboard -> Bool
$c/= :: QuadBitboard -> QuadBitboard -> Bool
== :: QuadBitboard -> QuadBitboard -> Bool
$c== :: QuadBitboard -> QuadBitboard -> Bool
Eq, (forall x. QuadBitboard -> Rep QuadBitboard x)
-> (forall x. Rep QuadBitboard x -> QuadBitboard)
-> Generic QuadBitboard
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, QuadBitboard -> Q Exp
QuadBitboard -> Q (TExp QuadBitboard)
(QuadBitboard -> Q Exp)
-> (QuadBitboard -> Q (TExp QuadBitboard)) -> Lift QuadBitboard
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: QuadBitboard -> Q (TExp QuadBitboard)
$cliftTyped :: QuadBitboard -> Q (TExp QuadBitboard)
lift :: QuadBitboard -> Q Exp
$clift :: QuadBitboard -> Q Exp
Lift, Eq QuadBitboard
Eq QuadBitboard
-> (QuadBitboard -> QuadBitboard -> Ordering)
-> (QuadBitboard -> QuadBitboard -> Bool)
-> (QuadBitboard -> QuadBitboard -> Bool)
-> (QuadBitboard -> QuadBitboard -> Bool)
-> (QuadBitboard -> QuadBitboard -> Bool)
-> (QuadBitboard -> QuadBitboard -> QuadBitboard)
-> (QuadBitboard -> QuadBitboard -> QuadBitboard)
-> Ord 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
$cp1Ord :: Eq QuadBitboard
Ord)

instance NFData QuadBitboard

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

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

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

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

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

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

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

instance IsList QuadBitboard where
  type Item QuadBitboard = (Square, Word4)
  fromList :: [Item QuadBitboard] -> QuadBitboard
fromList = [QuadBitboard] -> QuadBitboard
forall a. Monoid a => [a] -> a
mconcat ([QuadBitboard] -> QuadBitboard)
-> ([(Square, Word4)] -> [QuadBitboard])
-> [(Square, Word4)]
-> QuadBitboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Square, Word4) -> QuadBitboard)
-> [(Square, Word4)] -> [QuadBitboard]
forall a b. (a -> b) -> [a] -> [b]
map ((Square -> Word4 -> QuadBitboard)
-> (Square, Word4) -> QuadBitboard
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 Square
forall a. Bounded a => a
maxBound [] where
    go :: Square -> [(Square, Word4)] -> [(Square, Word4)]
go Square
sq [(Square, Word4)]
xs
      | Square
sq Square -> Square -> Bool
forall a. Eq a => a -> a -> Bool
/= Square
forall a. Bounded a => a
minBound = Square -> [(Square, Word4)] -> [(Square, Word4)]
go (Square -> Square
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 Word4 -> Word4 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word4
NoPiece = (Square
sq, Word4
nb) (Square, Word4) -> [(Square, Word4)] -> [(Square, Word4)]
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 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
b0') (Word64
b1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
b1') (Word64
b2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
b2') (Word64
b3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
b3')

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

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

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

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

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

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

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

instance Show Word4 where
  show :: Word4 -> String
show Word4
NoPiece     = String
"NoPiece"
  show Word4
WhiteKing   = String
"WhiteKing"
  show Word4
WhitePawn   = String
"WhitePawn"
  show Word4
WhiteKnight = String
"WhiteKnight"
  show Word4
WhiteBishop = String
"WhiteBishop"
  show Word4
WhiteRook   = String
"WhiteRook"
  show Word4
WhiteQueen  = String
"WhiteQueen"
  show Word4
BlackKing   = String
"BlackKing"
  show Word4
BlackPawn   = String
"BlackPawn"
  show Word4
BlackKnight = String
"BlackKnight"
  show Word4
BlackBishop = String
"BlackBishop"
  show Word4
BlackRook   = String
"BlackRook"
  show Word4
BlackQueen  = String
"BlackQueen"
  show (W4 Word8
n)      = String
"W4 " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
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 Word4 -> Word4 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word4
forall a. Bounded a => a
maxBound = Word4
x Word4 -> Word4 -> Word4
forall a. Num a => a -> a -> a
+ Word4
1
         | Bool
otherwise     = String -> Word4
forall a. String -> a
succError String
"Word4"
  pred :: Word4 -> Word4
pred Word4
x | Word4
x Word4 -> Word4 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word4
forall a. Bounded a => a
minBound = Word4
x Word4 -> Word4 -> Word4
forall a. Num a => a -> a -> a
- Word4
1
         | Bool
otherwise     = String -> Word4
forall a. String -> a
predError String
"Word4"
  toEnum :: Int -> Word4
toEnum Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Word4 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word4
forall a. Bounded a => a
maxBound::Word4) = Word8 -> Word4
W4 (Word8 -> Word4) -> Word8 -> Word4
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
           | Bool
otherwise     = String -> Int -> (Word4, Word4) -> Word4
forall a b. Show a => String -> Int -> (a, a) -> b
toEnumError String
"Word4" Int
i (Word4
forall a. Bounded a => a
minBound::Word4, Word4
forall a. Bounded a => a
maxBound::Word4)
  fromEnum :: Word4 -> Int
fromEnum (W4 Word8
x) = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x
  enumFrom :: Word4 -> [Word4]
enumFrom        = Word4 -> [Word4]
forall a. (Enum a, Bounded a) => a -> [a]
boundedEnumFrom
  enumFromThen :: Word4 -> Word4 -> [Word4]
enumFromThen    = Word4 -> Word4 -> [Word4]
forall a. (Enum a, Bounded a) => a -> a -> [a]
boundedEnumFromThen

instance FiniteBits Word4 where
  finiteBitSize :: Word4 -> Int
finiteBitSize Word4
_ = Int
4
  countLeadingZeros :: Word4 -> Int
countLeadingZeros (W4 Word8
x) = Word8 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word8
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4
  countTrailingZeros :: Word4 -> Int
countTrailingZeros (W4 Word8
x) = Word8 -> Int
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 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
sq
  f :: Int -> Word64
f !Int
n = Word4 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word4
nb Word4 -> Int -> Word4
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
n) Word4 -> Word4 -> Word4
forall a. Bits a => a -> a -> a
.&. Word4
1) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
b

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

{-# INLINE (!) #-}

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

instance Binary QuadBitboard

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

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 Int -> Word64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
black Int -> Word64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
pbq Int -> Word64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
nbk Int -> Word64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
rqk

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

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