如何修复Haskell中的内存泄漏（thunk泄漏？）？

我正在尝试修复此代码中的内存泄漏。它不会在十分钟内因小输入而终止，并在使用

stack exec

运行时出现“内存不足”错误。我认为内存泄漏是在newMap的构建过程中。我认为这可能是thunk泄漏，因为它位于递归函数中。我尝试过使用严格的GHC扩展，并在下面的代码中使用seq和deepseq以及变体

我认为漏洞就在这里：

    !existingPolysets <- get
    let newMap = (List.foldl' (\accumulator coefficient ->
                  let newMonomial = (Monomial coefficient degree)
                      innerMap = addOneMonomialToPolySets newMonomial (PolynomialConstraints x y bound maxDegree) existingPolysets accumulator in
                    Map.union innerMap accumulator) Map.empty [-bound..bound])
    ($!!) modify' (const newMap)

！existingPolysets[Identifier]--这是好的还是应该是[Int]？更多的打字似乎更安全
--返回subPolynomialSetsWithID中SubPolynomialSets的标识符列表
getSubPolynomialSetsIdentifiers=List.map（\（SubpolynomialSetWithiIdentifier单项多项式SetWithid identifier）->标识符）
getPolynomialSetIdentifier:：PolynomialSetWithiIdentifier->Identifier
--返回多项式集的标识符
getPolynomialSetIdentifier（PolynomialSetWithiIdentifier子多项式集标识符）=标识符
GetOutputForOneConference:：整数->整数->整数->整数->整数->整数
--返回多项式的输出，该多项式的系数为从maxDegree阶到minDegree阶的单项式
--度多项式约束->整数->布尔
--如果无法为多项式约束、多项式约束、单项式单项式生成y，则返回False，
--到目前为止计算的总输出是整数totalOutput
checkPolynomialSetPossible totalOutput（多项式约束x y界maxPolynomialDegree）monomialDegree
|单项次<最大多项式次=
设lowerBound=getLowerBound totalOutput（多项式约束x y界maxPolynomialDegree）monomialDegree
上限=getOutputForOneCoefficient（monomialDegree+1）maxPolynomialDegree bound x totalOutput in
lowerBound映射。映射索引多项式在标识符之间
--O（n）
--返回所有值都具有degree corrected degree的映射索引多项式twithIdentifier
FilterPolynomialByDegree映射多项式集correctDegree=Map.filterWithKey（\（索引度输出）polynomialSetID->degree==correctDegree）映射多项式集
mapValues:：Ord a=>Map.Map k a->Set.Set a
mapValues m=Map.foldlWithKey'（\acculator key value->Set.insert value acculator）Set.empty m
AddOne单项式拓扑分析集：：单项式->多项式约束->映射索引多项式网络标识符->映射索引多项式网络标识符->映射索引多项式网络标识符->映射索引多项式网络标识符
ADDONEMONIALTOPOLYSETS（单项系数阶）（多项式约束x y约束多项式阶）存在映射阶数1存在累加器映射=
让newMonomial=单项式系数度数-，这个定界太早了，但它太小了。。。可能是别的什么？
newMonomialOutput=系数*x^度数
Map.foldlWithKey'（\acculator（索引存在度存在输出）！存在多项式ETWITHID->
设！totalOutput=newMonomialOutput+中的现有输出
如果选中PolynomialSetPossible totalOutput（PolynomialConstraints x y bound polynomialDegree）次数
然后
的case Map.lookup（索引度totalOutput）累加器
Just（多项式网络标识符！亚多项式集）->
设！newSubPolynomialSetWithID=子多项式etwithier newMonomial existingPolynomialSetWithID（标识符$hash（newMonomial，getPolynomialSetIdentifier existingPolynomialSetWithID））在
让！newSubPolynomialSets=List。在中插入newSubPolynomialSetWithID子多项式集
让！newPolynomialSetWithID=PolynomialSetWithiIdentifier newSubPolynomialSets（标识符$hash$getSubPolynomialSetsIdentifiers newSubPolynomialSets）位于
插入（索引度总输出）新多项式带位累加器
没有->
设！newSubPolynomialSetWithID=子多项式etwithier newMonomial existingPolynomialSetWithID（标识符$hash（newMonomial，getPolynomialSetIdentifier existingPolynomialSetWithID））在
让！newPolynomialSetWithID=polynomialSetWithidier[newSubPolynomialSetWithID]（标识符$hash$GetSubpolynomialSetSidentiers[newSubPolynomialSetWithID]）位于
插入（索引度总输出）新多项式带位累加器
else累加器
)现有累加器映射现有映射深度1
makePolynomialSetsFast:：PolynomialConstraints->PolynomialSolutions（）
makePolynomialSetsFast（多项式约束x y界度）=
使多项式集正规化（多项式约束x y界0）度
makePolynomialSetsFastDegreeZero:：PolynomialConstraints->Integer->PolynomialSolutions（）
makePolynomialSetsFastDegreeZero（多项式约束x y界度）maxDegree=
让newMap=（List.foldl'（\acculator-covertificient->
设newMonomial=（单项式系数阶）
newSubPolynomialSet=子多项式etwhiteIdentifier newMonomial emptypolynomialsetwhiteId（标识符$hash（newMonomial，getPolynomialSetIdentifier emptypolynomialsetwhiteId））
新波
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE BangPatterns #-}
module Dag where

import Control.Monad.State.Strict
import Control.Monad (liftM, ap)
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import GHC.Generics (Generic)
import Data.Hashable
import Control.DeepSeq

data PolynomialConstraints = PolynomialConstraints Integer Integer Integer Integer
-- x y bound degree
  deriving (Show, Eq, Ord, Generic)

data Index = Index Integer Integer -- degree, output
  deriving (Show, Eq, Ord, Generic)
type MyState = Map.Map Index PolynomialSetWithIdentifier

instance NFData Index
instance NFData Monomial
instance NFData Identifier
instance NFData SubPolynomialSetWithIdentifier
instance NFData PolynomialSetWithIdentifier
instance NFData PolynomialConstraints

instance Hashable Monomial
instance Hashable Identifier
instance Hashable SubPolynomialSetWithIdentifier
instance Hashable PolynomialSetWithIdentifier

data PolynomialSetWithIdentifier = PolynomialSetWithIdentifier [SubPolynomialSetWithIdentifier] Identifier
  deriving (Show, Eq, Ord, Generic)
data SubPolynomialSetWithIdentifier = SubPolynomialSetWithIdentifier Monomial PolynomialSetWithIdentifier Identifier
  deriving (Show, Eq, Ord, Generic)

data Identifier = Identifier Int
  deriving (Show, Eq, Ord, Generic)

type PolynomialsSolutions a = State MyState a

data Monomial = Monomial Integer Integer
-- coeff, degree
  deriving (Show, Eq, Ord, Generic)

emptyPolynomialSetWithID = (PolynomialSetWithIdentifier [] (Identifier $ hash $ getSubPolynomialSetsIdentifiers []))

getSubPolynomialSetsIdentifiers :: [SubPolynomialSetWithIdentifier] -> [Identifier] -- is this good or should it be [Int] ? more typing seems safer
-- returns a list the identifiers of the SubPolynomialSets in subPolynomialSetsWithID
getSubPolynomialSetsIdentifiers = List.map (\(SubPolynomialSetWithIdentifier monomial polynomialSetWithID identifier) -> identifier)

getPolynomialSetIdentifier :: PolynomialSetWithIdentifier -> Identifier
-- returns the identifier of a PolynomialSet
getPolynomialSetIdentifier (PolynomialSetWithIdentifier subPolynomialSets identifier) = identifier

getOutputForOneCoefficient :: Integer -> Integer -> Integer -> Integer -> Integer -> Integer
-- returns the output of the polynomial having coefficient coefficient for monomials from degree maxDegree to degree minDegree
--  and monomials of degree < minDegree having total value computedOutput for x value x
--  minDegree must be <= maxDegree
getOutputForOneCoefficient minDegree maxDegree coefficient x computedOutput 
  = List.foldl' (\total degree -> total + (coefficient * x ^ degree)) computedOutput [minDegree .. maxDegree]

getLowerBound :: Integer -> PolynomialConstraints -> Integer -> Integer
-- returns the lower bound for the polynomial having sum totalOutput for monomials of degree <= monomialDegree 
--  and polynomial constraints (PolynomialConstraints x y bound maxPolynomialDegree) 
getLowerBound totalOutput (PolynomialConstraints x y bound maxPolynomialDegree) monomialDegree
  | x >= 0 = getOutputForOneCoefficient (monomialDegree + 1) maxPolynomialDegree (-bound) x totalOutput
  | otherwise = List.foldl' (\total degree ->
                              if degree `mod` 2 == 0
                              then total + (-bound) * x ^ degree
                              else total +   bound  * x ^ degree) totalOutput [monomialDegree + 1 .. maxPolynomialDegree]

checkPolynomialSetPossible :: Integer -> PolynomialConstraints -> Integer -> Bool
-- returns False if it is impossible to produce y for PolynomialConstraints polynomialConstraints, Monomial monomial,
--  and total output computed so far Integer totalOutput
checkPolynomialSetPossible totalOutput (PolynomialConstraints x y bound maxPolynomialDegree) monomialDegree
  | monomialDegree < maxPolynomialDegree =
    let lowerBound = getLowerBound totalOutput (PolynomialConstraints x y bound maxPolynomialDegree) monomialDegree
        upperBound = getOutputForOneCoefficient (monomialDegree + 1) maxPolynomialDegree   bound  x totalOutput in
          lowerBound <= y && y <= upperBound
  | otherwise = totalOutput == y

filterPolynomialsByDegree :: Map.Map Index PolynomialSetWithIdentifier -> Integer -> Map.Map Index PolynomialSetWithIdentifier
-- O(n)
-- returns Map Index PolynomialSetWithIdentifier in which all values have degree correctDegree
filterPolynomialsByDegree mapPolynomialSets correctDegree = Map.filterWithKey (\(Index degree output) polynomialSetID -> degree == correctDegree) mapPolynomialSets

mapValues :: Ord a => Map.Map k a -> Set.Set a
mapValues m = Map.foldlWithKey'(\accumulator key value -> Set.insert value accumulator) Set.empty m

addOneMonomialToPolySets :: Monomial -> PolynomialConstraints -> Map.Map Index PolynomialSetWithIdentifier -> Map.Map Index PolynomialSetWithIdentifier -> Map.Map Index PolynomialSetWithIdentifier

addOneMonomialToPolySets (Monomial coefficient degree) (PolynomialConstraints x y bound polynomialDegree) existingMapDegreeMinus1 existingAccumulatorMap =
  let newMonomial = Monomial coefficient degree -- this does get bound way too early, but it's so small... probably something else?
      newMonomialOutput = coefficient * x ^ degree in
        Map.foldlWithKey' (\accumulator (Index existingDegree existingOutput) !existingPolynomialSetWithID ->
                              let !totalOutput = newMonomialOutput + existingOutput in
                                if checkPolynomialSetPossible totalOutput (PolynomialConstraints x y bound polynomialDegree) degree
                                then
                                  case Map.lookup (Index degree totalOutput) accumulator of
                                    Just (PolynomialSetWithIdentifier !subPolynomialSets _) ->
                                      let !newSubPolynomialSetWithID   = SubPolynomialSetWithIdentifier newMonomial existingPolynomialSetWithID (Identifier $ hash (newMonomial, getPolynomialSetIdentifier existingPolynomialSetWithID)) in
                                        let !newSubPolynomialSets      = List.insert newSubPolynomialSetWithID subPolynomialSets in
                                          let !newPolynomialSetWithID  = PolynomialSetWithIdentifier newSubPolynomialSets (Identifier $ hash $ getSubPolynomialSetsIdentifiers newSubPolynomialSets) in
                                            insert (Index degree totalOutput) newPolynomialSetWithID accumulator
                                    Nothing ->
                                      let !newSubPolynomialSetWithID = SubPolynomialSetWithIdentifier newMonomial existingPolynomialSetWithID (Identifier $ hash (newMonomial, getPolynomialSetIdentifier existingPolynomialSetWithID)) in
                                        let !newPolynomialSetWithID  = PolynomialSetWithIdentifier [newSubPolynomialSetWithID] (Identifier $ hash $ getSubPolynomialSetsIdentifiers [newSubPolynomialSetWithID]) in
                                          insert (Index degree totalOutput) newPolynomialSetWithID accumulator
                                else accumulator
                                ) existingAccumulatorMap existingMapDegreeMinus1

makePolynomialSetsFast :: PolynomialConstraints -> PolynomialsSolutions ()
makePolynomialSetsFast (PolynomialConstraints x y bound degree) = 
  makePolynomialSetsForMaxDegree (PolynomialConstraints x y bound 0) degree

makePolynomialSetsFastDegreeZero :: PolynomialConstraints -> Integer -> PolynomialsSolutions ()
makePolynomialSetsFastDegreeZero (PolynomialConstraints x y bound degree) maxDegree =
  let newMap = (List.foldl' (\accumulator coefficient ->
                let newMonomial         = (Monomial coefficient degree)
                    newSubPolynomialSet = SubPolynomialSetWithIdentifier newMonomial emptyPolynomialSetWithID (Identifier $ hash (newMonomial, getPolynomialSetIdentifier emptyPolynomialSetWithID))
                    newPolynomialSet    = PolynomialSetWithIdentifier [newSubPolynomialSet] (Identifier $ hash $ getSubPolynomialSetsIdentifiers [newSubPolynomialSet]) in
                  Map.insert (Index degree coefficient) newPolynomialSet accumulator)  Map.empty [-bound .. bound]) in
  modify' (const newMap)

makePolynomialSetsForMaxDegree :: PolynomialConstraints -> Integer -> PolynomialsSolutions ()
makePolynomialSetsForMaxDegree (PolynomialConstraints x y bound degree) maxDegree
  | degree == maxDegree =
    if degree == 0
    then makePolynomialSetsFastDegreeZero (PolynomialConstraints x y bound degree) maxDegree
    else do -- base case
      !existingPolysets <- get only need highest level.
      let finalMap = (List.foldl' (\accumulator coefficient ->
                      let newMonomial = (Monomial coefficient degree) in
                        Map.union (addOneMonomialToPolySets newMonomial (PolynomialConstraints x y bound maxDegree) existingPolysets accumulator) accumulator) Map.empty [-bound .. bound])
      ($!!) modify' (const finalMap) -- definitely needs to be deep-seq'ed
  | degree == 0 = do
    makePolynomialSetsFastDegreeZero (PolynomialConstraints x y bound degree) maxDegree
    makePolynomialSetsForMaxDegree (PolynomialConstraints x y bound (degree +1)) maxDegree
  | otherwise = do
    !existingPolysets <- get
    let newMap = (List.foldl' (\accumulator coefficient ->
                  let newMonomial = (Monomial coefficient degree)
                      innerMap = addOneMonomialToPolySets newMonomial (PolynomialConstraints x y bound maxDegree) existingPolysets accumulator in
                    Map.union innerMap accumulator) Map.empty [-bound..bound])
    ($!!) modify' (const newMap)
    makePolynomialSetsForMaxDegree (PolynomialConstraints x y bound (degree +1)) maxDegree



Prelude Control.DeepSeq> seq (rnf (const undefined)) ()
()