[Git][ghc/ghc][wip/soulomoon/suggest-UnliftedNewtypes-unlifted-data-family-25593] 37 commits: Add flags for switching off speculative evaluation.
Patrick (@soulomoon)
gitlab at gitlab.haskell.org
Fri Jan 10 15:16:10 UTC 2025
Patrick pushed to branch wip/soulomoon/suggest-UnliftedNewtypes-unlifted-data-family-25593 at Glasgow Haskell Compiler / GHC
Commits:
23099752 by Luite Stegeman at 2025-01-08T00:33:33+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
- - - - -
0161badc by Ben Gamari at 2025-01-09T17:30:05-05:00
rts/printClosure: Print IPE information for thunks and functions
This makes it considerably easier to grok the structure of the heap
when IPE information is available.
- - - - -
96a72c6b by Patrick at 2025-01-10T15:14:29+00:00
relax newType instance check
- - - - -
a05acbcc by Patrick at 2025-01-10T15:14:29+00:00
include constructor in kind-checking for data family instance
- - - - -
23c8f259 by Patrick at 2025-01-10T15:14:29+00:00
add test case for T25611
- - - - -
c152e6bf by Patrick at 2025-01-10T15:14:29+00:00
add test for T25593
- - - - -
9909a336 by Patrick at 2025-01-10T15:14:29+00:00
add test for T25593
- - - - -
383fb3e8 by Patrick at 2025-01-10T15:14:29+00:00
Fix T25593
- - - - -
05f9a1b2 by Patrick at 2025-01-10T15:14:29+00:00
add test to ensure kind specialization is working as Note [Kind inference for data family instances]
- - - - -
31d1304a by Patrick at 2025-01-10T15:14:29+00:00
update test InstanceConKindSpecializationDataFamily
- - - - -
a46c7ad1 by Patrick at 2025-01-10T15:14:29+00:00
update test InstanceConKindSpecializationDataFamily
- - - - -
cdcb46a5 by Patrick at 2025-01-10T15:14:29+00:00
Update Note [Implementation of UnliftedNewtypes]
- - - - -
19d60a7a by Patrick at 2025-01-10T15:14:29+00:00
format
- - - - -
616e09ef by Patrick at 2025-01-10T15:14:29+00:00
update Test `UnliftedNewtypesFamilyKindFail2`, `UnliftedNewtypesInstanceFail` for additional warning introduced by reintroduce datafam decls in kind check.
- - - - -
09e0290b by Patrick at 2025-01-10T15:14:29+00:00
update comment
- - - - -
57314ec1 by Patrick at 2025-01-10T15:14:29+00:00
Change UnliftedNewtypesUnassociatedFamilyFail to UnliftedNewtypesUnassociatedFamilyInfer.
- - - - -
2464723e by Patrick at 2025-01-10T15:14:29+00:00
cleanup
- - - - -
a20cef68 by Patrick at 2025-01-10T15:14:29+00:00
Only kcConDecls for (A) newtype or (B) H98 style
- - - - -
b5c167f9 by Patrick at 2025-01-10T15:14:29+00:00
add isH98orNewType for clarity
- - - - -
bd85b20c by Patrick at 2025-01-10T15:14:29+00:00
tidy up
- - - - -
e262fe7a by Patrick at 2025-01-10T15:14:29+00:00
Check we defaults the result kind of the data instance correctly
- - - - -
a45fff74 by Patrick at 2025-01-10T15:14:29+00:00
add more examples to dataInstanceKindsDefaults
- - - - -
4297215d by Patrick at 2025-01-10T15:14:29+00:00
arrange the fix to 25593 to another branch
- - - - -
7375673b by Patrick at 2025-01-10T15:14:29+00:00
update Note [Kind inference for data family instances]
- - - - -
e3e6f1c0 by Patrick at 2025-01-10T15:14:29+00:00
format
- - - - -
1271f33c by Patrick at 2025-01-10T15:14:29+00:00
update Note [Kind inference for data family instances]
- - - - -
b553e6b9 by Patrick at 2025-01-10T15:14:29+00:00
adding test case UnliftedNewtypesRunTypeRepPoly
- - - - -
8f0b3553 by Patrick at 2025-01-10T15:14:29+00:00
rename etaExpandAlgTyCon -> maybeEtaExpandAlgTyCon and introduce etaExpandAlgTyCon to expand unconditionally
- - - - -
a1235ebf by Patrick at 2025-01-10T15:14:29+00:00
update note
- - - - -
7746dda9 by Patrick at 2025-01-10T15:14:29+00:00
update note
- - - - -
b8b4a9b2 by Patrick at 2025-01-10T15:14:29+00:00
update note
- - - - -
c5d41a76 by Patrick at 2025-01-10T15:14:29+00:00
update test UnliftedNewtypesRunTypeRepPoly
- - - - -
fc9ee1b0 by Patrick at 2025-01-10T15:14:29+00:00
update test DataInstanceKindsDefaults
- - - - -
0fd6a1bd by Patrick at 2025-01-10T15:14:29+00:00
update note [Data family/instance return kinds] and [Defaulting result kind of newtype/data family instance]
- - - - -
7add32d8 by Patrick at 2025-01-10T15:14:29+00:00
Refine the note
- - - - -
b6e43cfd by Patrick at 2025-01-10T15:14:29+00:00
update note [Data family/instance return kinds]
- - - - -
584ca538 by Patrick at 2025-01-10T15:14:29+00:00
format
- - - - -
28 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/Tc/Gen/HsType.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- docs/users_guide/using-optimisation.rst
- rts/Printer.c
- + 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
- + testsuite/tests/indexed-types/should_compile/T25611.hs
- testsuite/tests/indexed-types/should_compile/all.T
- + testsuite/tests/indexed-types/should_compile/dataInstanceKindsDefaults.hs
- testsuite/tests/indexed-types/should_fail/all.T
- + testsuite/tests/typecheck/should_compile/InstanceConKindSpecializationDataFamily.hs
- + testsuite/tests/typecheck/should_compile/UnliftedNewtypesRunTypeRepPoly.hs
- + testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamilyInfer.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr
- testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr
- − testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr
- testsuite/tests/typecheck/should_fail/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/Tc/Gen/HsType.hs
=====================================
@@ -42,7 +42,8 @@ module GHC.Tc.Gen.HsType (
-- Type checking type and class decls, and instances thereof
bindTyClTyVars, bindTyClTyVarsAndZonk,
tcFamTyPats,
- etaExpandAlgTyCon, tcbVisibilities,
+ maybeEtaExpandAlgTyCon, tcbVisibilities,
+ etaExpandAlgTyCon,
-- tyvars
zonkAndScopedSort,
@@ -2467,7 +2468,7 @@ kcCheckDeclHeader_cusk name flav
++ map (mkExplicitTyConBinder mentioned_kv_set) tc_bndrs
-- Eta expand if necessary; we are building a PolyTyCon
- ; (eta_tcbs, res_kind) <- etaExpandAlgTyCon flav skol_info all_tcbs res_kind
+ ; (eta_tcbs, res_kind) <- maybeEtaExpandAlgTyCon flav skol_info all_tcbs res_kind
; let all_tv_prs = mkTyVarNamePairs (scoped_kvs ++ binderVars tc_bndrs)
final_tcbs = all_tcbs `chkAppend` eta_tcbs
@@ -3920,14 +3921,20 @@ Hence using zonked_kinds when forming tvs'.
-}
-----------------------------------
-etaExpandAlgTyCon :: TyConFlavour tc -> SkolemInfo
+maybeEtaExpandAlgTyCon :: TyConFlavour tc -> SkolemInfo
-> [TcTyConBinder] -> Kind
-> TcM ([TcTyConBinder], Kind)
-etaExpandAlgTyCon flav skol_info tcbs res_kind
+maybeEtaExpandAlgTyCon flav skol_info tcbs res_kind
| needsEtaExpansion flav
- = splitTyConKind skol_info in_scope avoid_occs res_kind
+ = etaExpandAlgTyCon skol_info tcbs res_kind
| otherwise
= return ([], res_kind)
+
+etaExpandAlgTyCon :: SkolemInfo
+ -> [TcTyConBinder] -> Kind
+ -> TcM ([TcTyConBinder], Kind)
+etaExpandAlgTyCon skol_info tcbs res_kind
+ = splitTyConKind skol_info in_scope avoid_occs res_kind
where
tyvars = binderVars tcbs
in_scope = mkInScopeSetList tyvars
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -1135,7 +1135,7 @@ generaliseTcTyCon (tc, skol_info, scoped_prs, tc_res_kind)
flav = tyConFlavour tc
-- Eta expand
- ; (eta_tcbs, tc_res_kind) <- etaExpandAlgTyCon flav skol_info all_tcbs tc_res_kind
+ ; (eta_tcbs, tc_res_kind) <- maybeEtaExpandAlgTyCon flav skol_info all_tcbs tc_res_kind
-- Step 6: Make the result TcTyCon
; let final_tcbs = all_tcbs `chkAppend` eta_tcbs
@@ -1252,7 +1252,7 @@ paths for
Note that neither code path worries about point (4) above, as this
is nicely handled by not mangling the res_kind. (Mangling res_kinds is done
-*after* all this stuff, in tcDataDefn's call to etaExpandAlgTyCon.)
+*after* all this stuff, in tcDataDefn's call to maybeEtaExpandAlgTyCon.)
We can tell Inferred apart from Specified by looking at the scoped
tyvars; Specified are always included there.
@@ -2123,7 +2123,7 @@ DT3 Eta-expansion: Any forall-bound variables and function arguments in a result
data T a :: Type -> Type where ...
we really mean for T to have two parameters. The second parameter
- is produced by processing the return kind in etaExpandAlgTyCon,
+ is produced by processing the return kind in maybeEtaExpandAlgTyCon,
called in tcDataDefn.
See also Note [splitTyConKind] in GHC.Tc.Gen.HsType.
@@ -2218,14 +2218,20 @@ DF0 Where these kinds come from:
Type. This assumption is in getInitialKind for CUSKs or
get_fam_decl_initial_kind for non-signature & non-CUSK cases.
- Instances: The data family already has a known kind. The return kind
- of an instance is then calculated by applying the data family tycon
- to the patterns provided, as computed by the typeKind lhs_ty in the
- end of tcDataFamInstHeader. In the case of an instance written in GADT
- syntax, there are potentially *two* return kinds: the one computed from
- applying the data family tycon to the patterns, and the one given by
- the user. This second kind is checked by the tc_kind_sig function within
- tcDataFamInstHeader. See also DF3, below.
+ Instances: There are potentially *two* return kinds:
+ * Master kind:
+ The data family already has a known kind. The return kind of an instance
+ is then calculated by applying the data family tycon to the patterns
+ provided, as computed by the `tcFamTyPats fam_tc hs_pats` in the
+ tcDataFamInstHeader.
+ * Instance kind:
+ The kind specified by the user in GADT syntax. If H98 syntax is used,
+ with UnliftedNewtypes/UnliftedDatatypes, it defaults to newOpenTypeKind
+ for newtypes/datatypes, otherwise it defaults to liftedTypeKind.
+ This is checked or defaulted by the tc_kind_sig function within
+ tcDataFamInstHeader. Defaulting can be tricky for some cases,
+ See Note [Defaulting result kind of newtype/data family instance].
+ See also DF3, below.
DF1 In a data/newtype instance, we treat the kind of the /data family/,
once instantiated, as the "master kind" for the representation
=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -8,6 +8,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
@@ -714,10 +715,9 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env
-- Do /not/ check that the number of patterns = tyConArity fam_tc
-- See [Arity of data families] in GHC.Core.FamInstEnv
; skol_info <- mkSkolemInfo FamInstSkol
- ; let new_or_data = dataDefnConsNewOrData hs_cons
; (qtvs, non_user_tvs, pats, tc_res_kind, stupid_theta)
<- tcDataFamInstHeader mb_clsinfo skol_info fam_tc outer_bndrs fixity
- hs_ctxt hs_pats m_ksig new_or_data
+ hs_ctxt hs_pats m_ksig hs_cons
-- Eta-reduce the axiom if possible
-- Quite tricky: see Note [Implementing eta reduction for data families]
@@ -742,8 +742,7 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env
-- we did it before the "extra" tvs from etaExpandAlgTyCon
-- would always be eta-reduced
--
- ; let flav = newOrDataToFlavour new_or_data
- ; (extra_tcbs, tc_res_kind) <- etaExpandAlgTyCon flav skol_info full_tcbs tc_res_kind
+ ; (extra_tcbs, tc_res_kind) <- etaExpandAlgTyCon skol_info full_tcbs tc_res_kind
-- Check the result kind; it may come from a user-written signature.
-- See Note [Datatype return kinds] in GHC.Tc.TyCl point 4(a)
@@ -917,8 +916,7 @@ TyVarEnv will simply be empty, and there is nothing to worry about.
tcDataFamInstHeader
:: AssocInstInfo -> SkolemInfo -> TyCon -> HsOuterFamEqnTyVarBndrs GhcRn
-> LexicalFixity -> Maybe (LHsContext GhcRn)
- -> HsFamEqnPats GhcRn -> Maybe (LHsKind GhcRn)
- -> NewOrData
+ -> HsFamEqnPats GhcRn -> Maybe (LHsKind GhcRn) -> DataDefnCons (LConDecl GhcRn)
-> TcM ([TcTyVar], TyVarSet, [TcType], TcKind, TcThetaType)
-- All skolem TcTyVars, all zonked so it's clear what the free vars are
-- The "header" of a data family instance is the part other than
@@ -926,7 +924,7 @@ tcDataFamInstHeader
-- e.g. data instance D [a] :: * -> * where ...
-- Here the "header" is the bit before the "where"
tcDataFamInstHeader mb_clsinfo skol_info fam_tc hs_outer_bndrs fixity
- hs_ctxt hs_pats m_ksig new_or_data
+ hs_ctxt hs_pats m_ksig hs_cons
= do { traceTc "tcDataFamInstHeader {" (ppr fam_tc <+> ppr hs_pats)
; (tclvl, wanted, (outer_bndrs, (stupid_theta, lhs_ty, master_res_kind, instance_res_kind)))
<- pushLevelAndSolveEqualitiesX "tcDataFamInstHeader" $
@@ -942,16 +940,17 @@ tcDataFamInstHeader mb_clsinfo skol_info fam_tc hs_outer_bndrs fixity
-- with its parent class
; addConsistencyConstraints mb_clsinfo lhs_ty
- -- Add constraints from the result signature
- ; res_kind <- tc_kind_sig m_ksig
-
- -- Do not add constraints from the data constructors
+ -- Add constraints from the data constructors
+ -- Fix #25611
-- See Note [Kind inference for data family instances]
+ ; when is_H98_or_newtype $ kcConDecls lhs_applied_kind hs_cons
-- Check that the result kind of the TyCon applied to its args
-- is compatible with the explicit signature (or Type, if there
-- is none)
; let hs_lhs = nlHsTyConApp NotPromoted fixity (getName fam_tc) hs_pats
+ -- Add constraints from the result signature
+ ; res_kind <- tc_kind_sig m_ksig
; _ <- unifyKind (Just . HsTypeRnThing $ unLoc hs_lhs) lhs_applied_kind res_kind
; traceTc "tcDataFamInstHeader" $
@@ -1003,9 +1002,16 @@ tcDataFamInstHeader mb_clsinfo skol_info fam_tc hs_outer_bndrs fixity
where
fam_name = tyConName fam_tc
data_ctxt = DataKindCtxt fam_name
+ new_or_data = dataDefnConsNewOrData hs_cons
+ is_H98_or_newtype = case hs_cons of
+ NewTypeCon{} -> True
+ DataTypeCons _ cons -> all isH98 cons
+ isH98 (L _ (ConDeclH98 {})) = True
+ isH98 _ = False
-- See Note [Implementation of UnliftedNewtypes] in GHC.Tc.TyCl, families (2),
- -- and Note [Implementation of UnliftedDatatypes].
+ -- Note [Implementation of UnliftedDatatypes]
+ -- and Note [Defaulting result kind of newtype/data family instance].
tc_kind_sig Nothing
= do { unlifted_newtypes <- xoptM LangExt.UnliftedNewtypes
; unlifted_datatypes <- xoptM LangExt.UnliftedDatatypes
@@ -1031,6 +1037,21 @@ we actually have a place to put the regeneralised variables.
Thus: skolemise away. cf. GHC.Tc.Utils.Unify.tcTopSkolemise
Examples in indexed-types/should_compile/T12369
+Note [Defaulting result kind of newtype/data family instance]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It is tempting to let `tc_kind_sig` just return `newOpenTypeKind`
+even without `-XUnliftedNewtypes`, but we rely on `tc_kind_sig` to
+default the result kind of a newtype instance to `Type`.
+Consider the following example:
+
+ -- no UnliftedNewtypes
+ data family D :: k -> k
+ newtype instance D a = MkIntD a
+
+`tc_kind_sig` defaulting to `newOpenTypeKind` would result in `D a`
+having kind `forall r. TYPE r` instead of `Type`, which would be
+rejected validity checking. The same applies to Data Instances.
+
Note [Implementing eta reduction for data families]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
@@ -1185,31 +1206,48 @@ kind -- that came from the family declaration, and is not influenced
by the data instances -- and hence we /can/ specialise T's kind
differently in different GADT data constructors.
-SHORT SUMMARY: in a data instance decl, it's not clear whether kind
+SHORT SUMMARY: In a data instance decl, it's not clear whether kind
constraints arising from the data constructors should be considered
local to the (GADT) data /constructor/ or should apply to the entire
data instance.
-DESIGN CHOICE: in data/newtype family instance declarations, we ignore
-the /data constructor/ declarations altogether, looking only at the
-data instance /header/.
+DESIGN CHOICE: In a data/newtype family instance declaration:
+* We take account of the data constructors (via `kcConDecls`) for:
+ * Haskell-98 style data instance declarations
+ * All newtype instance declarations
+ For Haskell-98 style declarations, there is no GADT refinement. And for
+ GADT-style newtype declarations, no GADT matching is allowed anyway,
+ so it's just a syntactic difference from Haskell-98.
-Observations:
-* This choice is simple to describe, as well as simple to implement.
- For a data/newtype instance decl, the instance kinds are influenced
- /only/ by the header.
-
-* We could treat Haskell-98 style data-instance decls differently, by
- taking the data constructors into account, since there are no GADT
- issues. But we don't, for simplicity, and because it means you can
- understand the data type instance by looking only at the header.
+* We /ignore/ the data constructors for:
+ * GADT-style data instance declarations
+ Here, the instance kinds are influenced only by the header.
-* Newtypes can be declared in GADT syntax, but they can't do GADT-style
- specialisation, so like Haskell-98 definitions we could take the
- data constructors into account. Again we don't, for the same reason.
+This choice is implemented by the guarded call to `kcConDecls` in
+`tcDataFamInstHeader`.
-So for now at least, we keep the simplest choice. See #18891 and !4419
-for more discussion of this issue.
+Observations:
+* With `UnliftedNewtypes` or `UnliftedDatatypes`, looking at the data
+ constructors is necessary to infer the kind of the result type for
+ certain cases. Otherwise, additional kind signatures are required.
+ Consider the following example in #25611:
+
+ data family Fix :: (k -> Type) -> k
+ newtype instance Fix f = In { out :: f (Fix f) }
+
+ If we are not looking at the data constructors:
+ * Without `UnliftedNewtypes`, it is accepted since `Fix f` is defaulted
+ to `Type`.
+ * But with `UnliftedNewtypes`, `Fix f` is defaulted to `TYPE r` where
+ `r` is not scoped over the data constructor. Then the header `Fix f :: TYPE r`
+ will fail to kind unify with `f (Fix f) :: Type`.
+
+ Hence, we need to look at the data constructor to infer `Fix f :: Type`
+ for this newtype instance.
+
+This DESIGN CHOICE strikes a balance between well-rounded kind inference
+and implementation simplicity. See #25611, #18891, and !4419 for more
+discussion of this issue.
Kind inference for data types (Xie et al) https://arxiv.org/abs/1911.06153
takes a slightly different approach.
=====================================
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
=====================================
rts/Printer.c
=====================================
@@ -151,13 +151,20 @@ printClosure( const StgClosure *obj )
case FUN_1_0: case FUN_0_1:
case FUN_1_1: case FUN_0_2: case FUN_2_0:
case FUN_STATIC:
- debugBelch("FUN/%d(",(int)itbl_to_fun_itbl(info)->f.arity);
- printPtr((StgPtr)obj->header.info);
+ {
+ debugBelch("FUN/%d(",(int)itbl_to_fun_itbl(info)->f.arity);
+ printPtr((StgPtr)obj->header.info);
+
+ InfoProvEnt ipe;
+ if (lookupIPE(obj->header.info, &ipe)) {
+ debugBelch(", %s", ipe.prov.table_name);
+ }
#if defined(PROFILING)
- debugBelch(", %s", obj->header.prof.ccs->cc->label);
+ debugBelch(", %s", obj->header.prof.ccs->cc->label);
#endif
- printStdObjPayload(obj);
- break;
+ printStdObjPayload(obj);
+ break;
+ }
case PRIM:
debugBelch("PRIM(");
@@ -175,13 +182,19 @@ printClosure( const StgClosure *obj )
case THUNK_1_0: case THUNK_0_1:
case THUNK_1_1: case THUNK_0_2: case THUNK_2_0:
case THUNK_STATIC:
+ {
/* ToDo: will this work for THUNK_STATIC too? */
#if defined(PROFILING)
printThunkObject((StgThunk *)obj,GET_PROF_DESC(info));
#else
printThunkObject((StgThunk *)obj,"THUNK");
+ InfoProvEnt ipe;
+ if (lookupIPE(obj->header.info, &ipe)) {
+ debugBelch(", %s", ipe.prov.table_name);
+ }
#endif
break;
+ }
case THUNK_SELECTOR:
printStdObjHdr(obj, "THUNK_SELECTOR");
=====================================
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,6 @@
+test('T25284',
+ [js_skip, # allocation counters aren't available on the JS backend
+ extra_files(['Main.hs', 'A.hs', 'B.hs', 'Cls.hs']),
+ extra_run_opts('+RTS -T -RTS')],
+ multimod_compile_and_run,
+ ['Main', ''])
=====================================
testsuite/tests/indexed-types/should_compile/T25611.hs
=====================================
@@ -0,0 +1,9 @@
+{-# language DataKinds, PolyKinds, GADTs, TypeFamilies, RankNTypes,
+ TypeOperators, ConstraintKinds, UnliftedNewtypes #-}
+
+module T25611 where
+
+import Data.Kind
+
+data family Fix :: (k -> Type) -> k
+newtype instance Fix f = In { out :: f (Fix f) }
=====================================
testsuite/tests/indexed-types/should_compile/all.T
=====================================
@@ -310,3 +310,5 @@ test('T22717', normal, makefile_test, ['T22717'])
test('T22717_fam_orph', normal, multimod_compile, ['T22717_fam_orph', '-v0'])
test('T23408', normal, compile, [''])
test('T24134', normal, compile, [''])
+test('T25611', normal, compile, [''])
+test('dataInstanceKindsDefaults', normal, compile, [''])
=====================================
testsuite/tests/indexed-types/should_compile/dataInstanceKindsDefaults.hs
=====================================
@@ -0,0 +1,26 @@
+{-# language DataKinds, PolyKinds, GADTs, TypeFamilies, RankNTypes,
+ TypeOperators, ConstraintKinds #-}
+
+module DataInstanceKindsDefaults where
+
+import Data.Kind
+
+-- This test checks if we default the kind of the data instance correctly without UnliftedNewtypes
+-- or UnliftedDatatypes.
+-- Assumptions:
+-- If we default the result kind of the data instance to `TYPE r`,
+-- then `checkNewDataCon` would through the error since the result kind of the data instance
+-- should be `Type` without UnliftedNewtypes or UnliftedDatatypes.
+
+data family A :: k -> k
+newtype instance A a = MkA a
+
+data family B :: k -> k
+data instance B a = MkB a
+
+data family C :: k -> k
+data instance C a where MkC :: a -> C a
+
+data family D :: k -> k
+newtype instance D a where MkD :: a -> D a
+
=====================================
testsuite/tests/indexed-types/should_fail/all.T
=====================================
@@ -171,4 +171,4 @@ test('T20521', normal, compile_fail, [''])
test('T21896', normal, compile_fail, [''])
test('HsBootFam', [extra_files(['HsBootFam_aux.hs','HsBootFam_aux.hs-boot'])], multimod_compile_fail, ['HsBootFam', ''])
test('BadFamInstDecl', [extra_files(['BadFamInstDecl_aux.hs'])], multimod_compile_fail, ['BadFamInstDecl', ''])
-test('T19773', [], multimod_compile_fail, ['T19773', '-Wall'])
+test('T19773', [], multimod_compile_fail, ['T19773', '-Wall'])
\ No newline at end of file
=====================================
testsuite/tests/typecheck/should_compile/InstanceConKindSpecializationDataFamily.hs
=====================================
@@ -0,0 +1,16 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MagicHash #-}
+
+module InstanceConKindSpecializationDataFamily where
+
+import GHC.Prim (Int#)
+
+-- | A data family with a kind signature
+data family T :: forall k. (k->v) -> k -> v
+-- ensure the kind specialization is correctly handled in the GADT-style data instance
+-- see Note [Kind inference for data family instances]
+-- p will specialize differently in the two constructors
+data instance T p q where
+ MkkT :: forall r. r Int -> T r Int
+ MkkV :: forall l. l Int# -> T l Int#
=====================================
testsuite/tests/typecheck/should_compile/UnliftedNewtypesRunTypeRepPoly.hs
=====================================
@@ -0,0 +1,33 @@
+{-# LANGUAGE GADTSyntax #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnliftedNewtypes #-}
+{-# LANGUAGE RankNTypes #-}
+
+module UnliftedNewtypesRunTypeRepPoly where
+
+import GHC.Int (Int(I#))
+import GHC.Word (Word(W#))
+import GHC.Exts (Int#,Word#)
+import GHC.Types
+
+-- ensure newtype[instance] can be runtime-rep-polymorphic
+
+type N :: TYPE r -> TYPE r
+newtype N a = MkN a
+
+f :: Int# -> N Int#
+f x = MkN x
+
+g :: Int -> N Int
+g x = MkN x
+
+data family D :: Type -> k -> k
+newtype instance D Int a = MkD a
+
+f1 :: Int# -> D Int Int#
+f1 x = MkD x
+
+g1 :: Int -> D Int Int
+g1 x = MkD x
=====================================
testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamilyInfer.hs
=====================================
@@ -0,0 +1,29 @@
+{-# LANGUAGE UnliftedNewtypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE GADTs #-}
+
+module UnliftedNewtypesUnassociatedFamily where
+
+import GHC.Int (Int(I#))
+import GHC.Word (Word(W#))
+import GHC.Exts (Int#,Word#)
+import GHC.Exts (TYPE,RuntimeRep(IntRep,WordRep,TupleRep))
+
+data family DF :: TYPE (r :: RuntimeRep)
+
+-- it used to be failed: see #18891 and !4419
+-- See Note [Kind inference for data family instances]
+-- in GHC.Tc.TyCl.Instance
+-- but succ now see #25611
+newtype instance DF = MkDF1a Int#
+newtype instance DF = MkDF2a Word#
+newtype instance DF = MkDF3a (# Int#, Word# #)
+
+go = 1
+ where
+ x :: DF @IntRep
+ x = MkDF1a 3#
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -696,6 +696,7 @@ test('T505', normal, compile, [''])
test('T12928', normal, compile, [''])
test('UnliftedNewtypesGnd', normal, compile, [''])
test('UnliftedNewtypesUnassociatedFamily', normal, compile, [''])
+test('UnliftedNewtypesUnassociatedFamilyInfer', normal, compile, [''])
test('UnliftedNewtypesUnifySig', normal, compile, [''])
test('UnliftedNewtypesForall', normal, compile, [''])
test('UnlifNewUnify', normal, compile, [''])
@@ -932,3 +933,5 @@ test('T25266', normal, compile, [''])
test('T25266a', normal, compile_fail, [''])
test('T25266b', normal, compile, [''])
test('T25597', normal, compile, [''])
+test('InstanceConKindSpecializationDataFamily', normal, compile, [''])
+test('UnliftedNewtypesRunTypeRepPoly', normal, compile, [''])
\ No newline at end of file
=====================================
testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr
=====================================
@@ -5,3 +5,11 @@ UnliftedNewtypesFamilyKindFail2.hs:12:20: error: [GHC-83865]
• In the first argument of ‘F’, namely ‘5’
In the newtype instance declaration for ‘F’
+UnliftedNewtypesFamilyKindFail2.hs:12:31: [GHC-83865]
+ Expected a type,
+ but ‘5’ has kind
+ ‘GHC.Internal.Bignum.Natural.Natural’
+ In the first argument of ‘F’, namely ‘5’
+ In the type ‘(F 5)’
+ In the definition of data constructor ‘MkF’
+
=====================================
testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr
=====================================
@@ -3,3 +3,9 @@ UnliftedNewtypesInstanceFail.hs:13:3: error: [GHC-83865]
• Expected a WordRep type, but ‘Bar Bool’ is an IntRep type
• In the newtype instance declaration for ‘Bar’
In the instance declaration for ‘Foo Bool’
+
+UnliftedNewtypesInstanceFail.hs:14:17: [GHC-83865]
+ Expected an IntRep type, but ‘Word#’ is a WordRep type
+ In the type ‘Word#’
+ In the definition of data constructor ‘BarBoolC’
+ In the newtype instance declaration for ‘Bar’
\ No newline at end of file
=====================================
testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr deleted
=====================================
@@ -1,32 +0,0 @@
-
-UnliftedNewtypesUnassociatedFamilyFail.hs:21:30: error: [GHC-25897]
- • Couldn't match kind ‘t’ with ‘IntRep’
- Expected a type, but ‘Int#’ has kind ‘TYPE IntRep’
- ‘t’ is a rigid type variable bound by
- a family instance declaration
- at UnliftedNewtypesUnassociatedFamilyFail.hs:21:1-33
- • In the type ‘Int#’
- In the definition of data constructor ‘MkDF1a’
- In the newtype instance declaration for ‘DF’
-
-UnliftedNewtypesUnassociatedFamilyFail.hs:22:30: error: [GHC-25897]
- • Couldn't match kind ‘t’ with ‘WordRep’
- Expected a type, but ‘Word#’ has kind ‘TYPE WordRep’
- ‘t’ is a rigid type variable bound by
- a family instance declaration
- at UnliftedNewtypesUnassociatedFamilyFail.hs:22:1-34
- • In the type ‘Word#’
- In the definition of data constructor ‘MkDF2a’
- In the newtype instance declaration for ‘DF’
-
-UnliftedNewtypesUnassociatedFamilyFail.hs:23:30: error: [GHC-25897]
- • Couldn't match kind ‘t’ with ‘TupleRep [IntRep, WordRep]’
- Expected a type,
- but ‘(# Int#, Word# #)’ has kind ‘TYPE
- (TupleRep [IntRep, WordRep])’
- ‘t’ is a rigid type variable bound by
- a family instance declaration
- at UnliftedNewtypesUnassociatedFamilyFail.hs:23:1-46
- • In the type ‘(# Int#, Word# #)’
- In the definition of data constructor ‘MkDF3a’
- In the newtype instance declaration for ‘DF’
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -552,7 +552,6 @@ test('UnliftedNewtypesConstraintFamily', normal, compile_fail, [''])
test('UnliftedNewtypesMismatchedKind', normal, compile_fail, [''])
test('UnliftedNewtypesMismatchedKindRecord', normal, compile_fail, [''])
test('UnliftedNewtypesMultiFieldGadt', normal, compile_fail, [''])
-test('UnliftedNewtypesUnassociatedFamilyFail', normal, compile_fail, [''])
test('T13834', normal, compile_fail, [''])
test('T17077', normal, compile_fail, [''])
test('T16512a', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1c92e4474e082185cf41bf2fb36c02545ff98376...584ca538b36c58ede0cb414bb96a614f8dbbd1ab
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1c92e4474e082185cf41bf2fb36c02545ff98376...584ca538b36c58ede0cb414bb96a614f8dbbd1ab
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/20250110/dc1e8c2d/attachment-0001.html>
More information about the ghc-commits
mailing list