module Game.Chess.Internal where
import Data.Bits
( Bits((.&.), testBit, unsafeShiftR, unsafeShiftL, xor, (.|.), bit, complement),
FiniteBits(countLeadingZeros, countTrailingZeros) )
import Data.Char ( ord, chr )
import Data.Ix ( Ix(inRange) )
import Data.List (nub, sortOn)
import Data.Maybe ( fromJust, isJust, listToMaybe )
import Data.Ord (Down(..))
import Data.String ( IsString(..) )
import Data.Vector.Unboxed (Vector, (!))
import qualified Data.Vector.Unboxed as Vector
import Data.Word ( Word16, Word64 )
import Foreign.Storable
import Game.Chess.Internal.Square (IsSquare(toIndex, toRF), Sq(..), toCoord)
import Game.Chess.Internal.QuadBitboard (QuadBitboard)
import qualified Game.Chess.Internal.QuadBitboard as QBB
import Text.Read (readMaybe)
capturing :: Position -> Ply -> Maybe PieceType
capturing :: Position -> Ply -> Maybe PieceType
capturing pos :: Position
pos@Position{Word64
flags :: Position -> Word64
flags :: Word64
flags} (Ply -> (Int, Int, Maybe PieceType)
unpack -> (Int
_, Int
to, Maybe PieceType
_))
| (Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
epMask) Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
to = PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Pawn
| Bool
otherwise = (Color, PieceType) -> PieceType
forall a b. (a, b) -> b
snd ((Color, PieceType) -> PieceType)
-> Maybe (Color, PieceType) -> Maybe PieceType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position -> Int -> Maybe (Color, PieceType)
forall sq.
IsSquare sq =>
Position -> sq -> Maybe (Color, PieceType)
pieceAt Position
pos Int
to
isCapture :: Position -> Ply -> Bool
isCapture :: Position -> Ply -> Bool
isCapture Position
pos = Maybe PieceType -> Bool
forall a. Maybe a -> Bool
isJust (Maybe PieceType -> Bool)
-> (Ply -> Maybe PieceType) -> Ply -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Ply -> Maybe PieceType
capturing Position
pos
startpos :: Position
startpos :: Position
startpos = Maybe Position -> Position
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Position -> Position) -> Maybe Position -> Position
forall a b. (a -> b) -> a -> b
$
String -> Maybe Position
fromFEN String
"rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1"
data PieceType = Pawn | Knight | Bishop | Rook | Queen | King deriving (PieceType -> PieceType -> Bool
(PieceType -> PieceType -> Bool)
-> (PieceType -> PieceType -> Bool) -> Eq PieceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PieceType -> PieceType -> Bool
$c/= :: PieceType -> PieceType -> Bool
== :: PieceType -> PieceType -> Bool
$c== :: PieceType -> PieceType -> Bool
Eq, Ord PieceType
Ord PieceType
-> ((PieceType, PieceType) -> [PieceType])
-> ((PieceType, PieceType) -> PieceType -> Int)
-> ((PieceType, PieceType) -> PieceType -> Int)
-> ((PieceType, PieceType) -> PieceType -> Bool)
-> ((PieceType, PieceType) -> Int)
-> ((PieceType, PieceType) -> Int)
-> Ix PieceType
(PieceType, PieceType) -> Int
(PieceType, PieceType) -> [PieceType]
(PieceType, PieceType) -> PieceType -> Bool
(PieceType, PieceType) -> PieceType -> 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 :: (PieceType, PieceType) -> Int
$cunsafeRangeSize :: (PieceType, PieceType) -> Int
rangeSize :: (PieceType, PieceType) -> Int
$crangeSize :: (PieceType, PieceType) -> Int
inRange :: (PieceType, PieceType) -> PieceType -> Bool
$cinRange :: (PieceType, PieceType) -> PieceType -> Bool
unsafeIndex :: (PieceType, PieceType) -> PieceType -> Int
$cunsafeIndex :: (PieceType, PieceType) -> PieceType -> Int
index :: (PieceType, PieceType) -> PieceType -> Int
$cindex :: (PieceType, PieceType) -> PieceType -> Int
range :: (PieceType, PieceType) -> [PieceType]
$crange :: (PieceType, PieceType) -> [PieceType]
$cp1Ix :: Ord PieceType
Ix, Eq PieceType
Eq PieceType
-> (PieceType -> PieceType -> Ordering)
-> (PieceType -> PieceType -> Bool)
-> (PieceType -> PieceType -> Bool)
-> (PieceType -> PieceType -> Bool)
-> (PieceType -> PieceType -> Bool)
-> (PieceType -> PieceType -> PieceType)
-> (PieceType -> PieceType -> PieceType)
-> Ord PieceType
PieceType -> PieceType -> Bool
PieceType -> PieceType -> Ordering
PieceType -> PieceType -> PieceType
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 :: PieceType -> PieceType -> PieceType
$cmin :: PieceType -> PieceType -> PieceType
max :: PieceType -> PieceType -> PieceType
$cmax :: PieceType -> PieceType -> PieceType
>= :: PieceType -> PieceType -> Bool
$c>= :: PieceType -> PieceType -> Bool
> :: PieceType -> PieceType -> Bool
$c> :: PieceType -> PieceType -> Bool
<= :: PieceType -> PieceType -> Bool
$c<= :: PieceType -> PieceType -> Bool
< :: PieceType -> PieceType -> Bool
$c< :: PieceType -> PieceType -> Bool
compare :: PieceType -> PieceType -> Ordering
$ccompare :: PieceType -> PieceType -> Ordering
$cp1Ord :: Eq PieceType
Ord, Int -> PieceType -> ShowS
[PieceType] -> ShowS
PieceType -> String
(Int -> PieceType -> ShowS)
-> (PieceType -> String)
-> ([PieceType] -> ShowS)
-> Show PieceType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PieceType] -> ShowS
$cshowList :: [PieceType] -> ShowS
show :: PieceType -> String
$cshow :: PieceType -> String
showsPrec :: Int -> PieceType -> ShowS
$cshowsPrec :: Int -> PieceType -> ShowS
Show)
data Color = Black | White deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq, Ord Color
Ord Color
-> ((Color, Color) -> [Color])
-> ((Color, Color) -> Color -> Int)
-> ((Color, Color) -> Color -> Int)
-> ((Color, Color) -> Color -> Bool)
-> ((Color, Color) -> Int)
-> ((Color, Color) -> Int)
-> Ix Color
(Color, Color) -> Int
(Color, Color) -> [Color]
(Color, Color) -> Color -> Bool
(Color, Color) -> Color -> 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 :: (Color, Color) -> Int
$cunsafeRangeSize :: (Color, Color) -> Int
rangeSize :: (Color, Color) -> Int
$crangeSize :: (Color, Color) -> Int
inRange :: (Color, Color) -> Color -> Bool
$cinRange :: (Color, Color) -> Color -> Bool
unsafeIndex :: (Color, Color) -> Color -> Int
$cunsafeIndex :: (Color, Color) -> Color -> Int
index :: (Color, Color) -> Color -> Int
$cindex :: (Color, Color) -> Color -> Int
range :: (Color, Color) -> [Color]
$crange :: (Color, Color) -> [Color]
$cp1Ix :: Ord Color
Ix, Eq Color
Eq Color
-> (Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
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 :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
$cp1Ord :: Eq Color
Ord, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show)
pieceAt :: IsSquare sq => Position -> sq -> Maybe (Color, PieceType)
pieceAt :: Position -> sq -> Maybe (Color, PieceType)
pieceAt Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb} (sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex -> Int
sq) = case QuadBitboard
qbb QuadBitboard -> Int -> Word4
QBB.! Int
sq of
Word4
QBB.WhitePawn -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
White, PieceType
Pawn)
Word4
QBB.WhiteKnight -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
White, PieceType
Knight)
Word4
QBB.WhiteBishop -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
White, PieceType
Bishop)
Word4
QBB.WhiteRook -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
White, PieceType
Rook)
Word4
QBB.WhiteQueen -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
White, PieceType
Queen)
Word4
QBB.WhiteKing -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
White, PieceType
King)
Word4
QBB.BlackPawn -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
Black, PieceType
Pawn)
Word4
QBB.BlackKnight -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
Black, PieceType
Knight)
Word4
QBB.BlackBishop -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
Black, PieceType
Bishop)
Word4
QBB.BlackRook -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
Black, PieceType
Rook)
Word4
QBB.BlackQueen -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
Black, PieceType
Queen)
Word4
QBB.BlackKing -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
Black, PieceType
King)
Word4
_ -> Maybe (Color, PieceType)
forall a. Maybe a
Nothing
opponent :: Color -> Color
opponent :: Color -> Color
opponent Color
White = Color
Black
opponent Color
Black = Color
White
data Piece = Piece !Color !PieceType deriving (Piece -> Piece -> Bool
(Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> Eq Piece
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Piece -> Piece -> Bool
$c/= :: Piece -> Piece -> Bool
== :: Piece -> Piece -> Bool
$c== :: Piece -> Piece -> Bool
Eq, Int -> Piece -> ShowS
[Piece] -> ShowS
Piece -> String
(Int -> Piece -> ShowS)
-> (Piece -> String) -> ([Piece] -> ShowS) -> Show Piece
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Piece] -> ShowS
$cshowList :: [Piece] -> ShowS
show :: Piece -> String
$cshow :: Piece -> String
showsPrec :: Int -> Piece -> ShowS
$cshowsPrec :: Int -> Piece -> ShowS
Show)
data Position = Position {
Position -> QuadBitboard
qbb :: {-# UNPACK #-} !QuadBitboard
, Position -> Color
color :: !Color
, Position -> Word64
flags :: {-# UNPACK #-} !Word64
, Position -> Int
halfMoveClock :: {-# UNPACK #-} !Int
, Position -> Int
moveNumber :: {-# UNPACK #-} !Int
}
instance Eq Position where
Position
a == :: Position -> Position -> Bool
== Position
b = Position -> QuadBitboard
qbb Position
a QuadBitboard -> QuadBitboard -> Bool
forall a. Eq a => a -> a -> Bool
== Position -> QuadBitboard
qbb Position
b Bool -> Bool -> Bool
&& Position -> Color
color Position
a Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Position -> Color
color Position
b Bool -> Bool -> Bool
&& Position -> Word64
flags Position
a Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Position -> Word64
flags Position
b
repetitions :: [Position] -> Maybe (Int, Position)
repetitions :: [Position] -> Maybe (Int, Position)
repetitions [Position]
p = [(Int, Position)] -> Maybe (Int, Position)
forall a. [a] -> Maybe a
listToMaybe ([(Int, Position)] -> Maybe (Int, Position))
-> ([Position] -> [(Int, Position)])
-> [Position]
-> Maybe (Int, Position)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Position) -> Down Int)
-> [(Int, Position)] -> [(Int, Position)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int -> Down Int
forall a. a -> Down a
Down (Int -> Down Int)
-> ((Int, Position) -> Int) -> (Int, Position) -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Position) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Position)] -> [(Int, Position)])
-> ([Position] -> [(Int, Position)])
-> [Position]
-> [(Int, Position)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> (Int, Position)) -> [Position] -> [(Int, Position)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Position -> (Int, Position)
f ([Position] -> Maybe (Int, Position))
-> [Position] -> Maybe (Int, Position)
forall a b. (a -> b) -> a -> b
$ [Position] -> [Position]
forall a. Eq a => [a] -> [a]
nub [Position]
p where
f :: Position -> (Int, Position)
f Position
x = (Position -> [Position] -> Int
forall a. Eq a => a -> [a] -> Int
count Position
x [Position]
p, Position
x)
count :: a -> [a] -> Int
count a
x = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> ([a] -> [a]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x)
instance Show Position where
show :: Position -> String
show Position
p = Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: Position -> String
toFEN Position
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'"']
insufficientMaterial :: Position -> Bool
insufficientMaterial :: Position -> Bool
insufficientMaterial = QuadBitboard -> Bool
QBB.insufficientMaterial (QuadBitboard -> Bool)
-> (Position -> QuadBitboard) -> Position -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> QuadBitboard
qbb
fromFEN :: String -> Maybe Position
fromFEN :: String -> Maybe Position
fromFEN String
fen
| [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
6
= Maybe Position
forall a. Maybe a
Nothing
| Bool
otherwise =
QuadBitboard -> Color -> Word64 -> Int -> Int -> Position
Position (QuadBitboard -> Color -> Word64 -> Int -> Int -> Position)
-> Maybe QuadBitboard
-> Maybe (Color -> Word64 -> Int -> Int -> Position)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QuadBitboard -> Maybe QuadBitboard
forall a. a -> Maybe a
Just (String -> QuadBitboard
forall a. IsString a => String -> a
fromString ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
0))
Maybe (Color -> Word64 -> Int -> Int -> Position)
-> Maybe Color -> Maybe (Word64 -> Int -> Int -> Position)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Color
forall a. (Eq a, IsString a) => a -> Maybe Color
readColor ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
1)
Maybe (Word64 -> Int -> Int -> Position)
-> Maybe Word64 -> Maybe (Int -> Int -> Position)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Maybe Word64
readFlags ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
2) ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
3)
Maybe (Int -> Int -> Position)
-> Maybe Int -> Maybe (Int -> Position)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
4)
Maybe (Int -> Position) -> Maybe Int -> Maybe Position
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
5)
where
parts :: [String]
parts = String -> [String]
words String
fen
readColor :: a -> Maybe Color
readColor a
"w" = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
White
readColor a
"b" = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
Black
readColor a
_ = Maybe Color
forall a. Maybe a
Nothing
readFlags :: String -> String -> Maybe Word64
readFlags String
cst String
ep = Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.|.) (Word64 -> Word64 -> Word64)
-> Maybe Word64 -> Maybe (Word64 -> Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
readCst String
cst Maybe (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Word64
forall a. (Num a, Bits a) => String -> Maybe a
readEP String
ep where
readCst :: String -> Maybe Word64
readCst String
"-" = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
0
readCst String
x = String -> Maybe Word64
go String
x where
go :: String -> Maybe Word64
go (Char
'K':String
xs) = (Word64
crwKs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.) (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
go String
xs
go (Char
'Q':String
xs) = (Word64
crwQs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.) (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
go String
xs
go (Char
'k':String
xs) = (Word64
crbKs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.) (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
go String
xs
go (Char
'q':String
xs) = (Word64
crbQs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.) (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
go String
xs
go [] = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
0
go String
_ = Maybe Word64
forall a. Maybe a
Nothing
readEP :: String -> Maybe a
readEP String
"-" = a -> Maybe a
forall a. a -> Maybe a
Just a
0
readEP [Char
f,Char
r]
| (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'a',Char
'h') Char
f Bool -> Bool -> Bool
&& (Char
r Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'3' Bool -> Bool -> Bool
|| Char
r Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'6')
= a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a. Bits a => Int -> a
bit ((Char -> Int
ord Char
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'1') Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a'))
readEP String
_ = Maybe a
forall a. Maybe a
Nothing
toFEN :: Position -> String
toFEN :: Position -> String
toFEN Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, Color
color :: Color
color :: Position -> Color
color, Word64
flags :: Word64
flags :: Position -> Word64
flags, Int
halfMoveClock :: Int
halfMoveClock :: Position -> Int
halfMoveClock, Int
moveNumber :: Int
moveNumber :: Position -> Int
moveNumber} = [String] -> String
unwords
[ QuadBitboard -> String
QBB.toString QuadBitboard
qbb
, Color -> String
forall p. IsString p => Color -> p
showColor Color
color
, Word64 -> String
showCst (Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` Word64
epMask)
, Word64 -> String
forall p. IsString p => Word64 -> p
showEP (Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
epMask)
, Int -> String
forall a. Show a => a -> String
show Int
halfMoveClock
, Int -> String
forall a. Show a => a -> String
show Int
moveNumber
]
where
showColor :: Color -> p
showColor Color
White = p
"w"
showColor Color
Black = p
"b"
showCst :: Word64 -> String
showCst Word64
0 = String
"-"
showCst Word64
x = (Word64, String) -> String
forall a b. (a, b) -> b
snd ((Word64, String) -> String)
-> ((Word64, String) -> (Word64, String))
-> (Word64, String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, String) -> (Word64, String)
wks ((Word64, String) -> (Word64, String))
-> ((Word64, String) -> (Word64, String))
-> (Word64, String)
-> (Word64, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, String) -> (Word64, String)
wqs ((Word64, String) -> (Word64, String))
-> ((Word64, String) -> (Word64, String))
-> (Word64, String)
-> (Word64, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, String) -> (Word64, String)
bks ((Word64, String) -> (Word64, String))
-> ((Word64, String) -> (Word64, String))
-> (Word64, String)
-> (Word64, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, String) -> (Word64, String)
bqs ((Word64, String) -> String) -> (Word64, String) -> String
forall a b. (a -> b) -> a -> b
$ (Word64
x, String
"") where
wks :: (Word64, String) -> (Word64, String)
wks (Word64
v, String
xs) | Word64
v Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs = (Word64
v, Char
'K'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
| Bool
otherwise = (Word64
v, String
xs)
wqs :: (Word64, String) -> (Word64, String)
wqs (Word64
v, String
xs) | Word64
v Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs = (Word64
v, Char
'Q'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
| Bool
otherwise = (Word64
v, String
xs)
bks :: (Word64, String) -> (Word64, String)
bks (Word64
v, String
xs) | Word64
v Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs = (Word64
v, Char
'k'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
| Bool
otherwise = (Word64
v, String
xs)
bqs :: (Word64, String) -> (Word64, String)
bqs (Word64
v, String
xs) | Word64
v Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs = (Word64
v, Char
'q'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
| Bool
otherwise = (Word64
v, String
xs)
showEP :: Word64 -> p
showEP Word64
0 = p
"-"
showEP Word64
x = Int -> p
forall sq s. (IsSquare sq, IsString s) => sq -> s
toCoord (Word64 -> Int
bitScanForward Word64
x)
occupiedBy :: Color -> QuadBitboard -> Word64
occupiedBy :: Color -> QuadBitboard -> Word64
occupiedBy Color
White = QuadBitboard -> Word64
QBB.white
occupiedBy Color
Black = QuadBitboard -> Word64
QBB.black
occupied :: QuadBitboard -> Word64
occupied :: QuadBitboard -> Word64
occupied = QuadBitboard -> Word64
QBB.occupied
foldBits :: (a -> Int -> a) -> a -> Word64 -> a
foldBits :: (a -> Int -> a) -> a -> Word64 -> a
foldBits a -> Int -> a
f = a -> Word64 -> a
go where
go :: a -> Word64 -> a
go a
a Word64
0 = a
a
go a
a Word64
n = a -> Word64 -> a
go (a -> Int -> a
f a
a (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word64
n) (Word64 -> a) -> Word64 -> a
forall a b. (a -> b) -> a -> b
$! Word64
n Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64 -> Word64
forall a. Enum a => a -> a
pred Word64
n
bitScanForward, bitScanReverse :: Word64 -> Int
bitScanForward :: Word64 -> Int
bitScanForward = Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros
bitScanReverse :: Word64 -> Int
bitScanReverse = (Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> (Word64 -> Int) -> Word64 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros
newtype Ply = Ply Word16 deriving (Ply -> Ply -> Bool
(Ply -> Ply -> Bool) -> (Ply -> Ply -> Bool) -> Eq Ply
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ply -> Ply -> Bool
$c/= :: Ply -> Ply -> Bool
== :: Ply -> Ply -> Bool
$c== :: Ply -> Ply -> Bool
Eq, Ptr b -> Int -> IO Ply
Ptr b -> Int -> Ply -> IO ()
Ptr Ply -> IO Ply
Ptr Ply -> Int -> IO Ply
Ptr Ply -> Int -> Ply -> IO ()
Ptr Ply -> Ply -> IO ()
Ply -> Int
(Ply -> Int)
-> (Ply -> Int)
-> (Ptr Ply -> Int -> IO Ply)
-> (Ptr Ply -> Int -> Ply -> IO ())
-> (forall b. Ptr b -> Int -> IO Ply)
-> (forall b. Ptr b -> Int -> Ply -> IO ())
-> (Ptr Ply -> IO Ply)
-> (Ptr Ply -> Ply -> IO ())
-> Storable Ply
forall b. Ptr b -> Int -> IO Ply
forall b. Ptr b -> Int -> Ply -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Ply -> Ply -> IO ()
$cpoke :: Ptr Ply -> Ply -> IO ()
peek :: Ptr Ply -> IO Ply
$cpeek :: Ptr Ply -> IO Ply
pokeByteOff :: Ptr b -> Int -> Ply -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Ply -> IO ()
peekByteOff :: Ptr b -> Int -> IO Ply
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Ply
pokeElemOff :: Ptr Ply -> Int -> Ply -> IO ()
$cpokeElemOff :: Ptr Ply -> Int -> Ply -> IO ()
peekElemOff :: Ptr Ply -> Int -> IO Ply
$cpeekElemOff :: Ptr Ply -> Int -> IO Ply
alignment :: Ply -> Int
$calignment :: Ply -> Int
sizeOf :: Ply -> Int
$csizeOf :: Ply -> Int
Storable)
instance Show Ply where
show :: Ply -> String
show = Ply -> String
toUCI
move :: (IsSquare from, IsSquare to) => from -> to -> Ply
move :: from -> to -> Ply
move (from -> Int
forall sq. IsSquare sq => sq -> Int
toIndex -> Int
from) (to -> Int
forall sq. IsSquare sq => sq -> Int
toIndex -> Int
to) =
Word16 -> Ply
Ply (Word16 -> Ply) -> Word16 -> Ply
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
to Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
from Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
6
promoteTo :: Ply -> PieceType -> Ply
promoteTo :: Ply -> PieceType -> Ply
promoteTo (Ply Word16
x) = Word16 -> Ply
Ply (Word16 -> Ply) -> (PieceType -> Word16) -> PieceType -> Ply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceType -> Word16
set where
set :: PieceType -> Word16
set PieceType
Knight = Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xfff Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
0x1000
set PieceType
Bishop = Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xfff Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
0x2000
set PieceType
Rook = Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xfff Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
0x3000
set PieceType
Queen = Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xfff Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
0x4000
set PieceType
_ = Word16
x
plySource, plyTarget :: Ply -> Int
plySource :: Ply -> Int
plySource (Ply Word16
x) = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word16
x Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
6) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0b111111)
plyTarget :: Ply -> Int
plyTarget (Ply Word16
x) = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0b111111)
plyPromotion :: Ply -> Maybe PieceType
plyPromotion :: Ply -> Maybe PieceType
plyPromotion (Ply Word16
x) = case Word16
x Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
12 of
Word16
1 -> PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Knight
Word16
2 -> PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Bishop
Word16
3 -> PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Rook
Word16
4 -> PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Queen
Word16
_ -> Maybe PieceType
forall a. Maybe a
Nothing
unpack :: Ply -> (Int, Int, Maybe PieceType)
unpack :: Ply -> (Int, Int, Maybe PieceType)
unpack (Ply Word16
x) = ( Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word16
x Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
6) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0b111111)
, Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0b111111)
, Maybe PieceType
piece)
where
!piece :: Maybe PieceType
piece = case Word16
x Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
12 of
Word16
1 -> PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Knight
Word16
2 -> PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Bishop
Word16
3 -> PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Rook
Word16
4 -> PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Queen
Word16
_ -> Maybe PieceType
forall a. Maybe a
Nothing
fromPolyglot :: Position -> Ply -> Ply
fromPolyglot :: Position -> Ply -> Ply
fromPolyglot Position
pos pl :: Ply
pl@(Ply -> (Int, Int, Maybe PieceType)
unpack -> (Int
from, Int
to, Maybe PieceType
_)) = case Position -> Color
color Position
pos of
Color
White | Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E1
, Position -> Bool
canCastleKingside Position
pos
, Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
H1
-> Ply
wKscm
| Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E1
, Position -> Bool
canCastleQueenside Position
pos
, Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
A1
-> Ply
wQscm
Color
Black | Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E8
, Position -> Bool
canCastleKingside Position
pos
, Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
H8
-> Ply
bKscm
| Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E8
, Position -> Bool
canCastleQueenside Position
pos
, Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
A8
-> Ply
bQscm
Color
_ -> Ply
pl
toPolyglot :: Position -> Ply -> Ply
toPolyglot :: Position -> Ply -> Ply
toPolyglot Position
pos pl :: Ply
pl@(Ply -> (Int, Int, Maybe PieceType)
unpack -> (Int
from, Int
to, Maybe PieceType
_)) = case Position -> Color
color Position
pos of
Color
White | Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E1
, Position -> Bool
canCastleKingside Position
pos
, Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
G1
-> Int
from Int -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
`move` Sq
H1
| Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E1
, Position -> Bool
canCastleQueenside Position
pos
, Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
C1
-> Int
from Int -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
`move` Sq
A1
Color
Black | Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E8
, Position -> Bool
canCastleKingside Position
pos
, Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
G8
-> Int
from Int -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
`move` Sq
H8
| Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E8
, Position -> Bool
canCastleQueenside Position
pos
, Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
C8
-> Int
from Int -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
`move` Sq
A8
Color
_ -> Ply
pl
fromUCI :: Position -> String -> Maybe Ply
fromUCI :: Position -> String -> Maybe Ply
fromUCI Position
pos ((String -> (String, String))
-> (String, String) -> (String, (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
2) ((String, String) -> (String, (String, String)))
-> (String -> (String, String))
-> String
-> (String, (String, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
2 -> (String
from, (String
to, String
promo)))
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
promo
= Int -> Int -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move (Int -> Int -> Ply) -> Maybe Int -> Maybe (Int -> Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
readCoord String
from Maybe (Int -> Ply) -> Maybe Int -> Maybe Ply
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
readCoord String
to Maybe Ply -> (Ply -> Maybe Ply) -> Maybe Ply
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Position -> Ply -> Maybe Ply
relativeTo Position
pos
| Bool
otherwise
= (\Int
f Int
t PieceType
p -> Int -> Int -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move Int
f Int
t Ply -> PieceType -> Ply
`promoteTo` PieceType
p) (Int -> Int -> PieceType -> Ply)
-> Maybe Int -> Maybe (Int -> PieceType -> Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
readCoord String
from
Maybe (Int -> PieceType -> Ply)
-> Maybe Int -> Maybe (PieceType -> Ply)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
readCoord String
to
Maybe (PieceType -> Ply) -> Maybe PieceType -> Maybe Ply
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe PieceType
forall a. (Eq a, IsString a) => a -> Maybe PieceType
readPromo String
promo
Maybe Ply -> (Ply -> Maybe Ply) -> Maybe Ply
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Position -> Ply -> Maybe Ply
relativeTo Position
pos
where
readCoord :: String -> Maybe Int
readCoord [Char
f,Char
r]
| (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'a',Char
'h') Char
f Bool -> Bool -> Bool
&& (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'1',Char
'8') Char
r
= Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
ord Char
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'1') Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a')
readCoord String
_ = Maybe Int
forall a. Maybe a
Nothing
readPromo :: a -> Maybe PieceType
readPromo a
"q" = PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Queen
readPromo a
"r" = PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Rook
readPromo a
"b" = PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Bishop
readPromo a
"n" = PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Knight
readPromo a
_ = Maybe PieceType
forall a. Maybe a
Nothing
toUCI :: Ply -> String
toUCI :: Ply -> String
toUCI (Ply -> (Int, Int, Maybe PieceType)
unpack -> (Int
from, Int
to, Maybe PieceType
promo)) = Int -> String
forall sq. IsSquare sq => sq -> String
coord Int
from String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall sq. IsSquare sq => sq -> String
coord Int
to String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p where
coord :: sq -> String
coord sq
x = let (Int
r,Int
f) = sq -> (Int, Int)
forall sq. IsSquare sq => sq -> (Int, Int)
toRF sq
x in
Int -> Char
chr (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'a') Char -> ShowS
forall a. a -> [a] -> [a]
: [Int -> Char
chr (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'1')]
p :: String
p = case Maybe PieceType
promo of
Just PieceType
Queen -> String
"q"
Just PieceType
Rook -> String
"r"
Just PieceType
Bishop -> String
"b"
Just PieceType
Knight -> String
"n"
Maybe PieceType
_ -> String
""
relativeTo :: Position -> Ply -> Maybe Ply
relativeTo :: Position -> Ply -> Maybe Ply
relativeTo Position
pos Ply
m | Ply
m Ply -> [Ply] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Position -> [Ply]
legalPlies Position
pos = Ply -> Maybe Ply
forall a. a -> Maybe a
Just Ply
m
| Bool
otherwise = Maybe Ply
forall a. Maybe a
Nothing
shiftN, shiftNNE, shiftNE, shiftENE, shiftE, shiftESE, shiftSE, shiftSSE, shiftS, shiftSSW, shiftSW, shiftWSW, shiftW, shiftWNW, shiftNW, shiftNNW :: Word64 -> Word64
shiftN :: Word64 -> Word64
shiftN Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8
shiftNNE :: Word64 -> Word64
shiftNNE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
17 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftNE :: Word64 -> Word64
shiftNE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
9 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftENE :: Word64 -> Word64
shiftENE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
10 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notABFile
shiftE :: Word64 -> Word64
shiftE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftESE :: Word64 -> Word64
shiftESE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
6 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notABFile
shiftSE :: Word64 -> Word64
shiftSE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
7 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftSSE :: Word64 -> Word64
shiftSSE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
15 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftS :: Word64 -> Word64
shiftS Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8
shiftSSW :: Word64 -> Word64
shiftSSW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
17 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftSW :: Word64 -> Word64
shiftSW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
9 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftWSW :: Word64 -> Word64
shiftWSW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
10 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notGHFile
shiftW :: Word64 -> Word64
shiftW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftWNW :: Word64 -> Word64
shiftWNW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
6 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notGHFile
shiftNW :: Word64 -> Word64
shiftNW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
7 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftNNW :: Word64 -> Word64
shiftNNW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
15 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile
doPly :: Position -> Ply -> Position
doPly :: Position -> Ply -> Position
doPly Position
p Ply
m
| Ply
m Ply -> [Ply] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Position -> [Ply]
legalPlies Position
p = Position -> Ply -> Position
unsafeDoPly Position
p Ply
m
| Bool
otherwise = String -> Position
forall a. HasCallStack => String -> a
error String
"Game.Chess.doPly: Illegal move"
unsafeDoPly :: Position -> Ply -> Position
unsafeDoPly :: Position -> Ply -> Position
unsafeDoPly pos :: Position
pos@Position{color :: Position -> Color
color = Color
White, Int
halfMoveClock :: Int
halfMoveClock :: Position -> Int
halfMoveClock} Ply
m =
(Position -> Ply -> Position
unsafeDoPly' Position
pos Ply
m) { color :: Color
color = Color
Black, halfMoveClock :: Int
halfMoveClock = Int -> Int
forall a. Enum a => a -> a
succ Int
halfMoveClock }
unsafeDoPly pos :: Position
pos@Position{color :: Position -> Color
color = Color
Black, Int
moveNumber :: Int
moveNumber :: Position -> Int
moveNumber, Int
halfMoveClock :: Int
halfMoveClock :: Position -> Int
halfMoveClock} Ply
m =
(Position -> Ply -> Position
unsafeDoPly' Position
pos Ply
m) { color :: Color
color = Color
White, moveNumber :: Int
moveNumber = Int -> Int
forall a. Enum a => a -> a
succ Int
moveNumber, halfMoveClock :: Int
halfMoveClock = Int -> Int
forall a. Enum a => a -> a
succ Int
halfMoveClock }
unsafeDoPly' :: Position -> Ply -> Position
unsafeDoPly' :: Position -> Ply -> Position
unsafeDoPly' pos :: Position
pos@Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, Word64
flags :: Word64
flags :: Position -> Word64
flags} m :: Ply
m@(Ply -> (Int, Int, Maybe PieceType)
unpack -> (Int
from, Int
to, Maybe PieceType
promo))
| Ply
m Ply -> Ply -> Bool
forall a. Eq a => a -> a -> Bool
== Ply
wKscm Bool -> Bool -> Bool
&& Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs
= Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> QuadBitboard
QBB.whiteKingsideCastle
, flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
rank1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
epMask)
}
| Ply
m Ply -> Ply -> Bool
forall a. Eq a => a -> a -> Bool
== Ply
wQscm Bool -> Bool -> Bool
&& Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs
= Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> QuadBitboard
QBB.whiteQueensideCastle
, flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
rank1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
epMask)
}
| Ply
m Ply -> Ply -> Bool
forall a. Eq a => a -> a -> Bool
== Ply
bKscm Bool -> Bool -> Bool
&& Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs
= Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> QuadBitboard
QBB.blackKingsideCastle
, flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
rank8 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
epMask)
}
| Ply
m Ply -> Ply -> Bool
forall a. Eq a => a -> a -> Bool
== Ply
bQscm Bool -> Bool -> Bool
&& Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs
= Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> QuadBitboard
QBB.blackQueensideCastle
, flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
rank8 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
epMask)
}
| Just PieceType
piece <- Maybe PieceType
promo
= case Position -> Color
color Position
pos of
Color
White -> case PieceType
piece of
PieceType
Queen -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.whitePromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.WhiteQueen
, flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
}
PieceType
Rook -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.whitePromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.WhiteRook
, flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
}
PieceType
Bishop -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.whitePromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.WhiteBishop
, flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
}
PieceType
Knight -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.whitePromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.WhiteKnight
, flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
}
PieceType
_ -> String -> Position
forall a. HasCallStack => String -> a
error String
"Impossible: White tried to promote to Pawn"
Color
Black -> case PieceType
piece of
PieceType
Queen -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.blackPromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.BlackQueen
, flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
}
PieceType
Rook -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.blackPromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.BlackRook
, flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
}
PieceType
Bishop -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.blackPromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.BlackBishop
, flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
}
PieceType
Knight -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.blackPromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.BlackKnight
, flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
}
PieceType
_ -> String -> Position
forall a. HasCallStack => String -> a
error String
"Impossible: Black tried to promote to Pawn"
| QuadBitboard -> Word64
QBB.pawns QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
fromMask Bool -> Bool -> Bool
&&
Word64
toMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (Word64
rank3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
rank6) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
flags Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0
= Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> QuadBitboard
QBB.enPassant Int
from Int
to
, flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` Word64
toMask
}
| Bool
otherwise
= Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> QuadBitboard
QBB.move QuadBitboard
qbb Int
from Int
to
, flags :: Word64
flags = (Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
mask)) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
dpp
}
where
!fromMask :: Word64
fromMask = Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
from
!toMask :: Word64
toMask = Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
to
!mask :: Word64
mask = Word64
fromMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
toMask
dpp :: Word64
dpp = case Position -> Color
color Position
pos of
Color
White | Word64
fromMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
rank2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wPawns QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 Bool -> Bool -> Bool
&& Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
to -> Word64 -> Word64
shiftN Word64
fromMask
Color
Black | Word64
fromMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
rank7 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bPawns QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 Bool -> Bool -> Bool
&& Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
to -> Word64 -> Word64
shiftS Word64
fromMask
Color
_ -> Word64
0
legalPlies :: Position -> [Ply]
legalPlies :: Position -> [Ply]
legalPlies pos :: Position
pos@Position{Color
color :: Color
color :: Position -> Color
color, QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, Word64
flags :: Word64
flags :: Position -> Word64
flags} = (Ply -> Bool) -> [Ply] -> [Ply]
forall a. (a -> Bool) -> [a] -> [a]
filter Ply -> Bool
legalPly ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall a b. (a -> b) -> a -> b
$
[Ply] -> [Ply]
kingMoves
([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
knightMoves
([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceType -> Position -> Word64 -> Word64 -> [Ply] -> [Ply]
slideMoves PieceType
Queen Position
pos Word64
notOurs Word64
occ
([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceType -> Position -> Word64 -> Word64 -> [Ply] -> [Ply]
slideMoves PieceType
Rook Position
pos Word64
notOurs Word64
occ
([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceType -> Position -> Word64 -> Word64 -> [Ply] -> [Ply]
slideMoves PieceType
Bishop Position
pos Word64
notOurs Word64
occ
([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
pawnMoves
([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall a b. (a -> b) -> a -> b
$ []
where
legalPly :: Ply -> Bool
legalPly = Bool -> Bool
not (Bool -> Bool) -> (Ply -> Bool) -> Ply -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Position -> Bool
inCheck Color
color (Position -> Bool) -> (Ply -> Position) -> Ply -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Ply -> Position
unsafeDoPly' Position
pos
!ours :: Word64
ours = Color -> QuadBitboard -> Word64
occupiedBy Color
color QuadBitboard
qbb
!them :: Word64
them = Color -> QuadBitboard -> Word64
occupiedBy (Color -> Color
opponent Color
color) QuadBitboard
qbb
!notOurs :: Word64
notOurs = Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
ours
!occ :: Word64
occ = Word64
ours Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
them
(![Ply] -> [Ply]
pawnMoves, ![Ply] -> [Ply]
knightMoves, ![Ply] -> [Ply]
kingMoves) = case Color
color of
Color
White ->
( Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
wPawnMoves (QuadBitboard -> Word64
QBB.wPawns QuadBitboard
qbb) (Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
occ) (Word64
them Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
epMask))
, ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits [Ply] -> Int -> [Ply]
genNMoves) (QuadBitboard -> Word64
QBB.wKnights QuadBitboard
qbb)
, ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits [Ply] -> Int -> [Ply]
genKMoves) (QuadBitboard -> Word64
QBB.wKings QuadBitboard
qbb) ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
wShort ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
wLong)
Color
Black ->
( Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
bPawnMoves (QuadBitboard -> Word64
QBB.bPawns QuadBitboard
qbb) (Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
occ) (Word64
them Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
epMask))
, ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits [Ply] -> Int -> [Ply]
genNMoves) (QuadBitboard -> Word64
QBB.bKnights QuadBitboard
qbb)
, ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits [Ply] -> Int -> [Ply]
genKMoves) (QuadBitboard -> Word64
QBB.bKings QuadBitboard
qbb) ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
bShort ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
bLong)
genNMoves :: [Ply] -> Int -> [Ply]
genNMoves [Ply]
ms Int
sq = ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (Int -> [Ply] -> Int -> [Ply]
forall from to.
(IsSquare from, IsSquare to) =>
from -> [Ply] -> to -> [Ply]
mkM Int
sq) [Ply]
ms ((Vector Word64
knightAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOurs)
genKMoves :: [Ply] -> Int -> [Ply]
genKMoves [Ply]
ms Int
sq = ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (Int -> [Ply] -> Int -> [Ply]
forall from to.
(IsSquare from, IsSquare to) =>
from -> [Ply] -> to -> [Ply]
mkM Int
sq) [Ply]
ms ((Vector Word64
kingAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOurs)
wShort :: [Ply] -> [Ply]
wShort [Ply]
ml | Position -> Word64 -> Bool
canCastleKingside' Position
pos Word64
occ = Ply
wKscm Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ml
| Bool
otherwise = [Ply]
ml
wLong :: [Ply] -> [Ply]
wLong [Ply]
ml | Position -> Word64 -> Bool
canCastleQueenside' Position
pos Word64
occ = Ply
wQscm Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ml
| Bool
otherwise = [Ply]
ml
bShort :: [Ply] -> [Ply]
bShort [Ply]
ml | Position -> Word64 -> Bool
canCastleKingside' Position
pos Word64
occ = Ply
bKscm Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ml
| Bool
otherwise = [Ply]
ml
bLong :: [Ply] -> [Ply]
bLong [Ply]
ml | Position -> Word64 -> Bool
canCastleQueenside' Position
pos Word64
occ = Ply
bQscm Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ml
| Bool
otherwise = [Ply]
ml
mkM :: from -> [Ply] -> to -> [Ply]
mkM !from
from [Ply]
ms !to
to = from -> to -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move from
from to
to Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ms
inCheck :: Color -> Position -> Bool
inCheck :: Color -> Position -> Bool
inCheck Color
White Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb} =
Color -> QuadBitboard -> Word64 -> Int -> Bool
forall sq.
IsSquare sq =>
Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
Black QuadBitboard
qbb (QuadBitboard -> Word64
occupied QuadBitboard
qbb) (Word64 -> Int
bitScanForward (QuadBitboard -> Word64
QBB.wKings QuadBitboard
qbb))
inCheck Color
Black Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb} =
Color -> QuadBitboard -> Word64 -> Int -> Bool
forall sq.
IsSquare sq =>
Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
White QuadBitboard
qbb (QuadBitboard -> Word64
occupied QuadBitboard
qbb) (Word64 -> Int
bitScanForward (QuadBitboard -> Word64
QBB.bKings QuadBitboard
qbb))
wPawnMoves :: Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
wPawnMoves :: Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
wPawnMoves !Word64
pawns !Word64
emptySquares !Word64
opponentPieces =
([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
9) Word64
eastCaptureTargets
([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
7) Word64
westCaptureTargets
([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
8) Word64
singlePushTargets
([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
16) Word64
doublePushTargets
where
doublePushTargets :: Word64
doublePushTargets = Word64 -> Word64
shiftN Word64
singlePushTargets Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
emptySquares Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
rank4
singlePushTargets :: Word64
singlePushTargets = Word64 -> Word64
shiftN Word64
pawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
emptySquares
eastCaptureTargets :: Word64
eastCaptureTargets = Word64 -> Word64
shiftNE Word64
pawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
opponentPieces
westCaptureTargets :: Word64
westCaptureTargets = Word64 -> Word64
shiftNW Word64
pawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
opponentPieces
mkPly :: a -> [Ply] -> a -> [Ply]
mkPly a
diff [Ply]
ms a
tsq
| a
tsq a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
56 = (Ply -> PieceType -> Ply
promoteTo Ply
m (PieceType -> Ply) -> [PieceType] -> [Ply]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PieceType
Queen, PieceType
Rook, PieceType
Bishop, PieceType
Knight]) [Ply] -> [Ply] -> [Ply]
forall a. Semigroup a => a -> a -> a
<> [Ply]
ms
| Bool
otherwise = Ply
m Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ms
where m :: Ply
m = a -> a -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move (a
tsq a -> a -> a
forall a. Num a => a -> a -> a
- a
diff) a
tsq
bPawnMoves :: Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
bPawnMoves :: Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
bPawnMoves !Word64
pawns !Word64
emptySquares !Word64
opponentPieces =
([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
9) Word64
westCaptureTargets
([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
7) Word64
eastCaptureTargets
([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
8) Word64
singlePushTargets
([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
16) Word64
doublePushTargets
where
doublePushTargets :: Word64
doublePushTargets = Word64 -> Word64
shiftS Word64
singlePushTargets Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
emptySquares Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
rank5
singlePushTargets :: Word64
singlePushTargets = Word64 -> Word64
shiftS Word64
pawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
emptySquares
eastCaptureTargets :: Word64
eastCaptureTargets = Word64 -> Word64
shiftSE Word64
pawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
opponentPieces
westCaptureTargets :: Word64
westCaptureTargets = Word64 -> Word64
shiftSW Word64
pawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
opponentPieces
mkPly :: a -> [Ply] -> a -> [Ply]
mkPly a
diff [Ply]
ms a
tsq
| a
tsq a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
7 = (Ply -> PieceType -> Ply
promoteTo Ply
m (PieceType -> Ply) -> [PieceType] -> [Ply]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PieceType
Queen, PieceType
Rook, PieceType
Bishop, PieceType
Knight]) [Ply] -> [Ply] -> [Ply]
forall a. Semigroup a => a -> a -> a
<> [Ply]
ms
| Bool
otherwise = Ply
m Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ms
where m :: Ply
m = a -> a -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move (a
tsq a -> a -> a
forall a. Num a => a -> a -> a
+ a
diff) a
tsq
slideMoves :: PieceType -> Position -> Word64 -> Word64 -> [Ply] -> [Ply]
slideMoves :: PieceType -> Position -> Word64 -> Word64 -> [Ply] -> [Ply]
slideMoves PieceType
piece (Position QuadBitboard
bb Color
c Word64
_ Int
_ Int
_) !Word64
notOurs !Word64
occ =
([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits [Ply] -> Int -> [Ply]
gen) Word64
pieces
where
gen :: [Ply] -> Int -> [Ply]
gen [Ply]
ms Int
from = ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (Int -> [Ply] -> Int -> [Ply]
forall from to.
(IsSquare from, IsSquare to) =>
from -> [Ply] -> to -> [Ply]
mkPly Int
from) [Ply]
ms (Int -> Word64
targets Int
from)
mkPly :: from -> [Ply] -> to -> [Ply]
mkPly from
from [Ply]
ms to
to = from -> to -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move from
from to
to Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ms
targets :: Int -> Word64
targets Int
sq = case PieceType
piece of
PieceType
Rook -> Int -> Word64 -> Word64
rookTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOurs
PieceType
Bishop -> Int -> Word64 -> Word64
bishopTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOurs
PieceType
Queen -> Int -> Word64 -> Word64
queenTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOurs
PieceType
_ -> String -> Word64
forall a. HasCallStack => String -> a
error String
"Not a sliding piece"
pieces :: Word64
pieces = case (Color
c, PieceType
piece) of
(Color
White, PieceType
Bishop) -> QuadBitboard -> Word64
QBB.wBishops QuadBitboard
bb
(Color
Black, PieceType
Bishop) -> QuadBitboard -> Word64
QBB.bBishops QuadBitboard
bb
(Color
White, PieceType
Rook) -> QuadBitboard -> Word64
QBB.wRooks QuadBitboard
bb
(Color
Black, PieceType
Rook) -> QuadBitboard -> Word64
QBB.bRooks QuadBitboard
bb
(Color
White, PieceType
Queen) -> QuadBitboard -> Word64
QBB.wQueens QuadBitboard
bb
(Color
Black, PieceType
Queen) -> QuadBitboard -> Word64
QBB.bQueens QuadBitboard
bb
(Color, PieceType)
_ -> Word64
0
data Castle = Kingside | Queenside deriving (Castle -> Castle -> Bool
(Castle -> Castle -> Bool)
-> (Castle -> Castle -> Bool) -> Eq Castle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Castle -> Castle -> Bool
$c/= :: Castle -> Castle -> Bool
== :: Castle -> Castle -> Bool
$c== :: Castle -> Castle -> Bool
Eq, Ord Castle
Ord Castle
-> ((Castle, Castle) -> [Castle])
-> ((Castle, Castle) -> Castle -> Int)
-> ((Castle, Castle) -> Castle -> Int)
-> ((Castle, Castle) -> Castle -> Bool)
-> ((Castle, Castle) -> Int)
-> ((Castle, Castle) -> Int)
-> Ix Castle
(Castle, Castle) -> Int
(Castle, Castle) -> [Castle]
(Castle, Castle) -> Castle -> Bool
(Castle, Castle) -> Castle -> 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 :: (Castle, Castle) -> Int
$cunsafeRangeSize :: (Castle, Castle) -> Int
rangeSize :: (Castle, Castle) -> Int
$crangeSize :: (Castle, Castle) -> Int
inRange :: (Castle, Castle) -> Castle -> Bool
$cinRange :: (Castle, Castle) -> Castle -> Bool
unsafeIndex :: (Castle, Castle) -> Castle -> Int
$cunsafeIndex :: (Castle, Castle) -> Castle -> Int
index :: (Castle, Castle) -> Castle -> Int
$cindex :: (Castle, Castle) -> Castle -> Int
range :: (Castle, Castle) -> [Castle]
$crange :: (Castle, Castle) -> [Castle]
$cp1Ix :: Ord Castle
Ix, Eq Castle
Eq Castle
-> (Castle -> Castle -> Ordering)
-> (Castle -> Castle -> Bool)
-> (Castle -> Castle -> Bool)
-> (Castle -> Castle -> Bool)
-> (Castle -> Castle -> Bool)
-> (Castle -> Castle -> Castle)
-> (Castle -> Castle -> Castle)
-> Ord Castle
Castle -> Castle -> Bool
Castle -> Castle -> Ordering
Castle -> Castle -> Castle
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 :: Castle -> Castle -> Castle
$cmin :: Castle -> Castle -> Castle
max :: Castle -> Castle -> Castle
$cmax :: Castle -> Castle -> Castle
>= :: Castle -> Castle -> Bool
$c>= :: Castle -> Castle -> Bool
> :: Castle -> Castle -> Bool
$c> :: Castle -> Castle -> Bool
<= :: Castle -> Castle -> Bool
$c<= :: Castle -> Castle -> Bool
< :: Castle -> Castle -> Bool
$c< :: Castle -> Castle -> Bool
compare :: Castle -> Castle -> Ordering
$ccompare :: Castle -> Castle -> Ordering
$cp1Ord :: Eq Castle
Ord, Int -> Castle -> ShowS
[Castle] -> ShowS
Castle -> String
(Int -> Castle -> ShowS)
-> (Castle -> String) -> ([Castle] -> ShowS) -> Show Castle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Castle] -> ShowS
$cshowList :: [Castle] -> ShowS
show :: Castle -> String
$cshow :: Castle -> String
showsPrec :: Int -> Castle -> ShowS
$cshowsPrec :: Int -> Castle -> ShowS
Show)
castlingRights :: Position -> [(Color, Castle)]
castlingRights :: Position -> [(Color, Castle)]
castlingRights Position{Word64
flags :: Word64
flags :: Position -> Word64
flags} = [(Color, Castle)] -> [(Color, Castle)]
wks ([(Color, Castle)] -> [(Color, Castle)])
-> ([(Color, Castle)] -> [(Color, Castle)])
-> [(Color, Castle)]
-> [(Color, Castle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Color, Castle)] -> [(Color, Castle)]
wqs ([(Color, Castle)] -> [(Color, Castle)])
-> ([(Color, Castle)] -> [(Color, Castle)])
-> [(Color, Castle)]
-> [(Color, Castle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Color, Castle)] -> [(Color, Castle)]
bks ([(Color, Castle)] -> [(Color, Castle)])
-> ([(Color, Castle)] -> [(Color, Castle)])
-> [(Color, Castle)]
-> [(Color, Castle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Color, Castle)] -> [(Color, Castle)]
bqs ([(Color, Castle)] -> [(Color, Castle)])
-> [(Color, Castle)] -> [(Color, Castle)]
forall a b. (a -> b) -> a -> b
$ [] where
wks :: [(Color, Castle)] -> [(Color, Castle)]
wks [(Color, Castle)]
xs | Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs = (Color
White, Castle
Kingside)(Color, Castle) -> [(Color, Castle)] -> [(Color, Castle)]
forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
| Bool
otherwise = [(Color, Castle)]
xs
wqs :: [(Color, Castle)] -> [(Color, Castle)]
wqs [(Color, Castle)]
xs | Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs = (Color
White, Castle
Queenside)(Color, Castle) -> [(Color, Castle)] -> [(Color, Castle)]
forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
| Bool
otherwise = [(Color, Castle)]
xs
bks :: [(Color, Castle)] -> [(Color, Castle)]
bks [(Color, Castle)]
xs | Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs = (Color
Black, Castle
Kingside)(Color, Castle) -> [(Color, Castle)] -> [(Color, Castle)]
forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
| Bool
otherwise = [(Color, Castle)]
xs
bqs :: [(Color, Castle)] -> [(Color, Castle)]
bqs [(Color, Castle)]
xs | Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs = (Color
Black, Castle
Queenside)(Color, Castle) -> [(Color, Castle)] -> [(Color, Castle)]
forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
| Bool
otherwise = [(Color, Castle)]
xs
enPassantSquare :: Position -> Maybe Sq
enPassantSquare :: Position -> Maybe Sq
enPassantSquare Position{Word64
flags :: Word64
flags :: Position -> Word64
flags} = case Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
epMask of
Word64
0 -> Maybe Sq
forall a. Maybe a
Nothing
Word64
x -> Sq -> Maybe Sq
forall a. a -> Maybe a
Just (Sq -> Maybe Sq) -> Sq -> Maybe Sq
forall a b. (a -> b) -> a -> b
$ Int -> Sq
forall a. Enum a => Int -> a
toEnum (Int -> Sq) -> Int -> Sq
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
bitScanForward Word64
x
canCastleKingside, canCastleQueenside :: Position -> Bool
canCastleKingside :: Position -> Bool
canCastleKingside pos :: Position
pos@Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb} = Position -> Word64 -> Bool
canCastleKingside' Position
pos (QuadBitboard -> Word64
occupied QuadBitboard
qbb)
canCastleQueenside :: Position -> Bool
canCastleQueenside pos :: Position
pos@Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb} = Position -> Word64 -> Bool
canCastleQueenside' Position
pos (QuadBitboard -> Word64
occupied QuadBitboard
qbb)
canCastleKingside', canCastleQueenside' :: Position -> Word64 -> Bool
canCastleKingside' :: Position -> Word64 -> Bool
canCastleKingside' Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, color :: Position -> Color
color = Color
White, Word64
flags :: Word64
flags :: Position -> Word64
flags} !Word64
occ =
Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs Bool -> Bool -> Bool
&& Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
crwKe Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
Bool -> Bool
not ((Sq -> Bool) -> [Sq] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Word64 -> Sq -> Bool
forall sq.
IsSquare sq =>
Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
Black QuadBitboard
qbb Word64
occ) [Sq
E1, Sq
F1, Sq
G1])
canCastleKingside' Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, color :: Position -> Color
color = Color
Black, Word64
flags :: Word64
flags :: Position -> Word64
flags} !Word64
occ =
Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs Bool -> Bool -> Bool
&& Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
crbKe Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
Bool -> Bool
not ((Sq -> Bool) -> [Sq] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Word64 -> Sq -> Bool
forall sq.
IsSquare sq =>
Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
White QuadBitboard
qbb Word64
occ) [Sq
E8, Sq
F8, Sq
G8])
canCastleQueenside' :: Position -> Word64 -> Bool
canCastleQueenside' Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, color :: Position -> Color
color = Color
White, Word64
flags :: Word64
flags :: Position -> Word64
flags} !Word64
occ =
Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs Bool -> Bool -> Bool
&& Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
crwQe Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
Bool -> Bool
not ((Sq -> Bool) -> [Sq] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Word64 -> Sq -> Bool
forall sq.
IsSquare sq =>
Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
Black QuadBitboard
qbb Word64
occ) [Sq
E1, Sq
D1, Sq
C1])
canCastleQueenside' Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, color :: Position -> Color
color = Color
Black, Word64
flags :: Word64
flags :: Position -> Word64
flags} !Word64
occ =
Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs Bool -> Bool -> Bool
&& Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
crbQe Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
Bool -> Bool
not ((Sq -> Bool) -> [Sq] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Word64 -> Sq -> Bool
forall sq.
IsSquare sq =>
Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
White QuadBitboard
qbb Word64
occ) [Sq
E8, Sq
D8, Sq
C8])
wKscm, wQscm, bKscm, bQscm :: Ply
wKscm :: Ply
wKscm = Sq -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move Sq
E1 Sq
G1
wQscm :: Ply
wQscm = Sq -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move Sq
E1 Sq
C1
bKscm :: Ply
bKscm = Sq -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move Sq
E8 Sq
G8
bQscm :: Ply
bQscm = Sq -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move Sq
E8 Sq
C8
attackedBy :: IsSquare sq => Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy :: Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
White QuadBitboard
qbb !Word64
occ (sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex -> Int
sq)
| (Vector Word64
wPawnAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wPawns QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
| (Vector Word64
knightAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wKnights QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
| Int -> Word64 -> Word64
bishopTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wBishops QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
| Int -> Word64 -> Word64
rookTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wRooks QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
| Int -> Word64 -> Word64
queenTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wQueens QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
| (Vector Word64
kingAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wKings QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
| Bool
otherwise = Bool
False
attackedBy Color
Black QuadBitboard
qbb !Word64
occ (sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex -> Int
sq)
| (Vector Word64
bPawnAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bPawns QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
| (Vector Word64
knightAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bKnights QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
| Int -> Word64 -> Word64
bishopTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bBishops QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
| Int -> Word64 -> Word64
rookTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bRooks QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
| Int -> Word64 -> Word64
queenTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bQueens QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
| (Vector Word64
kingAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bKings QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
| Bool
otherwise = Bool
False
notAFile, notABFile, notGHFile, notHFile, rank1, rank2, rank3, rank4, rank5, rank6, rank7, rank8 :: Word64
notAFile :: Word64
notAFile = Word64
0xfefefefefefefefe
notABFile :: Word64
notABFile = Word64
0xfcfcfcfcfcfcfcfc
notGHFile :: Word64
notGHFile = Word64
0x3f3f3f3f3f3f3f3f
notHFile :: Word64
notHFile = Word64
0x7f7f7f7f7f7f7f7f
rank1 :: Word64
rank1 = Word64
0x00000000000000ff
rank2 :: Word64
rank2 = Word64
0x000000000000ff00
rank3 :: Word64
rank3 = Word64
0x0000000000ff0000
rank4 :: Word64
rank4 = Word64
0x00000000ff000000
rank5 :: Word64
rank5 = Word64
0x000000ff00000000
rank6 :: Word64
rank6 = Word64
0x0000ff0000000000
rank7 :: Word64
rank7 = Word64
0x00ff000000000000
rank8 :: Word64
rank8 = Word64
0xff00000000000000
epMask, crwKs, crwQs, crwKe, crwQe, crbKs, crbQs, crbKe, crbQe :: Word64
epMask :: Word64
epMask = Word64
rank3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
rank6
crwKs :: Word64
crwKs = Word64
0x0000000000000090
crwQs :: Word64
crwQs = Word64
0x0000000000000011
crwKe :: Word64
crwKe = Word64
0x0000000000000060
crwQe :: Word64
crwQe = Word64
0x000000000000000e
crbKs :: Word64
crbKs = Word64
0x9000000000000000
crbQs :: Word64
crbQs = Word64
0x1100000000000000
crbKe :: Word64
crbKe = Word64
0x6000000000000000
crbQe :: Word64
crbQe = Word64
0x0e00000000000000
kingAttacks, knightAttacks, wPawnAttacks, bPawnAttacks :: Vector Word64
kingAttacks :: Vector Word64
kingAttacks = Int -> (Int -> Word64) -> Vector Word64
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Word64) -> Vector Word64)
-> (Int -> Word64) -> Vector Word64
forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Word64
b = Int -> Word64
forall a. Bits a => Int -> a
bit Int
sq in
Word64 -> Word64
shiftN Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftNE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftSE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
Word64 -> Word64
shiftS Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftSW Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftW Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftNW Word64
b
knightAttacks :: Vector Word64
knightAttacks = Int -> (Int -> Word64) -> Vector Word64
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Word64) -> Vector Word64)
-> (Int -> Word64) -> Vector Word64
forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Word64
b = Int -> Word64
forall a. Bits a => Int -> a
bit Int
sq in
Word64 -> Word64
shiftNNE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftENE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
Word64 -> Word64
shiftESE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftSSE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
Word64 -> Word64
shiftSSW Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftWSW Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
Word64 -> Word64
shiftWNW Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftNNW Word64
b
wPawnAttacks :: Vector Word64
wPawnAttacks = Int -> (Int -> Word64) -> Vector Word64
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Word64) -> Vector Word64)
-> (Int -> Word64) -> Vector Word64
forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Word64
b = Int -> Word64
forall a. Bits a => Int -> a
bit Int
sq in
Word64 -> Word64
shiftSE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftSW Word64
b
bPawnAttacks :: Vector Word64
bPawnAttacks = Int -> (Int -> Word64) -> Vector Word64
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Word64) -> Vector Word64)
-> (Int -> Word64) -> Vector Word64
forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Word64
b = Int -> Word64
forall a. Bits a => Int -> a
bit Int
sq in
Word64 -> Word64
shiftNE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftNW Word64
b
data Direction = N | NE | E | SE | S | SW | W | NW deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show)
rookTargets, bishopTargets, queenTargets :: Int -> Word64 -> Word64
rookTargets :: Int -> Word64 -> Word64
rookTargets !Int
sq !Word64
occ = Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
N Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
E Word64
occ
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
S Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
W Word64
occ
bishopTargets :: Int -> Word64 -> Word64
bishopTargets !Int
sq !Word64
occ = Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
NW Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
NE Word64
occ
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
SE Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
SW Word64
occ
queenTargets :: Int -> Word64 -> Word64
queenTargets Int
sq Word64
occ = Int -> Word64 -> Word64
rookTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64 -> Word64
bishopTargets Int
sq Word64
occ
getRayTargets :: Int -> Direction -> Word64 -> Word64
getRayTargets :: Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
dir Word64
occ = Word64 -> Word64
blocked (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ Word64
attacks Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
occ where
blocked :: Word64 -> Word64
blocked Word64
0 = Word64
attacks
blocked Word64
bb = Word64
attacks Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` (Vector Word64
ray Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Word64 -> Int
bitScan Word64
bb)
attacks :: Word64
attacks = Vector Word64
ray Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq
(Word64 -> Int
bitScan, Vector Word64
ray) = case Direction
dir of
Direction
NW -> (Word64 -> Int
bitScanForward, Vector Word64
attackNW)
Direction
N -> (Word64 -> Int
bitScanForward, Vector Word64
attackN)
Direction
NE -> (Word64 -> Int
bitScanForward, Vector Word64
attackNE)
Direction
E -> (Word64 -> Int
bitScanForward, Vector Word64
attackE)
Direction
SE -> (Word64 -> Int
bitScanReverse, Vector Word64
attackSE)
Direction
S -> (Word64 -> Int
bitScanReverse, Vector Word64
attackS)
Direction
SW -> (Word64 -> Int
bitScanReverse, Vector Word64
attackSW)
Direction
W -> (Word64 -> Int
bitScanReverse, Vector Word64
attackW)
attackDir :: (Word64 -> Word64) -> Vector Word64
attackDir :: (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
s = Int -> (Int -> Word64) -> Vector Word64
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Word64) -> Vector Word64)
-> (Int -> Word64) -> Vector Word64
forall a b. (a -> b) -> a -> b
$ \Int
sq ->
(Word64 -> Word64 -> Word64) -> Word64 -> [Word64] -> Word64
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.|.) Word64
0 ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
7 ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ [Word64] -> [Word64]
forall a. [a] -> [a]
tail ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ (Word64 -> Word64) -> Word64 -> [Word64]
forall a. (a -> a) -> a -> [a]
iterate Word64 -> Word64
s (Int -> Word64
forall a. Bits a => Int -> a
bit Int
sq)
attackNW, attackN, attackNE, attackE, attackSE, attackS, attackSW, attackW :: Vector Word64
attackNW :: Vector Word64
attackNW = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftNW
attackN :: Vector Word64
attackN = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftN
attackNE :: Vector Word64
attackNE = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftNE
attackE :: Vector Word64
attackE = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftE
attackSE :: Vector Word64
attackSE = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftSE
attackS :: Vector Word64
attackS = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftS
attackSW :: Vector Word64
attackSW = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftSW
attackW :: Vector Word64
attackW = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftW
clearMask :: Bits a => a -> a -> a
clearMask :: a -> a -> a
clearMask a
a a
b = a
a a -> a -> a
forall a. Bits a => a -> a -> a
.&. a -> a
forall a. Bits a => a -> a
complement a
b
testMask :: Bits a => a -> a -> Bool
testMask :: a -> a -> Bool
testMask a
a a
b = a
a a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b
{-# INLINE clearMask #-}
{-# INLINE testMask #-}
{-# INLINE attackedBy #-}
{-# INLINE slideMoves #-}
{-# INLINE wPawnMoves #-}
{-# INLINE bPawnMoves #-}
{-# INLINE unpack #-}
{-# INLINE foldBits #-}
{-# INLINE bitScanForward #-}
{-# INLINE bitScanReverse #-}