[Git][ghc/ghc][wip/haddock-mem-fixes] Memory usage fixes for Haddock
Finley McIlwaine (@FinleyMcIlwaine)
gitlab at gitlab.haskell.org
Wed May 24 16:10:36 UTC 2023
Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC
Commits:
d6e80d76 by Finley McIlwaine at 2023-05-24T10:07:52-06:00
Memory usage fixes for Haddock
- Do not include `mi_globals` in the `NoBackend` backend. It was only included
for Haddock, but Haddock does not actually need it. This causes a 200MB
reduction in max residency when generating haddocks on the Agda codebase
(roughly 1GB to 800MB).
- Strictly evaluate some SrcSpans in mkDoc{Next,Prev} to avoid thunks
- Strictly evaluate names in `rnHsDoc` to avoid retention of GlobalRdrEnv
- Strictly evaluate fields of `IfaceTyConInfo`
- Update haddock perf tests to be more accurate and force evaluation of renamed
doc thunks using `-fwrite-interface`
- Accept a higher increase (40%) in allocations in the renamer due to `-haddock`.
- Update Haddock submodule to move over to initial implementation of hi-haddock,
including the other memory performance gains recently added to haddock.
- - - - -
8 changed files:
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/Doc.hs
- compiler/GHC/Types/Name/Occurrence.hs
- testsuite/tests/haddock/perf/Fold.hs
- testsuite/tests/haddock/perf/Makefile
- utils/haddock
Changes:
=====================================
compiler/GHC/Driver/Backend.hs
=====================================
@@ -551,17 +551,14 @@ backendRespectsSpecialise (Named NoBackend) = False
-- | This back end wants the `mi_globals` field of a
-- `ModIface` to be populated (with the top-level bindings
--- of the original source). True for the interpreter, and
--- also true for "no backend", which is used by Haddock.
--- (After typechecking a module, Haddock wants access to
--- the module's `GlobalRdrEnv`.)
+-- of the original source). Only true for the interpreter.
backendWantsGlobalBindings :: Backend -> Bool
backendWantsGlobalBindings (Named NCG) = False
backendWantsGlobalBindings (Named LLVM) = False
backendWantsGlobalBindings (Named ViaC) = False
backendWantsGlobalBindings (Named JavaScript) = False
+backendWantsGlobalBindings (Named NoBackend) = False
backendWantsGlobalBindings (Named Interpreter) = True
-backendWantsGlobalBindings (Named NoBackend) = True
-- | The back end targets a technology that implements
-- `switch` natively. (For example, LLVM or C.) Therefore
=====================================
compiler/GHC/Iface/Type.hs
=====================================
@@ -355,13 +355,13 @@ See Note [The equality types story] in GHC.Builtin.Types.Prim.
-}
data IfaceTyConInfo -- Used only to guide pretty-printing
- = IfaceTyConInfo { ifaceTyConIsPromoted :: PromotionFlag
+ = IfaceTyConInfo { ifaceTyConIsPromoted :: !PromotionFlag
-- A PromotionFlag value of IsPromoted indicates
-- that the type constructor came from a data
-- constructor promoted by -XDataKinds, and thus
-- should be printed as 'D to distinguish it from
-- an existing type constructor D.
- , ifaceTyConSort :: IfaceTyConSort }
+ , ifaceTyConSort :: !IfaceTyConSort }
deriving (Eq)
-- This smart constructor allows sharing of the two most common
=====================================
compiler/GHC/Parser/PostProcess/Haddock.hs
=====================================
@@ -1360,11 +1360,15 @@ mkDocIE (L l_comment hdk_comment) =
span = mkSrcSpanPs l_comment
mkDocNext :: PsLocated HdkComment -> Maybe (Located HsDocString)
-mkDocNext (L l (HdkCommentNext doc)) = Just (L (mkSrcSpanPs l) doc)
+mkDocNext (L l (HdkCommentNext doc)) =
+ let !src_span = mkSrcSpanPs l
+ in Just (L src_span doc)
mkDocNext _ = Nothing
mkDocPrev :: PsLocated HdkComment -> Maybe (Located HsDocString)
-mkDocPrev (L l (HdkCommentPrev doc)) = Just (L (mkSrcSpanPs l) doc)
+mkDocPrev (L l (HdkCommentPrev doc)) =
+ let !src_span = mkSrcSpanPs l
+ in Just (L src_span doc)
mkDocPrev _ = Nothing
=====================================
compiler/GHC/Rename/Doc.hs
=====================================
@@ -1,5 +1,7 @@
module GHC.Rename.Doc ( rnHsDoc, rnLHsDoc, rnLDocDecl, rnDocDecl ) where
+import Control.DeepSeq (force)
+
import GHC.Prelude
import GHC.Tc.Types
@@ -33,7 +35,11 @@ rnDocDecl (DocGroup i doc) = do
rnHsDoc :: WithHsDocIdentifiers a GhcPs -> RnM (WithHsDocIdentifiers a GhcRn)
rnHsDoc (WithHsDocIdentifiers s ids) = do
gre <- tcg_rdr_env <$> getGblEnv
- pure (WithHsDocIdentifiers s (rnHsDocIdentifiers gre ids))
+
+ -- This is forced to avoid retention of the GlobalRdrEnv
+ let !rn = force $ rnHsDocIdentifiers gre ids
+
+ pure (WithHsDocIdentifiers s rn)
rnHsDocIdentifiers :: GlobalRdrEnv
-> [Located RdrName]
=====================================
compiler/GHC/Types/Name/Occurrence.hs
=====================================
@@ -600,7 +600,7 @@ unitOccEnv (OccName ns s) a = MkOccEnv $ unitFsEnv s (unitUFM ns a)
-- | Add a single element to an 'OccEnv'.
extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv (MkOccEnv as) (OccName ns s) a =
- MkOccEnv $ extendFsEnv_C plusUFM as s (unitUFM ns a)
+ MkOccEnv $ extendFsEnv_C plusUFM as s $! unitUFM ns a
-- | Extend an 'OccEnv' by a list.
--
=====================================
testsuite/tests/haddock/perf/Fold.hs
=====================================
@@ -143,6 +143,7 @@ import Prelude
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Control.Monad as Monad
+import Control.Monad.Fix
import Control.Monad.Reader
import qualified Control.Monad.Reader as Reader
import Data.Functor
=====================================
testsuite/tests/haddock/perf/Makefile
=====================================
@@ -4,12 +4,12 @@ include $(TOP)/mk/test.mk
# We accept a 5% increase in parser allocations due to -haddock
haddock_parser_perf :
- WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \
- WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \
+ WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \
+ WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \
awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.05) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }"
-# Similarly for the renamer
+# We accept a 40% increase in renamer allocations due to -haddock
haddock_renamer_perf :
- WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \
- WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \
- awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.20) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }"
+ WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \
+ WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \
+ awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.40) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }"
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit e16e20d592a6f5d9ed1af17b77fafd6495242345
+Subproject commit 2cbc683d1ffa5c90b48be80f355de2c1023b315d
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6e80d76b9b127b4e0a19c93419dbbf14286155f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6e80d76b9b127b4e0a19c93419dbbf14286155f
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230524/e9e9d230/attachment-0001.html>
More information about the ghc-commits
mailing list