diff --git a/book/twic-9g.bin b/book/twic-9g.bin # file too large to diff: book/twic-9g.bin diff --git a/chessIO.cabal b/chessIO.cabal --- a/chessIO.cabal +++ b/chessIO.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: chessIO -version: 0.9.4.0 +version: 0.9.5.0 synopsis: Basic chess library description: A simple and fast library for generating legal chess moves. Also includes a module for communication with external processes that speak the UCI (Universal Chess Interface) protocol, a PGN parser/pretty printer, and Polyglot opening book support. On top of that, provides a console frontend program (cboard) that can be used to interactively play against UCI engines. category: Game @@ -13,7 +13,7 @@ bug-reports: https://github.com/mlang/chessIO/issues author: Mario Lang maintainer: mlang@blind.guru -copyright: 2021 Mario Lang +copyright: 2024 Mario Lang license: BSD3 license-file: LICENSE build-type: Simple diff --git a/src/Game/Chess/Internal.hs b/src/Game/Chess/Internal.hs --- a/src/Game/Chess/Internal.hs +++ b/src/Game/Chess/Internal.hs @@ -250,9 +250,9 @@ occupied :: QuadBitboard -> Bitboard occupied = QBB.occupied -bitScanForward, bitScanReverse :: Word64 -> Int +bitScanForward, bitScanReverse :: Bitboard -> Int bitScanForward = countTrailingZeros -bitScanReverse bb = 63 - countLeadingZeros bb +bitScanReverse = (63 -) . countLeadingZeros {-# INLINE bitScanForward #-} {-# INLINE bitScanReverse #-} @@ -592,13 +592,13 @@ forBits (knightAttacks `unsafeIndex` src .&. notUs) $ \dst -> do add $ move (Sq src) (Sq dst) forBits bishops $ \src -> do - forBits (bishopTargets src occ .&. notUs) $ \dst -> do + forBits (diagonal src occ .&. notUs) $ \dst -> do add $ move (Sq src) (Sq dst) forBits rooks $ \src -> do - forBits (rookTargets src occ .&. notUs) $ \dst -> do + forBits (orthogonal src occ .&. notUs) $ \dst -> do add $ move (Sq src) (Sq dst) forBits queens $ \src -> do - forBits (queenTargets src occ .&. notUs) $ \dst -> do + forBits ((orthogonal src occ .|. diagonal src occ) .&. notUs) $ \dst -> do add $ move (Sq src) (Sq dst) {-# INLINE piecePlies #-} @@ -660,22 +660,18 @@ bQscm = move E8 C8 attackedBy :: Color -> QuadBitboard -> Word64 -> Square -> Bool -attackedBy White !qbb !occ (Sq sq) - | unsafeIndex wPawnAttacks sq .&. QBB.wPawns qbb /= 0 = True - | unsafeIndex knightAttacks sq .&. QBB.wKnights qbb /= 0 = True - | bishopTargets sq occ .&. QBB.wBishops qbb /= 0 = True - | rookTargets sq occ .&. QBB.wRooks qbb /= 0 = True - | queenTargets sq occ .&. QBB.wQueens qbb /= 0 = True - | unsafeIndex kingAttacks sq .&. QBB.wKings qbb /= 0 = True - | otherwise = False -attackedBy Black !qbb !occ (Sq sq) - | unsafeIndex bPawnAttacks sq .&. QBB.bPawns qbb /= 0 = True - | unsafeIndex knightAttacks sq .&. QBB.bKnights qbb /= 0 = True - | bishopTargets sq occ .&. QBB.bBishops qbb /= 0 = True - | rookTargets sq occ .&. QBB.bRooks qbb /= 0 = True - | queenTargets sq occ .&. QBB.bQueens qbb /= 0 = True - | unsafeIndex kingAttacks sq .&. QBB.bKings qbb /= 0 = True - | otherwise = False +attackedBy White !qbb !occ (Sq sq) = + (unsafeIndex wPawnAttacks sq .&. QBB.wPawns qbb) .|. + (unsafeIndex knightAttacks sq .&. QBB.wKnights qbb) .|. + (diagonal sq occ .&. QBB.wDiagonals qbb) .|. + (orthogonal sq occ .&. QBB.wOrthogonals qbb) .|. + (unsafeIndex kingAttacks sq .&. QBB.wKings qbb) /= 0 +attackedBy Black !qbb !occ (Sq sq) = + (unsafeIndex bPawnAttacks sq .&. QBB.bPawns qbb) .|. + (unsafeIndex knightAttacks sq .&. QBB.bKnights qbb) .|. + (diagonal sq occ .&. QBB.bDiagonals qbb) .|. + (orthogonal sq occ .&. QBB.bOrthogonals qbb) .|. + (unsafeIndex kingAttacks sq .&. QBB.bKings qbb) /= 0 {-# INLINE attackedBy #-} @@ -723,52 +719,35 @@ bPawnAttacks = Vector.generate 64 $ \sq -> let b = bit sq in shiftNE b .|. shiftNW b -rookTargets, bishopTargets, queenTargets :: Int -> Word64 -> Word64 -rookTargets !sq !occ = rayN occ sq .|. rayE occ sq - .|. rayS occ sq .|. rayW occ sq -bishopTargets !sq !occ = rayNW occ sq .|. rayNE occ sq - .|. raySE occ sq .|. raySW occ sq -queenTargets !sq !occ = rookTargets sq occ .|. bishopTargets sq occ - -rayTargets :: Vector Word64 -> (Word64 -> Int) -> Word64 -> Int -> Word64 -rayTargets !ray !bitScan !occ (unsafeIndex ray -> a) = case a .&. occ of - 0 -> a - (bitScan -> sq) -> a `xor` unsafeIndex ray sq - -{-# INLINE rayTargets #-} - -rayNW, rayN, rayNE, rayE, raySE, rayS, raySW, rayW :: Word64 -> Int -> Word64 -rayNW = rayTargets attackNW bitScanForward -rayN = rayTargets attackN bitScanForward -rayNE = rayTargets attackNE bitScanForward -rayE = rayTargets attackE bitScanForward -raySE = rayTargets attackSE bitScanReverse -rayS = rayTargets attackS bitScanReverse -raySW = rayTargets attackSW bitScanReverse -rayW = rayTargets attackW bitScanReverse - -{-# INLINE rayNW #-} -{-# INLINE rayN #-} -{-# INLINE rayNE #-} -{-# INLINE rayE #-} -{-# INLINE raySE #-} -{-# INLINE rayS #-} -{-# INLINE raySW #-} -{-# INLINE rayW #-} - -attackDir :: (Word64 -> Word64) -> Vector Word64 -attackDir s = Vector.generate 64 $ \sq -> - foldr (.|.) 0 $ take 7 $ tail $ iterate s (bit sq) +orthogonal, diagonal :: Int -> Bitboard -> Bitboard +orthogonal !sq !occ = mask .&. ((up .&. down) .|. (left .&. right)) where + mask = complement $ unsafeShiftL 1 sq + occ' = occ .&. mask + up = unsafeShiftR hFile $ (63 -) $ bitScanForward $ + unsafeShiftL aFile sq .&. (occ' .|. rank8) + down = unsafeShiftL aFile $ bitScanReverse $ + unsafeShiftR hFile (63 - sq) .&. (occ' .|. rank1) + right = unsafeShiftR rank8 $ (63 -) $ bitScanForward $ + unsafeShiftL rank1 sq .&. (occ' .|. hFile) + left = unsafeShiftL rank1 $ bitScanReverse $ + unsafeShiftR rank8 (63 - sq) .&. (occ' .|. aFile) +diagonal !sq !occ = mask .&. ((up .&. down) .|. (left .&. right)) where + mask = complement $ unsafeShiftL 1 sq + occ' = occ .&. mask + up = unsafeShiftR a1h8 $ (63 -) $ bitScanForward $ + unsafeShiftL a1h8 sq .&. (occ' .|. rank8 .|. hFile) + down = unsafeShiftL a1h8 $ bitScanReverse $ + unsafeShiftR a1h8 (63 - sq) .&. (occ' .|. rank1 .|. aFile) + right = unsafeShiftL h1a8 $ bitScanReverse $ + unsafeShiftR h1a8 (63 - sq) .&. (occ' .|. rank1 .|. hFile) + left = unsafeShiftR h1a8 $ (63 -) $ bitScanForward $ + unsafeShiftL h1a8 sq .&. (occ' .|. aFile .|. rank8) -attackNW, attackN, attackNE, attackE, attackSE, attackS, attackSW, attackW :: Vector Word64 -attackNW = attackDir shiftNW -attackN = attackDir shiftN -attackNE = attackDir shiftNE -attackE = attackDir shiftE -attackSE = attackDir shiftSE -attackS = attackDir shiftS -attackSW = attackDir shiftSW -attackW = attackDir shiftW +aFile, hFile, a1h8, h1a8 :: Bitboard +aFile = 0x0101010101010101 +hFile = 0x8080808080808080 +a1h8 = 0x8040201008040201 +h1a8 = 0x8102040810204081 clearMask :: Bits a => a -> a -> a clearMask a b = a .&. complement b diff --git a/src/Game/Chess/Internal/QuadBitboard.hs b/src/Game/Chess/Internal/QuadBitboard.hs --- a/src/Game/Chess/Internal/QuadBitboard.hs +++ b/src/Game/Chess/Internal/QuadBitboard.hs @@ -15,6 +15,7 @@ , pawns, knights, bishops, rooks, queens, kings , wPawns, wKnights, wBishops, wRooks, wQueens, wKings , bPawns, bKnights, bBishops, bRooks, bQueens, bKings +, wOrthogonals, bOrthogonals, wDiagonals, bDiagonals , insufficientMaterial , toString -- * Square codes @@ -98,6 +99,15 @@ bQueens = liftA2 (.&.) queens black bKings = liftA2 (.&.) kings black +orthogonals, diagonals, wOrthogonals, bOrthogonals, wDiagonals, bDiagonals :: QuadBitboard -> Word64 +diagonals = liftA2 (.&.) pbq (complement . pawns) +orthogonals = liftA2 (.&.) rqk (complement . kings) +wOrthogonals = liftA2 (.&.) orthogonals (complement . black) +bOrthogonals = liftA2 (.&.) orthogonals black +wDiagonals = liftA2 (.&.) diagonals (complement . black) +bDiagonals = liftA2 (.&.) diagonals black + + {-# INLINE occupied #-} {-# INLINE white #-} {-# INLINE pawns #-} @@ -118,6 +128,14 @@ {-# INLINE bRooks #-} {-# INLINE bQueens #-} {-# INLINE bKings #-} +{-# INLINE diagonals #-} +{-# INLINE orthogonals #-} +{-# INLINE wOrthogonals #-} +{-# INLINE bOrthogonals #-} +{-# INLINE wDiagonals #-} +{-# INLINE bDiagonals #-} + + pattern NoPiece :: Word4 pattern NoPiece = 0