From d95d0e123eb8e227b1518f9352072ddffd2569ae Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Sun, 11 Sep 2016 17:54:05 -0700 Subject: [PATCH 1/2] Fix a space leak in package preferences (part of issue #3824). The space leak was introduced in #3594. #3594 added a new variable, sortedVersions, to sort the subtrees under package choice nodes in the search tree. However, sortedVersions referenced the subtrees and caused them to be retained when it was not used. This commit forces evaluation of sortedVersions. --- .../Distribution/Solver/Modular/Preference.hs | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/cabal-install/Distribution/Solver/Modular/Preference.hs b/cabal-install/Distribution/Solver/Modular/Preference.hs index 5a15d7a90bc..5ca4161b2f4 100644 --- a/cabal-install/Distribution/Solver/Modular/Preference.hs +++ b/cabal-install/Distribution/Solver/Modular/Preference.hs @@ -51,17 +51,26 @@ import qualified Distribution.Solver.Modular.WeightedPSQ as W -- | Update the weights of children under 'PChoice' nodes. 'addWeights' takes a -- list of weight-calculating functions in order to avoid sorting the package -- choices multiple times. Each function takes the package name, sorted list of --- siblings' versions, and package option. 'addWeights' prepends the new +-- children's versions, and package option. 'addWeights' prepends the new -- weights to the existing weights, which gives precedence to preferences that -- are applied later. addWeights :: [PN -> [Ver] -> POption -> Weight] -> Tree a -> Tree a addWeights fs = trav go where + go :: TreeF a (Tree a) -> TreeF a (Tree a) go (PChoiceF qpn@(Q _ pn) x cs) = - let sortedVersions = L.sortBy (flip compare) $ L.map version (W.keys cs) + let versions = L.map version (W.keys cs) + sortedVersions = L.sortBy (flip compare) versions weights k = [f pn sortedVersions k | f <- fs] - in PChoiceF qpn x $ - W.mapWeightsWithKey (\k w -> weights k ++ w) cs + + elemsToWhnf :: [a] -> () + elemsToWhnf = foldr seq () + in PChoiceF qpn x + -- Evaluate the children's versions before evaluating any of the + -- subtrees, so that 'versions' doesn't hold onto all of the + -- subtrees (referenced by cs) and cause a space leak. + (elemsToWhnf versions `seq` + W.mapWeightsWithKey (\k w -> weights k ++ w) cs) go x = x addWeight :: (PN -> [Ver] -> POption -> Weight) -> Tree a -> Tree a From 2e5374e2b76a2cad95af995f8dfa3ed1de3c72d6 Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Sun, 11 Sep 2016 21:15:43 -0700 Subject: [PATCH 2/2] Simplify Preference.addWeights. --- cabal-install/Distribution/Solver/Modular/Preference.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/cabal-install/Distribution/Solver/Modular/Preference.hs b/cabal-install/Distribution/Solver/Modular/Preference.hs index 5ca4161b2f4..f844f4eaeb6 100644 --- a/cabal-install/Distribution/Solver/Modular/Preference.hs +++ b/cabal-install/Distribution/Solver/Modular/Preference.hs @@ -59,17 +59,16 @@ addWeights fs = trav go where go :: TreeF a (Tree a) -> TreeF a (Tree a) go (PChoiceF qpn@(Q _ pn) x cs) = - let versions = L.map version (W.keys cs) - sortedVersions = L.sortBy (flip compare) versions + let sortedVersions = L.sortBy (flip compare) $ L.map version (W.keys cs) weights k = [f pn sortedVersions k | f <- fs] elemsToWhnf :: [a] -> () elemsToWhnf = foldr seq () in PChoiceF qpn x -- Evaluate the children's versions before evaluating any of the - -- subtrees, so that 'versions' doesn't hold onto all of the + -- subtrees, so that 'sortedVersions' doesn't hold onto all of the -- subtrees (referenced by cs) and cause a space leak. - (elemsToWhnf versions `seq` + (elemsToWhnf sortedVersions `seq` W.mapWeightsWithKey (\k w -> weights k ++ w) cs) go x = x