[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Add flags for switching off speculative evaluation.
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Jan 7 12:59:07 UTC 2025
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
5ad1abca by Luite Stegeman at 2025-01-07T04:35:15+01:00
Add flags for switching off speculative evaluation.
We found that speculative evaluation can increase the amount of
allocations in some circumstances. This patch adds new flags for
selectively disabling speculative evaluation, allowing us to
test the effect of the optimization.
The new flags are:
-fspec-eval
globally enable speculative evaluation
-fspec-eval-dictfun
enable speculative evaluation for dictionary functions (no effect
if speculative evaluation is globally disabled)
The new flags are on by default for all optimisation levels.
See #25284
- - - - -
1d872b38 by Matthew Pickering at 2025-01-07T07:58:47-05:00
warnings: Find out if a qualified name is in the interactive scope directly
There were two ad-hoc mechanisms used to determine which modules were in
the interactive scope.
1. Look at everything in the GRE, to see what is imported qualified.
2. Look at the last loaded module in the HPT.
(1) Is very inefficient, GlobalRdrEnvs can be very big.
(2) is incorrect, there is no reason to assume the "last" thing added to
the HPT has any relevance to module loading order.
Happily, the same checks can be implemented directly by looking at the
interactive imports from the interactive context. This mirrors what
happens for normal imports.
Arguably, the error reporting code shouldn't be doing this kind of
processing and it should be an option is set when rendering the error
message. However, this just improves the situation and doesn't block
progress on that front in future.
See #14225 and #15611
Fixes #25600
- - - - -
4483a1ef by Simon Peyton Jones at 2025-01-07T07:58:48-05:00
Tidy up kcConDecls
Addresses #25630
In particular,
* Introduce ConArgKind and use it.
* Make kcConDecls and tcConDecls work the same way
concerning the kind of argument types
- - - - -
14 changed files:
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Config/CoreToStg/Prep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Tc/TyCl.hs
- docs/users_guide/using-optimisation.rst
- + testsuite/tests/core-to-stg/T25284/A.hs
- + testsuite/tests/core-to-stg/T25284/B.hs
- + testsuite/tests/core-to-stg/T25284/Cls.hs
- + testsuite/tests/core-to-stg/T25284/Main.hs
- + testsuite/tests/core-to-stg/T25284/T25284.stdout
- + testsuite/tests/core-to-stg/T25284/all.T
Changes:
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -2051,6 +2051,16 @@ conceptually.
See also Note [Floats and FloatDecision] for how we maintain whole groups of
floats and how far they go.
+Note [Controlling Speculative Evaluation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Most of the time, speculative evaluation has a positive effect on performance,
+but we have found a case where speculative evaluation of dictionary functions
+leads to a performance regression #25284.
+
+Therefore we have some flags to control it. See the optimization section in
+the User's Guide for the description of these flags and when to use them.
+
Note [Floats and FloatDecision]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We have a special datatype `Floats` for modelling a telescope of `FloatingBind`
@@ -2275,7 +2285,15 @@ mkNonRecFloat env lev bndr rhs
}
is_hnf = exprIsHNF rhs
- ok_for_spec = exprOkForSpecEval (not . is_rec_call) rhs
+ cfg = cpe_config env
+
+ ok_for_spec = exprOkForSpecEval call_ok_for_spec rhs
+ -- See Note [Controlling Speculative Evaluation]
+ call_ok_for_spec x
+ | is_rec_call x = False
+ | not (cp_specEval cfg) = False
+ | not (cp_specEvalDFun cfg) && isDFunId x = False
+ | otherwise = True
is_rec_call = (`elemUnVarSet` cpe_rec_ids env)
-- See Note [Pin evaluatedness on floats]
@@ -2517,6 +2535,11 @@ data CorePrepConfig = CorePrepConfig
-- ^ Configuration for arity analysis ('exprEtaExpandArity').
-- See Note [Eta expansion of arguments in CorePrep]
-- When 'Nothing' (e.g., -O0, -O1), use the cheaper 'exprArity' instead
+ , cp_specEval :: !Bool
+ -- ^ Whether to perform speculative evaluation
+ -- See Note [Controlling Speculative Evaluation]
+ , cp_specEvalDFun :: !Bool
+ -- ^ Whether to perform speculative evaluation on DFuns
}
data CorePrepEnv
=====================================
compiler/GHC/Driver/Config/CoreToStg/Prep.hs
=====================================
@@ -24,6 +24,8 @@ initCorePrepConfig hsc_env = do
, cp_arityOpts = if gopt Opt_DoCleverArgEtaExpansion dflags
then Just (initArityOpts dflags)
else Nothing
+ , cp_specEval = gopt Opt_SpecEval dflags
+ , cp_specEvalDFun = gopt Opt_SpecEvalDictFun dflags
}
initCorePrepPgmConfig :: DynFlags -> [Var] -> CorePrepPgmConfig
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -1287,6 +1287,8 @@ optLevelFlags -- see Note [Documenting optimisation flags]
-- RegsGraph suffers performance regression. See #7679
-- , ([2], Opt_StaticArgumentTransformation)
-- Static Argument Transformation needs investigation. See #9374
+ , ([0,1,2], Opt_SpecEval)
+ , ([0,1,2], Opt_SpecEvalDictFun)
]
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -674,6 +674,9 @@ data GeneralFlag
| Opt_NumConstantFolding
| Opt_CoreConstantFolding
| Opt_FastPAPCalls -- #6084
+ | Opt_SpecEval
+ | Opt_SpecEvalDictFun -- See Note [Controlling Speculative Evaluation]
+
-- Inference flags
| Opt_DoTagInferenceChecks
@@ -912,6 +915,8 @@ optimisationFlags = EnumSet.fromList
, Opt_WorkerWrapper
, Opt_WorkerWrapperUnlift
, Opt_SolveConstantDicts
+ , Opt_SpecEval
+ , Opt_SpecEvalDictFun
]
-- | The set of flags which affect code generation and can change a program's
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2544,6 +2544,8 @@ fFlagsDeps = [
flagSpec "num-constant-folding" Opt_NumConstantFolding,
flagSpec "core-constant-folding" Opt_CoreConstantFolding,
flagSpec "fast-pap-calls" Opt_FastPAPCalls,
+ flagSpec "spec-eval" Opt_SpecEval,
+ flagSpec "spec-eval-dictfun" Opt_SpecEvalDictFun,
flagSpec "cmm-control-flow" Opt_CmmControlFlow,
flagSpec "show-warning-groups" Opt_ShowWarnGroups,
flagSpec "hide-source-paths" Opt_HideSourcePaths,
=====================================
compiler/GHC/Rename/Unbound.hs
=====================================
@@ -34,10 +34,11 @@ import GHC.Prelude
import GHC.Driver.DynFlags
import GHC.Driver.Ppr
+import GHC.Driver.Env.Types
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Monad
-import GHC.Builtin.Names ( mkUnboundName, isUnboundName, getUnique)
+import GHC.Builtin.Names ( mkUnboundName, isUnboundName )
import GHC.Utils.Misc
import GHC.Utils.Panic (panic)
@@ -53,16 +54,16 @@ import GHC.Types.Hint
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Name
import GHC.Types.Name.Reader
-import GHC.Types.Unique.DFM (udfmToList)
import GHC.Unit.Module
import GHC.Unit.Module.Imported
-import GHC.Unit.Home.ModInfo
+import GHC.Utils.Outputable
+import GHC.Runtime.Context
import GHC.Data.Bag
-import GHC.Utils.Outputable (empty)
+import Language.Haskell.Syntax.ImpExp
-import Data.List (sortBy, partition, nub)
+import Data.List (sortBy, partition)
import Data.List.NonEmpty ( pattern (:|), NonEmpty )
import Data.Function ( on )
import qualified Data.Semigroup as S
@@ -146,10 +147,10 @@ unboundNameOrTermInType if_term_in_type looking_for rdr_name hints
; global_env <- getGlobalRdrEnv
; impInfo <- getImports
; currmod <- getModule
- ; hpt <- getHpt
+ ; ic <- hsc_IC <$> getTopEnv
; let (imp_errs, suggs) =
unknownNameSuggestions_ looking_for
- dflags hpt currmod global_env local_env impInfo
+ dflags ic currmod global_env local_env impInfo
rdr_name
; addErr $
make_error imp_errs (hints ++ suggs) }
@@ -179,17 +180,17 @@ notInScopeErr where_look rdr_name
unknownNameSuggestions :: LocalRdrEnv -> WhatLooking -> RdrName -> RnM ([ImportError], [GhcHint])
unknownNameSuggestions lcl_env what_look tried_rdr_name =
do { dflags <- getDynFlags
- ; hpt <- getHpt
; rdr_env <- getGlobalRdrEnv
; imp_info <- getImports
; curr_mod <- getModule
+ ; interactive_context <- hsc_IC <$> getTopEnv
; return $
unknownNameSuggestions_
(LF what_look WL_Anywhere)
- dflags hpt curr_mod rdr_env lcl_env imp_info tried_rdr_name }
+ dflags interactive_context curr_mod rdr_env lcl_env imp_info tried_rdr_name }
-unknownNameSuggestions_ :: LookingFor -> DynFlags
- -> HomePackageTable -> Module
+unknownNameSuggestions_ :: LookingFor -> DynFlags -> InteractiveContext
+ -> Module
-> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails
-> RdrName -> ([ImportError], [GhcHint])
unknownNameSuggestions_ looking_for dflags hpt curr_mod global_env local_env
@@ -201,7 +202,7 @@ unknownNameSuggestions_ looking_for dflags hpt curr_mod global_env local_env
, map (ImportSuggestion $ rdrNameOcc tried_rdr_name) imp_suggs
, extensionSuggestions tried_rdr_name
, fieldSelectorSuggestions global_env tried_rdr_name ]
- (imp_errs, imp_suggs) = importSuggestions looking_for global_env hpt curr_mod imports tried_rdr_name
+ (imp_errs, imp_suggs) = importSuggestions looking_for hpt curr_mod imports tried_rdr_name
if_ne :: (NonEmpty a -> b) -> [a] -> [b]
if_ne _ [] = []
@@ -308,15 +309,13 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
-- | Generate errors and helpful suggestions if a qualified name Mod.foo is not in scope.
importSuggestions :: LookingFor
- -> GlobalRdrEnv
- -> HomePackageTable -> Module
+ -> InteractiveContext -> Module
-> ImportAvails -> RdrName -> ([ImportError], [ImportSuggestion])
-importSuggestions looking_for global_env hpt currMod imports rdr_name
+importSuggestions looking_for ic currMod imports rdr_name
| WL_LocalOnly <- lf_where looking_for = ([], [])
| WL_LocalTop <- lf_where looking_for = ([], [])
| not (isQual rdr_name || isUnqual rdr_name) = ([], [])
- | null interesting_imports
- , Just name <- mod_name
+ | Just name <- mod_name
, show_not_imported_line name
= ([MissingModule name], [])
| is_qualified
@@ -344,6 +343,17 @@ importSuggestions looking_for global_env hpt currMod imports rdr_name
, Just imp <- return $ pick (importedByUser mod_imports)
]
+ -- Choose the imports from the interactive context which might have provided
+ -- a module.
+ interactive_imports =
+ filter pick_interactive (ic_imports ic)
+
+ pick_interactive :: InteractiveImport -> Bool
+ pick_interactive (IIDecl d) | mod_name == Just (unLoc (ideclName d)) = True
+ | mod_name == fmap unLoc (ideclAs d) = True
+ pick_interactive (IIModule m) | mod_name == Just m = True
+ pick_interactive _ = False
+
-- We want to keep only one for each original module; preferably one with an
-- explicit import list (for no particularly good reason)
pick :: [ImportedModsVal] -> Maybe ImportedModsVal
@@ -369,17 +379,10 @@ importSuggestions looking_for global_env hpt currMod imports rdr_name
-- See Note [When to show/hide the module-not-imported line]
show_not_imported_line :: ModuleName -> Bool -- #15611
show_not_imported_line modnam
- | modnam `elem` glob_mods = False -- #14225 -- 1
- | moduleName currMod == modnam = False -- 2.1
- | is_last_loaded_mod modnam hpt_uniques = False -- 2.2
+ | not (null interactive_imports) = False -- 1 (interactive context)
+ | not (null interesting_imports) = False -- 1 (normal module import)
+ | moduleName currMod == modnam = False -- 2
| otherwise = True
- where
- hpt_uniques = map fst (udfmToList hpt)
- is_last_loaded_mod modnam uniqs = lastMaybe uniqs == Just (getUnique modnam)
- glob_mods = nub [ mod
- | gre <- globalRdrEnvElts global_env
- , (mod, _) <- qualsInScope gre
- ]
extensionSuggestions :: RdrName -> [GhcHint]
extensionSuggestions rdrName
@@ -478,13 +481,8 @@ For the error message:
Module X does not export Y
No module named ‘X’ is imported:
there are 2 cases, where we hide the last "no module is imported" line:
-1. If the module X has been imported.
-2. If the module X is the current module. There are 2 subcases:
- 2.1 If the unknown module name is in a input source file,
- then we can use the getModule function to get the current module name.
- (See test T15611a)
- 2.2 If the unknown module name has been entered by the user in GHCi,
- then the getModule function returns something like "interactive:Ghci1",
- and we have to check the current module in the last added entry of
- the HomePackageTable. (See test T15611b)
+1. If the module X has been imported (normally or via interactive context).
+2. It is the current module we are trying to compile
+ then we can use the getModule function to get the current module name.
+ (See test T15611a)
-}
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -1759,7 +1759,9 @@ kcTyClDecl :: TyClDecl GhcRn -> MonoTcTyCon -> TcM ()
-- - In this function, those TcTyVars are unified with other kind variables during
-- kind inference (see GHC.Tc.TyCl Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon])
-kcTyClDecl (DataDecl { tcdLName = (L _ _name), tcdDataDefn = HsDataDefn { dd_ctxt = ctxt, dd_cons = cons } }) tycon
+kcTyClDecl (DataDecl { tcdLName = (L _ _name)
+ , tcdDataDefn = HsDataDefn { dd_ctxt = ctxt, dd_cons = cons } })
+ tycon
= tcExtendNameTyVarEnv (tcTyConScopedTyVars tycon) $
-- NB: binding these tyvars isn't necessary for GADTs, but it does no
-- harm. For GADTs, each data con brings its own tyvars into scope,
@@ -1767,7 +1769,7 @@ kcTyClDecl (DataDecl { tcdLName = (L _ _name), tcdDataDefn = HsDataDefn { dd_
-- (conceivably) shadowed.
do { traceTc "kcTyClDecl" (ppr tycon $$ ppr (tyConTyVars tycon) $$ ppr (tyConResKind tycon))
; _ <- tcHsContext ctxt
- ; kcConDecls (dataDefnConsNewOrData cons) (tyConResKind tycon) cons
+ ; kcConDecls (tyConResKind tycon) cons
}
kcTyClDecl (SynDecl { tcdLName = L _ _name, tcdRhs = rhs }) tycon
@@ -1799,67 +1801,70 @@ kcTyClDecl (FamDecl _ (FamilyDecl { fdInfo = fd_info })) fam_tc
-- This includes doing kind unification if the type is a newtype.
-- See Note [Implementation of UnliftedNewtypes] for why we need
-- the first two arguments.
-kcConArgTys :: NewOrData -> TcKind -> [HsScaled GhcRn (LHsType GhcRn)] -> TcM ()
-kcConArgTys new_or_data res_kind arg_tys = do
- { let exp_kind = getArgExpKind new_or_data res_kind
- ; forM_ arg_tys (\(HsScaled mult ty) -> do _ <- tcCheckLHsTypeInContext (getBangType ty) exp_kind
- tcMult mult)
+kcConArgTys :: ConArgKind -- Expected kind of the argument(s)
+ -> [HsScaled GhcRn (LHsType GhcRn)] -- User-written argument types
+ -> TcM ()
+kcConArgTys exp_kind arg_tys
+ = forM_ arg_tys $ \(HsScaled mult ty) ->
+ do { _ <- tcCheckLHsTypeInContext (getBangType ty) exp_kind
+ ; tcMult mult }
-- See Note [Implementation of UnliftedNewtypes], STEP 2
- }
-- Kind-check the types of arguments to a Haskell98 data constructor.
-kcConH98Args :: NewOrData -> TcKind -> HsConDeclH98Details GhcRn -> TcM ()
-kcConH98Args new_or_data res_kind con_args = case con_args of
- PrefixCon _ tys -> kcConArgTys new_or_data res_kind tys
- InfixCon ty1 ty2 -> kcConArgTys new_or_data res_kind [ty1, ty2]
- RecCon (L _ flds) -> kcConArgTys new_or_data res_kind $
+kcConH98Args :: ConArgKind -- Expected kind of the argument(s)
+ -> HsConDeclH98Details GhcRn
+ -> TcM ()
+kcConH98Args exp_kind con_args = case con_args of
+ PrefixCon _ tys -> kcConArgTys exp_kind tys
+ InfixCon ty1 ty2 -> kcConArgTys exp_kind [ty1, ty2]
+ RecCon (L _ flds) -> kcConArgTys exp_kind $
map (hsLinear . cd_fld_type . unLoc) flds
-- Kind-check the types of arguments to a GADT data constructor.
-kcConGADTArgs :: NewOrData -> TcKind -> HsConDeclGADTDetails GhcRn -> TcM ()
-kcConGADTArgs new_or_data res_kind con_args = case con_args of
- PrefixConGADT _ tys -> kcConArgTys new_or_data res_kind tys
- RecConGADT _ (L _ flds) -> kcConArgTys new_or_data res_kind $
+kcConGADTArgs :: ConArgKind -- Expected kind of the argument(s)
+ -> HsConDeclGADTDetails GhcRn
+ -> TcM ()
+kcConGADTArgs exp_kind con_args = case con_args of
+ PrefixConGADT _ tys -> kcConArgTys exp_kind tys
+ RecConGADT _ (L _ flds) -> kcConArgTys exp_kind $
map (hsLinear . cd_fld_type . unLoc) flds
-kcConDecls :: Foldable f
- => NewOrData
- -> TcKind -- The result kind signature
- -- Used only in H98 case
- -> f (LConDecl GhcRn) -- The data constructors
- -> TcM ()
+kcConDecls :: TcKind -- Result kind of tycon
+ -- Used only in H98 case
+ -> DataDefnCons (LConDecl GhcRn) -> TcM ()
-- See Note [kcConDecls: kind-checking data type decls]
-kcConDecls new_or_data tc_res_kind = traverse_ (wrapLocMA_ (kcConDecl new_or_data tc_res_kind))
+kcConDecls tc_res_kind cons
+ = traverse_ (wrapLocMA_ (kcConDecl new_or_data tc_res_kind)) cons
+ where
+ new_or_data = dataDefnConsNewOrData cons
-- Kind check a data constructor. In additional to the data constructor,
-- we also need to know about whether or not its corresponding type was
-- declared with data or newtype, and we need to know the result kind of
-- this type. See Note [Implementation of UnliftedNewtypes] for why
-- we need the first two arguments.
-kcConDecl :: NewOrData
- -> TcKind -- Result kind of the type constructor
- -- Usually Type but can be TYPE UnliftedRep
- -- or even TYPE r, in the case of unlifted newtype
- -- Used only in H98 case
- -> ConDecl GhcRn
- -> TcM ()
-kcConDecl new_or_data tc_res_kind (ConDeclH98
- { con_name = name, con_ex_tvs = ex_tvs
- , con_mb_cxt = ex_ctxt, con_args = args })
+kcConDecl :: NewOrData -> TcKind -> ConDecl GhcRn -> TcM ()
+kcConDecl new_or_data tc_res_kind
+ (ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
+ , con_mb_cxt = ex_ctxt, con_args = args })
= addErrCtxt (dataConCtxt (NE.singleton name)) $
discardResult $
bindExplicitTKBndrs_Tv ex_tvs $
do { _ <- tcHsContext ex_ctxt
- ; kcConH98Args new_or_data tc_res_kind args
+ ; let arg_exp_kind = getArgExpKind new_or_data tc_res_kind
+ -- getArgExpKind: for newtypes, check that the argument kind
+ -- is the same as the tc_res_kind. See (KCD1)
+ -- in Note [kcConDecls: kind-checking data type decls]
+ ; kcConH98Args arg_exp_kind args
-- We don't need to check the telescope here,
-- because that's done in tcConDecl
}
-kcConDecl new_or_data
- _tc_res_kind -- Not used in GADT case (and doesn't make sense)
- (ConDeclGADT
- { con_names = names, con_bndrs = L _ outer_bndrs, con_mb_cxt = cxt
- , con_g_args = args, con_res_ty = res_ty })
+kcConDecl new_or_data _tc_res_kind
+ -- NB: _tc_res_kind is unused. See (KCD3) in
+ -- Note [kcConDecls: kind-checking data type decls]
+ (ConDeclGADT { con_names = names, con_bndrs = L _ outer_bndrs
+ , con_mb_cxt = cxt, con_g_args = args, con_res_ty = res_ty })
= -- See Note [kcConDecls: kind-checking data type decls]
addErrCtxt (dataConCtxt names) $
discardResult $
@@ -1870,45 +1875,80 @@ kcConDecl new_or_data
; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty)
; con_res_kind <- newOpenTypeKind
; _ <- tcCheckLHsTypeInContext res_ty (TheKind con_res_kind)
- ; kcConGADTArgs new_or_data con_res_kind args
- ; traceTc "kcConDecl:GADT }" (ppr names $$ ppr con_res_kind)
+
+ ; let arg_exp_kind = getArgExpKind new_or_data con_res_kind
+ -- getArgExpKind: for newtypes, check that the argument kind
+ -- is the same the kind of `res_ty`, the data con's return type
+ -- See (KCD2) in Note [kcConDecls: kind-checking data type decls]
+ ; kcConGADTArgs arg_exp_kind args
+
+ ; traceTc "kcConDecl:GADT }" (ppr names $$ ppr arg_exp_kind)
; return () }
{- Note [kcConDecls: kind-checking data type decls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
kcConDecls is used when we are inferring the kind of the type
-constructor in a data type declaration. E.g.
- data T f a = MkT (f a)
-we want to infer the kind of 'f' and 'a'. The basic plan is described
-in Note [Inferring kinds for type declarations]; here we are doing Step 2.
-
-In the GADT case we may have this:
- data T f a where
- MkT :: forall g b. g b -> T g b
-
-Notice that the variables f,a, and g,b are quite distinct.
-Nevertheless, the type signature for MkT must still influence the kind
-T which is (remember Step 1) something like
- T :: kappa1 -> kappa2 -> Type
-Otherwise we'd infer the bogus kind
- T :: forall k1 k2. k1 -> k2 -> Type.
-
-The type signature for MkT influences the kind of T simply by
-kind-checking the result type (T g b), which will force 'f' and 'g' to
-have the same kinds. This is the call to
- tcCheckLHsTypeInContext res_ty (TheKind con_res_kind)
-Because this is the result type of an arrow, we know the kind must be
-of form (TYPE rr), and we get better error messages if we enforce that
-here (e.g. test gadt10).
-
-For unlifted newtypes only, we must ensure that the argument kind
-and result kind are the same:
-* In the H98 case, we need the result kind of the TyCon, to unify with
- the argument kind.
-
-* In GADT syntax, this unification happens via the result kind passed
- to kcConGADTArgs. The tycon's result kind is not used at all in the
- GADT case.
+constructor in a data type declaration. The basic plan is described in
+Note [Inferring kinds for type declarations]; here we are doing Step 2.
+
+We are kind-checking the data constructors /only/ to compute the kind of
+the type construtor. For example
+ data T f a = MkT (f a)
+The (f a) in the data construtor constrains the kinds of `f` and `a`, and hence
+of `T`.
+
+There are two cases to consider in `kcConDecl`
+
+* Haskell 98 data constructors, as above. We simply bring `f` and `a`
+ into scope and kind-check the data constructors.
+
+* GADT data type decls e.g.
+ data S f a where
+ MkS :: g b -> S g b
+ Here `f` and `a` don't scope over the data constructor signatures.
+ Instead, we just kind-check the entire signature (including the result `S g b`),
+ relying on the fact that `S` is in scope with its initial kind `k1 -> k2 -> Type`;
+ doing so will constrain `k1` and `k2` appropriately.
+
+The arguments of each data constructor are always of kind (TYPE r) for some
+r :: RuntimeRep. But in the case of a newytype, the argument kind must be
+the same as the tycon result kind. Since we are trying to figure out the
+tycon kind, kcConDecls must account for this, which is surprisingly tricky.
+Again there are two cases to consider in `kcConDecl`:
+
+* Haskell 98 data type decls, e.g.
+ data T f a = MkT (f a)
+ * In the header, all the tycon binders are specified (here `f` and `a`)
+ and there is no result kind signature.
+ * The binders from the header scope over the data construtors.
+ * In the case of unlifted newtypes, the argument kind affects the tycon kind
+ newtype N = MkN Int#
+ Here `getInitialKind` will give `N` the result kind `TYPE r`, where `r` is
+ a unification variable, and `kcConDecls` should unify that `r` with
+ `IntRep` becuase of the `Int#`
+
+ Solution (KCD1): just check that the argumet type has the same kind as the result
+ kind of the tycon.
+
+* GADT data type decls e.g.
+ data S f :: Type -> Type where
+ MkS :: g a -> S g a
+ * In the header, not all the tycon binders are specified (here just `f`),
+ and there can be a kind signature
+ * The kind signature may describe some, all, or none of the tycon binders.
+ Regardless, in the TcTyCon constructed by `getInitialKind`, the tyConResKind
+ is the signature, not the "ultimate" result type of the tycon (which is
+ usually Type)
+ * In the case of unlifted newtypes, we again want the argument kind to be the
+ same as the result kind of the tycon; but it's not so clear what /is/ the
+ result kind of the tycon, because of the signature stuff in the previous bullet.
+
+ Solution (KCD2): kind-check the result type of the data constructor (here
+ `S g a`) and, for newtypes, ensure that the arugment has that same kind.
+
+ (KCD3) The tycon's result kind `tc_res_kind` is not used at all in the GADT
+ case; rather it is accessed via looking up S's kind in the type environment
+ when kind-checking the result type of the data constructor.
Note [Using TyVarTvs for kind-checking GADTs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -3866,13 +3906,21 @@ nothing wrong with it). We are implicitly requiring tha
tcInferLHsTypeKind doesn't any gratuitous top-level casts.
-}
+
+type ConArgKind = ContextKind
+ -- The expected kind of the argument(s) of a constructor
+ -- For data types this is always OpenKind
+ -- For newtypes it is (TheKind ki)
+ -- where `ki` is the result kind of the newtype
+ -- With NoUnliftedNewtype, ki=Type, but with UnliftedNewtypes it can be a variable
+
-- | Produce an "expected kind" for the arguments of a data/newtype.
-- If the declaration is indeed for a newtype,
-- then this expected kind will be the kind provided. Otherwise,
-- it is OpenKind for datatypes and liftedTypeKind.
-- Why do we not check for -XUnliftedNewtypes? See point <Error Messages>
-- in Note [Implementation of UnliftedNewtypes]
-getArgExpKind :: NewOrData -> TcKind -> ContextKind
+getArgExpKind :: NewOrData -> TcKind -> ConArgKind
getArgExpKind NewType res_ki = TheKind res_ki
getArgExpKind DataType _ = OpenKind
@@ -3898,7 +3946,7 @@ tcConIsInfixGADT con details
; return (con `elemNameEnv` fix_env) }
| otherwise -> return False
-tcConH98Args :: ContextKind -- expected kind of arguments
+tcConH98Args :: ConArgKind -- expected kind of arguments
-- always OpenKind for datatypes, but unlifted newtypes
-- might have a specific kind
-> HsConDeclH98Details GhcRn
@@ -3912,7 +3960,7 @@ tcConH98Args exp_kind (InfixCon bty1 bty2)
tcConH98Args exp_kind (RecCon fields)
= tcRecConDeclFields exp_kind fields
-tcConGADTArgs :: ContextKind -- expected kind of arguments
+tcConGADTArgs :: ConArgKind -- expected kind of arguments
-- always OpenKind for datatypes, but unlifted newtypes
-- might have a specific kind
-> HsConDeclGADTDetails GhcRn
@@ -3922,7 +3970,7 @@ tcConGADTArgs exp_kind (PrefixConGADT _ btys)
tcConGADTArgs exp_kind (RecConGADT _ fields)
= tcRecConDeclFields exp_kind fields
-tcConArg :: ContextKind -- expected kind for args; always OpenKind for datatypes,
+tcConArg :: ConArgKind -- expected kind for args; always OpenKind for datatypes,
-- but might be an unlifted type with UnliftedNewtypes
-> HsScaled GhcRn (LHsType GhcRn) -> TcM (Scaled TcType, HsSrcBang)
tcConArg exp_kind (HsScaled w bty)
@@ -3932,7 +3980,7 @@ tcConArg exp_kind (HsScaled w bty)
; traceTc "tcConArg 2" (ppr bty)
; return (Scaled w' arg_ty, getBangStrictness bty) }
-tcRecConDeclFields :: ContextKind
+tcRecConDeclFields :: ConArgKind
-> LocatedL [LConDeclField GhcRn]
-> TcM [(Scaled TcType, HsSrcBang)]
tcRecConDeclFields exp_kind fields
=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -405,6 +405,55 @@ as such you shouldn't need to set any of them explicitly. A flag
intermediate language, where it is able to common up some subexpressions
that differ in their types, but not their representation.
+.. ghc-flag:: -fspec-eval
+ :shortdesc: Enables speculative evaluation.
+ :type: dynamic
+ :category:
+ :reverse: -fno-spec-eval
+
+ :default: on
+ :since: 9.14.1
+
+ Enables speculative evaluation which usually results in fewer allocations.
+ Enabling speculative evaluation should not cause performance regressions.
+ If you encounter any, please open a ticket.
+
+ Note that disabling this flag will switch off speculative evaluation
+ completely, causing :ghc-flag:`-fspec-eval-dictfun` to have
+ no effect.
+
+.. ghc-flag:: -fspec-eval-dictfun
+ :shortdesc: Enables speculative evaluation of dictionary functions.
+ :type: dynamic
+ :category:
+ :reverse: -fno-spec-eval-dictfun
+
+ :default: on
+ :since: 9.14.1
+
+ Enables speculative (strict) evaluation of dictionary functions.
+
+ This is best explained with an example ::
+
+ instance C a => D a where ...
+
+ g :: D a => a -> Int
+ g x = ...
+
+ f :: C a => a -> Int
+ f x = g x
+
+ Function `f` has to pass a `D a` dictionary to `g`, and uses a dictionary
+ function `C a => D a` to compute it. If speculative evaluation for
+ dictionary functions is enabled, this dictionary is computed
+ strictly.
+
+ Speculative evalation of dictionary functions can lead to slightly better
+ performance, because a thunk is avoided. However, it results in unnecessary
+ computation and allocation if the dictionary goes unused. This causes
+ a significant increase in allocation if the dictionary is large.
+ See (:ghc-ticket:`25284`).
+
.. ghc-flag:: -fdicts-cheap
:shortdesc: Make dictionary-valued expressions seem cheap to the optimiser.
:type: dynamic
=====================================
testsuite/tests/core-to-stg/T25284/A.hs
=====================================
@@ -0,0 +1,8 @@
+{-# OPTIONS_GHC -fspec-eval-dictfun #-}
+module A (testX) where
+
+import qualified Cls
+
+-- this creates the big dictionary strictly because of speculative evaluation
+testX :: (Show a, Cls.HasConst a) => a -> Int -> IO ()
+testX a b = Cls.printConst a b
=====================================
testsuite/tests/core-to-stg/T25284/B.hs
=====================================
@@ -0,0 +1,8 @@
+{-# OPTIONS_GHC -fno-spec-eval-dictfun #-}
+module B (testX) where
+
+import qualified Cls
+
+-- this creates the big dictionary lazily
+testX :: (Show a, Cls.HasConst a) => a -> Int -> IO ()
+testX a b = Cls.printConst a b
=====================================
testsuite/tests/core-to-stg/T25284/Cls.hs
=====================================
@@ -0,0 +1,40 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Cls where
+
+class HasConst a where constVal :: a
+
+instance Cls.HasConst Word where constVal = 123
+
+instance Cls.HasConst Int where constVal = 456
+
+-- this class has a big dictionary
+class HasConst10 a where
+ constA :: a
+ constInt1 :: a -> Int
+ constInt1 _ = 1
+ constInt2 :: a -> Int
+ constInt2 _ = 2
+ constInt3 :: a -> Int
+ constInt3 _ = 3
+ constInt4 :: a -> Int
+ constInt4 _ = 4
+ constInt5 :: a -> Int
+ constInt5 _ = 5
+ constInt6 :: a -> Int
+ constInt6 _ = 6
+ constInt7 :: a -> Int
+ constInt7 _ = 7
+ constInt8 :: a -> Int
+ constInt8 _ = 8
+ constInt9 :: a -> Int
+ constInt9 _ = 9
+
+instance HasConst a => HasConst10 a where
+ constA = constVal
+
+-- this doesn't use the big dictionary most of the time
+printConst :: forall a. (Show a, HasConst10 a)
+ => a -> Int -> IO ()
+printConst x 5000 = print @a constA >> print (constInt8 x)
+printConst _ _ = pure ()
=====================================
testsuite/tests/core-to-stg/T25284/Main.hs
=====================================
@@ -0,0 +1,57 @@
+{-
+
+ This tests that speculative evaluation for dictionary functions works as
+ expected, with a large dictionary that goes unused.
+
+ - Module A: dictfun speculative evaluation enabled
+ - Module B: dictfun speculative evaluation disabled
+
+ Speculative evaluation causes the unused large dictionary to be allocated
+ strictly in module A, so we expect more allocations than in module B.
+
+ -}
+module Main where
+
+import qualified A
+import qualified B
+import qualified Cls
+
+import Data.Word
+import System.Mem (performGC)
+import GHC.Stats
+import Control.Monad
+
+{-# NOINLINE getAllocated #-}
+getAllocated :: IO Word64
+getAllocated = do
+ performGC
+ allocated_bytes <$> getRTSStats
+
+main :: IO ()
+main = do
+ -- warm up (just in case)
+ _ <- testMain A.testX
+ _ <- testMain B.testX
+
+ -- for real
+ a_alloc <- testMain A.testX
+ b_alloc <- testMain B.testX
+
+ -- expect B to allocate less than A
+ let alloc_ratio :: Double
+ alloc_ratio = fromIntegral b_alloc / fromIntegral a_alloc
+ putStrLn ("expected alloc: " ++ show (alloc_ratio < 0.7))
+
+iter :: (Int -> IO ()) -> Int -> Int -> IO ()
+iter m !i !j
+ | i < j = m i >> iter m (i+1) j
+ | otherwise = pure ()
+
+{-# NOINLINE testMain #-}
+testMain :: (forall b. (Show b, Cls.HasConst b) => b -> Int -> IO ())
+ -> IO Word64
+testMain f = do
+ alloc0 <- getAllocated
+ iter (\i -> f (0::Int) i >> f (0::Word) i) 1 100000
+ alloc1 <- getAllocated
+ pure (alloc1 - alloc0)
=====================================
testsuite/tests/core-to-stg/T25284/T25284.stdout
=====================================
@@ -0,0 +1,17 @@
+456
+8
+123
+8
+456
+8
+123
+8
+456
+8
+123
+8
+456
+8
+123
+8
+expected alloc: True
=====================================
testsuite/tests/core-to-stg/T25284/all.T
=====================================
@@ -0,0 +1,5 @@
+test('T25284',
+ [extra_files(['Main.hs', 'A.hs', 'B.hs', 'Cls.hs']),
+ extra_run_opts('+RTS -T -RTS')],
+ multimod_compile_and_run,
+ ['Main', ''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78c441f0ddce190ddcbba94aa03104ea9859c8fa...4483a1efb3e98f9cd0bd5a73b2c2c456ebcb684b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78c441f0ddce190ddcbba94aa03104ea9859c8fa...4483a1efb3e98f9cd0bd5a73b2c2c456ebcb684b
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/20250107/699b0f9f/attachment-0001.html>
More information about the ghc-commits
mailing list