From d6645c07af824f5796285a635ed55475d9b0202a Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Sun, 17 Nov 2024 20:48:12 +0100 Subject: [PATCH] simplify --- src/Game/Chess/Internal.hs | 27 ++++++++++++------------- src/Game/Chess/Internal/QuadBitboard.hs | 16 ++++----------- stack.yaml | 2 +- 3 files changed, 18 insertions(+), 27 deletions(-) diff --git a/src/Game/Chess/Internal.hs b/src/Game/Chess/Internal.hs index b3d34a5..b39eb01 100644 --- a/src/Game/Chess/Internal.hs +++ b/src/Game/Chess/Internal.hs @@ -660,18 +660,17 @@ bKscm = move E8 G8 bQscm = move E8 C8 attackedBy :: Color -> QuadBitboard -> Word64 -> Square -> Bool -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 +attackedBy c !qbb !occ (Sq sq) = + ( pawnAttacks sq .&. QBB.pawns qbb + .|. unsafeIndex knightAttacks sq .&. QBB.knights qbb + .|. diagonal sq occ .&. QBB.diagonals qbb + .|. orthogonal sq occ .&. QBB.orthogonals qbb + .|. unsafeIndex kingAttacks sq .&. QBB.kings qbb + ) .&. us /= 0 + where + (# !pawnAttacks, !us #) = case c of + White -> (# unsafeIndex wPawnAttacks, QBB.white qbb #) + Black -> (# unsafeIndex bPawnAttacks, QBB.black qbb #) {-# INLINE attackedBy #-} @@ -720,7 +719,7 @@ bPawnAttacks = Vector.generate 64 $ \sq -> let b = bit sq in shiftNE b .|. shiftNW b orthogonal, diagonal :: Int -> Bitboard -> Bitboard -orthogonal !sq !occ = mask .&. ((up .&. down) .|. (left .&. right)) where +orthogonal !sq !occ = mask .&. (up .&. down .|. left .&. right) where mask = complement $ unsafeShiftL 1 sq occ' = occ .&. mask up = unsafeShiftR hFile $ (63 -) $ bitScanForward $ @@ -731,7 +730,7 @@ orthogonal !sq !occ = mask .&. ((up .&. down) .|. (left .&. right)) where unsafeShiftL rank1 sq .&. (occ' .|. hFile) left = unsafeShiftL rank1 $ bitScanReverse $ unsafeShiftR rank8 (63 - sq) .&. (occ' .|. aFile) -diagonal !sq !occ = mask .&. ((up .&. down) .|. (left .&. right)) where +diagonal !sq !occ = mask .&. (up .&. down .|. left .&. right) where mask = complement $ unsafeShiftL 1 sq occ' = occ .&. mask up = unsafeShiftR a1h8 $ (63 -) $ bitScanForward $ diff --git a/src/Game/Chess/Internal/QuadBitboard.hs b/src/Game/Chess/Internal/QuadBitboard.hs index a4e41f6..3d61f99 100644 --- a/src/Game/Chess/Internal/QuadBitboard.hs +++ b/src/Game/Chess/Internal/QuadBitboard.hs @@ -15,7 +15,7 @@ module Game.Chess.Internal.QuadBitboard ( , pawns, knights, bishops, rooks, queens, kings , wPawns, wKnights, wBishops, wRooks, wQueens, wKings , bPawns, bKnights, bBishops, bRooks, bQueens, bKings -, wOrthogonals, bOrthogonals, wDiagonals, bDiagonals +, orthogonals, diagonals , insufficientMaterial , toString -- * Square codes @@ -99,13 +99,9 @@ bRooks = liftA2 (.&.) rooks black 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 +orthogonals, diagonals :: QuadBitboard -> Word64 +diagonals = liftA2 xor pbq pawns +orthogonals = liftA2 xor rqk kings {-# INLINE occupied #-} @@ -130,10 +126,6 @@ bDiagonals = liftA2 (.&.) diagonals black {-# INLINE bKings #-} {-# INLINE diagonals #-} {-# INLINE orthogonals #-} -{-# INLINE wOrthogonals #-} -{-# INLINE bOrthogonals #-} -{-# INLINE wDiagonals #-} -{-# INLINE bDiagonals #-} diff --git a/stack.yaml b/stack.yaml index 666f669..c2a76f9 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-22.38 +resolver: lts-22.41 packages: - . flags: