[Git][ghc/ghc][wip/haddock-mem-fixes] 3 commits: Use setSrcSpan rather than setLclEnv in solveForAll
Finley McIlwaine (@FinleyMcIlwaine)
gitlab at gitlab.haskell.org
Thu May 18 15:40:55 UTC 2023
Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC
Commits:
5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00
Use setSrcSpan rather than setLclEnv in solveForAll
In subsequent MRs (#23409) we want to remove the TcLclEnv argument from
a CtLoc. This MR prepares us for that by removing the one place where
the entire TcLclEnv is used, by using it more precisely to just set the
contexts source location.
Fixes #23390
- - - - -
385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00
Update the users guide paragraph on -O in GHCi
In relation to #23056
- - - - -
72e21440 by Finley McIlwaine at 2023-05-18T09:40:45-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
- Update Haddock submodule
- - - - -
6 changed files:
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Tc/Solver/Canonical.hs
- compiler/GHC/Tc/Solver/Monad.hs
- docs/users_guide/ghci.rst
- 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/Tc/Solver/Canonical.hs
=====================================
@@ -53,6 +53,7 @@ import GHC.Data.Bag
import Data.Maybe ( isJust )
import qualified Data.Semigroup as S
+import GHC.Tc.Utils.Monad (getLclEnvLoc)
{-
************************************************************************
@@ -876,8 +877,8 @@ solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel
solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc })
tvs theta pred _fuel
= -- See Note [Solving a Wanted forall-constraint]
- setLclEnv (ctLocEnv loc) $
- -- This setLclEnv is important: the emitImplicationTcS uses that
+ setSrcSpan (getLclEnvLoc $ ctLocEnv loc) $
+ -- This setSrcSpan is important: the emitImplicationTcS uses that
-- TcLclEnv for the implication, and that in turn sets the location
-- for the Givens when solving the constraint (#21006)
do { let empty_subst = mkEmptySubst $ mkInScopeSet $
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -57,7 +57,7 @@ module GHC.Tc.Solver.Monad (
getSolvedDicts, setSolvedDicts,
getInstEnvs, getFamInstEnvs, -- Getting the environments
- getTopEnv, getGblEnv, getLclEnv, setLclEnv,
+ getTopEnv, getGblEnv, getLclEnv, setSrcSpan,
getTcEvBindsVar, getTcLevel,
getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap,
tcLookupClass, tcLookupId, tcLookupTyCon,
@@ -194,6 +194,7 @@ import Data.IORef
import Data.List ( mapAccumL )
import Data.Foldable
import qualified Data.Semigroup as S
+import GHC.Types.SrcLoc
#if defined(DEBUG)
import GHC.Types.Unique.Set (nonDetEltsUniqSet)
@@ -1398,8 +1399,8 @@ getGblEnv = wrapTcS $ TcM.getGblEnv
getLclEnv :: TcS TcLclEnv
getLclEnv = wrapTcS $ TcM.getLclEnv
-setLclEnv :: TcLclEnv -> TcS a -> TcS a
-setLclEnv env = wrap2TcS (TcM.setLclEnv env)
+setSrcSpan :: RealSrcSpan -> TcS a -> TcS a
+setSrcSpan ss = wrap2TcS (TcM.setSrcSpan (RealSrcSpan ss mempty))
tcLookupClass :: Name -> TcS Class
tcLookupClass c = wrapTcS $ TcM.tcLookupClass c
=====================================
docs/users_guide/ghci.rst
=====================================
@@ -3546,41 +3546,19 @@ The interpreter can't load modules with foreign export declarations!
Unfortunately not. We haven't implemented it yet. Please compile any
offending modules by hand before loading them into GHCi.
-:ghc-flag:`-O` doesn't work with GHCi!
+:ghc-flag:`-O` is ineffective in GHCi!
.. index::
single: optimization; and GHCi
- For technical reasons, the bytecode compiler doesn't interact well
- with one of the optimisation passes, so we have disabled
- optimisation when using the interpreter. This isn't a great loss:
- you'll get a much bigger win by compiling the bits of your code that
- need to go fast, rather than interpreting them with optimisation
- turned on.
+ Before GHC 9.8, optimizations were considered too unstable to be used with
+ the bytecode interpreter.
+ This restriction has been lifted, but is still regarded as experimental and
+ guarded by :ghc-flag:`-funoptimized-core-for-interpreter`, which is enabled
+ by default.
+ In order to use optimizations, run: ::
-Modules using unboxed tuples or sums will automatically enable :ghc-flag:`-fobject-code`
-
- .. index::
- single: unboxed tuples, sums; and GHCi
-
- The bytecode interpreter doesn't support most uses of unboxed tuples or
- sums, so GHCi will automatically compile these modules, and all modules
- they depend on, to object code instead of bytecode.
-
- GHCi checks for the presence of unboxed tuples and sums in a somewhat
- conservative fashion: it simply checks to see if a module enables the
- :extension:`UnboxedTuples` or :extension:`UnboxedSums` language extensions.
- It is not always the case that code which enables :extension:`UnboxedTuples`
- or :extension:`UnboxedSums` requires :ghc-flag:`-fobject-code`, so if you
- *really* want to compile
- :extension:`UnboxedTuples`/:extension:`UnboxedSums`-using code to
- bytecode, you can do so explicitly by enabling the :ghc-flag:`-fbyte-code`
- flag. If you do this, do note that bytecode interpreter will throw an error
- if it encounters unboxed tuple/sum–related code that it cannot handle.
-
- Incidentally, the previous point, that :ghc-flag:`-O` is
- incompatible with GHCi, is because the bytecode compiler can't
- deal with unboxed tuples or sums.
+ ghci -fno-unoptimized-core-for-interpreter -O
Concurrent threads don't carry on running when GHCi is waiting for input.
This should work, as long as your GHCi was built with the
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit e16e20d592a6f5d9ed1af17b77fafd6495242345
+Subproject commit 04e9d6048bb297de5831651e60d496217525ef62
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eabfb75f4499a8468a9f2dec3d17546272a834f6...72e21440778d5316380e4f40950935865bf4921c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eabfb75f4499a8468a9f2dec3d17546272a834f6...72e21440778d5316380e4f40950935865bf4921c
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/20230518/de8be9cc/attachment-0001.html>
More information about the ghc-commits
mailing list