Optimizing a Haskell function to prevent stack overflows

I'm trying to create a function that recursively plays all possible games of tic-tac-toe using a genetic algorithm, and then returns a tuple of (wins,losses,ties). However,开发者_运维知识库 the function below always overflows the stack when called like this:

scoreOne :: UnscoredPlayer -> [String] -> ScoredPlayer
scoreOne player boards = ScoredPlayer (token player) (chromosome player) (evaluateG $!             testPlayer player boards)
...
let results = map (\x->scoreOne x boards) players
print (maximum results)

where players is a list of chromosomes. The overflow doesn't occur with only 1 player, but with two it happens.

EDIT: If the function is called in the following way, it does not overflow the stack.

let results = map (\player -> evaluateG (testPlayer player boards)) players
print (maximum results)

However, the following way does overflow the stack.

let results = map (\player -> ScoredPlayer (token player) (chromosome player) (evaluateG $! testPlayer player boards)) players

For reference, ScoredPlayer is defined as (the string is the player token, [Int] is the chromosome, and Float is the score):

data ScoredPlayer = ScoredPlayer String ![Int] !Float deriving (Eq)

From what I know of Haskell, the playAll' function isn't tail-recursive because the foldl' call I'm using is performing further processing on the function results. However, I have no idea how to eliminate the foldl' call, since it's needed to ensure all possible games are played. Is there any way to restructure the function so that it is tail-recursive (or at least doesn't overflow the stack)?

Thanks in advance, and sorry for the massive code listing.

playAll' :: (Num a) => UnscoredPlayer -> Bool -> String -> [String] -> (a,a,a) ->    (a,a,a)
playAll' player playerTurn board boards (w,ls,t)= 
    if won == self then (w+1,ls,t) -- I won this game
    else
        if won == enemy then (w,ls+1,t) -- My enemy won this game
        else
            if '_' `notElem` board then (w,ls,t+1) -- It's a tie
            else
                if playerTurn then --My turn; make a move and try all possible combinations for the enemy
                    playAll' player False (makeMove ...) boards (w,ls,t)
                else --Try each possible move against myself
                    (foldl' (\(x,y,z) (s1,s2,s3) -> (x+s1,y+s2,z+s3)) (w,ls,t)
                        [playAll' player True newBoard boards (w,ls,t)| newBoard <- (permute enemy board)])
    where
        won = winning board --if someone has one, who is it?
        enemy = (opposite.token) player --what player is my enemy?
        self = token player --what player am I?

The foldl' function is tail-recursive, the problem is that it's not strict enough. This is the problem Don Stewart mentions in his comment.

Think of Haskell data structures as lazy boxes, where every new constructor makes a new box. When you have a fold like

foldl' (\(x,y,z) (s1,s2,s3) -> (x+s1,y+s2,z+s3))

the tuples are one box, and each element within them are another box. The strictness from foldl' only removes the outermost box. Each element within the tuple is still in a lazy box.

To get around this you need to apply deeper strictness to remove the extra boxes. Don's suggestion is to make

data R = R !Int !Int !Int

foldl' (\(R x y z) (s1,s2,s3) -> R (x+s1) (y+s2) (z+s3))

Now the strictness of foldl' is sufficient. The individual elements of R are strict, so when the outermost box (the R constructor) is removed, the three values inside are evaluated as well.

Without seeing more code that's about all I can provide. I wasn't able to run this listing so I don't know if this solves the problem or if there are other issues in the full program.

As a point of style, instead of nested if's you may prefer the following:

playAll' player playerTurn board boards (w,ls,t)=
  case () of
    _ | won == self -> (w+1,ls,t) -- I won this game
    _ | won == enemy -> (w,ls+1,t) -- My enemy won this game
    _ | '_' `notElem` board -> (w,ls,t+1) -- It's a tie 
    _ -> ... --code omitted