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