public
Created

I still get the errors: Couldn't match type `s' with `PrimState (ST s)'

  • Download Gist
gistfile1.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
{-# LANGUAGE BangPatterns
#-}
 
module WhatsWrong (
genCMoves
) where
 
import Control.Monad (when, liftM)
import Control.Monad.ST.Lazy
import Control.Monad.Primitive
import Control.Applicative
import Data.Foldable (foldrM)
import qualified Data.Vector.Unboxed.Mutable as U
import Data.Word
 
maxMovesPerPos = 256 -- should be fine in almost all postions
 
-- dummy types for structures
type MyPos = Word64
type Color = Int
type Move = Word32
 
data MList s = MList {
mlPos :: MyPos, -- the position for which we generate the moves
mlColor :: Color, -- the color for which we generate the moves
mlVec :: U.MVector s Move, -- vector of moves
mlToMove :: !Int, -- index of the next move to execute
mlToGen :: !Int, -- index of the next location to generate moves
mlNextPh :: GenPhase s, -- function for the next move generation phase
mlCheck :: CheckFunc s, -- function to check the next move
mlTTMove :: Maybe Move, -- TT move (if any)
mlKills :: [Move], -- list of killer moves
mlBads :: [Move] -- list of bad captures (with negative SEE)
}
 
-- When we list moves from a generation phase we take the next move, but have to check it
-- to see if:
-- we already gave that move in an earlier phase (e.g. TT move, or killers)
-- (in case of captures) if it's a good capture
-- Earlier generated moves will be skipped, bad captures will be delayed
data CheckResult = Skip | Delay | Ok
type CheckFunc s = MList s -> Move -> CheckResult
 
type GenPhase s = MList s -> ST s (Maybe (MList s))
 
-- When we generate only the (good) captures:
genCMoves :: MyPos -> Color -> [Move]
genCMoves pos col = runST $ do
v <- U.new maxMovesPerPos
let ml = MList { mlPos = pos, mlColor = col, mlVec = v, mlToMove = 0, mlToGen = 0,
mlNextPh = nextPhaseOnlyCapts,
mlCheck = constOk, mlTTMove = Nothing, mlKills = [], mlBads = [] }
listMoves ml
 
-- Transforms a move list to a list of moves - lazy
-- listMoves :: MList s -> ST s [Move]
listMoves ml = do
sm <- splitMove ml
case sm of
Just (m, ml') -> (m :) <$> listMoves ml'
Nothing -> return []
 
nextPhaseOnlyCapts :: GenPhase s
nextPhaseOnlyCapts ml = do
n <- genCapts (mlPos ml) (mlColor ml) (mlVec ml) (mlToGen ml)
return $ Just ml { mlToGen = n, mlNextPh = nextPhaseEnd, mlCheck = constOk }
 
-- nextPhaseEnd :: GenPhase s
nextPhaseEnd _ = return Nothing
 
-- constOk :: CheckFunc s
constOk _ _ = Ok
 
-- Split the first move from the move list and return it together with
-- the new move list (without the first move). Return Nothing if there
-- is no further move
-- splitMove :: MList s -> ST s (Maybe (Move, MList s))
splitMove ml
| mlToMove ml >= mlToGen ml = do
mml <- nextPhase ml
case mml of
Nothing -> return Nothing
Just ml' -> splitMove ml'
| otherwise = do
m <- U.unsafeRead (mlVec ml) (mlToMove ml)
case mlCheck ml ml m of
Ok -> return (Just (m, ml1))
Skip -> splitMove ml1
Delay -> splitMove ml1 { mlBads = m : mlBads ml }
where !ml1 = ml { mlToMove = mlToMove ml + 1 }
 
-- genCapts :: MyPos -> Color -> U.MVector s Move -> Int -> ST s Int
genCapts pos col vec start = do
let fts = genMoveCapt pos col -- here: how to generates transformations??
if null fts
then return start
else do
next <- foldrM fromtos start fts
return next
where fromtos ft@(f, t) i = do
U.write vec i 0xFFFF -- dummy value to write here
return $! i + 1
 
-- Invoke the next phase of move generation and return new move list if
-- there really was one, otherwise returns Nothing, which should be interpreted
-- as the move list is done
-- nextPhase :: GenPhase s
nextPhase ml = (mlNextPh ml) ml
 
-- dummy genMoveCapt:
genMoveCapt _ _ = []

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.