module Search.Quiescence (quiesceSearch) where import AppPrelude import Evaluation.Evaluation import Models.Move import Models.Position import Models.Score import MoveGen.MakeMove import MoveGen.MoveQueries import MoveGen.PieceCaptures import MoveGen.PositionQueries import MoveGen.PieceQuietMoves import Search.Perft import Control.Monad.State quiesceSearch :: (?nodes :: IORef Word64) => Score -> Score -> Ply -> Position -> IO Score quiesceSearch :: (?nodes::IORef Word64) => Score -> Score -> Ply -> Position -> IO Score quiesceSearch !Score alpha !Score beta !Ply ply !Position pos | Score standPat Score -> Score -> Bool forall a. Ord a => a -> a -> Bool >= Score beta = Score -> IO Score forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Score beta | Bool otherwise = do IORef Word64 -> (Word64 -> Word64) -> IO () forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m () modifyIORef' ?nodes::IORef Word64 IORef Word64 ?nodes (Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a + Word64 1) (Maybe Score score, Score finalAlpha) <- StateT Score IO (Maybe Score) -> Score -> IO (Maybe Score, Score) forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s) runStateT StateT Score IO (Maybe Score) scoreState Score newAlpha Score -> IO Score forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Score -> IO Score) -> Score -> IO Score forall a b. (a -> b) -> a -> b $! Score -> Maybe Score -> Score forall a. a -> Maybe a -> a fromMaybe Score finalAlpha Maybe Score score where scoreState :: StateT Score IO (Maybe Score) scoreState = (Int -> Move -> StateT Score IO (Maybe Score)) -> [Move] -> StateT Score IO (Maybe Score) forall (m :: * -> *) a b. Monad m => (Int -> a -> m (Maybe b)) -> [a] -> m (Maybe b) findTraverseIndex ((?nodes::IORef Word64) => Score -> Ply -> Position -> Int -> Move -> StateT Score IO (Maybe Score) Score -> Ply -> Position -> Int -> Move -> StateT Score IO (Maybe Score) getMoveScore Score beta Ply ply Position pos) [Move] moves moves :: [Move] moves | Position -> Bool isKingInCheck Position pos = Position -> [Move] allMoves Position pos | Ply ply Ply -> Ply -> Bool forall a. Ord a => a -> a -> Bool <= Ply 1 = Position -> [Move] getWinningCapturesAndChecks Position pos | Bool otherwise = Position -> [Move] getWinningCaptures Position pos !newAlpha :: Score newAlpha = Score -> Score -> Score forall a. Ord a => a -> a -> a max Score alpha Score standPat !standPat :: Score standPat = Position -> Score evaluatePosition Position pos getMoveScore :: (?nodes :: IORef Word64) => Score -> Ply -> Position -> Int -> Move -> QuiesceM (Maybe Score) getMoveScore :: (?nodes::IORef Word64) => Score -> Ply -> Position -> Int -> Move -> StateT Score IO (Maybe Score) getMoveScore !Score beta !Ply ply !Position pos Int _ Move mv = do !Score alpha <- StateT Score IO Score forall s (m :: * -> *). MonadState s m => m s get !Score score <- IO Score -> StateT Score IO Score forall a. IO a -> StateT Score IO a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (Score -> Score forall a. Num a => a -> a negate (Score -> Score) -> IO Score -> IO Score forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (?nodes::IORef Word64) => Score -> Score -> Ply -> Position -> IO Score Score -> Score -> Ply -> Position -> IO Score quiesceSearch (-Score beta) (-Score alpha) (Ply ply Ply -> Ply -> Ply forall a. Num a => a -> a -> a + Ply 1) (Move -> Position -> Position makeMove Move mv Position pos)) let !nodeType :: NodeType nodeType = Score -> Score -> Score -> NodeType getNodeType Score alpha Score beta Score score Score -> Score -> NodeType -> StateT Score IO (Maybe Score) advanceState Score beta Score score NodeType nodeType advanceState :: Score -> Score -> NodeType -> QuiesceM (Maybe Score) advanceState :: Score -> Score -> NodeType -> StateT Score IO (Maybe Score) advanceState !Score beta !Score score !NodeType nodeType = case NodeType nodeType of NodeType PV -> Maybe Score forall a. Maybe a Nothing Maybe Score -> StateT Score IO () -> StateT Score IO (Maybe Score) forall a b. a -> StateT Score IO b -> StateT Score IO a forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Score -> StateT Score IO () forall s (m :: * -> *). MonadState s m => s -> m () put Score score NodeType Cut -> Maybe Score -> StateT Score IO (Maybe Score) forall a. a -> StateT Score IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Score -> StateT Score IO (Maybe Score)) -> Maybe Score -> StateT Score IO (Maybe Score) forall a b. (a -> b) -> a -> b $ Score -> Maybe Score forall a. a -> Maybe a Just Score beta NodeType All -> Maybe Score -> StateT Score IO (Maybe Score) forall a. a -> StateT Score IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Score forall a. Maybe a Nothing getWinningCapturesAndChecks :: Position -> [Move] getWinningCapturesAndChecks :: Position -> [Move] getWinningCapturesAndChecks Position pos = Position -> [Move] getWinningCaptures Position pos [Move] -> [Move] -> [Move] forall a. Semigroup a => a -> a -> a <> (Element [Move] -> Bool) -> [Move] -> [Move] forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq filter (Move -> Position -> Bool `isCheckMove` Position pos) (Position -> [Move] allQuietMoves Position pos) getWinningCaptures :: Position -> [Move] getWinningCaptures :: Position -> [Move] getWinningCaptures Position pos = (Element [Move] -> Bool) -> [Move] -> [Move] forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq filter (Move -> Position -> Bool `isWinningCapture` Position pos) (Position -> [Move] allCaptures Position pos) type QuiesceM = StateT Score IO