[Git][ghc/ghc][wip/haddock-mem-fixes] Memory usage fixes for Haddock

[Finley McIlwaine (@FinleyMcIlwaine)]

Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC


Commits:
027eb2dd by Finley McIlwaine at 2023-05-19T06:44:04-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
- Update haddock perf tests to be more accurate and force evaluation of renamed
  doc thunks
- Update Haddock submodule

- - - - -


5 changed files:

- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/Doc.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/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]


=====================================
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
 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-  ) ;  \
+	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.20) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }"


=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit e16e20d592a6f5d9ed1af17b77fafd6495242345
+Subproject commit 04e9d6048bb297de5831651e60d496217525ef62



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/027eb2dd62d203450e03aa9b8323678ac2965810

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/027eb2dd62d203450e03aa9b8323678ac2965810
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/20230519/3b409785/attachment-0001.html>