{-# 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 :: Word64 -> Word64
ep Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x0000ff0000ff0000

{-# INLINE ep #-}

type Bitboard = Word64

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

capturing :: Position -> Ply -> Maybe PieceType
capturing :: Position -> Ply -> Maybe PieceType
capturing pos :: Position
pos@Position{Word64
flags :: Position -> Word64
flags :: Word64
flags} (Ply -> Square
plyTarget -> Square
to)
  | Word64 -> Word64
ep Word64
flags Word64 -> 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 :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb, Word64
flags :: Word64
flags :: Position -> Word64
flags} =
  Word64 -> Square -> Bool
testSquare (QuadBitboard -> Word64
QBB.occupied QuadBitboard
qbb Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
ep Word64
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 :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb} = Word64 -> Square -> Bool
testSquare (QuadBitboard -> Word64
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
/= :: PieceType -> PieceType -> Bool
$c/= :: PieceType -> PieceType -> Bool
== :: PieceType -> PieceType -> Bool
$c== :: PieceType -> PieceType -> Bool
Eq, Ord PieceType
Ord PieceType
-> ((PieceType, PieceType) -> [PieceType])
-> ((PieceType, PieceType) -> PieceType -> Int)
-> ((PieceType, PieceType) -> PieceType -> Int)
-> ((PieceType, PieceType) -> PieceType -> Bool)
-> ((PieceType, PieceType) -> Int)
-> ((PieceType, PieceType) -> Int)
-> Ix PieceType
(PieceType, PieceType) -> Int
(PieceType, PieceType) -> [PieceType]
(PieceType, PieceType) -> PieceType -> Bool
(PieceType, PieceType) -> PieceType -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (PieceType, PieceType) -> Int
$cunsafeRangeSize :: (PieceType, PieceType) -> Int
rangeSize :: (PieceType, PieceType) -> Int
$crangeSize :: (PieceType, PieceType) -> Int
inRange :: (PieceType, PieceType) -> PieceType -> Bool
$cinRange :: (PieceType, PieceType) -> PieceType -> Bool
unsafeIndex :: (PieceType, PieceType) -> PieceType -> Int
$cunsafeIndex :: (PieceType, PieceType) -> PieceType -> Int
index :: (PieceType, PieceType) -> PieceType -> Int
$cindex :: (PieceType, PieceType) -> PieceType -> Int
range :: (PieceType, PieceType) -> [PieceType]
$crange :: (PieceType, PieceType) -> [PieceType]
$cp1Ix :: Ord PieceType
Ix, PieceType -> Q Exp
PieceType -> Q (TExp PieceType)
(PieceType -> Q Exp)
-> (PieceType -> Q (TExp PieceType)) -> Lift PieceType
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: PieceType -> Q (TExp PieceType)
$cliftTyped :: PieceType -> Q (TExp PieceType)
lift :: PieceType -> Q Exp
$clift :: PieceType -> Q Exp
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
min :: PieceType -> PieceType -> PieceType
$cmin :: PieceType -> PieceType -> PieceType
max :: PieceType -> PieceType -> PieceType
$cmax :: PieceType -> PieceType -> PieceType
>= :: PieceType -> PieceType -> Bool
$c>= :: PieceType -> PieceType -> Bool
> :: PieceType -> PieceType -> Bool
$c> :: PieceType -> PieceType -> Bool
<= :: PieceType -> PieceType -> Bool
$c<= :: PieceType -> PieceType -> Bool
< :: PieceType -> PieceType -> Bool
$c< :: PieceType -> PieceType -> Bool
compare :: PieceType -> PieceType -> Ordering
$ccompare :: PieceType -> PieceType -> Ordering
$cp1Ord :: Eq PieceType
Ord)

pattern Pawn, Knight, Bishop, Rook, Queen, King :: PieceType
pattern $bPawn :: PieceType
$mPawn :: forall r. PieceType -> (Void# -> r) -> (Void# -> r) -> r
Pawn = PieceType 0
pattern $bKnight :: PieceType
$mKnight :: forall r. PieceType -> (Void# -> r) -> (Void# -> r) -> r
Knight = PieceType 1
pattern $bBishop :: PieceType
$mBishop :: forall r. PieceType -> (Void# -> r) -> (Void# -> r) -> r
Bishop = PieceType 2
pattern $bRook :: PieceType
$mRook :: forall r. PieceType -> (Void# -> r) -> (Void# -> r) -> r
Rook = PieceType 3
pattern $bQueen :: PieceType
$mQueen :: forall r. PieceType -> (Void# -> r) -> (Void# -> r) -> r
Queen = PieceType 4
pattern $bKing :: PieceType
$mKing :: forall r. PieceType -> (Void# -> r) -> (Void# -> r) -> r
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
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: 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
$cto :: forall x. Rep Color x -> Color
$cfrom :: forall x. Color -> Rep Color x
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
unsafeRangeSize :: (Color, Color) -> Int
$cunsafeRangeSize :: (Color, Color) -> Int
rangeSize :: (Color, Color) -> Int
$crangeSize :: (Color, Color) -> Int
inRange :: (Color, Color) -> Color -> Bool
$cinRange :: (Color, Color) -> Color -> Bool
unsafeIndex :: (Color, Color) -> Color -> Int
$cunsafeIndex :: (Color, Color) -> Color -> Int
index :: (Color, Color) -> Color -> Int
$cindex :: (Color, Color) -> Color -> Int
range :: (Color, Color) -> [Color]
$crange :: (Color, Color) -> [Color]
$cp1Ix :: Ord Color
Ix, Eq Color
Eq Color
-> (Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
$cp1Ord :: Eq Color
Ord, Color -> Q Exp
Color -> Q (TExp Color)
(Color -> Q Exp) -> (Color -> Q (TExp Color)) -> Lift Color
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Color -> Q (TExp Color)
$cliftTyped :: Color -> Q (TExp Color)
lift :: Color -> Q Exp
$clift :: Color -> Q Exp
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
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> 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 :: QuadBitboard
qbb :: Position -> 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 -> Word64
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
$cto :: forall x. Rep Position x -> Position
$cfrom :: forall x. Position -> Rep Position x
Generic, Position -> Q Exp
Position -> Q (TExp Position)
(Position -> Q Exp)
-> (Position -> Q (TExp Position)) -> Lift Position
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Position -> Q (TExp Position)
$cliftTyped :: Position -> Q (TExp Position)
lift :: Position -> Q Exp
$clift :: Position -> Q Exp
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 -> Word64
flags Position
a Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Position -> Word64
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 -> Word64
flags Position
a Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Position -> Word64
flags Position
b

instance Hashable Position where
  hashWithSalt :: Int -> Position -> Int
hashWithSalt Int
s Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, Color
color :: Color
color :: Position -> Color
color, Word64
flags :: Word64
flags :: Position -> Word64
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 -> Word64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
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 (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 (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6
  = QuadBitboard -> Color -> Word64 -> Int -> Int -> Position
Position (QuadBitboard -> Color -> Word64 -> Int -> Int -> Position)
-> Maybe QuadBitboard
-> Maybe (Color -> Word64 -> Int -> Int -> Position)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QuadBitboard -> Maybe QuadBitboard
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> QuadBitboard
forall a. IsString a => String -> a
fromString ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
0))
             Maybe (Color -> Word64 -> Int -> Int -> Position)
-> Maybe Color -> Maybe (Word64 -> Int -> Int -> Position)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Color
forall a. (Eq a, IsString a) => a -> Maybe Color
readColor ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
1)
             Maybe (Word64 -> Int -> Int -> Position)
-> Maybe Word64 -> Maybe (Int -> Int -> Position)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Maybe Word64
readFlags ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
2) ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
3)
             Maybe (Int -> Int -> Position)
-> Maybe Int -> Maybe (Int -> Position)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
4)
             Maybe (Int -> Position) -> Maybe Int -> Maybe Position
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
5)
  | [String] -> 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 -> Word64 -> Int -> Int -> Position
Position (QuadBitboard -> Color -> Word64 -> Int -> Int -> Position)
-> Maybe QuadBitboard
-> Maybe (Color -> Word64 -> Int -> Int -> Position)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QuadBitboard -> Maybe QuadBitboard
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> QuadBitboard
forall a. IsString a => String -> a
fromString ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
0))
             Maybe (Color -> Word64 -> Int -> Int -> Position)
-> Maybe Color -> Maybe (Word64 -> Int -> Int -> Position)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Color
forall a. (Eq a, IsString a) => a -> Maybe Color
readColor ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
1)
             Maybe (Word64 -> Int -> Int -> Position)
-> Maybe Word64 -> Maybe (Int -> Int -> Position)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Maybe Word64
readFlags ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
2) ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
3)
             Maybe (Int -> Int -> Position)
-> Maybe Int -> Maybe (Int -> Position)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
             Maybe (Int -> Position) -> Maybe Int -> Maybe Position
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Int
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 Word64
readFlags String
c String
e = Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.|.) (Word64 -> Word64 -> Word64)
-> Maybe Word64 -> Maybe (Word64 -> Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
readCst String
c Maybe (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Word64
forall a. (Num a, Bits a) => String -> Maybe a
readEP String
e where
    readCst :: String -> Maybe Word64
readCst String
"-" = Word64 -> Maybe Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
    readCst String
x = String -> Maybe Word64
go String
x where
      go :: String -> Maybe Word64
go (Char
'K':String
xs) = (Word64
crwKs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.) (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
go String
xs
      go (Char
'Q':String
xs) = (Word64
crwQs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.) (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
go String
xs
      go (Char
'k':String
xs) = (Word64
crbKs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.) (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
go String
xs
      go (Char
'q':String
xs) = (Word64
crbQs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.) (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
go String
xs
      go []       = Word64 -> Maybe Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
      go String
_        = Maybe Word64
forall a. Maybe a
Nothing
    readEP :: String -> Maybe a
readEP String
"-" = a -> Maybe a
forall a. a -> Maybe a
Just a
0
    readEP [Char
f,Char
r]
      | (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'a',Char
'h') Char
f Bool -> Bool -> Bool
&& (Char
r Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'3' Bool -> Bool -> Bool
|| Char
r Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'6')
      = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a. Bits a => Int -> a
bit ((Char -> Int
ord Char
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'1') Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a'))
    readEP String
_ = Maybe a
forall a. Maybe a
Nothing

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

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

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

bitScanForward, bitScanReverse :: Word64 -> Int
bitScanForward :: Word64 -> Int
bitScanForward = Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros
bitScanReverse :: Word64 -> Int
bitScanReverse Word64
bb = Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word64 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word64
bb

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

instance Show Ply where
  show :: Ply -> String
show (Ply -> (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 :: MVector s Ply -> Int
basicLength (MV_Ply v) = MVector s Word16 -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
M.basicLength MVector s Word16
v
  basicUnsafeSlice :: Int -> Int -> MVector s Ply -> MVector s Ply
basicUnsafeSlice Int
i Int
n (MV_Ply 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 (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 :: MVector s Ply -> MVector s Ply -> Bool
basicOverlaps (MV_Ply v1) (MV_Ply v2) = 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 :: Int -> m (MVector (PrimState m) Ply)
basicUnsafeNew Int
n = MVector (PrimState m) Word16 -> MVector (PrimState m) Ply
forall s. MVector s Word16 -> MVector s Ply
MV_Ply (MVector (PrimState m) Word16 -> MVector (PrimState m) Ply)
-> m (MVector (PrimState m) Word16)
-> m (MVector (PrimState m) Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) Word16)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
M.basicUnsafeNew Int
n
  basicInitialize :: MVector (PrimState m) Ply -> m ()
basicInitialize (MV_Ply v) = MVector (PrimState m) Word16 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicInitialize MVector (PrimState m) Word16
v
  basicUnsafeReplicate :: Int -> Ply -> m (MVector (PrimState m) Ply)
basicUnsafeReplicate Int
n (Ply Word16
pl) = MVector (PrimState m) Word16 -> MVector (PrimState m) Ply
forall s. MVector s Word16 -> MVector s Ply
MV_Ply (MVector (PrimState m) Word16 -> MVector (PrimState m) Ply)
-> m (MVector (PrimState m) Word16)
-> m (MVector (PrimState m) Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Word16 -> m (MVector (PrimState m) Word16)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
M.basicUnsafeReplicate Int
n Word16
pl
  basicUnsafeRead :: MVector (PrimState m) Ply -> Int -> m Ply
basicUnsafeRead (MV_Ply v) Int
i = Word16 -> Ply
Ply (Word16 -> Ply) -> m Word16 -> m Ply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) Word16 -> Int -> m Word16
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
M.basicUnsafeRead MVector (PrimState m) Word16
v Int
i
  basicUnsafeWrite :: MVector (PrimState m) Ply -> Int -> Ply -> m ()
basicUnsafeWrite (MV_Ply v) Int
i (Ply Word16
pl) = MVector (PrimState m) Word16 -> Int -> Word16 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
M.basicUnsafeWrite MVector (PrimState m) Word16
v Int
i Word16
pl
  basicClear :: MVector (PrimState m) Ply -> m ()
basicClear (MV_Ply v) = MVector (PrimState m) Word16 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicClear MVector (PrimState m) Word16
v
  basicSet :: MVector (PrimState m) Ply -> Ply -> m ()
basicSet (MV_Ply v) (Ply Word16
pl) = MVector (PrimState m) Word16 -> Word16 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
M.basicSet MVector (PrimState m) Word16
v Word16
pl
  basicUnsafeCopy :: MVector (PrimState m) Ply -> MVector (PrimState m) Ply -> m ()
basicUnsafeCopy (MV_Ply v1) (MV_Ply v2) = MVector (PrimState m) Word16
-> MVector (PrimState m) Word16 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeCopy MVector (PrimState m) Word16
v1 MVector (PrimState m) Word16
v2
  basicUnsafeMove :: MVector (PrimState m) Ply -> MVector (PrimState m) Ply -> m ()
basicUnsafeMove (MV_Ply v1) (MV_Ply v2) = MVector (PrimState m) Word16
-> MVector (PrimState m) Word16 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeMove MVector (PrimState m) Word16
v1 MVector (PrimState m) Word16
v2
  basicUnsafeGrow :: MVector (PrimState m) Ply -> Int -> m (MVector (PrimState m) Ply)
basicUnsafeGrow (MV_Ply v) Int
n = MVector (PrimState m) Word16 -> MVector (PrimState m) Ply
forall s. MVector s Word16 -> MVector s Ply
MV_Ply (MVector (PrimState m) Word16 -> MVector (PrimState m) Ply)
-> m (MVector (PrimState m) Word16)
-> m (MVector (PrimState m) Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) Word16
-> Int -> m (MVector (PrimState m) Word16)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
M.basicUnsafeGrow MVector (PrimState m) Word16
v Int
n

instance G.Vector Vector Ply where
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeFreeze :: Mutable Vector (PrimState m) Ply -> m (Vector Ply)
basicUnsafeFreeze (MV_Ply v) = Vector Word16 -> Vector Ply
V_Ply (Vector Word16 -> Vector Ply)
-> m (Vector Word16) -> m (Vector Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector (PrimState m) Word16 -> m (Vector Word16)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
G.basicUnsafeFreeze MVector (PrimState m) Word16
Mutable Vector (PrimState m) Word16
v
  basicUnsafeThaw :: Vector Ply -> m (Mutable Vector (PrimState m) Ply)
basicUnsafeThaw (V_Ply v) = MVector (PrimState m) Word16 -> MVector (PrimState m) Ply
forall s. MVector s Word16 -> MVector s Ply
MV_Ply (MVector (PrimState m) Word16 -> MVector (PrimState m) Ply)
-> m (MVector (PrimState m) Word16)
-> m (MVector (PrimState m) Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word16 -> m (Mutable Vector (PrimState m) Word16)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
G.basicUnsafeThaw Vector Word16
v
  basicLength :: Vector Ply -> Int
basicLength (V_Ply 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 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 -> m Ply
basicUnsafeIndexM (V_Ply v) Int
i = Word16 -> Ply
Ply (Word16 -> Ply) -> m Word16 -> m Ply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word16 -> Int -> m Word16
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
G.basicUnsafeIndexM Vector Word16
v Int
i
  basicUnsafeCopy :: Mutable Vector (PrimState m) Ply -> Vector Ply -> m ()
basicUnsafeCopy (MV_Ply mv) (V_Ply v) = Mutable Vector (PrimState m) Word16 -> Vector Word16 -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
G.basicUnsafeCopy MVector (PrimState m) Word16
Mutable Vector (PrimState m) Word16
mv Vector Word16
v
  elemseq :: Vector Ply -> Ply -> b -> b
elemseq Vector Ply
_ Ply
pl b
z = Vector Ply -> Ply -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: Vector a) 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 (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 (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 (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 (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe PieceType
forall a. (Eq a, IsString a) => a -> Maybe PieceType
readPromo String
promo
      Maybe Ply -> (Ply -> Maybe Ply) -> Maybe Ply
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Position -> Ply -> Maybe Ply
relativeTo Position
pos
 where
  readCoord :: String -> Maybe 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 :: Word64 -> Word64
shiftN   Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8
shiftNN :: Word64 -> Word64
shiftNN   Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16
shiftNNE :: Word64 -> Word64
shiftNNE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
17 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftNE :: Word64 -> Word64
shiftNE  Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
9 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftENE :: Word64 -> Word64
shiftENE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
10 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notABFile
shiftE :: Word64 -> Word64
shiftE   Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftESE :: Word64 -> Word64
shiftESE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
6 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notABFile
shiftSE :: Word64 -> Word64
shiftSE  Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
7 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftSSE :: Word64 -> Word64
shiftSSE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
15 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftS :: Word64 -> Word64
shiftS   Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8
shiftSS :: Word64 -> Word64
shiftSS   Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16
shiftSSW :: Word64 -> Word64
shiftSSW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
17 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftSW :: Word64 -> Word64
shiftSW  Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
9 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftWSW :: Word64 -> Word64
shiftWSW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
10 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notGHFile
shiftW :: Word64 -> Word64
shiftW   Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftWNW :: Word64 -> Word64
shiftWNW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
6 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notGHFile
shiftNW :: Word64 -> Word64
shiftNW  Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
7 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftNNW :: Word64 -> Word64
shiftNNW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
15 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile

{-# 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 :: 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 :: Color
color :: Position -> Color
color, Int
halfMoveClock :: Int
halfMoveClock :: Position -> Int
halfMoveClock, Int
moveNumber :: Int
moveNumber :: Position -> Int
moveNumber} Ply
m =
  (Position -> Ply -> Position
unsafeDoPly' Position
pos Ply
m)
  { color :: Color
color = Color -> Color
opponent Color
color
  , halfMoveClock :: Int
halfMoveClock = if Position -> Ply -> Bool
isCapture Position
pos Ply
m Bool -> Bool -> Bool
|| Position -> Ply -> Bool
isPawnPush Position
pos Ply
m
                    then Int
0
                    else Int
halfMoveClock Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  , moveNumber :: Int
moveNumber = if Color
color Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
Black
                 then Int
moveNumber Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                 else Int
moveNumber
  }

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

forBits :: Word64 -> (Int -> ST s ()) -> ST s ()
forBits :: Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
w Int -> ST s ()
f = Word64 -> ST s ()
go Word64
w where
  go :: Word64 -> ST s ()
go Word64
0 = () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  go Word64
n = Int -> ST s ()
f (Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word64
n) ST s () -> ST s () -> ST s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> ST s ()
go (Word64
n Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
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 :: Color
color :: Position -> Color
color, QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, Word64
flags :: Word64
flags :: Position -> Word64
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
      {-# INLINE add #-}

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

      -- Pawn
      let !wPawns :: Word64
wPawns = QuadBitboard -> Word64
QBB.wPawns QuadBitboard
qbb
      let !singlePushTargets :: Word64
singlePushTargets = Word64 -> Word64
shiftN Word64
wPawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOcc
      let !doublePushTargets :: Word64
doublePushTargets = Word64 -> Word64
shiftN Word64
singlePushTargets Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOcc Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
rank4
      let !captureTargets :: Word64
captureTargets = Word64
them Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
ep Word64
flags
      let !eastCaptureTargets :: Word64
eastCaptureTargets = Word64 -> Word64
shiftNE Word64
wPawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
captureTargets
      let !westCaptureTargets :: Word64
westCaptureTargets = Word64 -> Word64
shiftNW Word64
wPawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
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)
      Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
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
      Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
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
      Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
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
      Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
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)

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

      -- King
      Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (QuadBitboard -> Word64
QBB.wKings QuadBitboard
qbb) ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
src -> do
        Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (Vector Word64
kingAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
`unsafeIndex` Int
src Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
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 -> Word64 -> Bool
canWhiteCastleKingside Position
pos Word64
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 -> Word64 -> Bool
canWhiteCastleQueenside Position
pos Word64
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 :: Word64
us = QuadBitboard -> Word64
QBB.black QuadBitboard
qbb
          !them :: Word64
them = QuadBitboard -> Word64
QBB.white QuadBitboard
qbb
          !notUs :: Word64
notUs = Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
us
          !occ :: Word64
occ = Word64
us Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
them
          !notOcc :: Word64
notOcc = Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
occ

      -- Pawn
      let !bPawns :: Word64
bPawns = QuadBitboard -> Word64
QBB.bPawns QuadBitboard
qbb
      let !singlePushTargets :: Word64
singlePushTargets = Word64 -> Word64
shiftS Word64
bPawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOcc
      let !doublePushTargets :: Word64
doublePushTargets = Word64 -> Word64
shiftS Word64
singlePushTargets Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOcc Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
rank5
      let !captureTargets :: Word64
captureTargets = Word64
them Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
ep Word64
flags
      let !eastCaptureTargets :: Word64
eastCaptureTargets = Word64 -> Word64
shiftSE Word64
bPawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
captureTargets
      let !westCaptureTargets :: Word64
westCaptureTargets = Word64 -> Word64
shiftSW Word64
bPawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
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)
      Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
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
      Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
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
      Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
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
      Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
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)

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

      -- King
      Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (QuadBitboard -> Word64
QBB.bKings QuadBitboard
qbb) ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
src -> do
        Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (Vector Word64
kingAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
`unsafeIndex` Int
src Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
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 -> Word64 -> Bool
canBlackCastleKingside Position
pos Word64
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 -> Word64 -> Bool
canBlackCastleQueenside Position
pos Word64
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)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
Vector.unsafeFreeze (MVector s Ply -> ST s (Vector Ply))
-> ST s (MVector s Ply) -> ST s (Vector Ply)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((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 -> MVector s Ply) -> ST s Int -> ST s (MVector s Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 :: Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> (Ply -> ST s ())
-> ST s ()
piecePlies !Word64
knights !Word64
bishops !Word64
rooks !Word64
queens !Word64
occ !Word64
notUs Ply -> ST s ()
add = do
  Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
knights ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
src -> do
    Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (Vector Word64
knightAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
`unsafeIndex` Int
src Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
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)
  Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
bishops ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
src -> do
    Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (Int -> Word64 -> Word64
bishopTargets Int
src Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
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)
  Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
rooks ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
src -> do
    Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (Int -> Word64 -> Word64
rookTargets Int
src Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
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)
  Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
queens ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
src -> do
    Word64 -> (Int -> ST s ()) -> ST s ()
forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (Int -> Word64 -> Word64
queenTargets Int
src Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
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 :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb} =
  Color -> QuadBitboard -> Word64 -> Square -> Bool
attackedBy Color
Black QuadBitboard
qbb (QuadBitboard -> Word64
QBB.occupied QuadBitboard
qbb) (Int -> Square
Sq (Word64 -> Int
bitScanForward (QuadBitboard -> Word64
QBB.wKings QuadBitboard
qbb)))
inCheck Color
Black Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb} =
  Color -> QuadBitboard -> Word64 -> Square -> Bool
attackedBy Color
White QuadBitboard
qbb (QuadBitboard -> Word64
QBB.occupied QuadBitboard
qbb) (Int -> Square
Sq (Word64 -> Int
bitScanForward (QuadBitboard -> Word64
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
/= :: Castle -> Castle -> Bool
$c/= :: Castle -> Castle -> Bool
== :: Castle -> Castle -> Bool
$c== :: Castle -> Castle -> Bool
Eq, Ord Castle
Ord Castle
-> ((Castle, Castle) -> [Castle])
-> ((Castle, Castle) -> Castle -> Int)
-> ((Castle, Castle) -> Castle -> Int)
-> ((Castle, Castle) -> Castle -> Bool)
-> ((Castle, Castle) -> Int)
-> ((Castle, Castle) -> Int)
-> Ix Castle
(Castle, Castle) -> Int
(Castle, Castle) -> [Castle]
(Castle, Castle) -> Castle -> Bool
(Castle, Castle) -> Castle -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Castle, Castle) -> Int
$cunsafeRangeSize :: (Castle, Castle) -> Int
rangeSize :: (Castle, Castle) -> Int
$crangeSize :: (Castle, Castle) -> Int
inRange :: (Castle, Castle) -> Castle -> Bool
$cinRange :: (Castle, Castle) -> Castle -> Bool
unsafeIndex :: (Castle, Castle) -> Castle -> Int
$cunsafeIndex :: (Castle, Castle) -> Castle -> Int
index :: (Castle, Castle) -> Castle -> Int
$cindex :: (Castle, Castle) -> Castle -> Int
range :: (Castle, Castle) -> [Castle]
$crange :: (Castle, Castle) -> [Castle]
$cp1Ix :: Ord Castle
Ix, Eq Castle
Eq Castle
-> (Castle -> Castle -> Ordering)
-> (Castle -> Castle -> Bool)
-> (Castle -> Castle -> Bool)
-> (Castle -> Castle -> Bool)
-> (Castle -> Castle -> Bool)
-> (Castle -> Castle -> Castle)
-> (Castle -> Castle -> Castle)
-> Ord Castle
Castle -> Castle -> Bool
Castle -> Castle -> Ordering
Castle -> Castle -> Castle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Castle -> Castle -> Castle
$cmin :: Castle -> Castle -> Castle
max :: Castle -> Castle -> Castle
$cmax :: Castle -> Castle -> Castle
>= :: Castle -> Castle -> Bool
$c>= :: Castle -> Castle -> Bool
> :: Castle -> Castle -> Bool
$c> :: Castle -> Castle -> Bool
<= :: Castle -> Castle -> Bool
$c<= :: Castle -> Castle -> Bool
< :: Castle -> Castle -> Bool
$c< :: Castle -> Castle -> Bool
compare :: Castle -> Castle -> Ordering
$ccompare :: Castle -> Castle -> Ordering
$cp1Ord :: Eq Castle
Ord, Int -> Castle -> ShowS
[Castle] -> ShowS
Castle -> String
(Int -> Castle -> ShowS)
-> (Castle -> String) -> ([Castle] -> ShowS) -> Show Castle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Castle] -> ShowS
$cshowList :: [Castle] -> ShowS
show :: Castle -> String
$cshow :: Castle -> String
showsPrec :: Int -> Castle -> ShowS
$cshowsPrec :: Int -> Castle -> ShowS
Show)

castlingRights :: Position -> [(Color, Castle)]
castlingRights :: Position -> [(Color, Castle)]
castlingRights Position{Word64
flags :: Word64
flags :: Position -> Word64
flags} = [(Color, Castle)] -> [(Color, Castle)]
wks ([(Color, Castle)] -> [(Color, Castle)])
-> ([(Color, Castle)] -> [(Color, Castle)])
-> [(Color, Castle)]
-> [(Color, Castle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Color, Castle)] -> [(Color, Castle)]
wqs ([(Color, Castle)] -> [(Color, Castle)])
-> ([(Color, Castle)] -> [(Color, Castle)])
-> [(Color, Castle)]
-> [(Color, Castle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Color, Castle)] -> [(Color, Castle)]
bks ([(Color, Castle)] -> [(Color, Castle)])
-> ([(Color, Castle)] -> [(Color, Castle)])
-> [(Color, Castle)]
-> [(Color, Castle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Color, Castle)] -> [(Color, Castle)]
bqs ([(Color, Castle)] -> [(Color, Castle)])
-> [(Color, Castle)] -> [(Color, Castle)]
forall a b. (a -> b) -> a -> b
$ [] where
  wks :: [(Color, Castle)] -> [(Color, Castle)]
wks [(Color, Castle)]
xs | Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs = (Color
White, Castle
Kingside)(Color, Castle) -> [(Color, Castle)] -> [(Color, Castle)]
forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
         | Bool
otherwise              = [(Color, Castle)]
xs
  wqs :: [(Color, Castle)] -> [(Color, Castle)]
wqs [(Color, Castle)]
xs | Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs = (Color
White, Castle
Queenside)(Color, Castle) -> [(Color, Castle)] -> [(Color, Castle)]
forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
         | Bool
otherwise              = [(Color, Castle)]
xs
  bks :: [(Color, Castle)] -> [(Color, Castle)]
bks [(Color, Castle)]
xs | Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs = (Color
Black, Castle
Kingside)(Color, Castle) -> [(Color, Castle)] -> [(Color, Castle)]
forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
         | Bool
otherwise              = [(Color, Castle)]
xs
  bqs :: [(Color, Castle)] -> [(Color, Castle)]
bqs [(Color, Castle)]
xs | Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs = (Color
Black, Castle
Queenside)(Color, Castle) -> [(Color, Castle)] -> [(Color, Castle)]
forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
         | Bool
otherwise              = [(Color, Castle)]
xs

enPassantSquare :: Position -> Maybe Square
enPassantSquare :: Position -> Maybe Square
enPassantSquare Position{Word64
flags :: Word64
flags :: Position -> Word64
flags} = case Word64 -> Word64
ep Word64
flags of
  Word64
0 -> Maybe Square
forall a. Maybe a
Nothing
  Word64
x -> Square -> Maybe Square
forall a. a -> Maybe a
Just (Square -> Maybe Square)
-> (Word64 -> Square) -> Word64 -> Maybe Square
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Square
Sq (Int -> Square) -> (Word64 -> Int) -> Word64 -> Square
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
bitScanForward (Word64 -> Maybe Square) -> Word64 -> Maybe Square
forall a b. (a -> b) -> a -> b
$ Word64
x

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

canWhiteCastleKingside, canBlackCastleKingside, canWhiteCastleQueenside, canBlackCastleQueenside :: Position -> Word64 -> Bool
canWhiteCastleKingside :: Position -> Word64 -> Bool
canWhiteCastleKingside Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, Word64
flags :: Word64
flags :: Position -> Word64
flags} !Word64
occ =
  Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs Bool -> Bool -> Bool
&& Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
crwKe Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not ((Square -> Bool) -> [Square] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Word64 -> Square -> Bool
attackedBy Color
Black QuadBitboard
qbb Word64
occ) [Square
E1, Square
F1, Square
G1])
canBlackCastleKingside :: Position -> Word64 -> Bool
canBlackCastleKingside Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, Word64
flags :: Word64
flags :: Position -> Word64
flags} !Word64
occ =
  Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs Bool -> Bool -> Bool
&& Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
crbKe Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not ((Square -> Bool) -> [Square] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Word64 -> Square -> Bool
attackedBy Color
White QuadBitboard
qbb Word64
occ) [Square
E8, Square
F8, Square
G8])
canWhiteCastleQueenside :: Position -> Word64 -> Bool
canWhiteCastleQueenside Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, Word64
flags :: Word64
flags :: Position -> Word64
flags} !Word64
occ =
  Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs Bool -> Bool -> Bool
&& Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
crwQe Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not ((Square -> Bool) -> [Square] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Word64 -> Square -> Bool
attackedBy Color
Black QuadBitboard
qbb Word64
occ) [Square
E1, Square
D1, Square
C1])
canBlackCastleQueenside :: Position -> Word64 -> Bool
canBlackCastleQueenside Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, Word64
flags :: Word64
flags :: Position -> Word64
flags} !Word64
occ =
  Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs Bool -> Bool -> Bool
&& Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
crbQe Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not ((Square -> Bool) -> [Square] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Word64 -> Square -> Bool
attackedBy Color
White QuadBitboard
qbb Word64
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 -> Word64 -> Square -> Bool
attackedBy Color
White !QuadBitboard
qbb !Word64
occ (Sq Int
sq)
  | Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
wPawnAttacks Int
sq Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wPawns QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
knightAttacks Int
sq Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wKnights QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
bishopTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wBishops QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
rookTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&.   QuadBitboard -> Word64
QBB.wRooks QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
queenTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wQueens QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
kingAttacks Int
sq Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wKings QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0   = Bool
True
  | Bool
otherwise                        = Bool
False
attackedBy Color
Black !QuadBitboard
qbb !Word64
occ (Sq Int
sq)
  | Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
bPawnAttacks Int
sq Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bPawns QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
knightAttacks Int
sq Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bKnights QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
bishopTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bBishops QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
rookTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&.   QuadBitboard -> Word64
QBB.bRooks QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
queenTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&.  QuadBitboard -> Word64
QBB.bQueens QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
kingAttacks Int
sq Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bKings QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0   = Bool
True
  | Bool
otherwise                        = Bool
False

{-# INLINE attackedBy #-}

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

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

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

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

rookTargets, bishopTargets, queenTargets :: Int -> Word64 -> Word64
rookTargets :: Int -> Word64 -> Word64
rookTargets !Int
sq !Word64
occ = Word64 -> Int -> Word64
rayN Word64
occ Int
sq Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
rayE Word64
occ Int
sq
                   Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
rayS Word64
occ Int
sq Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
rayW Word64
occ Int
sq
bishopTargets :: Int -> Word64 -> Word64
bishopTargets !Int
sq !Word64
occ = Word64 -> Int -> Word64
rayNW Word64
occ Int
sq Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
rayNE Word64
occ Int
sq
                     Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
raySE Word64
occ Int
sq Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
raySW Word64
occ Int
sq
queenTargets :: Int -> Word64 -> Word64
queenTargets !Int
sq !Word64
occ = Int -> Word64 -> Word64
rookTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64 -> Word64
bishopTargets Int
sq Word64
occ

rayTargets :: Vector Word64 -> (Word64 -> Int) -> Word64 -> Int -> Word64
rayTargets :: Vector Word64 -> (Word64 -> Int) -> Word64 -> Int -> Word64
rayTargets !Vector Word64
ray !Word64 -> Int
bitScan !Word64
occ (Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
ray -> Word64
a) = case Word64
a Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
occ of
  Word64
0               -> Word64
a
  (Word64 -> Int
bitScan -> Int
sq) -> Word64
a Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
ray Int
sq

{-# INLINE rayTargets #-}

rayNW, rayN, rayNE, rayE, raySE, rayS, raySW, rayW :: Word64 -> Int -> Word64
rayNW :: Word64 -> Int -> Word64
rayNW = Vector Word64 -> (Word64 -> Int) -> Word64 -> Int -> Word64
rayTargets Vector Word64
attackNW Word64 -> Int
bitScanForward
rayN :: Word64 -> Int -> Word64
rayN  = Vector Word64 -> (Word64 -> Int) -> Word64 -> Int -> Word64
rayTargets Vector Word64
attackN  Word64 -> Int
bitScanForward
rayNE :: Word64 -> Int -> Word64
rayNE = Vector Word64 -> (Word64 -> Int) -> Word64 -> Int -> Word64
rayTargets Vector Word64
attackNE Word64 -> Int
bitScanForward
rayE :: Word64 -> Int -> Word64
rayE  = Vector Word64 -> (Word64 -> Int) -> Word64 -> Int -> Word64
rayTargets Vector Word64
attackE  Word64 -> Int
bitScanForward
raySE :: Word64 -> Int -> Word64
raySE = Vector Word64 -> (Word64 -> Int) -> Word64 -> Int -> Word64
rayTargets Vector Word64
attackSE Word64 -> Int
bitScanReverse
rayS :: Word64 -> Int -> Word64
rayS  = Vector Word64 -> (Word64 -> Int) -> Word64 -> Int -> Word64
rayTargets Vector Word64
attackS  Word64 -> Int
bitScanReverse
raySW :: Word64 -> Int -> Word64
raySW = Vector Word64 -> (Word64 -> Int) -> Word64 -> Int -> Word64
rayTargets Vector Word64
attackSW Word64 -> Int
bitScanReverse
rayW :: Word64 -> Int -> Word64
rayW  = Vector Word64 -> (Word64 -> Int) -> Word64 -> Int -> Word64
rayTargets Vector Word64
attackW  Word64 -> Int
bitScanReverse

{-# INLINE rayNW #-}
{-# INLINE rayN #-}
{-# INLINE rayNE #-}
{-# INLINE rayE #-}
{-# INLINE raySE #-}
{-# INLINE rayS #-}
{-# INLINE raySW #-}
{-# INLINE rayW #-}

attackDir :: (Word64 -> Word64) -> Vector Word64
attackDir :: (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
s = Int -> (Int -> Word64) -> Vector Word64
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Word64) -> Vector Word64)
-> (Int -> Word64) -> Vector Word64
forall a b. (a -> b) -> a -> b
$ \Int
sq ->
  (Word64 -> Word64 -> Word64) -> Word64 -> [Word64] -> Word64
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.|.) Word64
0 ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
7 ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ [Word64] -> [Word64]
forall a. [a] -> [a]
tail ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ (Word64 -> Word64) -> Word64 -> [Word64]
forall a. (a -> a) -> a -> [a]
iterate Word64 -> Word64
s (Int -> Word64
forall a. Bits a => Int -> a
bit Int
sq)

attackNW, attackN, attackNE, attackE, attackSE, attackS, attackSW, attackW :: Vector Word64
attackNW :: Vector Word64
attackNW = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftNW
attackN :: Vector Word64
attackN  = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftN
attackNE :: Vector Word64
attackNE = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftNE
attackE :: Vector Word64
attackE  = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftE
attackSE :: Vector Word64
attackSE = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftSE
attackS :: Vector Word64
attackS  = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftS
attackSW :: Vector Word64
attackSW = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftSW
attackW :: Vector Word64
attackW  = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftW

clearMask :: Bits a => a -> a -> a
clearMask :: a -> a -> a
clearMask a
a a
b = a
a a -> a -> a
forall a. Bits a => a -> a -> a
.&. a -> a
forall a. Bits a => a -> a
complement a
b

testMask :: Bits a => a -> a -> Bool
testMask :: a -> a -> Bool
testMask a
a a
b = a
a a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b

{-# INLINE testMask #-}