{-# 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 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 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
sq forall a. Bits a => a -> a -> a
.&. Word64
bb 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 = forall a. a -> Maybe a
Just PieceType
Pawn
  | Bool
otherwise = forall a b. (a, b) -> b
snd 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 forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
ep Word64
flags) 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) 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 = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Position
fromFEN

newtype PieceType = PieceType Int deriving (PieceType -> PieceType -> Bool
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
(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]
Ix, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => PieceType -> m Exp
forall (m :: * -> *). Quote m => PieceType -> Code m PieceType
liftTyped :: forall (m :: * -> *). Quote m => PieceType -> Code m PieceType
$cliftTyped :: forall (m :: * -> *). Quote m => PieceType -> Code m PieceType
lift :: forall (m :: * -> *). Quote m => PieceType -> m Exp
$clift :: forall (m :: * -> *). Quote m => PieceType -> m Exp
Lift, Eq 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
Ord)

pattern Pawn, Knight, Bishop, Rook, Queen, King :: PieceType
pattern $bPawn :: PieceType
$mPawn :: forall {r}. PieceType -> ((# #) -> r) -> ((# #) -> r) -> r
Pawn = PieceType 0
pattern $bKnight :: PieceType
$mKnight :: forall {r}. PieceType -> ((# #) -> r) -> ((# #) -> r) -> r
Knight = PieceType 1
pattern $bBishop :: PieceType
$mBishop :: forall {r}. PieceType -> ((# #) -> r) -> ((# #) -> r) -> r
Bishop = PieceType 2
pattern $bRook :: PieceType
$mRook :: forall {r}. PieceType -> ((# #) -> r) -> ((# #) -> r) -> r
Rook = PieceType 3
pattern $bQueen :: PieceType
$mQueen :: forall {r}. PieceType -> ((# #) -> r) -> ((# #) -> r) -> r
Queen = PieceType 4
pattern $bKing :: PieceType
$mKing :: forall {r}. PieceType -> ((# #) -> r) -> ((# #) -> 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
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. 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
(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]
Ix, Eq 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
Ord, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Color -> m Exp
forall (m :: * -> *). Quote m => Color -> Code m Color
liftTyped :: forall (m :: * -> *). Quote m => Color -> Code m Color
$cliftTyped :: forall (m :: * -> *). Quote m => Color -> Code m Color
lift :: forall (m :: * -> *). Quote m => Color -> m Exp
$clift :: forall (m :: * -> *). Quote m => Color -> m Exp
Lift, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
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 -> forall a. Maybe a
Nothing
  Word4
nb          -> forall a. a -> Maybe a
Just
    ( if forall a. Bits a => a -> Int -> Bool
testBit Word4
nb Int
0 then Color
Black else Color
White
    , Int -> PieceType
PieceType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word4
nb forall a. Integral a => a -> a -> a
`div` Word4
2 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. 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, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Position -> m Exp
forall (m :: * -> *). Quote m => Position -> Code m Position
liftTyped :: forall (m :: * -> *). Quote m => Position -> Code m Position
$cliftTyped :: forall (m :: * -> *). Quote m => Position -> Code m Position
lift :: forall (m :: * -> *). Quote m => Position -> m Exp
$clift :: forall (m :: * -> *). Quote m => Position -> m 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 forall a. Eq a => a -> a -> Bool
== Position -> QuadBitboard
qbb Position
b Bool -> Bool -> Bool
&& Position -> Color
color Position
a forall a. Eq a => a -> a -> Bool
== Position -> Color
color Position
b Bool -> Bool -> Bool
&& Position -> Word64
flags Position
a 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 forall a. Ord a => a -> a -> Ordering
`compare` Position -> QuadBitboard
qbb Position
b
             forall a. Semigroup a => a -> a -> a
<> Position -> Color
color Position
a forall a. Ord a => a -> a -> Ordering
`compare` Position -> Color
color Position
b
             forall a. Semigroup a => a -> a -> a
<> Position -> Word64
flags Position
a 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
    forall a. Hashable a => Int -> a -> Int
`hashWithSalt` QuadBitboard
qbb
    forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Color
color
    forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
flags

repetitions :: [Position] -> Maybe (Int, Position)
repetitions :: [Position] -> Maybe (Int, Position)
repetitions [Position]
xs = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ Position -> (Int, Position)
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => [a] -> [a]
nub [Position]
xs where
  f :: Position -> (Int, Position)
f Position
x = (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== Position
x) forall a b. (a -> b) -> a -> b
$ [Position]
xs, Position
x)

instance Show Position where
  show :: Position -> String
show Position
p = Char
'"' forall a. a -> [a] -> [a]
: Position -> String
toFEN Position
p forall a. Semigroup a => a -> a -> a
<> [Char
'"']

insufficientMaterial :: Position -> Bool
insufficientMaterial :: Position -> Bool
insufficientMaterial = QuadBitboard -> Bool
QBB.insufficientMaterial 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
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parts forall a. Eq a => a -> a -> Bool
== Int
6
  = QuadBitboard -> Color -> Word64 -> Int -> Int -> Position
Position forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. IsString a => String -> a
fromString ([String]
parts forall a. [a] -> Int -> a
!! Int
0))
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. (Eq a, IsString a) => a -> Maybe Color
readColor ([String]
parts forall a. [a] -> Int -> a
!! Int
1)
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Maybe Word64
readFlags ([String]
parts forall a. [a] -> Int -> a
!! Int
2) ([String]
parts forall a. [a] -> Int -> a
!! Int
3)
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => String -> Maybe a
readMaybe ([String]
parts forall a. [a] -> Int -> a
!! Int
4)
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => String -> Maybe a
readMaybe ([String]
parts forall a. [a] -> Int -> a
!! Int
5)
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parts forall a. Eq a => a -> a -> Bool
== Int
4
  = QuadBitboard -> Color -> Word64 -> Int -> Int -> Position
Position forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. IsString a => String -> a
fromString ([String]
parts forall a. [a] -> Int -> a
!! Int
0))
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. (Eq a, IsString a) => a -> Maybe Color
readColor ([String]
parts forall a. [a] -> Int -> a
!! Int
1)
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Maybe Word64
readFlags ([String]
parts forall a. [a] -> Int -> a
!! Int
2) ([String]
parts forall a. [a] -> Int -> a
!! Int
3)
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1
  | Bool
otherwise = forall a. Maybe a
Nothing
 where
  parts :: [String]
parts = String -> [String]
words String
fen
  readColor :: a -> Maybe Color
readColor a
"w" = forall a. a -> Maybe a
Just Color
White
  readColor a
"b" = forall a. a -> Maybe a
Just Color
Black
  readColor a
_   = forall a. Maybe a
Nothing

  readFlags :: String -> String -> Maybe Word64
readFlags String
c String
e = forall a. Bits a => a -> a -> a
(.|.) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
readCst String
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. (Num a, Bits a) => String -> Maybe a
readEP String
e where
    readCst :: String -> Maybe Word64
readCst String
"-" = 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 forall a. Bits a => a -> a -> a
.|.) 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 forall a. Bits a => a -> a -> a
.|.) 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 forall a. Bits a => a -> a -> a
.|.) 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 forall a. Bits a => a -> a -> a
.|.) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
go String
xs
      go []       = forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
      go String
_        = forall a. Maybe a
Nothing
    readEP :: String -> Maybe a
readEP String
"-" = forall a. a -> Maybe a
Just a
0
    readEP [Char
f,Char
r]
      | forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'a',Char
'h') Char
f Bool -> Bool -> Bool
&& (Char
r forall a. Eq a => a -> a -> Bool
== Char
'3' Bool -> Bool -> Bool
|| Char
r forall a. Eq a => a -> a -> Bool
== Char
'6')
      = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Bits a => Int -> a
bit ((Char -> Int
ord Char
r forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'1') forall a. Num a => a -> a -> a
* Int
8 forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
f forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a'))
    readEP String
_ = 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
  , forall {a}. IsString a => Color -> a
showColor Color
color
  , Word64 -> String
showCst (Word64
flags forall a. Bits a => a -> a -> a
`clearMask` Word64
epMask)
  , forall {a}. IsString a => Word64 -> a
showEP (Word64 -> Word64
ep Word64
flags)
  , forall a. Show a => a -> String
show Int
halfMoveClock
  , forall a. Show a => a -> String
show Int
moveNumber
  ]
 where
  showColor :: Color -> a
showColor Color
White = a
"w"
  showColor Color
Black = a
"b"
  showCst :: Word64 -> String
showCst Word64
x
    | String
str forall a. Eq a => a -> a -> Bool
== String
"" = String
"-"
    | Bool
otherwise = String
str
   where
    str :: String
str = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, String) -> (Word64, String)
wks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, String) -> (Word64, String)
wqs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, String) -> (Word64, String)
bks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, String) -> (Word64, String)
bqs forall a b. (a -> b) -> a -> b
$ (Word64
x, String
"")
    wks :: (Word64, String) -> (Word64, String)
wks (Word64
v, String
xs) | Word64
v forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs = (Word64
v, Char
'K'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 forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs = (Word64
v, Char
'Q'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 forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs = (Word64
v, Char
'k'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 forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs = (Word64
v, Char
'q'forall a. a -> [a] -> [a]
:String
xs)
                | Bool
otherwise          = (Word64
v, String
xs)
  showEP :: Word64 -> a
showEP Word64
0 = a
"-"
  showEP Word64
x = forall s. IsString s => Square -> s
toCoord forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Square
Sq forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
bitScanForward 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 = forall b. FiniteBits b => b -> Int
countTrailingZeros
bitScanReverse :: Word64 -> Int
bitScanReverse Word64
bb = Int
63 forall a. Num a => a -> a -> a
- 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
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
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
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
Hashable, Eq 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
Ord, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Ply -> m Exp
forall (m :: * -> *). Quote m => Ply -> Code m Ply
liftTyped :: forall (m :: * -> *). Quote m => Ply -> Code m Ply
$cliftTyped :: forall (m :: * -> *). Quote m => Ply -> Code m Ply
lift :: forall (m :: * -> *). Quote m => Ply -> m Exp
$clift :: forall (m :: * -> *). Quote m => Ply -> m Exp
Lift, Ptr Ply -> IO Ply
Ptr Ply -> Int -> IO Ply
Ptr Ply -> Int -> Ply -> IO ()
Ptr Ply -> Ply -> IO ()
Ply -> Int
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 :: forall b. Ptr b -> Int -> Ply -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Ply -> IO ()
peekByteOff :: forall b. 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 " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Square
f forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Square
t forall a. Semigroup a => a -> a -> a
<> String
p' where
    p' :: String
p' = case Maybe PieceType
p of
      Just PieceType
piece -> String
" `promoteTo` " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show PieceType
piece
      Maybe PieceType
Nothing    -> String
""

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

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

instance G.Vector Vector Ply where
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeFreeze :: forall s. Mutable Vector s Ply -> ST s (Vector Ply)
basicUnsafeFreeze (MV_Ply MVector s Word16
v) = Vector Word16 -> Vector Ply
V_Ply forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
G.basicUnsafeFreeze MVector s Word16
v
  basicUnsafeThaw :: forall s. Vector Ply -> ST s (Mutable Vector s Ply)
basicUnsafeThaw (V_Ply Vector Word16
v) = forall s. MVector s Word16 -> MVector s Ply
MV_Ply forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
G.basicUnsafeThaw Vector Word16
v
  basicLength :: Vector Ply -> Int
basicLength (V_Ply Vector Word16
v) = forall (v :: * -> *) a. Vector v a => v a -> Int
G.basicLength Vector Word16
v
  basicUnsafeSlice :: Int -> Int -> Vector Ply -> Vector Ply
basicUnsafeSlice Int
i Int
n (V_Ply Vector Word16
v) = Vector Word16 -> Vector Ply
V_Ply forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice  Int
i Int
n Vector Word16
v
  basicUnsafeIndexM :: Vector Ply -> Int -> Box Ply
basicUnsafeIndexM (V_Ply Vector Word16
v) Int
i = Word16 -> Ply
Ply forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector Word16
v Int
i
  basicUnsafeCopy :: forall s. Mutable Vector s Ply -> Vector Ply -> ST s ()
basicUnsafeCopy (MV_Ply MVector s Word16
mv) (V_Ply Vector Word16
v) = forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
G.basicUnsafeCopy MVector s Word16
mv Vector Word16
v
  elemseq :: forall b. Vector Ply -> Ply -> b -> b
elemseq Vector Ply
_ Ply
pl b
z = forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (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 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dst forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
src 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 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 forall a. Bits a => a -> a -> a
.&. Word16
0xfff forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
v forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
12)

plySource, plyTarget :: Ply -> Square
plySource :: Ply -> Square
plySource (Ply Word16
x) = Int -> Square
Sq forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word16
x forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Word16
0b111111)
plyTarget :: Ply -> Square
plyTarget (Ply Word16
x) = Int -> Square
Sq forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
x forall a. Bits a => a -> a -> a
.&. Word16
0b111111)

plyPromotion :: Ply -> Maybe PieceType
plyPromotion :: Ply -> Maybe PieceType
plyPromotion (Ply Word16
x) = case forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Word16
x forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
12) forall a. Bits a => a -> a -> a
.&. Word16
0b111 of
  Int
0 -> forall a. Maybe a
Nothing
  Int
n -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PieceType
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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Int -> [a] -> ([a], [a])
splitAt Int
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> ([a], [a])
splitAt Int
2 -> (String
src, (String
dst, String
promo)))
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
promo
  = Square -> Square -> Ply
move forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Square
readCoord String
src forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Square
readCoord String
dst 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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Square
readCoord String
src
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Square
readCoord String
dst
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. (Eq a, IsString a) => a -> Maybe PieceType
readPromo String
promo
      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]
    | forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'a',Char
'h') Char
f Bool -> Bool -> Bool
&& forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'1',Char
'8') Char
r
    = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall s t a b. AnIso s t a b -> Iso b a t s
from Iso' Square (Rank, File)
rankFile) forall a b. (a -> b) -> a -> b
$ (HasCallStack => Int -> Rank
mkRank forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
r forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'1',  HasCallStack => Int -> File
mkFile forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
f forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a')
  readCoord String
_ = forall a. Maybe a
Nothing
  readPromo :: a -> Maybe PieceType
readPromo a
"q" = forall a. a -> Maybe a
Just PieceType
Queen
  readPromo a
"r" = forall a. a -> Maybe a
Just PieceType
Rook
  readPromo a
"b" = forall a. a -> Maybe a
Just PieceType
Bishop
  readPromo a
"n" = forall a. a -> Maybe a
Just PieceType
Knight
  readPromo a
_   = 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 forall a. Semigroup a => a -> a -> a
<> Square -> String
coord Square
dst forall a. Semigroup a => a -> a -> a
<> String
p where
  coord :: Square -> String
coord Square
x = let (Rank
r,File
f) = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' Square (Rank, File)
rankFile Square
x in
            Int -> Char
chr (File -> Int
unFile File
f forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'a') forall a. a -> [a] -> [a]
: [Int -> Char
chr (Rank -> Int
unRank Rank
r 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 forall a. (Unbox a, Eq a) => a -> Vector a -> Bool
`Vector.elem` Position -> Vector Ply
legalPlies' Position
pos = forall a. a -> Maybe a
Just Ply
m
                 | Bool
otherwise = 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 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8
shiftNN :: Word64 -> Word64
shiftNN   Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16
shiftNNE :: Word64 -> Word64
shiftNNE Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
17 forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftNE :: Word64 -> Word64
shiftNE  Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
9 forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftENE :: Word64 -> Word64
shiftENE Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
10 forall a. Bits a => a -> a -> a
.&. Word64
notABFile
shiftE :: Word64 -> Word64
shiftE   Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1 forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftESE :: Word64 -> Word64
shiftESE Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
6 forall a. Bits a => a -> a -> a
.&. Word64
notABFile
shiftSE :: Word64 -> Word64
shiftSE  Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
7 forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftSSE :: Word64 -> Word64
shiftSSE Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
15 forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftS :: Word64 -> Word64
shiftS   Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8
shiftSS :: Word64 -> Word64
shiftSS   Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16
shiftSSW :: Word64 -> Word64
shiftSSW Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
17 forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftSW :: Word64 -> Word64
shiftSW  Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
9 forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftWSW :: Word64 -> Word64
shiftWSW Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
10 forall a. Bits a => a -> a -> a
.&. Word64
notGHFile
shiftW :: Word64 -> Word64
shiftW   Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1 forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftWNW :: Word64 -> Word64
shiftWNW Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
6 forall a. Bits a => a -> a -> a
.&. Word64
notGHFile
shiftNW :: Word64 -> Word64
shiftNW  Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
7 forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftNNW :: Word64 -> Word64
shiftNNW Word64
w = Word64
w forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
15 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 :: HasCallStack => Position -> Ply -> Position
doPly Position
p Ply
m
  | Ply
m 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        = 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 forall a. Num a => a -> a -> a
+ Int
1
  , moveNumber :: Int
moveNumber = if Color
color forall a. Eq a => a -> a -> Bool
== Color
Black
                 then Int
moveNumber 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 forall a. Eq a => a -> a -> Bool
== Ply
wKscm Bool -> Bool -> Bool
&& Word64
flags forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs
  = Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb forall a. Semigroup a => a -> a -> a
<> QuadBitboard
QBB.whiteKingsideCastle
        , flags :: Word64
flags = Word64
flags forall a. Bits a => a -> a -> a
`clearMask` (Word64
rank1 forall a. Bits a => a -> a -> a
.|. Word64
epMask)
        }
  | Ply
m forall a. Eq a => a -> a -> Bool
== Ply
wQscm Bool -> Bool -> Bool
&& Word64
flags forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs
  = Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb forall a. Semigroup a => a -> a -> a
<> QuadBitboard
QBB.whiteQueensideCastle
        , flags :: Word64
flags = Word64
flags forall a. Bits a => a -> a -> a
`clearMask` (Word64
rank1 forall a. Bits a => a -> a -> a
.|. Word64
epMask)
        }
  | Ply
m forall a. Eq a => a -> a -> Bool
== Ply
bKscm Bool -> Bool -> Bool
&& Word64
flags forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs
  = Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb forall a. Semigroup a => a -> a -> a
<> QuadBitboard
QBB.blackKingsideCastle
        , flags :: Word64
flags = Word64
flags forall a. Bits a => a -> a -> a
`clearMask` (Word64
rank8 forall a. Bits a => a -> a -> a
.|. Word64
epMask)
        }
  | Ply
m forall a. Eq a => a -> a -> Bool
== Ply
bQscm Bool -> Bool -> Bool
&& Word64
flags forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs
  = Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb forall a. Semigroup a => a -> a -> a
<> QuadBitboard
QBB.blackQueensideCastle
        , flags :: Word64
flags = Word64
flags forall a. Bits a => a -> a -> a
`clearMask` (Word64
rank8 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 forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask forall a. Bits a => a -> a -> a
.|. 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 forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask forall a. Bits a => a -> a -> a
.|. 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 forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask forall a. Bits a => a -> a -> a
.|. 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 forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask forall a. Bits a => a -> a -> a
.|. forall a. Bits a => Int -> a
bit (Square -> Int
unSquare Square
dst))
                      }
        PieceType
_ -> 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 forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask forall a. Bits a => a -> a -> a
.|. 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 forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask forall a. Bits a => a -> a -> a
.|. 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 forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask forall a. Bits a => a -> a -> a
.|. 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 forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask forall a. Bits a => a -> a -> a
.|. forall a. Bits a => Int -> a
bit (Square -> Int
unSquare Square
dst))
                      }
        PieceType
_ -> forall a. HasCallStack => String -> a
error String
"Impossible: Black tried to promote to Pawn"
  | Word64
pawns forall a. Bits a => a -> a -> Bool
`testMask` Word64
fromMask
  , Word64 -> Word64
ep Word64
flags forall a. Bits a => a -> a -> Bool
`testMask` Word64
toMask
  = Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb forall a. Semigroup a => a -> a -> a
<> Square -> Square -> QuadBitboard
QBB.enPassant Square
src Square
dst
        , flags :: Word64
flags = Word64
flags 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 forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask forall a. Bits a => a -> a -> a
.|. Word64
mask) forall a. Bits a => a -> a -> a
.|. Word64
dpp
        }
 where
  !fromMask :: Word64
fromMask = Word64
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Square -> Int
unSquare Square
src
  !toMask :: Word64
toMask = Word64
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Square -> Int
unSquare Square
dst
  !mask :: Word64
mask = Word64
fromMask forall a. Bits a => a -> a -> a
.|. Word64
toMask
  !pawns :: Word64
pawns = QuadBitboard -> Word64
QBB.pawns QuadBitboard
qbb
  !dpp :: Word64
dpp
    | (Word64
pawns forall a. Bits a => a -> a -> a
.&. (Word64
rank2 forall a. Bits a => a -> a -> a
.|. Word64
rank7)) forall a. Bits a => a -> a -> Bool
`testMask` Word64
fromMask
    = if | Word64 -> Word64
shiftNN Word64
fromMask forall a. Eq a => a -> a -> Bool
== Word64
toMask -> Word64 -> Word64
shiftN Word64
fromMask
         | Word64 -> Word64
shiftSS Word64
fromMask 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 :: forall s. 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  go Word64
n = Int -> ST s ()
f (forall b. FiniteBits b => b -> Int
countTrailingZeros Word64
n) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> ST s ()
go (Word64
n forall a. Bits a => a -> a -> a
.&. (Word64
n 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 = forall a. Unbox a => Vector a -> [a]
Vector.toList 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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  MVector s Ply
v <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
VUM.new Int
100
  STRef s Int
i <- forall a s. a -> ST s (STRef s a)
newSTRef Int
0
  let add :: Ply -> ST s ()
add Ply
pl
        | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Color -> Position -> Bool
inCheck Color
color (Position -> Ply -> Position
unsafeDoPly' Position
pos Ply
pl) = do
          Int
i' <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
i
          forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VUM.unsafeWrite MVector s Ply
v Int
i' Ply
pl
          forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Int
i (forall a. Num a => a -> a -> a
+ Int
1)
        | Bool
otherwise = 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 = forall a. Bits a => a -> a
complement Word64
us
          !occ :: Word64
occ = Word64
us forall a. Bits a => a -> a -> a
.|. Word64
them
          !notOcc :: Word64
notOcc = 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 forall a. Bits a => a -> a -> a
.&. Word64
notOcc
      let !doublePushTargets :: Word64
doublePushTargets = Word64 -> Word64
shiftN Word64
singlePushTargets forall a. Bits a => a -> a -> a
.&. Word64
notOcc forall a. Bits a => a -> a -> a
.&. Word64
rank4
      let !captureTargets :: Word64
captureTargets = Word64
them forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
ep Word64
flags
      let !eastCaptureTargets :: Word64
eastCaptureTargets = Word64 -> Word64
shiftNE Word64
wPawns forall a. Bits a => a -> a -> a
.&. Word64
captureTargets
      let !westCaptureTargets :: Word64
westCaptureTargets = Word64 -> Word64
shiftNW Word64
wPawns forall a. Bits a => a -> a -> a
.&. Word64
captureTargets
      let pawn :: Int -> Int -> ST s ()
pawn Int
s Int
d
            | Int
d 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 forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [PieceType
Queen, PieceType
Rook, PieceType
Bishop, PieceType
Knight] forall a b. (a -> b) -> a -> b
$ \PieceType
p ->
                   Ply -> ST s ()
add forall a b. (a -> b) -> a -> b
$ Ply
pl Ply -> PieceType -> Ply
`promoteTo` PieceType
p
            | Bool
otherwise
            = Ply -> ST s ()
add forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
s) (Int -> Square
Sq Int
d)
      forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
westCaptureTargets forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
        Int -> Int -> ST s ()
pawn (Int
dst forall a. Num a => a -> a -> a
- Int
7) Int
dst
      forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
eastCaptureTargets forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
        Int -> Int -> ST s ()
pawn (Int
dst forall a. Num a => a -> a -> a
- Int
9) Int
dst
      forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
singlePushTargets forall a b. (a -> b) -> a -> b
$ \Int
dst ->
        Int -> Int -> ST s ()
pawn (Int
dst forall a. Num a => a -> a -> a
- Int
8) Int
dst
      forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
doublePushTargets forall a b. (a -> b) -> a -> b
$ \Int
dst ->
        Ply -> ST s ()
add forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq forall a b. (a -> b) -> a -> b
$ Int
dst forall a. Num a => a -> a -> a
- Int
16) (Int -> Square
Sq Int
dst)

      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
      forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (QuadBitboard -> Word64
QBB.wKings QuadBitboard
qbb) forall a b. (a -> b) -> a -> b
$ \Int
src -> do
        forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (Vector Word64
kingAttacks forall a. Unbox a => Vector a -> Int -> a
`unsafeIndex` Int
src forall a. Bits a => a -> a -> a
.&. Word64
notUs) forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
          Ply -> ST s ()
add forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
src) (Int -> Square
Sq Int
dst)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Position -> Word64 -> Bool
canWhiteCastleKingside Position
pos Word64
occ) forall a b. (a -> b) -> a -> b
$ Ply -> ST s ()
add Ply
wKscm
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Position -> Word64 -> Bool
canWhiteCastleQueenside Position
pos Word64
occ) 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 = forall a. Bits a => a -> a
complement Word64
us
          !occ :: Word64
occ = Word64
us forall a. Bits a => a -> a -> a
.|. Word64
them
          !notOcc :: Word64
notOcc = 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 forall a. Bits a => a -> a -> a
.&. Word64
notOcc
      let !doublePushTargets :: Word64
doublePushTargets = Word64 -> Word64
shiftS Word64
singlePushTargets forall a. Bits a => a -> a -> a
.&. Word64
notOcc forall a. Bits a => a -> a -> a
.&. Word64
rank5
      let !captureTargets :: Word64
captureTargets = Word64
them forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
ep Word64
flags
      let !eastCaptureTargets :: Word64
eastCaptureTargets = Word64 -> Word64
shiftSE Word64
bPawns forall a. Bits a => a -> a -> a
.&. Word64
captureTargets
      let !westCaptureTargets :: Word64
westCaptureTargets = Word64 -> Word64
shiftSW Word64
bPawns forall a. Bits a => a -> a -> a
.&. Word64
captureTargets
      let pawn :: Int -> Int -> ST s ()
pawn Int
s Int
d
            | Int
d 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 forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [PieceType
Queen, PieceType
Rook, PieceType
Bishop, PieceType
Knight] forall a b. (a -> b) -> a -> b
$ \PieceType
p ->
                   Ply -> ST s ()
add forall a b. (a -> b) -> a -> b
$ Ply
pl Ply -> PieceType -> Ply
`promoteTo` PieceType
p
            | Bool
otherwise
            = Ply -> ST s ()
add forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
s) (Int -> Square
Sq Int
d)
      forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
westCaptureTargets forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
        Int -> Int -> ST s ()
pawn (Int
dst forall a. Num a => a -> a -> a
+ Int
9) Int
dst
      forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
eastCaptureTargets forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
        Int -> Int -> ST s ()
pawn (Int
dst forall a. Num a => a -> a -> a
+ Int
7) Int
dst
      forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
singlePushTargets forall a b. (a -> b) -> a -> b
$ \Int
dst ->
        Int -> Int -> ST s ()
pawn (Int
dst forall a. Num a => a -> a -> a
+ Int
8) Int
dst
      forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
doublePushTargets forall a b. (a -> b) -> a -> b
$ \Int
dst ->
        Ply -> ST s ()
add forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq forall a b. (a -> b) -> a -> b
$ Int
dst forall a. Num a => a -> a -> a
+ Int
16) (Int -> Square
Sq Int
dst)

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

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

piecePlies :: Bitboard -> Bitboard -> Bitboard -> Bitboard
           -> Bitboard -> Bitboard -> (Ply -> ST s ())
           -> ST s ()
piecePlies :: forall s.
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
  forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
knights forall a b. (a -> b) -> a -> b
$ \Int
src -> do
    forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (Vector Word64
knightAttacks forall a. Unbox a => Vector a -> Int -> a
`unsafeIndex` Int
src forall a. Bits a => a -> a -> a
.&. Word64
notUs) forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
      Ply -> ST s ()
add forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
src) (Int -> Square
Sq Int
dst)
  forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
bishops forall a b. (a -> b) -> a -> b
$ \Int
src -> do
    forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (Int -> Word64 -> Word64
bishopTargets Int
src Word64
occ forall a. Bits a => a -> a -> a
.&. Word64
notUs) forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
      Ply -> ST s ()
add forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
src) (Int -> Square
Sq Int
dst)
  forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
rooks forall a b. (a -> b) -> a -> b
$ \Int
src -> do
    forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (Int -> Word64 -> Word64
rookTargets Int
src Word64
occ forall a. Bits a => a -> a -> a
.&. Word64
notUs) forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
      Ply -> ST s ()
add forall a b. (a -> b) -> a -> b
$ Square -> Square -> Ply
move (Int -> Square
Sq Int
src) (Int -> Square
Sq Int
dst)
  forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits Word64
queens forall a b. (a -> b) -> a -> b
$ \Int
src -> do
    forall s. Word64 -> (Int -> ST s ()) -> ST s ()
forBits (Int -> Word64 -> Word64
queenTargets Int
src Word64
occ forall a. Bits a => a -> a -> a
.&. Word64
notUs) forall a b. (a -> b) -> a -> b
$ \Int
dst -> do
      Ply -> ST s ()
add 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
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
(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]
Ix, Eq 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
Ord, Int -> Castle -> ShowS
[Castle] -> ShowS
Castle -> String
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Color, Castle)] -> [(Color, Castle)]
wqs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Color, Castle)] -> [(Color, Castle)]
bks forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Color, Castle)] -> [(Color, Castle)]
bqs forall a b. (a -> b) -> a -> b
$ [] where
  wks :: [(Color, Castle)] -> [(Color, Castle)]
wks [(Color, Castle)]
xs | Word64
flags forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs = (Color
White, Castle
Kingside)forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
         | Bool
otherwise              = [(Color, Castle)]
xs
  wqs :: [(Color, Castle)] -> [(Color, Castle)]
wqs [(Color, Castle)]
xs | Word64
flags forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs = (Color
White, Castle
Queenside)forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
         | Bool
otherwise              = [(Color, Castle)]
xs
  bks :: [(Color, Castle)] -> [(Color, Castle)]
bks [(Color, Castle)]
xs | Word64
flags forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs = (Color
Black, Castle
Kingside)forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
         | Bool
otherwise              = [(Color, Castle)]
xs
  bqs :: [(Color, Castle)] -> [(Color, Castle)]
bqs [(Color, Castle)]
xs | Word64
flags forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs = (Color
Black, Castle
Queenside)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 -> forall a. Maybe a
Nothing
  Word64
x -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Square
Sq forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
bitScanForward 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 forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs Bool -> Bool -> Bool
&& Word64
occ forall a. Bits a => a -> a -> a
.&. Word64
crwKe forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not (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 forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs Bool -> Bool -> Bool
&& Word64
occ forall a. Bits a => a -> a -> a
.&. Word64
crbKe forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not (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 forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs Bool -> Bool -> Bool
&& Word64
occ forall a. Bits a => a -> a -> a
.&. Word64
crwQe forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not (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 forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs Bool -> Bool -> Bool
&& Word64
occ forall a. Bits a => a -> a -> a
.&. Word64
crbQe forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not (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)
  | forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
wPawnAttacks Int
sq forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wPawns QuadBitboard
qbb forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
knightAttacks Int
sq forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wKnights QuadBitboard
qbb forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
bishopTargets Int
sq Word64
occ forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wBishops QuadBitboard
qbb forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
rookTargets Int
sq Word64
occ forall a. Bits a => a -> a -> a
.&.   QuadBitboard -> Word64
QBB.wRooks QuadBitboard
qbb forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
queenTargets Int
sq Word64
occ forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wQueens QuadBitboard
qbb forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
kingAttacks Int
sq forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wKings QuadBitboard
qbb 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)
  | forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
bPawnAttacks Int
sq forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bPawns QuadBitboard
qbb forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
knightAttacks Int
sq forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bKnights QuadBitboard
qbb forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
bishopTargets Int
sq Word64
occ forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bBishops QuadBitboard
qbb forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
rookTargets Int
sq Word64
occ forall a. Bits a => a -> a -> a
.&.   QuadBitboard -> Word64
QBB.bRooks QuadBitboard
qbb forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
queenTargets Int
sq Word64
occ forall a. Bits a => a -> a -> a
.&.  QuadBitboard -> Word64
QBB.bQueens QuadBitboard
qbb forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
kingAttacks Int
sq forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bKings QuadBitboard
qbb 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 -> forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
wPawnAttacks Int
sq forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wPawns QuadBitboard
qbb forall a. Eq a => a -> a -> Bool
/= Word64
0
  Color
Black -> forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
bPawnAttacks Int
sq forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bPawns QuadBitboard
qbb 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 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 = forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Word64
b = forall a. Bits a => Int -> a
bit Int
sq in
  Word64 -> Word64
shiftN Word64
b forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftNE Word64
b forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftE Word64
b forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftSE Word64
b forall a. Bits a => a -> a -> a
.|.
  Word64 -> Word64
shiftS Word64
b forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftSW Word64
b forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftW Word64
b forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftNW Word64
b
knightAttacks :: Vector Word64
knightAttacks = forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Word64
b = forall a. Bits a => Int -> a
bit Int
sq in
  Word64 -> Word64
shiftNNE Word64
b forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftENE Word64
b forall a. Bits a => a -> a -> a
.|.
  Word64 -> Word64
shiftESE Word64
b forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftSSE Word64
b forall a. Bits a => a -> a -> a
.|.
  Word64 -> Word64
shiftSSW Word64
b forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftWSW Word64
b forall a. Bits a => a -> a -> a
.|.
  Word64 -> Word64
shiftWNW Word64
b forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftNNW Word64
b
wPawnAttacks :: Vector Word64
wPawnAttacks = forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Word64
b = forall a. Bits a => Int -> a
bit Int
sq in
  Word64 -> Word64
shiftSE Word64
b forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftSW Word64
b
bPawnAttacks :: Vector Word64
bPawnAttacks = forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Word64
b = forall a. Bits a => Int -> a
bit Int
sq in
  Word64 -> Word64
shiftNE Word64
b 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 forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
rayE Word64
occ Int
sq
                   forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
rayS Word64
occ Int
sq 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 forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
rayNE Word64
occ Int
sq
                     forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
raySE Word64
occ Int
sq 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 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 (forall a. Unbox a => Vector a -> Int -> a
unsafeIndex Vector Word64
ray -> Word64
a) = case Word64
a forall a. Bits a => a -> a -> a
.&. Word64
occ of
  Word64
0               -> Word64
a
  (Word64 -> Int
bitScan -> Int
sq) -> Word64
a forall a. Bits a => a -> a -> a
`xor` 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 = forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 forall a b. (a -> b) -> a -> b
$ \Int
sq ->
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Bits a => a -> a -> a
(.|.) Word64
0 forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
7 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate Word64 -> Word64
s (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 :: forall a. Bits a => a -> a -> a
clearMask a
a a
b = a
a forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement a
b

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

{-# INLINE testMask #-}