module Utils.KillersTable where import AppPrelude import Models.Move import Models.Position import Models.Score import MoveGen.MoveQueries import Data.Vector.Storable.Mutable (IOVector) import qualified Data.Vector.Storable.Mutable as Vector type KillersTable = IOVector StorableMove lookupMoves :: (?killersTable :: KillersTable) => Ply -> IO [Move] lookupMoves :: (?killersTable::KillersTable) => Ply -> IO [Move] lookupMoves !Ply ply = do StorableMove firstMove <- MVector (PrimState IO) StorableMove -> Int -> IO StorableMove forall (m :: * -> *) a. (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a Vector.unsafeRead ?killersTable::KillersTable KillersTable MVector (PrimState IO) StorableMove ?killersTable Int idx StorableMove secondMove <- MVector (PrimState IO) StorableMove -> Int -> IO StorableMove forall (m :: * -> *) a. (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a Vector.unsafeRead ?killersTable::KillersTable KillersTable MVector (PrimState IO) StorableMove ?killersTable (Int idx Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1) [Move] -> IO [Move] forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ([Move] -> IO [Move]) -> [Move] -> IO [Move] forall a b. (a -> b) -> a -> b $ (StorableMove -> Maybe Move) -> [StorableMove] -> [Move] forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe StorableMove -> Maybe Move decodeMove [StorableMove firstMove, StorableMove secondMove] where !idx :: Int idx = Int killerSlots Int -> Int -> Int forall a. Num a => a -> a -> a * Ply -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral Ply ply insert :: (?killersTable :: KillersTable) => Ply -> Position -> Move -> IO () insert :: (?killersTable::KillersTable) => Ply -> Position -> Move -> IO () insert !Ply ply Position pos Move mv = Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (Move -> Position -> Bool isQuietMove Move mv Position pos) do StorableMove firstMove <- MVector (PrimState IO) StorableMove -> Int -> IO StorableMove forall (m :: * -> *) a. (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a Vector.unsafeRead ?killersTable::KillersTable KillersTable MVector (PrimState IO) StorableMove ?killersTable Int idx Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless (Move mv Move -> Maybe Move -> Bool forall a. Eq a => a -> Maybe a -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` StorableMove -> Maybe Move decodeMove StorableMove firstMove) do MVector (PrimState IO) StorableMove -> Int -> StorableMove -> IO () forall (m :: * -> *) a. (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () Vector.unsafeWrite ?killersTable::KillersTable KillersTable MVector (PrimState IO) StorableMove ?killersTable Int idx (Maybe Move -> StorableMove encodeMove (Maybe Move -> StorableMove) -> Maybe Move -> StorableMove forall a b. (a -> b) -> a -> b $ Move -> Maybe Move forall a. a -> Maybe a Just Move mv) MVector (PrimState IO) StorableMove -> Int -> StorableMove -> IO () forall (m :: * -> *) a. (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () Vector.unsafeWrite ?killersTable::KillersTable KillersTable MVector (PrimState IO) StorableMove ?killersTable (Int idx Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1) StorableMove firstMove where !idx :: Int idx = Int killerSlots Int -> Int -> Int forall a. Num a => a -> a -> a * Ply -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral Ply ply create :: IO KillersTable create :: IO KillersTable create = Int -> StorableMove -> IO (MVector (PrimState IO) StorableMove) forall (m :: * -> *) a. (PrimMonad m, Storable a) => Int -> a -> m (MVector (PrimState m) a) Vector.replicate (Int killerSlots Int -> Int -> Int forall a. Num a => a -> a -> a * (Ply -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral (forall a. Bounded a => a maxBound @Ply) Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1)) (Maybe Move -> StorableMove encodeMove Maybe Move forall a. Maybe a Nothing) clear :: KillersTable -> IO () clear :: KillersTable -> IO () clear = KillersTable -> IO () MVector (PrimState IO) StorableMove -> IO () forall (m :: * -> *) a. (PrimMonad m, Storable a) => MVector (PrimState m) a -> m () Vector.clear killerSlots :: Int killerSlots :: Int killerSlots = Int 2