{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE BinaryLiterals             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveLift                 #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE ViewPatterns               #-}
{-|
Module      : Game.Chess
Description : Basic data types and functions related to the game of chess
Copyright   : (c) Mario Lang, 2020
License     : BSD3
Maintainer  : mlang@blind.guru
Stability   : experimental

A small collection of data types and functions to represent Chess positions
and moves including move generation and parsing from external sources.

This module does deliberately not implement
any search or evaluation functionality.  It is intended to be used
to lay the ground for communicating with other programs or players, hence the
package name chessIO.
-}
module Game.Chess.Internal where

import           Control.DeepSeq
import           Control.Lens                     (view)
import           Control.Lens.Iso                 (from)
import           Control.Monad                    (when)
import           Control.Monad.ST
import           Data.Binary
import           Data.Bits                        (Bits (bit, complement, testBit, unsafeShiftL, unsafeShiftR, xor, (.&.), (.|.)),
                                                   FiniteBits (countLeadingZeros, countTrailingZeros))
import           Data.Char                        (chr, ord)
import           Data.Foldable                    (for_)
import           Data.Hashable
import           Data.Ix                          (Ix (inRange))
import           Data.List                        (nub, sortOn)
import           Data.Maybe                       (fromJust, listToMaybe)
import           Data.Ord                         (Down (..))
import           Data.STRef
import           Data.String                      (IsString (..))
import qualified Data.Vector.Generic              as G
import qualified Data.Vector.Generic.Mutable      as M
import           Data.Vector.Unboxed              (MVector, Unbox, Vector,
                                                   unsafeIndex)
import qualified Data.Vector.Unboxed              as Vector
import qualified Data.Vector.Unboxed.Mutable      as VUM
import           Foreign.Storable
import           GHC.Generics                     (Generic)
import           GHC.Stack                        (HasCallStack)
import           Game.Chess.Internal.QuadBitboard (QuadBitboard)
import qualified Game.Chess.Internal.QuadBitboard as QBB
import           Game.Chess.Internal.Square
import           Language.Haskell.TH.Syntax       (Lift)
import           Text.Read                        (readMaybe)

ep :: Word64 -> Word64
ep :: Bitboard -> Bitboard
ep Bitboard
flags = Bitboard
flags Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
0x0000ff0000ff0000

{-# INLINE ep #-}

type Bitboard = Word64

testSquare :: Bitboard -> Square -> Bool
testSquare :: Bitboard -> Square -> Bool
testSquare Bitboard
bb (Sq Int
sq) = Bitboard
1 Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
sq Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
bb Bitboard -> Bitboard -> Bool
forall a. Eq a => a -> a -> Bool
/= Bitboard
0
{-# INLINE testSquare #-}

capturing :: Position -> Ply -> Maybe PieceType
capturing :: Position -> Ply -> Maybe PieceType
capturing pos :: Position
pos@Position{Bitboard
flags :: Bitboard
flags :: Position -> Bitboard
flags} (Ply -> Square
plyTarget -> Square
to)
  | Bitboard -> Bitboard
ep Bitboard
flags Bitboard -> Square -> Bool
`testSquare` Square
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 -> Square -> Maybe (Color, PieceType)
pieceAt Position
pos Square
to

isCapture :: Position -> Ply -> Bool
isCapture :: Position -> Ply -> Bool
isCapture Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, Bitboard
flags :: Position -> Bitboard
flags :: Bitboard
flags} =
  Bitboard -> Square -> Bool
testSquare (QuadBitboard -> Bitboard
QBB.occupied QuadBitboard
qbb Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
ep Bitboard
flags) (Square -> Bool) -> (Ply -> Square) -> Ply -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ply -> Square
plyTarget

{-# INLINE isCapture #-}

isPawnPush :: Position -> Ply -> Bool
isPawnPush :: Position -> Ply -> Bool
isPawnPush Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb} = Bitboard -> Square -> Bool
testSquare (QuadBitboard -> Bitboard
QBB.pawns QuadBitboard
qbb) (Square -> Bool) -> (Ply -> Square) -> Ply -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ply -> Square
plySource

{-# INLINE isPawnPush #-}

-- | The starting position as given by the FEN string
--   "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1".
startpos :: Position
startpos :: Position
startpos = Position
"rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1"

instance IsString Position where fromString :: String -> Position
fromString = Maybe Position -> Position
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Position -> Position)
-> (String -> Maybe Position) -> String -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Position
fromFEN

newtype PieceType = PieceType Int deriving (PieceType -> PieceType -> Bool
(PieceType -> PieceType -> Bool)
-> (PieceType -> PieceType -> Bool) -> Eq PieceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PieceType -> PieceType -> Bool
== :: PieceType -> PieceType -> Bool
$c/= :: PieceType -> PieceType -> Bool
/= :: 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
$crange :: (PieceType, PieceType) -> [PieceType]
range :: (PieceType, PieceType) -> [PieceType]
$cindex :: (PieceType, PieceType) -> PieceType -> Int
index :: (PieceType, PieceType) -> PieceType -> Int
$cunsafeIndex :: (PieceType, PieceType) -> PieceType -> Int
unsafeIndex :: (PieceType, PieceType) -> PieceType -> Int
$cinRange :: (PieceType, PieceType) -> PieceType -> Bool
inRange :: (PieceType, PieceType) -> PieceType -> Bool
$crangeSize :: (PieceType, PieceType) -> Int
rangeSize :: (PieceType, PieceType) -> Int
$cunsafeRangeSize :: (PieceType, PieceType) -> Int
unsafeRangeSize :: (PieceType, PieceType) -> Int
Ix, (forall (m :: * -> *). Quote m => PieceType -> m Exp)
-> (forall (m :: * -> *). Quote m => PieceType -> Code m PieceType)
-> Lift PieceType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => PieceType -> m Exp
forall (m :: * -> *). Quote m => PieceType -> Code m PieceType
$clift :: forall (m :: * -> *). Quote m => PieceType -> m Exp
lift :: forall (m :: * -> *). Quote m => PieceType -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => PieceType -> Code m PieceType
liftTyped :: forall (m :: * -> *). Quote m => PieceType -> Code m PieceType
Lift, 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
$ccompare :: PieceType -> PieceType -> Ordering
compare :: PieceType -> PieceType -> Ordering
$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
>= :: PieceType -> PieceType -> Bool
$cmax :: PieceType -> PieceType -> PieceType
max :: PieceType -> PieceType -> PieceType
$cmin :: PieceType -> PieceType -> PieceType
min :: PieceType -> PieceType -> PieceType
Ord)

pattern Pawn, Knight, Bishop, Rook, Queen, King :: PieceType
pattern $mPawn :: forall {r}. PieceType -> ((# #) -> r) -> ((# #) -> r) -> r
$bPawn :: PieceType
Pawn = PieceType 0
pattern $mKnight :: forall {r}. PieceType -> ((# #) -> r) -> ((# #) -> r) -> r
$bKnight :: PieceType
Knight = PieceType 1
pattern $mBishop :: forall {r}. PieceType -> ((# #) -> r) -> ((# #) -> r) -> r
$bBishop :: PieceType
Bishop = PieceType 2
pattern $mRook :: forall {r}. PieceType -> ((# #) -> r) -> ((# #) -> r) -> r
$bRook :: PieceType
Rook = PieceType 3
pattern $mQueen :: forall {r}. PieceType -> ((# #) -> r) -> ((# #) -> r) -> r
$bQueen :: PieceType
Queen = PieceType 4
pattern $mKing :: forall {r}. PieceType -> ((# #) -> r) -> ((# #) -> r) -> r
$bKing :: PieceType
King = PieceType 5

{-# COMPLETE Pawn, Knight, Bishop, Rook, Queen, King :: PieceType #-}

instance Show PieceType where
  show :: PieceType -> String
show = \case
    PieceType
Pawn   -> String
"Pawn"
    PieceType
Knight -> String
"Knight"
    PieceType
Bishop -> String
"Bishop"
    PieceType
Rook   -> String
"Rook"
    PieceType
Queen  -> String
"Queen"
    PieceType
King   -> String
"King"

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
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: Color -> Color -> Bool
Eq, (forall x. Color -> Rep Color x)
-> (forall x. Rep Color x -> Color) -> Generic Color
forall x. Rep Color x -> Color
forall x. Color -> Rep Color x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Color -> Rep Color x
from :: forall x. Color -> Rep Color x
$cto :: forall x. Rep Color x -> Color
to :: forall x. Rep Color x -> Color
Generic, 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
$crange :: (Color, Color) -> [Color]
range :: (Color, Color) -> [Color]
$cindex :: (Color, Color) -> Color -> Int
index :: (Color, Color) -> Color -> Int
$cunsafeIndex :: (Color, Color) -> Color -> Int
unsafeIndex :: (Color, Color) -> Color -> Int
$cinRange :: (Color, Color) -> Color -> Bool
inRange :: (Color, Color) -> Color -> Bool
$crangeSize :: (Color, Color) -> Int
rangeSize :: (Color, Color) -> Int
$cunsafeRangeSize :: (Color, Color) -> Int
unsafeRangeSize :: (Color, Color) -> Int
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
$ccompare :: Color -> Color -> Ordering
compare :: Color -> Color -> Ordering
$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
>= :: Color -> Color -> Bool
$cmax :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
min :: Color -> Color -> Color
Ord, (forall (m :: * -> *). Quote m => Color -> m Exp)
-> (forall (m :: * -> *). Quote m => Color -> Code m Color)
-> Lift Color
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Color -> m Exp
forall (m :: * -> *). Quote m => Color -> Code m Color
$clift :: forall (m :: * -> *). Quote m => Color -> m Exp
lift :: forall (m :: * -> *). Quote m => Color -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Color -> Code m Color
liftTyped :: forall (m :: * -> *). Quote m => Color -> Code m Color
Lift, 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
$cshowsPrec :: Int -> Color -> ShowS
showsPrec :: Int -> Color -> ShowS
$cshow :: Color -> String
show :: Color -> String
$cshowList :: [Color] -> ShowS
showList :: [Color] -> ShowS
Show)

instance Binary Color
instance NFData Color
instance Hashable Color

pieceAt :: Position -> Square -> Maybe (Color, PieceType)
pieceAt :: Position -> Square -> Maybe (Color, PieceType)
pieceAt Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb} Square
sq = case QuadBitboard
qbb QuadBitboard -> Square -> Word4
QBB.! Square
sq of
  Word4
QBB.NoPiece -> Maybe (Color, PieceType)
forall a. Maybe a
Nothing
  Word4
nb          -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just
    ( if Word4 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word4
nb Int
0 then Color
Black else Color
White
    , Int -> PieceType
PieceType (Int -> PieceType) -> (Word4 -> Int) -> Word4 -> PieceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word4 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word4 -> PieceType) -> Word4 -> PieceType
forall a b. (a -> b) -> a -> b
$ Word4
nb Word4 -> Word4 -> Word4
forall a. Integral a => a -> a -> a
`div` Word4
2 Word4 -> Word4 -> Word4
forall a. Num a => a -> a -> a
- Word4
1
    )

opponent :: Color -> Color
opponent :: Color -> Color
opponent Color
White = Color
Black
opponent Color
Black = Color
White

data Position = Position {
  Position -> QuadBitboard
qbb           :: {-# UNPACK #-} !QuadBitboard
, Position -> Color
color         :: !Color
  -- ^ active color
, Position -> Bitboard
flags         :: {-# UNPACK #-} !Word64
, Position -> Int
halfMoveClock :: {-# UNPACK #-} !Int
, Position -> Int
moveNumber    :: {-# UNPACK #-} !Int
  -- ^ number of the full move
} deriving ((forall x. Position -> Rep Position x)
-> (forall x. Rep Position x -> Position) -> Generic Position
forall x. Rep Position x -> Position
forall x. Position -> Rep Position x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Position -> Rep Position x
from :: forall x. Position -> Rep Position x
$cto :: forall x. Rep Position x -> Position
to :: forall x. Rep Position x -> Position
Generic, (forall (m :: * -> *). Quote m => Position -> m Exp)
-> (forall (m :: * -> *). Quote m => Position -> Code m Position)
-> Lift Position
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Position -> m Exp
forall (m :: * -> *). Quote m => Position -> Code m Position
$clift :: forall (m :: * -> *). Quote m => Position -> m Exp
lift :: forall (m :: * -> *). Quote m => Position -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Position -> Code m Position
liftTyped :: forall (m :: * -> *). Quote m => Position -> Code m Position
Lift)

instance Binary Position
instance NFData Position

-- Article 9.2 states that a position is considered
-- identical to another if the same player is on move, the same types of
-- pieces of the same colors occupy the same squares, and the same moves
-- are available to each player; in particular, each player has the same
-- castling and en passant capturing rights.
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 -> Bitboard
flags Position
a Bitboard -> Bitboard -> Bool
forall a. Eq a => a -> a -> Bool
== Position -> Bitboard
flags Position
b

instance Ord Position where
  Position
a compare :: Position -> Position -> Ordering
`compare` Position
b = Position -> QuadBitboard
qbb Position
a QuadBitboard -> QuadBitboard -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Position -> QuadBitboard
qbb Position
b
             Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Position -> Color
color Position
a Color -> Color -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Position -> Color
color Position
b
             Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Position -> Bitboard
flags Position
a Bitboard -> Bitboard -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Position -> Bitboard
flags Position
b

instance Hashable Position where
  hashWithSalt :: Int -> Position -> Int
hashWithSalt Int
s Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, Color
color :: Position -> Color
color :: Color
color, Bitboard
flags :: Position -> Bitboard
flags :: Bitboard
flags} = Int
s
    Int -> QuadBitboard -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` QuadBitboard
qbb
    Int -> Color -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Color
color
    Int -> Bitboard -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Bitboard
flags

repetitions :: [Position] -> Maybe (Int, Position)
repetitions :: [Position] -> Maybe (Int, Position)
repetitions [Position]
xs = [(Int, Position)] -> Maybe (Int, Position)
forall a. [a] -> Maybe a
listToMaybe ([(Int, Position)] -> Maybe (Int, Position))
-> ([(Int, Position)] -> [(Int, Position)])
-> [(Int, 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)] -> Maybe (Int, Position))
-> [(Int, Position)] -> Maybe (Int, Position)
forall a b. (a -> b) -> a -> b
$ Position -> (Int, Position)
f (Position -> (Int, Position)) -> [Position] -> [(Int, Position)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Position] -> [Position]
forall a. Eq a => [a] -> [a]
nub [Position]
xs where
  f :: Position -> (Int, Position)
f Position
x = ([Position] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Position] -> Int)
-> ([Position] -> [Position]) -> [Position] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Bool) -> [Position] -> [Position]
forall a. (a -> Bool) -> [a] -> [a]
filter (Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
x) ([Position] -> Int) -> [Position] -> Int
forall a b. (a -> b) -> a -> b
$ [Position]
xs, Position
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

-- | Construct a position from Forsyth-Edwards-Notation.
fromFEN :: String -> Maybe Position
fromFEN :: String -> Maybe Position
fromFEN String
fen
  | [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6
  = QuadBitboard -> Color -> Bitboard -> Int -> Int -> Position
Position (QuadBitboard -> Color -> Bitboard -> Int -> Int -> Position)
-> Maybe QuadBitboard
-> Maybe (Color -> Bitboard -> Int -> Int -> Position)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QuadBitboard -> Maybe QuadBitboard
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> QuadBitboard
forall a. IsString a => String -> a
fromString ([String]
parts [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
0))
             Maybe (Color -> Bitboard -> Int -> Int -> Position)
-> Maybe Color -> Maybe (Bitboard -> Int -> Int -> Position)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
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. HasCallStack => [a] -> Int -> a
!! Int
1)
             Maybe (Bitboard -> Int -> Int -> Position)
-> Maybe Bitboard -> Maybe (Int -> Int -> Position)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Maybe Bitboard
readFlags ([String]
parts [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
2) ([String]
parts [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
3)
             Maybe (Int -> Int -> Position)
-> Maybe Int -> Maybe (Int -> Position)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
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. HasCallStack => [a] -> Int -> a
!! Int
4)
             Maybe (Int -> Position) -> Maybe Int -> Maybe Position
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
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. HasCallStack => [a] -> Int -> a
!! Int
5)
  | [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
  = QuadBitboard -> Color -> Bitboard -> Int -> Int -> Position
Position (QuadBitboard -> Color -> Bitboard -> Int -> Int -> Position)
-> Maybe QuadBitboard
-> Maybe (Color -> Bitboard -> Int -> Int -> Position)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QuadBitboard -> Maybe QuadBitboard
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> QuadBitboard
forall a. IsString a => String -> a
fromString ([String]
parts [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
0))
             Maybe (Color -> Bitboard -> Int -> Int -> Position)
-> Maybe Color -> Maybe (Bitboard -> Int -> Int -> Position)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
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. HasCallStack => [a] -> Int -> a
!! Int
1)
             Maybe (Bitboard -> Int -> Int -> Position)
-> Maybe Bitboard -> Maybe (Int -> Int -> Position)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Maybe Bitboard
readFlags ([String]
parts [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
2) ([String]
parts [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
3)
             Maybe (Int -> Int -> Position)
-> Maybe Int -> Maybe (Int -> Position)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Int
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
             Maybe (Int -> Position) -> Maybe Int -> Maybe Position
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Int
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1
  | Bool
otherwise = Maybe Position
forall a. Maybe a
Nothing
 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 Bitboard
readFlags String
c String
e = Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
(.|.) (Bitboard -> Bitboard -> Bitboard)
-> Maybe Bitboard -> Maybe (Bitboard -> Bitboard)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Bitboard
readCst String
c Maybe (Bitboard -> Bitboard) -> Maybe Bitboard -> Maybe Bitboard
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Bitboard
forall {a}. (Num a, Bits a) => String -> Maybe a
readEP String
e where
    readCst :: String -> Maybe Bitboard
readCst String
"-" = Bitboard -> Maybe Bitboard
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bitboard
0
    readCst String
x = String -> Maybe Bitboard
go String
x where
      go :: String -> Maybe Bitboard
go (Char
'K':String
xs) = (Bitboard
crwKs Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.) (Bitboard -> Bitboard) -> Maybe Bitboard -> Maybe Bitboard
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Bitboard
go String
xs
      go (Char
'Q':String
xs) = (Bitboard
crwQs Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.) (Bitboard -> Bitboard) -> Maybe Bitboard -> Maybe Bitboard
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Bitboard
go String
xs
      go (Char
'k':String
xs) = (Bitboard
crbKs Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.) (Bitboard -> Bitboard) -> Maybe Bitboard -> Maybe Bitboard
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Bitboard
go String
xs
      go (Char
'q':String
xs) = (Bitboard
crbQs Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.) (Bitboard -> Bitboard) -> Maybe Bitboard -> Maybe Bitboard
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Bitboard
go String
xs
      go []       = Bitboard -> Maybe Bitboard
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bitboard
0
      go String
_        = Maybe Bitboard
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

-- | Convert a position to Forsyth-Edwards-Notation.
toFEN :: Position -> String
toFEN :: Position -> String
toFEN Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, Color
color :: Position -> Color
color :: Color
color, Bitboard
flags :: Position -> Bitboard
flags :: Bitboard
flags, Int
halfMoveClock :: Position -> Int
halfMoveClock :: Int
halfMoveClock, Int
moveNumber :: Position -> Int
moveNumber :: Int
moveNumber} = [String] -> String
unwords
  [ QuadBitboard -> String
QBB.toString QuadBitboard
qbb
  , Color -> String
forall {a}. IsString a => Color -> a
showColor Color
color
  , Bitboard -> String
showCst (Bitboard
flags Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
`clearMask` Bitboard
epMask)
  , Bitboard -> String
forall {a}. IsString a => Bitboard -> a
showEP (Bitboard -> Bitboard
ep Bitboard
flags)
  , 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 -> a
showColor Color
White = a
"w"
  showColor Color
Black = a
"b"
  showCst :: Bitboard -> String
showCst Bitboard
x
    | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = String
"-"
    | Bool
otherwise = String
str
   where
    str :: String
str = (Bitboard, String) -> String
forall a b. (a, b) -> b
snd ((Bitboard, String) -> String)
-> ((Bitboard, String) -> (Bitboard, String))
-> (Bitboard, String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bitboard, String) -> (Bitboard, String)
wks ((Bitboard, String) -> (Bitboard, String))
-> ((Bitboard, String) -> (Bitboard, String))
-> (Bitboard, String)
-> (Bitboard, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bitboard, String) -> (Bitboard, String)
wqs ((Bitboard, String) -> (Bitboard, String))
-> ((Bitboard, String) -> (Bitboard, String))
-> (Bitboard, String)
-> (Bitboard, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bitboard, String) -> (Bitboard, String)
bks ((Bitboard, String) -> (Bitboard, String))
-> ((Bitboard, String) -> (Bitboard, String))
-> (Bitboard, String)
-> (Bitboard, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bitboard, String) -> (Bitboard, String)
bqs ((Bitboard, String) -> String) -> (Bitboard, String) -> String
forall a b. (a -> b) -> a -> b
$ (Bitboard
x, String
"")
    wks :: (Bitboard, String) -> (Bitboard, String)
wks (Bitboard
v, String
xs) | Bitboard
v Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
crwKs = (Bitboard
v, Char
'K'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
                | Bool
otherwise          = (Bitboard
v, String
xs)
    wqs :: (Bitboard, String) -> (Bitboard, String)
wqs (Bitboard
v, String
xs) | Bitboard
v Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
crwQs = (Bitboard
v, Char
'Q'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
                | Bool
otherwise          = (Bitboard
v, String
xs)
    bks :: (Bitboard, String) -> (Bitboard, String)
bks (Bitboard
v, String
xs) | Bitboard
v Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
crbKs = (Bitboard
v, Char
'k'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
                | Bool
otherwise          = (Bitboard
v, String
xs)
    bqs :: (Bitboard, String) -> (Bitboard, String)
bqs (Bitboard
v, String
xs) | Bitboard
v Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
crbQs = (Bitboard
v, Char
'q'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
                | Bool
otherwise          = (Bitboard
v, String
xs)
  showEP :: Bitboard -> a
showEP Bitboard
0 = a
"-"
  showEP Bitboard
x = Square -> a
forall s. IsString s => Square -> s
toCoord (Square -> a) -> (Bitboard -> Square) -> Bitboard -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Square
Sq (Int -> Square) -> (Bitboard -> Int) -> Bitboard -> Square
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bitboard -> Int
bitScanForward (Bitboard -> a) -> Bitboard -> a
forall a b. (a -> b) -> a -> b
$ Bitboard
x

occupiedBy :: Color -> QuadBitboard -> Bitboard
occupiedBy :: Color -> QuadBitboard -> Bitboard
occupiedBy Color
White = QuadBitboard -> Bitboard
QBB.white
occupiedBy Color
Black = QuadBitboard -> Bitboard
QBB.black

occupied :: QuadBitboard -> Bitboard
occupied :: QuadBitboard -> Bitboard
occupied = QuadBitboard -> Bitboard
QBB.occupied

bitScanForward, bitScanReverse :: Bitboard -> Int
bitScanForward :: Bitboard -> Int
bitScanForward = Bitboard -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros
bitScanReverse :: Bitboard -> Int
bitScanReverse = (Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> (Bitboard -> Int) -> Bitboard -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bitboard -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros

{-# INLINE bitScanForward #-}
{-# INLINE bitScanReverse #-}

newtype Ply = Ply { Ply -> Word16
unPly :: Word16 } deriving (Get Ply
[Ply] -> Put
Ply -> Put
(Ply -> Put) -> Get Ply -> ([Ply] -> Put) -> Binary Ply
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: Ply -> Put
put :: Ply -> Put
$cget :: Get Ply
get :: Get Ply
$cputList :: [Ply] -> Put
putList :: [Ply] -> Put
Binary, Ply -> Ply -> Bool
(Ply -> Ply -> Bool) -> (Ply -> Ply -> Bool) -> Eq Ply
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ply -> Ply -> Bool
== :: Ply -> Ply -> Bool
$c/= :: Ply -> Ply -> Bool
/= :: Ply -> Ply -> Bool
Eq, Eq Ply
Eq Ply => (Int -> Ply -> Int) -> (Ply -> Int) -> Hashable Ply
Int -> Ply -> Int
Ply -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Ply -> Int
hashWithSalt :: Int -> Ply -> Int
$chash :: Ply -> Int
hash :: Ply -> Int
Hashable, Eq Ply
Eq Ply =>
(Ply -> Ply -> Ordering)
-> (Ply -> Ply -> Bool)
-> (Ply -> Ply -> Bool)
-> (Ply -> Ply -> Bool)
-> (Ply -> Ply -> Bool)
-> (Ply -> Ply -> Ply)
-> (Ply -> Ply -> Ply)
-> Ord Ply
Ply -> Ply -> Bool
Ply -> Ply -> Ordering
Ply -> Ply -> Ply
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
$ccompare :: Ply -> Ply -> Ordering
compare :: Ply -> Ply -> Ordering
$c< :: Ply -> Ply -> Bool
< :: Ply -> Ply -> Bool
$c<= :: Ply -> Ply -> Bool
<= :: Ply -> Ply -> Bool
$c> :: Ply -> Ply -> Bool
> :: Ply -> Ply -> Bool
$c>= :: Ply -> Ply -> Bool
>= :: Ply -> Ply -> Bool
$cmax :: Ply -> Ply -> Ply
max :: Ply -> Ply -> Ply
$cmin :: Ply -> Ply -> Ply
min :: Ply -> Ply -> Ply
Ord, (forall (m :: * -> *). Quote m => Ply -> m Exp)
-> (forall (m :: * -> *). Quote m => Ply -> Code m Ply) -> Lift Ply
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Ply -> m Exp
forall (m :: * -> *). Quote m => Ply -> Code m Ply
$clift :: forall (m :: * -> *). Quote m => Ply -> m Exp
lift :: forall (m :: * -> *). Quote m => Ply -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Ply -> Code m Ply
liftTyped :: forall (m :: * -> *). Quote m => Ply -> Code m Ply
Lift, 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
$csizeOf :: Ply -> Int
sizeOf :: Ply -> Int
$calignment :: Ply -> Int
alignment :: Ply -> Int
$cpeekElemOff :: Ptr Ply -> Int -> IO Ply
peekElemOff :: Ptr Ply -> Int -> IO Ply
$cpokeElemOff :: Ptr Ply -> Int -> Ply -> IO ()
pokeElemOff :: Ptr Ply -> Int -> Ply -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Ply
peekByteOff :: forall b. Ptr b -> Int -> IO Ply
$cpokeByteOff :: forall b. Ptr b -> Int -> Ply -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Ply -> IO ()
$cpeek :: Ptr Ply -> IO Ply
peek :: Ptr Ply -> IO Ply
$cpoke :: Ptr Ply -> Ply -> IO ()
poke :: Ptr Ply -> Ply -> IO ()
Storable)

instance Show Ply where
  show :: Ply -> String
show (Ply -> (Square, Square, Maybe PieceType)
unpack -> (Square
f, Square
t, Maybe PieceType
p)) = String
"move " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Square -> String
forall a. Show a => a -> String
show Square
f String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Square -> String
forall a. Show a => a -> String
show Square
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p' where
    p' :: String
p' = case Maybe PieceType
p of
      Just PieceType
piece -> String
" `promoteTo` " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PieceType -> String
forall a. Show a => a -> String
show PieceType
piece
      Maybe PieceType
Nothing    -> String
""

newtype instance MVector s Ply = MV_Ply (MVector s Word16)
newtype instance Vector    Ply = V_Ply (Vector Word16)

instance M.MVector MVector Ply where
  basicLength :: forall s. MVector s Ply -> Int
basicLength (MV_Ply MVector s Word16
v) = MVector s Word16 -> Int
forall s. MVector s Word16 -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
M.basicLength MVector s Word16
v
  basicUnsafeSlice :: forall s. Int -> Int -> MVector s Ply -> MVector s Ply
basicUnsafeSlice Int
i Int
n (MV_Ply MVector s Word16
v) = MVector s Word16 -> MVector s Ply
forall s. MVector s Word16 -> MVector s Ply
MV_Ply (MVector s Word16 -> MVector s Ply)
-> MVector s Word16 -> MVector s Ply
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MVector s Word16 -> MVector s Word16
forall s. Int -> Int -> MVector s Word16 -> MVector s Word16
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
M.basicUnsafeSlice Int
i Int
n MVector s Word16
v
  basicOverlaps :: forall s. MVector s Ply -> MVector s Ply -> Bool
basicOverlaps (MV_Ply MVector s Word16
v1) (MV_Ply MVector s Word16
v2) = MVector s Word16 -> MVector s Word16 -> Bool
forall s. MVector s Word16 -> MVector s Word16 -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
M.basicOverlaps MVector s Word16
v1 MVector s Word16
v2
  basicUnsafeNew :: forall s. Int -> ST s (MVector s Ply)
basicUnsafeNew Int
n = MVector s Word16 -> MVector s Ply
forall s. MVector s Word16 -> MVector s Ply
MV_Ply (MVector s Word16 -> MVector s Ply)
-> ST s (MVector s Word16) -> ST s (MVector s Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ST s (MVector s Word16)
forall s. Int -> ST s (MVector s Word16)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
M.basicUnsafeNew Int
n
  basicInitialize :: forall s. MVector s Ply -> ST s ()
basicInitialize (MV_Ply MVector s Word16
v) = MVector s Word16 -> ST s ()
forall s. MVector s Word16 -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
M.basicInitialize MVector s Word16
v
  basicUnsafeReplicate :: forall s. Int -> Ply -> ST s (MVector s Ply)
basicUnsafeReplicate Int
n (Ply Word16
pl) = MVector s Word16 -> MVector s Ply
forall s. MVector s Word16 -> MVector s Ply
MV_Ply (MVector s Word16 -> MVector s Ply)
-> ST s (MVector s Word16) -> ST s (MVector s Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Word16 -> ST s (MVector s Word16)
forall s. Int -> Word16 -> ST s (MVector s Word16)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> a -> ST s (v s a)
M.basicUnsafeReplicate Int
n Word16
pl
  basicUnsafeRead :: forall s. MVector s Ply -> Int -> ST s Ply
basicUnsafeRead (MV_Ply MVector s Word16
v) Int
i = Word16 -> Ply
Ply (Word16 -> Ply) -> ST s Word16 -> ST s Ply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s Word16 -> Int -> ST s Word16
forall s. MVector s Word16 -> Int -> ST s Word16
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
M.basicUnsafeRead MVector s Word16
v Int
i
  basicUnsafeWrite :: forall s. MVector s Ply -> Int -> Ply -> ST s ()
basicUnsafeWrite (MV_Ply MVector s Word16
v) Int
i (Ply Word16
pl) = MVector s Word16 -> Int -> Word16 -> ST s ()
forall s. MVector s Word16 -> Int -> Word16 -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
M.basicUnsafeWrite MVector s Word16
v Int
i Word16
pl
  basicClear :: forall s. MVector s Ply -> ST s ()
basicClear (MV_Ply MVector s Word16
v) = MVector s Word16 -> ST s ()
forall s. MVector s Word16 -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
M.basicClear MVector s Word16
v
  basicSet :: forall s. MVector s Ply -> Ply -> ST s ()
basicSet (MV_Ply MVector s Word16
v) (Ply Word16
pl) = MVector s Word16 -> Word16 -> ST s ()
forall s. MVector s Word16 -> Word16 -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> a -> ST s ()
M.basicSet MVector s Word16
v Word16
pl
  basicUnsafeCopy :: forall s. MVector s Ply -> MVector s Ply -> ST s ()
basicUnsafeCopy (MV_Ply MVector s Word16
v1) (MV_Ply MVector s Word16
v2) = MVector s Word16 -> MVector s Word16 -> ST s ()
forall s. MVector s Word16 -> MVector s Word16 -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
M.basicUnsafeCopy MVector s Word16
v1 MVector s Word16
v2
  basicUnsafeMove :: forall s. MVector s Ply -> MVector s Ply -> ST s ()
basicUnsafeMove (MV_Ply MVector s Word16
v1) (MV_Ply MVector s Word16
v2) = MVector s Word16 -> MVector s Word16 -> ST s ()
forall s. MVector s Word16 -> MVector s Word16 -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
M.basicUnsafeMove MVector s Word16
v1 MVector s Word16
v2
  basicUnsafeGrow :: forall s. MVector s Ply -> Int -> ST s (MVector s Ply)
basicUnsafeGrow (MV_Ply MVector s Word16
v) Int
n = MVector s Word16 -> MVector s Ply
forall s. MVector s Word16 -> MVector s Ply
MV_Ply (MVector s Word16 -> MVector s Ply)
-> ST s (MVector s Word16) -> ST s (MVector s Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s Word16 -> Int -> ST s (MVector s Word16)
forall s. MVector s Word16 -> Int -> ST s (MVector s Word16)
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
M.basicUnsafeGrow MVector s Word16
v Int
n

instance G.Vector Vector Ply where
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeFreeze :: forall s. Mutable Vector s Ply -> ST s (Vector Ply)
basicUnsafeFreeze (MV_Ply MVector s Word16
v) = Vector Word16 -> Vector Ply
V_Ply (Vector Word16 -> Vector Ply)
-> ST s (Vector Word16) -> ST s (Vector Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector s Word16 -> ST s (Vector Word16)
forall s. Mutable Vector s Word16 -> ST s (Vector Word16)
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
G.basicUnsafeFreeze MVector s Word16
Mutable Vector s Word16
v
  basicUnsafeThaw :: forall s. Vector Ply -> ST s (Mutable Vector s Ply)
basicUnsafeThaw (V_Ply Vector Word16
v) = MVector s Word16 -> MVector s Ply
forall s. MVector s Word16 -> MVector s Ply
MV_Ply (MVector s Word16 -> MVector s Ply)
-> ST s (MVector s Word16) -> ST s (MVector s Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word16 -> ST s (Mutable Vector s Word16)
forall s. Vector Word16 -> ST s (Mutable Vector s Word16)
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
G.basicUnsafeThaw Vector Word16
v
  basicLength :: Vector Ply -> Int
basicLength (V_Ply Vector Word16
v) = Vector Word16 -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.basicLength Vector Word16
v
  basicUnsafeSlice :: Int -> Int -> Vector Ply -> Vector Ply
basicUnsafeSlice Int
i Int
n (V_Ply Vector Word16
v) = Vector Word16 -> Vector Ply
V_Ply (Vector Word16 -> Vector Ply) -> Vector Word16 -> Vector Ply
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector Word16 -> Vector Word16
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice  Int
i Int
n Vector Word16
v
  basicUnsafeIndexM :: Vector Ply -> Int -> Box Ply
basicUnsafeIndexM (V_Ply Vector Word16
v) Int
i = Word16 -> Ply
Ply (Word16 -> Ply) -> Box Word16 -> Box Ply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word16 -> Int -> Box Word16
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector Word16
v Int
i
  basicUnsafeCopy :: forall s. Mutable Vector s Ply -> Vector Ply -> ST s ()
basicUnsafeCopy (MV_Ply MVector s Word16
mv) (V_Ply Vector Word16
v) = Mutable Vector s Word16 -> Vector Word16 -> ST s ()
forall s. Mutable Vector s Word16 -> Vector Word16 -> ST s ()
forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
G.basicUnsafeCopy MVector s Word16
Mutable Vector s Word16
mv Vector Word16
v
  elemseq :: forall b. Vector Ply -> Ply -> b -> b
elemseq Vector Ply
_ Ply
pl b
z = Vector Ply -> Ply -> b -> b
forall b. Vector Ply -> Ply -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (Vector a
forall {a}. Vector a
forall a. HasCallStack => a
undefined :: Vector a) Ply
pl b
z

instance Unbox Ply

move :: Square -> Square -> Ply
move :: Square -> Square -> Ply
move (Sq Int
src) (Sq Int
dst) =
  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
dst Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
src 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
Pawn          = Word16
x
  set PieceType
King          = Word16
x
  set (PieceType Int
v) = Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xfff Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
v Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
12)

plySource, plyTarget :: Ply -> Square
plySource :: Ply -> Square
plySource (Ply Word16
x) = Int -> Square
Sq (Int -> Square) -> Int -> Square
forall a b. (a -> b) -> a -> b
$ 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 -> Square
plyTarget (Ply Word16
x) = Int -> Square
Sq (Int -> Square) -> Int -> Square
forall a b. (a -> b) -> a -> b
$ 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 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ (Word16
x Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
12) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0b111 of
  Int
0 -> Maybe PieceType
forall a. Maybe a
Nothing
  Int
n -> PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just (PieceType -> Maybe PieceType)
-> (Int -> PieceType) -> Int -> Maybe PieceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PieceType
PieceType (Int -> Maybe PieceType) -> Int -> Maybe PieceType
forall a b. (a -> b) -> a -> b
$ Int
n

unpack :: Ply -> (Square, Square, Maybe PieceType)
unpack :: Ply -> (Square, Square, Maybe PieceType)
unpack Ply
pl = ( Ply -> Square
plySource Ply
pl, Ply -> Square
plyTarget Ply
pl, Ply -> Maybe PieceType
plyPromotion Ply
pl)

-- | Parse a move in the format used by the Universal Chess Interface protocol.
fromUCI :: Position -> String -> Maybe Ply
fromUCI :: Position -> String -> Maybe Ply
fromUCI Position
pos ((String -> (String, String))
-> (String, String) -> (String, (String, String))
forall a b. (a -> b) -> (String, a) -> (String, b)
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
src, (String
dst, String
promo)))
  | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
promo
  = Square -> Square -> Ply
move (Square -> Square -> Ply) -> Maybe Square -> Maybe (Square -> Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Square
readCoord String
src Maybe (Square -> Ply) -> Maybe Square -> Maybe Ply
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Square
readCoord String
dst Maybe Ply -> (Ply -> Maybe Ply) -> Maybe Ply
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Position -> Ply -> Maybe Ply
relativeTo Position
pos
  | Bool
otherwise
  = (\Square
f Square
t PieceType
p -> Square -> Square -> Ply
move Square
f Square
t Ply -> PieceType -> Ply
`promoteTo` PieceType
p) (Square -> Square -> PieceType -> Ply)
-> Maybe Square -> Maybe (Square -> PieceType -> Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Square
readCoord String
src
                                       Maybe (Square -> PieceType -> Ply)
-> Maybe Square -> Maybe (PieceType -> Ply)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Square
readCoord String
dst
                                       Maybe (PieceType -> Ply) -> Maybe PieceType -> Maybe Ply
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Position -> Ply -> Maybe Ply
relativeTo Position
pos
 where
  readCoord :: String -> Maybe Square
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
    = Square -> Maybe Square
forall a. a -> Maybe a
Just (Square -> Maybe Square)
-> ((Rank, File) -> Square) -> (Rank, File) -> Maybe Square
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Square (Rank, File) Square -> (Rank, File) -> Square
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (AnIso Square Square (Rank, File) (Rank, File)
-> Iso (Rank, File) (Rank, File) Square Square
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso Square Square (Rank, File) (Rank, File)
Iso' Square (Rank, File)
rankFile) ((Rank, File) -> Maybe Square) -> (Rank, File) -> Maybe Square
forall a b. (a -> b) -> a -> b
$ (HasCallStack => Int -> Rank
Int -> Rank
mkRank (Int -> Rank) -> Int -> Rank
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',  HasCallStack => Int -> File
Int -> File
mkFile (Int -> File) -> Int -> File
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a')
  readCoord String
_ = Maybe Square
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

-- | Convert a move to the format used by the Universal Chess Interface protocol.
toUCI :: Ply -> String
toUCI :: Ply -> String
toUCI (Ply -> (Square, Square, Maybe PieceType)
unpack -> (Square
src, Square
dst, Maybe PieceType
promo)) = Square -> String
coord Square
src String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Square -> String
coord Square
dst String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p where
  coord :: Square -> String
coord Square
x = let (Rank
r,File
f) = Getting (Rank, File) Square (Rank, File) -> Square -> (Rank, File)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Rank, File) Square (Rank, File)
Iso' Square (Rank, File)
rankFile Square
x in
            Int -> Char
chr (File -> Int
unFile File
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 (Rank -> Int
unRank Rank
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
""

-- | Validate that a certain move is legal in the given position.
relativeTo :: Position -> Ply -> Maybe Ply
relativeTo :: Position -> Ply -> Maybe Ply
relativeTo Position
pos Ply
m | Ply
m Ply -> Vector Ply -> Bool
forall a. (Unbox a, Eq a) => a -> Vector a -> Bool
`Vector.elem` Position -> Vector 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, shiftNN, shiftNNE, shiftNE, shiftENE, shiftE, shiftESE, shiftSE, shiftSSE, shiftS, shiftSS, shiftSSW, shiftSW, shiftWSW, shiftW, shiftWNW, shiftNW, shiftNNW :: Bitboard -> Bitboard
shiftN :: Bitboard -> Bitboard
shiftN   Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8
shiftNN :: Bitboard -> Bitboard
shiftNN   Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16
shiftNNE :: Bitboard -> Bitboard
shiftNNE Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
17 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notAFile
shiftNE :: Bitboard -> Bitboard
shiftNE  Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
9 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notAFile
shiftENE :: Bitboard -> Bitboard
shiftENE Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
10 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notABFile
shiftE :: Bitboard -> Bitboard
shiftE   Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notAFile
shiftESE :: Bitboard -> Bitboard
shiftESE Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
6 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notABFile
shiftSE :: Bitboard -> Bitboard
shiftSE  Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
7 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notAFile
shiftSSE :: Bitboard -> Bitboard
shiftSSE Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
15 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notAFile
shiftS :: Bitboard -> Bitboard
shiftS   Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8
shiftSS :: Bitboard -> Bitboard
shiftSS   Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16
shiftSSW :: Bitboard -> Bitboard
shiftSSW Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
17 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notHFile
shiftSW :: Bitboard -> Bitboard
shiftSW  Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
9 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notHFile
shiftWSW :: Bitboard -> Bitboard
shiftWSW Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
10 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notGHFile
shiftW :: Bitboard -> Bitboard
shiftW   Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notHFile
shiftWNW :: Bitboard -> Bitboard
shiftWNW Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
6 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notGHFile
shiftNW :: Bitboard -> Bitboard
shiftNW  Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
7 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notHFile
shiftNNW :: Bitboard -> Bitboard
shiftNNW Bitboard
w = Bitboard
w Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
15 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notHFile

{-# INLINE shiftN #-}
{-# INLINE shiftNN #-}
{-# INLINE shiftS #-}
{-# INLINE shiftSS #-}

-- | Apply a move to the given position.
--
-- This function checks if the move is actually legal and throws and error
-- if it isn't.  See 'unsafeDoPly' for a version that omits the legality check.
doPly :: HasCallStack => Position -> Ply -> Position
doPly :: HasCallStack => Position -> Ply -> Position
doPly Position
p Ply
m
  | Ply
m Ply -> Vector Ply -> Bool
forall a. (Unbox a, Eq a) => a -> Vector a -> Bool
`Vector.elem` Position -> Vector 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"

-- | An unsafe version of 'doPly'.  Only use this if you are sure the given move
-- can be applied to the position.  This is useful if the move has been generated
-- by the 'legalPlies' function.
unsafeDoPly :: Position -> Ply -> Position
unsafeDoPly :: Position -> Ply -> Position
unsafeDoPly pos :: Position
pos@Position{Color
color :: Position -> Color
color :: Color
color, Int
halfMoveClock :: Position -> Int
halfMoveClock :: Int
halfMoveClock, Int
moveNumber :: Position -> Int
moveNumber :: Int
moveNumber} Ply
m =
  (Position -> Ply -> Position
unsafeDoPly' Position
pos Ply
m)
  { color = opponent color
  , halfMoveClock = if isCapture pos m || isPawnPush pos m
                    then 0
                    else halfMoveClock + 1
  , moveNumber = if color == Black
                 then moveNumber + 1
                 else moveNumber
  }

unsafeDoPly' :: Position -> Ply -> Position
unsafeDoPly' :: Position -> Ply -> Position
unsafeDoPly' pos :: Position
pos@Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, Bitboard
flags :: Position -> Bitboard
flags :: Bitboard
flags} m :: Ply
m@(Ply -> (Square, Square, Maybe PieceType)
unpack -> (Square
src, Square
dst, Maybe PieceType
promo))
  | Ply
m Ply -> Ply -> Bool
forall a. Eq a => a -> a -> Bool
== Ply
wKscm Bool -> Bool -> Bool
&& Bitboard
flags Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
crwKs
  = Position
pos { qbb = qbb <> QBB.whiteKingsideCastle
        , flags = flags `clearMask` (rank1 .|. epMask)
        }
  | Ply
m Ply -> Ply -> Bool
forall a. Eq a => a -> a -> Bool
== Ply
wQscm Bool -> Bool -> Bool
&& Bitboard
flags Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
crwQs
  = Position
pos { qbb = qbb <> QBB.whiteQueensideCastle
        , flags = flags `clearMask` (rank1 .|. epMask)
        }
  | Ply
m Ply -> Ply -> Bool
forall a. Eq a => a -> a -> Bool
== Ply
bKscm Bool -> Bool -> Bool
&& Bitboard
flags Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
crbKs
  = Position
pos { qbb = qbb <> QBB.blackKingsideCastle
        , flags = flags `clearMask` (rank8 .|. epMask)
        }
  | Ply
m Ply -> Ply -> Bool
forall a. Eq a => a -> a -> Bool
== Ply
bQscm Bool -> Bool -> Bool
&& Bitboard
flags Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
crbQs
  = Position
pos { qbb = qbb <> QBB.blackQueensideCastle
        , flags = flags `clearMask` (rank8 .|. 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 = QBB.whitePromotion qbb src dst QBB.WhiteQueen
                     , flags = flags `clearMask` (epMask .|. bit (unSquare dst))
                     }
        PieceType
Rook  -> Position
pos { qbb = QBB.whitePromotion qbb src dst QBB.WhiteRook
                     , flags = flags `clearMask` (epMask .|. bit (unSquare dst))
                     }
        PieceType
Bishop -> Position
pos { qbb = QBB.whitePromotion qbb src dst QBB.WhiteBishop
                      , flags = flags `clearMask` (epMask .|. bit (unSquare dst))
                      }
        PieceType
Knight -> Position
pos { qbb = QBB.whitePromotion qbb src dst QBB.WhiteKnight
                      , flags = flags `clearMask` (epMask .|. bit (unSquare dst))
                      }
        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 = QBB.blackPromotion qbb src dst QBB.BlackQueen
                     , flags = flags `clearMask` (epMask .|. bit (unSquare dst))
                     }
        PieceType
Rook   -> Position
pos { qbb = QBB.blackPromotion qbb src dst QBB.BlackRook
                      , flags = flags `clearMask` (epMask .|. bit (unSquare dst))
                      }
        PieceType
Bishop -> Position
pos { qbb = QBB.blackPromotion qbb src dst QBB.BlackBishop
                      , flags = flags `clearMask` (epMask .|. bit (unSquare dst))
                      }
        PieceType
Knight -> Position
pos { qbb = QBB.blackPromotion qbb src dst QBB.BlackKnight
                      , flags = flags `clearMask` (epMask .|. bit (unSquare dst))
                      }
        PieceType
_ -> String -> Position
forall a. HasCallStack => String -> a
error String
"Impossible: Black tried to promote to Pawn"
  | Bitboard
pawns Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
fromMask
  , Bitboard -> Bitboard
ep Bitboard
flags Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
toMask
  = Position
pos { qbb = qbb <> QBB.enPassant src dst
        , flags = flags `clearMask` toMask
        }
  | Bool
otherwise
  = Position
pos { qbb = QBB.move qbb src dst
        , flags = flags `clearMask` (epMask .|. mask) .|. dpp
        }
 where
  !fromMask :: Bitboard
fromMask = Bitboard
1 Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Square -> Int
unSquare Square
src
  !toMask :: Bitboard
toMask = Bitboard
1 Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Square -> Int
unSquare Square
dst
  !mask :: Bitboard
mask = Bitboard
fromMask Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
toMask
  !pawns :: Bitboard
pawns = QuadBitboard -> Bitboard
QBB.pawns QuadBitboard
qbb
  !dpp :: Bitboard
dpp
    | (Bitboard
pawns Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. (Bitboard
rank2 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
rank7)) Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
fromMask
    = if | Bitboard -> Bitboard
shiftNN Bitboard
fromMask Bitboard -> Bitboard -> Bool
forall a. Eq a => a -> a -> Bool
== Bitboard
toMask -> Bitboard -> Bitboard
shiftN Bitboard
fromMask
         | Bitboard -> Bitboard
shiftSS Bitboard
fromMask Bitboard -> Bitboard -> Bool
forall a. Eq a => a -> a -> Bool
== Bitboard
toMask -> Bitboard -> Bitboard
shiftS Bitboard
fromMask
         | Bool
otherwise                  -> Bitboard
0
    | Bool
otherwise = Bitboard
0

forBits :: Word64 -> (Int -> ST s ()) -> ST s ()
forBits :: forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits Bitboard
w Int -> ST s ()
f = Bitboard -> ST s ()
go Bitboard
w where
  go :: Bitboard -> ST s ()
go Bitboard
0 = () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  go Bitboard
n = Int -> ST s ()
f (Bitboard -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Bitboard
n) ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bitboard -> ST s ()
go (Bitboard
n Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. (Bitboard
n Bitboard -> Bitboard -> Bitboard
forall a. Num a => a -> a -> a
- Bitboard
1))
{-# INLINE forBits #-}

-- | Generate a list of possible moves for the given position.
legalPlies :: Position -> [Ply]
legalPlies :: Position -> [Ply]
legalPlies = Vector Ply -> [Ply]
forall a. Unbox a => Vector a -> [a]
Vector.toList (Vector Ply -> [Ply])
-> (Position -> Vector Ply) -> Position -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Vector Ply
legalPlies'

legalPlies' :: Position -> Vector Ply
legalPlies' :: Position -> Vector Ply
legalPlies' pos :: Position
pos@Position{Color
color :: Position -> Color
color :: Color
color, QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, Bitboard
flags :: Position -> Bitboard
flags :: Bitboard
flags} = (forall s. ST s (Vector Ply)) -> Vector Ply
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector Ply)) -> Vector Ply)
-> (forall s. ST s (Vector Ply)) -> Vector Ply
forall a b. (a -> b) -> a -> b
$ do
  MVector s Ply
v <- Int -> ST s (MVector (PrimState (ST s)) Ply)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
VUM.new Int
100
  STRef s Int
i <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0
  let add :: Ply -> ST s ()
add Ply
pl
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Color -> Position -> Bool
inCheck Color
color (Position -> Ply -> Position
unsafeDoPly' Position
pos Ply
pl) = do
          Int
i' <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
i
          MVector (PrimState (ST s)) Ply -> Int -> Ply -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VUM.unsafeWrite MVector s Ply
MVector (PrimState (ST s)) Ply
v Int
i' Ply
pl
          STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Int
i (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        | Bool
otherwise = () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      {-# INLINE add #-}

  case Color
color of
    Color
White -> do
      let !us :: Bitboard
us = QuadBitboard -> Bitboard
QBB.white QuadBitboard
qbb
          !them :: Bitboard
them = QuadBitboard -> Bitboard
QBB.black QuadBitboard
qbb
          !notUs :: Bitboard
notUs = Bitboard -> Bitboard
forall a. Bits a => a -> a
complement Bitboard
us
          !occ :: Bitboard
occ = Bitboard
us Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
them
          !notOcc :: Bitboard
notOcc = Bitboard -> Bitboard
forall a. Bits a => a -> a
complement Bitboard
occ

      -- Pawn
      let !wPawns :: Bitboard
wPawns = QuadBitboard -> Bitboard
QBB.wPawns QuadBitboard
qbb
      let !singlePushTargets :: Bitboard
singlePushTargets = Bitboard -> Bitboard
shiftN Bitboard
wPawns Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notOcc
      let !doublePushTargets :: Bitboard
doublePushTargets = Bitboard -> Bitboard
shiftN Bitboard
singlePushTargets Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notOcc Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
rank4
      let !captureTargets :: Bitboard
captureTargets = Bitboard
them Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
ep Bitboard
flags
      let !eastCaptureTargets :: Bitboard
eastCaptureTargets = Bitboard -> Bitboard
shiftNE Bitboard
wPawns Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
captureTargets
      let !westCaptureTargets :: Bitboard
westCaptureTargets = Bitboard -> Bitboard
shiftNW Bitboard
wPawns Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
captureTargets
      let pawn :: Int -> Int -> ST s ()
pawn Int
s Int
d
            | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
56
            = let pl :: Ply
pl = Square -> Square -> Ply
move (Int -> Square
Sq Int
s) (Int -> Square
Sq Int
d)
              in [PieceType] -> (PieceType -> ST s ()) -> ST s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [PieceType
Queen, PieceType
Rook, PieceType
Bishop, PieceType
Knight] ((PieceType -> ST s ()) -> ST s ())
-> (PieceType -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \PieceType
p ->
                   Ply -> ST s ()
add (Ply -> ST s ()) -> Ply -> ST s ()
forall a b. (a -> b) -> a -> b
$ Ply
pl Ply -> PieceType -> Ply
`promoteTo` PieceType
p
            | Bool
otherwise
            = Ply -> ST s ()
add (Ply -> ST s ()) -> Ply -> ST s ()
forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
s) (Int -> Square
Sq Int
d)
      Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits Bitboard
westCaptureTargets ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
        Int -> Int -> ST s ()
pawn (Int
dst Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7) Int
dst
      Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits Bitboard
eastCaptureTargets ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
        Int -> Int -> ST s ()
pawn (Int
dst Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
9) Int
dst
      Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits Bitboard
singlePushTargets ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst ->
        Int -> Int -> ST s ()
pawn (Int
dst Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) Int
dst
      Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits Bitboard
doublePushTargets ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst ->
        Ply -> ST s ()
add (Ply -> ST s ()) -> Ply -> ST s ()
forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq (Int -> Square) -> Int -> Square
forall a b. (a -> b) -> a -> b
$ Int
dst Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16) (Int -> Square
Sq Int
dst)

      Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> (Ply -> ST s ())
-> ST s ()
forall s.
Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> (Ply -> ST s ())
-> ST s ()
piecePlies (QuadBitboard -> Bitboard
QBB.wKnights QuadBitboard
qbb)
                 (QuadBitboard -> Bitboard
QBB.wBishops QuadBitboard
qbb)
                 (QuadBitboard -> Bitboard
QBB.wRooks QuadBitboard
qbb)
                 (QuadBitboard -> Bitboard
QBB.wQueens QuadBitboard
qbb)
        Bitboard
occ Bitboard
notUs Ply -> ST s ()
add

      -- King
      Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits (QuadBitboard -> Bitboard
QBB.wKings QuadBitboard
qbb) ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
src -> do
        Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits (Vector Bitboard
kingAttacks Vector Bitboard -> Int -> Bitboard
forall a. Unbox a => Vector a -> Int -> a
`unsafeIndex` Int
src Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notUs) ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
          Ply -> ST s ()
add (Ply -> ST s ()) -> Ply -> ST s ()
forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
src) (Int -> Square
Sq Int
dst)
      Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Position -> Bitboard -> Bool
canWhiteCastleKingside Position
pos Bitboard
occ) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Ply -> ST s ()
add Ply
wKscm
      Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Position -> Bitboard -> Bool
canWhiteCastleQueenside Position
pos Bitboard
occ) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Ply -> ST s ()
add Ply
wQscm

    Color
Black -> do
      let !us :: Bitboard
us = QuadBitboard -> Bitboard
QBB.black QuadBitboard
qbb
          !them :: Bitboard
them = QuadBitboard -> Bitboard
QBB.white QuadBitboard
qbb
          !notUs :: Bitboard
notUs = Bitboard -> Bitboard
forall a. Bits a => a -> a
complement Bitboard
us
          !occ :: Bitboard
occ = Bitboard
us Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
them
          !notOcc :: Bitboard
notOcc = Bitboard -> Bitboard
forall a. Bits a => a -> a
complement Bitboard
occ

      -- Pawn
      let !bPawns :: Bitboard
bPawns = QuadBitboard -> Bitboard
QBB.bPawns QuadBitboard
qbb
      let !singlePushTargets :: Bitboard
singlePushTargets = Bitboard -> Bitboard
shiftS Bitboard
bPawns Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notOcc
      let !doublePushTargets :: Bitboard
doublePushTargets = Bitboard -> Bitboard
shiftS Bitboard
singlePushTargets Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notOcc Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
rank5
      let !captureTargets :: Bitboard
captureTargets = Bitboard
them Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
ep Bitboard
flags
      let !eastCaptureTargets :: Bitboard
eastCaptureTargets = Bitboard -> Bitboard
shiftSE Bitboard
bPawns Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
captureTargets
      let !westCaptureTargets :: Bitboard
westCaptureTargets = Bitboard -> Bitboard
shiftSW Bitboard
bPawns Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
captureTargets
      let pawn :: Int -> Int -> ST s ()
pawn Int
s Int
d
            | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7
            = let pl :: Ply
pl = Square -> Square -> Ply
move (Int -> Square
Sq Int
s) (Int -> Square
Sq Int
d)
              in [PieceType] -> (PieceType -> ST s ()) -> ST s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [PieceType
Queen, PieceType
Rook, PieceType
Bishop, PieceType
Knight] ((PieceType -> ST s ()) -> ST s ())
-> (PieceType -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \PieceType
p ->
                   Ply -> ST s ()
add (Ply -> ST s ()) -> Ply -> ST s ()
forall a b. (a -> b) -> a -> b
$ Ply
pl Ply -> PieceType -> Ply
`promoteTo` PieceType
p
            | Bool
otherwise
            = Ply -> ST s ()
add (Ply -> ST s ()) -> Ply -> ST s ()
forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
s) (Int -> Square
Sq Int
d)
      Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits Bitboard
westCaptureTargets ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
        Int -> Int -> ST s ()
pawn (Int
dst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
9) Int
dst
      Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits Bitboard
eastCaptureTargets ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
        Int -> Int -> ST s ()
pawn (Int
dst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int
dst
      Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits Bitboard
singlePushTargets ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst ->
        Int -> Int -> ST s ()
pawn (Int
dst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Int
dst
      Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits Bitboard
doublePushTargets ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst ->
        Ply -> ST s ()
add (Ply -> ST s ()) -> Ply -> ST s ()
forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq (Int -> Square) -> Int -> Square
forall a b. (a -> b) -> a -> b
$ Int
dst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16) (Int -> Square
Sq Int
dst)

      Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> (Ply -> ST s ())
-> ST s ()
forall s.
Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> (Ply -> ST s ())
-> ST s ()
piecePlies (QuadBitboard -> Bitboard
QBB.bKnights QuadBitboard
qbb)
                 (QuadBitboard -> Bitboard
QBB.bBishops QuadBitboard
qbb)
                 (QuadBitboard -> Bitboard
QBB.bRooks QuadBitboard
qbb)
                 (QuadBitboard -> Bitboard
QBB.bQueens QuadBitboard
qbb)
        Bitboard
occ Bitboard
notUs Ply -> ST s ()
add

      -- King
      Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits (QuadBitboard -> Bitboard
QBB.bKings QuadBitboard
qbb) ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
src -> do
        Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits (Vector Bitboard
kingAttacks Vector Bitboard -> Int -> Bitboard
forall a. Unbox a => Vector a -> Int -> a
`unsafeIndex` Int
src Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notUs) ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
          Ply -> ST s ()
add (Ply -> ST s ()) -> Ply -> ST s ()
forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
src) (Int -> Square
Sq Int
dst)
      Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Position -> Bitboard -> Bool
canBlackCastleKingside Position
pos Bitboard
occ) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Ply -> ST s ()
add Ply
bKscm
      Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Position -> Bitboard -> Bool
canBlackCastleQueenside Position
pos Bitboard
occ) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Ply -> ST s ()
add Ply
bQscm

  MVector s Ply -> ST s (Vector Ply)
MVector (PrimState (ST s)) Ply -> ST s (Vector Ply)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
Vector.unsafeFreeze (MVector s Ply -> ST s (Vector Ply))
-> (Int -> MVector s Ply) -> Int -> ST s (Vector Ply)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MVector s Ply -> MVector s Ply) -> MVector s Ply -> MVector s Ply
forall a b. (a -> b) -> a -> b
$ MVector s Ply
v) ((MVector s Ply -> MVector s Ply) -> MVector s Ply)
-> (Int -> MVector s Ply -> MVector s Ply) -> Int -> MVector s Ply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> MVector s Ply -> MVector s Ply
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
VUM.unsafeSlice Int
0 (Int -> ST s (Vector Ply)) -> ST s Int -> ST s (Vector Ply)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
i

piecePlies :: Bitboard -> Bitboard -> Bitboard -> Bitboard
           -> Bitboard -> Bitboard -> (Ply -> ST s ())
           -> ST s ()
piecePlies :: forall s.
Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> Bitboard
-> (Ply -> ST s ())
-> ST s ()
piecePlies !Bitboard
knights !Bitboard
bishops !Bitboard
rooks !Bitboard
queens !Bitboard
occ !Bitboard
notUs Ply -> ST s ()
add = do
  Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits Bitboard
knights ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
src -> do
    Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits (Vector Bitboard
knightAttacks Vector Bitboard -> Int -> Bitboard
forall a. Unbox a => Vector a -> Int -> a
`unsafeIndex` Int
src Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notUs) ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
      Ply -> ST s ()
add (Ply -> ST s ()) -> Ply -> ST s ()
forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
src) (Int -> Square
Sq Int
dst)
  Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits Bitboard
bishops ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
src -> do
    Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits (Int -> Bitboard -> Bitboard
diagonal Int
src Bitboard
occ Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notUs) ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
      Ply -> ST s ()
add (Ply -> ST s ()) -> Ply -> ST s ()
forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
src) (Int -> Square
Sq Int
dst)
  Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits Bitboard
rooks ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
src -> do
    Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits (Int -> Bitboard -> Bitboard
orthogonal Int
src Bitboard
occ Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notUs) ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
      Ply -> ST s ()
add (Ply -> ST s ()) -> Ply -> ST s ()
forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
src) (Int -> Square
Sq Int
dst)
  Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits Bitboard
queens ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
src -> do
    Bitboard -> (Int -> ST s ()) -> ST s ()
forall s. Bitboard -> (Int -> ST s ()) -> ST s ()
forBits ((Int -> Bitboard -> Bitboard
orthogonal Int
src Bitboard
occ Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Int -> Bitboard -> Bitboard
diagonal Int
src Bitboard
occ) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
notUs) ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
      Ply -> ST s ()
add (Ply -> ST s ()) -> Ply -> ST s ()
forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
src) (Int -> Square
Sq Int
dst)
{-# INLINE piecePlies #-}

-- | Returns 'True' if 'Color' is in check in the given position.
inCheck :: Color -> Position -> Bool
inCheck :: Color -> Position -> Bool
inCheck Color
White Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb} =
  Color -> QuadBitboard -> Bitboard -> Square -> Bool
attackedBy Color
Black QuadBitboard
qbb (QuadBitboard -> Bitboard
QBB.occupied QuadBitboard
qbb) (Int -> Square
Sq (Bitboard -> Int
bitScanForward (QuadBitboard -> Bitboard
QBB.wKings QuadBitboard
qbb)))
inCheck Color
Black Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb} =
  Color -> QuadBitboard -> Bitboard -> Square -> Bool
attackedBy Color
White QuadBitboard
qbb (QuadBitboard -> Bitboard
QBB.occupied QuadBitboard
qbb) (Int -> Square
Sq (Bitboard -> Int
bitScanForward (QuadBitboard -> Bitboard
QBB.bKings QuadBitboard
qbb)))

{-# INLINE inCheck #-}

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
$c== :: Castle -> Castle -> Bool
== :: Castle -> Castle -> Bool
$c/= :: Castle -> Castle -> Bool
/= :: 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
$crange :: (Castle, Castle) -> [Castle]
range :: (Castle, Castle) -> [Castle]
$cindex :: (Castle, Castle) -> Castle -> Int
index :: (Castle, Castle) -> Castle -> Int
$cunsafeIndex :: (Castle, Castle) -> Castle -> Int
unsafeIndex :: (Castle, Castle) -> Castle -> Int
$cinRange :: (Castle, Castle) -> Castle -> Bool
inRange :: (Castle, Castle) -> Castle -> Bool
$crangeSize :: (Castle, Castle) -> Int
rangeSize :: (Castle, Castle) -> Int
$cunsafeRangeSize :: (Castle, Castle) -> Int
unsafeRangeSize :: (Castle, Castle) -> Int
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
$ccompare :: Castle -> Castle -> Ordering
compare :: Castle -> Castle -> Ordering
$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
>= :: Castle -> Castle -> Bool
$cmax :: Castle -> Castle -> Castle
max :: Castle -> Castle -> Castle
$cmin :: Castle -> Castle -> Castle
min :: Castle -> Castle -> 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
$cshowsPrec :: Int -> Castle -> ShowS
showsPrec :: Int -> Castle -> ShowS
$cshow :: Castle -> String
show :: Castle -> String
$cshowList :: [Castle] -> ShowS
showList :: [Castle] -> ShowS
Show)

castlingRights :: Position -> [(Color, Castle)]
castlingRights :: Position -> [(Color, Castle)]
castlingRights Position{Bitboard
flags :: Position -> Bitboard
flags :: Bitboard
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 | Bitboard
flags Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
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 | Bitboard
flags Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
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 | Bitboard
flags Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
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 | Bitboard
flags Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
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 Square
enPassantSquare :: Position -> Maybe Square
enPassantSquare Position{Bitboard
flags :: Position -> Bitboard
flags :: Bitboard
flags} = case Bitboard -> Bitboard
ep Bitboard
flags of
  Bitboard
0 -> Maybe Square
forall a. Maybe a
Nothing
  Bitboard
x -> Square -> Maybe Square
forall a. a -> Maybe a
Just (Square -> Maybe Square)
-> (Bitboard -> Square) -> Bitboard -> Maybe Square
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Square
Sq (Int -> Square) -> (Bitboard -> Int) -> Bitboard -> Square
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bitboard -> Int
bitScanForward (Bitboard -> Maybe Square) -> Bitboard -> Maybe Square
forall a b. (a -> b) -> a -> b
$ Bitboard
x

canCastleKingside, canCastleQueenside :: Position -> Bool
canCastleKingside :: Position -> Bool
canCastleKingside pos :: Position
pos@Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, color :: Position -> Color
color = Color
White} =
  Position -> Bitboard -> Bool
canWhiteCastleKingside Position
pos (QuadBitboard -> Bitboard
occupied QuadBitboard
qbb)
canCastleKingside pos :: Position
pos@Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, color :: Position -> Color
color = Color
Black} =
  Position -> Bitboard -> Bool
canBlackCastleKingside Position
pos (QuadBitboard -> Bitboard
occupied QuadBitboard
qbb)
canCastleQueenside :: Position -> Bool
canCastleQueenside pos :: Position
pos@Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, color :: Position -> Color
color = Color
White} =
  Position -> Bitboard -> Bool
canWhiteCastleQueenside Position
pos (QuadBitboard -> Bitboard
occupied QuadBitboard
qbb)
canCastleQueenside pos :: Position
pos@Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, color :: Position -> Color
color = Color
Black} =
  Position -> Bitboard -> Bool
canBlackCastleQueenside Position
pos (QuadBitboard -> Bitboard
occupied QuadBitboard
qbb)

canWhiteCastleKingside, canBlackCastleKingside, canWhiteCastleQueenside, canBlackCastleQueenside :: Position -> Word64 -> Bool
canWhiteCastleKingside :: Position -> Bitboard -> Bool
canWhiteCastleKingside Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, Bitboard
flags :: Position -> Bitboard
flags :: Bitboard
flags} !Bitboard
occ =
  Bitboard
flags Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
crwKs Bool -> Bool -> Bool
&& Bitboard
occ Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
crwKe Bitboard -> Bitboard -> Bool
forall a. Eq a => a -> a -> Bool
== Bitboard
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not ((Square -> Bool) -> [Square] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Bitboard -> Square -> Bool
attackedBy Color
Black QuadBitboard
qbb Bitboard
occ) [Square
E1, Square
F1, Square
G1])
canBlackCastleKingside :: Position -> Bitboard -> Bool
canBlackCastleKingside Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, Bitboard
flags :: Position -> Bitboard
flags :: Bitboard
flags} !Bitboard
occ =
  Bitboard
flags Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
crbKs Bool -> Bool -> Bool
&& Bitboard
occ Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
crbKe Bitboard -> Bitboard -> Bool
forall a. Eq a => a -> a -> Bool
== Bitboard
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not ((Square -> Bool) -> [Square] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Bitboard -> Square -> Bool
attackedBy Color
White QuadBitboard
qbb Bitboard
occ) [Square
E8, Square
F8, Square
G8])
canWhiteCastleQueenside :: Position -> Bitboard -> Bool
canWhiteCastleQueenside Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, Bitboard
flags :: Position -> Bitboard
flags :: Bitboard
flags} !Bitboard
occ =
  Bitboard
flags Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
crwQs Bool -> Bool -> Bool
&& Bitboard
occ Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
crwQe Bitboard -> Bitboard -> Bool
forall a. Eq a => a -> a -> Bool
== Bitboard
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not ((Square -> Bool) -> [Square] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Bitboard -> Square -> Bool
attackedBy Color
Black QuadBitboard
qbb Bitboard
occ) [Square
E1, Square
D1, Square
C1])
canBlackCastleQueenside :: Position -> Bitboard -> Bool
canBlackCastleQueenside Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, Bitboard
flags :: Position -> Bitboard
flags :: Bitboard
flags} !Bitboard
occ =
  Bitboard
flags Bitboard -> Bitboard -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Bitboard
crbQs Bool -> Bool -> Bool
&& Bitboard
occ Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
crbQe Bitboard -> Bitboard -> Bool
forall a. Eq a => a -> a -> Bool
== Bitboard
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not ((Square -> Bool) -> [Square] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Bitboard -> Square -> Bool
attackedBy Color
White QuadBitboard
qbb Bitboard
occ) [Square
E8, Square
D8, Square
C8])

wKscm, wQscm, bKscm, bQscm :: Ply
wKscm :: Ply
wKscm = Square -> Square -> Ply
move Square
E1 Square
G1
wQscm :: Ply
wQscm = Square -> Square -> Ply
move Square
E1 Square
C1
bKscm :: Ply
bKscm = Square -> Square -> Ply
move Square
E8 Square
G8
bQscm :: Ply
bQscm = Square -> Square -> Ply
move Square
E8 Square
C8

attackedBy :: Color -> QuadBitboard -> Word64 -> Square -> Bool
attackedBy :: Color -> QuadBitboard -> Bitboard -> Square -> Bool
attackedBy Color
White !QuadBitboard
qbb !Bitboard
occ (Sq Int
sq) =
  (Vector Bitboard -> Int -> Bitboard
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Bitboard
wPawnAttacks Int
sq Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Bitboard
QBB.wPawns QuadBitboard
qbb) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.
  (Vector Bitboard -> Int -> Bitboard
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Bitboard
knightAttacks Int
sq Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Bitboard
QBB.wKnights QuadBitboard
qbb) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.
  (Int -> Bitboard -> Bitboard
diagonal Int
sq Bitboard
occ Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Bitboard
QBB.wDiagonals QuadBitboard
qbb) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.
  (Int -> Bitboard -> Bitboard
orthogonal Int
sq Bitboard
occ Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&.   QuadBitboard -> Bitboard
QBB.wOrthogonals QuadBitboard
qbb) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.
  (Vector Bitboard -> Int -> Bitboard
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Bitboard
kingAttacks Int
sq Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Bitboard
QBB.wKings QuadBitboard
qbb) Bitboard -> Bitboard -> Bool
forall a. Eq a => a -> a -> Bool
/= Bitboard
0
attackedBy Color
Black !QuadBitboard
qbb !Bitboard
occ (Sq Int
sq) =
  (Vector Bitboard -> Int -> Bitboard
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Bitboard
bPawnAttacks Int
sq Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Bitboard
QBB.bPawns QuadBitboard
qbb) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.
  (Vector Bitboard -> Int -> Bitboard
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Bitboard
knightAttacks Int
sq Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Bitboard
QBB.bKnights QuadBitboard
qbb) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.
  (Int -> Bitboard -> Bitboard
diagonal Int
sq Bitboard
occ Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Bitboard
QBB.bDiagonals QuadBitboard
qbb) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.
  (Int -> Bitboard -> Bitboard
orthogonal Int
sq Bitboard
occ Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&.   QuadBitboard -> Bitboard
QBB.bOrthogonals QuadBitboard
qbb) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.
  (Vector Bitboard -> Int -> Bitboard
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Bitboard
kingAttacks Int
sq Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Bitboard
QBB.bKings QuadBitboard
qbb) Bitboard -> Bitboard -> Bool
forall a. Eq a => a -> a -> Bool
/= Bitboard
0

{-# INLINE attackedBy #-}

attackedByPawn :: Square -> Position -> Bool
attackedByPawn :: Square -> Position -> Bool
attackedByPawn (Sq Int
sq) Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, Color
color :: Position -> Color
color :: Color
color} = case Color
color of
  Color
White -> Vector Bitboard -> Int -> Bitboard
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Bitboard
wPawnAttacks Int
sq Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Bitboard
QBB.wPawns QuadBitboard
qbb Bitboard -> Bitboard -> Bool
forall a. Eq a => a -> a -> Bool
/= Bitboard
0
  Color
Black -> Vector Bitboard -> Int -> Bitboard
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Bitboard
bPawnAttacks Int
sq Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Bitboard
QBB.bPawns QuadBitboard
qbb Bitboard -> Bitboard -> Bool
forall a. Eq a => a -> a -> Bool
/= Bitboard
0

notAFile, notABFile, notGHFile, notHFile, rank1, rank2, rank3, rank4, rank5, rank6, rank7, rank8 :: Word64
notAFile :: Bitboard
notAFile = Bitboard
0xfefefefefefefefe
notABFile :: Bitboard
notABFile = Bitboard
0xfcfcfcfcfcfcfcfc
notGHFile :: Bitboard
notGHFile = Bitboard
0x3f3f3f3f3f3f3f3f
notHFile :: Bitboard
notHFile = Bitboard
0x7f7f7f7f7f7f7f7f
rank1 :: Bitboard
rank1 = Bitboard
0x00000000000000ff
rank2 :: Bitboard
rank2 = Bitboard
0x000000000000ff00
rank3 :: Bitboard
rank3 = Bitboard
0x0000000000ff0000
rank4 :: Bitboard
rank4 = Bitboard
0x00000000ff000000
rank5 :: Bitboard
rank5 = Bitboard
0x000000ff00000000
rank6 :: Bitboard
rank6 = Bitboard
0x0000ff0000000000
rank7 :: Bitboard
rank7 = Bitboard
0x00ff000000000000
rank8 :: Bitboard
rank8 = Bitboard
0xff00000000000000

epMask, crwKs, crwQs, crwKe, crwQe, crbKs, crbQs, crbKe, crbQe :: Word64
epMask :: Bitboard
epMask = Bitboard
rank3 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
rank6        -- mask for en passant
crwKs :: Bitboard
crwKs  = Bitboard
0x0000000000000090     -- white: king & rook position for kingside castle
crwQs :: Bitboard
crwQs  = Bitboard
0x0000000000000011     -- white: king & rook pisition for queenside castle^M
crwKe :: Bitboard
crwKe  = Bitboard
0x0000000000000060     -- white: empty fields for kingside castle
crwQe :: Bitboard
crwQe  = Bitboard
0x000000000000000e     -- white: empty fields for queenside castle
crbKs :: Bitboard
crbKs  = Bitboard
0x9000000000000000     -- black: king & rook position for kingside castle
crbQs :: Bitboard
crbQs  = Bitboard
0x1100000000000000     -- black: king & rook position for queenside castle^M
crbKe :: Bitboard
crbKe  = Bitboard
0x6000000000000000     -- black: empty fields for kingside castle
crbQe :: Bitboard
crbQe  = Bitboard
0x0e00000000000000     -- black: empty fields for queenside castle

kingAttacks, knightAttacks, wPawnAttacks, bPawnAttacks :: Vector Word64
kingAttacks :: Vector Bitboard
kingAttacks = Int -> (Int -> Bitboard) -> Vector Bitboard
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Bitboard) -> Vector Bitboard)
-> (Int -> Bitboard) -> Vector Bitboard
forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Bitboard
b = Int -> Bitboard
forall a. Bits a => Int -> a
bit Int
sq in
  Bitboard -> Bitboard
shiftN Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
shiftNE Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
shiftE Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
shiftSE Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.
  Bitboard -> Bitboard
shiftS Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
shiftSW Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
shiftW Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
shiftNW Bitboard
b
knightAttacks :: Vector Bitboard
knightAttacks = Int -> (Int -> Bitboard) -> Vector Bitboard
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Bitboard) -> Vector Bitboard)
-> (Int -> Bitboard) -> Vector Bitboard
forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Bitboard
b = Int -> Bitboard
forall a. Bits a => Int -> a
bit Int
sq in
  Bitboard -> Bitboard
shiftNNE Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
shiftENE Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.
  Bitboard -> Bitboard
shiftESE Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
shiftSSE Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.
  Bitboard -> Bitboard
shiftSSW Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
shiftWSW Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|.
  Bitboard -> Bitboard
shiftWNW Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
shiftNNW Bitboard
b
wPawnAttacks :: Vector Bitboard
wPawnAttacks = Int -> (Int -> Bitboard) -> Vector Bitboard
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Bitboard) -> Vector Bitboard)
-> (Int -> Bitboard) -> Vector Bitboard
forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Bitboard
b = Int -> Bitboard
forall a. Bits a => Int -> a
bit Int
sq in
  Bitboard -> Bitboard
shiftSE Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
shiftSW Bitboard
b
bPawnAttacks :: Vector Bitboard
bPawnAttacks = Int -> (Int -> Bitboard) -> Vector Bitboard
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Bitboard) -> Vector Bitboard)
-> (Int -> Bitboard) -> Vector Bitboard
forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Bitboard
b = Int -> Bitboard
forall a. Bits a => Int -> a
bit Int
sq in
  Bitboard -> Bitboard
shiftNE Bitboard
b Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard -> Bitboard
shiftNW Bitboard
b

orthogonal, diagonal :: Int -> Bitboard -> Bitboard
orthogonal :: Int -> Bitboard -> Bitboard
orthogonal !Int
sq !Bitboard
occ = Bitboard
mask Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. ((Bitboard
up Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
down) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. (Bitboard
left Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
right)) where
  mask :: Bitboard
mask = Bitboard -> Bitboard
forall a. Bits a => a -> a
complement (Bitboard -> Bitboard) -> Bitboard -> Bitboard
forall a b. (a -> b) -> a -> b
$ Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftL Bitboard
1 Int
sq
  occ' :: Bitboard
occ' = Bitboard
occ Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
mask
  up :: Bitboard
up = Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftR Bitboard
hFile (Int -> Bitboard) -> Int -> Bitboard
forall a b. (a -> b) -> a -> b
$ (Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Bitboard -> Int
bitScanForward (Bitboard -> Int) -> Bitboard -> Int
forall a b. (a -> b) -> a -> b
$
       Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftL Bitboard
aFile Int
sq Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. (Bitboard
occ' Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
rank8)
  down :: Bitboard
down = Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftL Bitboard
aFile (Int -> Bitboard) -> Int -> Bitboard
forall a b. (a -> b) -> a -> b
$ Bitboard -> Int
bitScanReverse (Bitboard -> Int) -> Bitboard -> Int
forall a b. (a -> b) -> a -> b
$
         Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftR Bitboard
hFile (Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sq) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. (Bitboard
occ' Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
rank1)
  right :: Bitboard
right = Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftR Bitboard
rank8 (Int -> Bitboard) -> Int -> Bitboard
forall a b. (a -> b) -> a -> b
$ (Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Bitboard -> Int
bitScanForward (Bitboard -> Int) -> Bitboard -> Int
forall a b. (a -> b) -> a -> b
$
          Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftL Bitboard
rank1 Int
sq Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. (Bitboard
occ' Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
hFile)
  left :: Bitboard
left = Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftL Bitboard
rank1 (Int -> Bitboard) -> Int -> Bitboard
forall a b. (a -> b) -> a -> b
$ Bitboard -> Int
bitScanReverse (Bitboard -> Int) -> Bitboard -> Int
forall a b. (a -> b) -> a -> b
$
         Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftR Bitboard
rank8 (Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sq) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. (Bitboard
occ' Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
aFile)
diagonal :: Int -> Bitboard -> Bitboard
diagonal !Int
sq !Bitboard
occ = Bitboard
mask Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. ((Bitboard
up Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
down) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. (Bitboard
left Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
right)) where
  mask :: Bitboard
mask = Bitboard -> Bitboard
forall a. Bits a => a -> a
complement (Bitboard -> Bitboard) -> Bitboard -> Bitboard
forall a b. (a -> b) -> a -> b
$ Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftL Bitboard
1 Int
sq
  occ' :: Bitboard
occ' = Bitboard
occ Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
mask
  up :: Bitboard
up = Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftR Bitboard
a1h8 (Int -> Bitboard) -> Int -> Bitboard
forall a b. (a -> b) -> a -> b
$ (Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Bitboard -> Int
bitScanForward (Bitboard -> Int) -> Bitboard -> Int
forall a b. (a -> b) -> a -> b
$
       Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftL Bitboard
a1h8 Int
sq Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. (Bitboard
occ' Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
rank8 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
hFile)
  down :: Bitboard
down = Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftL Bitboard
a1h8 (Int -> Bitboard) -> Int -> Bitboard
forall a b. (a -> b) -> a -> b
$ Bitboard -> Int
bitScanReverse (Bitboard -> Int) -> Bitboard -> Int
forall a b. (a -> b) -> a -> b
$
         Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftR Bitboard
a1h8 (Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sq) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. (Bitboard
occ' Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
rank1 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
aFile)
  right :: Bitboard
right = Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftL Bitboard
h1a8 (Int -> Bitboard) -> Int -> Bitboard
forall a b. (a -> b) -> a -> b
$ Bitboard -> Int
bitScanReverse (Bitboard -> Int) -> Bitboard -> Int
forall a b. (a -> b) -> a -> b
$
          Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftR Bitboard
h1a8 (Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sq) Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. (Bitboard
occ' Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
rank1 Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
hFile)
  left :: Bitboard
left = Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftR Bitboard
h1a8 (Int -> Bitboard) -> Int -> Bitboard
forall a b. (a -> b) -> a -> b
$ (Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Bitboard -> Int
bitScanForward (Bitboard -> Int) -> Bitboard -> Int
forall a b. (a -> b) -> a -> b
$
         Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
unsafeShiftL Bitboard
h1a8 Int
sq Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. (Bitboard
occ' Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
aFile Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.|. Bitboard
rank8)

aFile, hFile, a1h8, h1a8 :: Bitboard
aFile :: Bitboard
aFile = Bitboard
0x0101010101010101
hFile :: Bitboard
hFile = Bitboard
0x8080808080808080
a1h8 :: Bitboard
a1h8 = Bitboard
0x8040201008040201
h1a8 :: Bitboard
h1a8 = Bitboard
0x8102040810204081

clearMask :: Bits a => a -> a -> a
clearMask :: forall a. Bits a => 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 :: forall a. Bits a => 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 testMask #-}