[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Improve toInteger @Word32 on 64-bit platforms
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Mar 23 01:21:48 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
77c39b86 by Matthew Craven at 2024-03-22T21:20:42-04:00
Improve toInteger @Word32 on 64-bit platforms
On 64-bit platforms, every Word32 fits in an Int, so we can
convert to Int# without having to perform the overflow check
integerFromWord# uses internally.
- - - - -
0ff06794 by Apoorv Ingle at 2024-03-22T21:20:42-04:00
Fix for #24552 (see testcase T24552)
Fixes for a bug in desugaring pattern synonyms matches, introduced
while working on on expanding `do`-blocks in #18324
The `matchWrapper` unecessarily (and incorrectly) filtered out the
default wild patterns in a match. Now the wild pattern alternative is
simply ignored by the pm check as its origin is `Generated`.
The current code now matches the expected semantics according to the language spec.
- - - - -
65a3f458 by Simon Peyton Jones at 2024-03-22T21:20:42-04:00
Print more info about kinds in error messages
This fixes #24553, where GHC unhelpfully said
error: [GHC-83865]
• Expected kind ‘* -> * -> *’, but ‘Foo’ has kind ‘* -> * -> *’
See Note [Showing invisible bits of types in error messages]
- - - - -
08876875 by Tristan Cacqueray at 2024-03-22T21:20:44-04:00
docs: remove the don't use float hint
This hint is outdated, ``Complex Float`` are now specialised,
and the heap space suggestion needs more nuance so it should
be explained in the unboxed/storable array documentation.
- - - - -
21 changed files:
- compiler/GHC/Core/Map/Type.hs
- compiler/GHC/Core/TyCo/Compare.hs
- compiler/GHC/Core/TyCo/Ppr.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Utils/TcType.hs
- docs/users_guide/hints.rst
- libraries/base/changelog.md
- libraries/ghc-internal/src/GHC/Internal/Word.hs
- + testsuite/tests/patsyn/should_run/T24552.hs
- + testsuite/tests/patsyn/should_run/T24552.stdout
- testsuite/tests/patsyn/should_run/all.T
- + testsuite/tests/typecheck/should_fail/T24553.hs
- + testsuite/tests/typecheck/should_fail/T24553.stderr
- testsuite/tests/typecheck/should_fail/all.T
Changes:
=====================================
compiler/GHC/Core/Map/Type.hs
=====================================
@@ -228,7 +228,7 @@ eqDeBruijnType env_t1@(D env1 t1) env_t2@(D env2 t2) =
andEq TEQX e = hasCast e
andEq TEQ e = e
- -- See Note [Comparing nullary type synonyms] in GHC.Core.Type
+ -- See Note [Comparing nullary type synonyms] in GHC.Core.TyCo.Compare
go (D _ (TyConApp tc1 [])) (D _ (TyConApp tc2 []))
| tc1 == tc2
= TEQ
=====================================
compiler/GHC/Core/TyCo/Compare.hs
=====================================
@@ -12,8 +12,9 @@ module GHC.Core.TyCo.Compare (
nonDetCmpTypesX, nonDetCmpTc,
eqVarBndrs,
- pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck, tcEqTypeVis,
+ pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck,
tcEqTyConApps,
+ mayLookIdentical,
-- * Visiblity comparision
eqForAllVis, cmpForAllVis
@@ -22,7 +23,8 @@ module GHC.Core.TyCo.Compare (
import GHC.Prelude
-import GHC.Core.Type( typeKind, coreView, tcSplitAppTyNoView_maybe, splitAppTyNoView_maybe )
+import GHC.Core.Type( typeKind, coreView, tcSplitAppTyNoView_maybe, splitAppTyNoView_maybe
+ , isLevityTy, isRuntimeRepTy, isMultiplicityTy )
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.FVs
@@ -129,52 +131,119 @@ Cabal.
See #19226.
-}
+mayLookIdentical :: Type -> Type -> Bool
+-- | Returns True if the /visible/ part of the types
+-- might look equal, even if they are really unequal (in the invisible bits)
+--
+-- This function is very similar to tc_eq_type but it is much more
+-- heuristic. Notably, it is always safe to return True, even with types
+-- that might (in truth) be unequal -- this affects error messages only
+-- (Originally there were one function with an extra flag, but the result
+-- was hard to understand.)
+mayLookIdentical orig_ty1 orig_ty2
+ = go orig_env orig_ty1 orig_ty2
+ where
+ orig_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [orig_ty1, orig_ty2]
+
+ go :: RnEnv2 -> Type -> Type -> Bool
+ -- See Note [Comparing nullary type synonyms]
+ go _ (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2 = True
+
+ go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2
+ go env t1 t2 | Just t2' <- coreView t2 = go env t1 t2'
+
+ go env (TyVarTy tv1) (TyVarTy tv2) = rnOccL env tv1 == rnOccR env tv2
+ go _ (LitTy lit1) (LitTy lit2) = lit1 == lit2
+ go env (CastTy t1 _) t2 = go env t1 t2
+ go env t1 (CastTy t2 _) = go env t1 t2
+ go _ (CoercionTy {}) (CoercionTy {}) = True
+
+ go env (ForAllTy (Bndr tv1 vis1) ty1)
+ (ForAllTy (Bndr tv2 vis2) ty2)
+ = vis1 `eqForAllVis` vis2 -- See Note [ForAllTy and type equality]
+ && go (rnBndr2 env tv1 tv2) ty1 ty2
+ -- Visible stuff only: ignore kinds of binders
+
+ -- If we have (forall (r::RunTimeRep). ty1 ~ blah) then respond
+ -- with True. Reason: the type pretty-printer defaults RuntimeRep
+ -- foralls (see Ghc.Iface.Type.hideNonStandardTypes). That can make,
+ -- say (forall r. TYPE r -> Type) into (Type -> Type), so it looks the
+ -- same as a very different type (#24553). By responding True, we
+ -- tell GHC (see calls of mayLookIdentical) to display without defaulting.
+ -- See Note [Showing invisible bits of types in error messages]
+ -- in GHC.Tc.Errors.Ppr
+ go _ (ForAllTy b _) _ | isDefaultableBndr b = True
+ go _ _ (ForAllTy b _) | isDefaultableBndr b = True
+
+ go env (FunTy _ w1 arg1 res1) (FunTy _ w2 arg2 res2)
+ = go env arg1 arg2 && go env res1 res2 && go env w1 w2
+ -- Visible stuff only: ignore agg kinds
+
+ -- See Note [Equality on AppTys] in GHC.Core.Type
+ go env (AppTy s1 t1) ty2
+ | Just (s2, t2) <- tcSplitAppTyNoView_maybe ty2
+ = go env s1 s2 && go env t1 t2
+ go env ty1 (AppTy s2 t2)
+ | Just (s1, t1) <- tcSplitAppTyNoView_maybe ty1
+ = go env s1 s2 && go env t1 t2
+
+ go env (TyConApp tc1 ts1) (TyConApp tc2 ts2)
+ = tc1 == tc2 && gos env (tyConBinders tc1) ts1 ts2
+
+ go _ _ _ = False
+
+ gos :: RnEnv2 -> [TyConBinder] -> [Type] -> [Type] -> Bool
+ gos _ _ [] [] = True
+ gos env bs (t1:ts1) (t2:ts2)
+ | (invisible, bs') <- case bs of
+ [] -> (False, [])
+ (b:bs) -> (isInvisibleTyConBinder b, bs)
+ = (invisible || go env t1 t2) && gos env bs' ts1 ts2
+
+ gos _ _ _ _ = False
+
+
-- | Type equality comparing both visible and invisible arguments and expanding
-- type synonyms.
tcEqTypeNoSyns :: Type -> Type -> Bool
-tcEqTypeNoSyns ta tb = tc_eq_type False False ta tb
-
--- | Like 'tcEqType', but returns True if the /visible/ part of the types
--- are equal, even if they are really unequal (in the invisible bits)
-tcEqTypeVis :: Type -> Type -> Bool
-tcEqTypeVis ty1 ty2 = tc_eq_type False True ty1 ty2
+tcEqTypeNoSyns ta tb = tc_eq_type False ta tb
-- | Like 'pickyEqTypeVis', but returns a Bool for convenience
pickyEqType :: Type -> Type -> Bool
-- Check when two types _look_ the same, _including_ synonyms.
-- So (pickyEqType String [Char]) returns False
-- This ignores kinds and coercions, because this is used only for printing.
-pickyEqType ty1 ty2 = tc_eq_type True False ty1 ty2
+pickyEqType ty1 ty2 = tc_eq_type True ty1 ty2
-- | Real worker for 'tcEqType'. No kind check!
tc_eq_type :: Bool -- ^ True <=> do not expand type synonyms
- -> Bool -- ^ True <=> compare visible args only
-> Type -> Type
-> Bool
-- Flags False, False is the usual setting for tc_eq_type
-- See Note [Computing equality on types] in Type
-tc_eq_type keep_syns vis_only orig_ty1 orig_ty2
+{-# INLINE tc_eq_type #-} -- See Note [Specialising tc_eq_type].
+tc_eq_type keep_syns orig_ty1 orig_ty2
= go orig_env orig_ty1 orig_ty2
where
+ orig_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [orig_ty1, orig_ty2]
+
go :: RnEnv2 -> Type -> Type -> Bool
- -- See Note [Comparing nullary type synonyms] in GHC.Core.Type.
- go _ (TyConApp tc1 []) (TyConApp tc2 [])
- | tc1 == tc2
- = True
+ -- See Note [Comparing nullary type synonyms]
+ go _ (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2 = True
go env t1 t2 | not keep_syns, Just t1' <- coreView t1 = go env t1' t2
go env t1 t2 | not keep_syns, Just t2' <- coreView t2 = go env t1 t2'
- go env (TyVarTy tv1) (TyVarTy tv2)
- = rnOccL env tv1 == rnOccR env tv2
-
- go _ (LitTy lit1) (LitTy lit2)
- = lit1 == lit2
+ go env (TyVarTy tv1) (TyVarTy tv2) = rnOccL env tv1 == rnOccR env tv2
+ go _ (LitTy lit1) (LitTy lit2) = lit1 == lit2
+ go env (CastTy t1 _) t2 = go env t1 t2
+ go env t1 (CastTy t2 _) = go env t1 t2
+ go _ (CoercionTy {}) (CoercionTy {}) = True
go env (ForAllTy (Bndr tv1 vis1) ty1)
(ForAllTy (Bndr tv2 vis2) ty2)
= vis1 `eqForAllVis` vis2 -- See Note [ForAllTy and type equality]
- && (vis_only || go env (varType tv1) (varType tv2))
+ && go env (varType tv1) (varType tv2)
&& go (rnBndr2 env tv1 tv2) ty1 ty2
-- Make sure we handle all FunTy cases since falling through to the
@@ -183,11 +252,9 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2
-- See Note [Equality on FunTys] in GHC.Core.TyCo.Rep: we must check
-- kinds here
go env (FunTy _ w1 arg1 res1) (FunTy _ w2 arg2 res2)
- = kinds_eq && go env arg1 arg2 && go env res1 res2 && go env w1 w2
- where
- kinds_eq | vis_only = True
- | otherwise = go env (typeKind arg1) (typeKind arg2) &&
- go env (typeKind res1) (typeKind res2)
+ = go env (typeKind arg1) (typeKind arg2) &&
+ go env (typeKind res1) (typeKind res2) &&
+ go env arg1 arg2 && go env res1 res2 && go env w1 w2
-- See Note [Equality on AppTys] in GHC.Core.Type
go env (AppTy s1 t1) ty2
@@ -198,32 +265,24 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2
= go env s1 s2 && go env t1 t2
go env (TyConApp tc1 ts1) (TyConApp tc2 ts2)
- = tc1 == tc2 && gos env (tc_vis tc1) ts1 ts2
-
- go env (CastTy t1 _) t2 = go env t1 t2
- go env t1 (CastTy t2 _) = go env t1 t2
- go _ (CoercionTy {}) (CoercionTy {}) = True
+ = tc1 == tc2 && gos env ts1 ts2
go _ _ _ = False
- gos _ _ [] [] = True
- gos env (ig:igs) (t1:ts1) (t2:ts2) = (ig || go env t1 t2)
- && gos env igs ts1 ts2
- gos _ _ _ _ = False
+ gos _ [] [] = True
+ gos env (t1:ts1) (t2:ts2) = go env t1 t2 && gos env ts1 ts2
+ gos _ _ _ = False
- tc_vis :: TyCon -> [Bool] -- True for the fields we should ignore
- tc_vis tc | vis_only = inviss ++ repeat False -- Ignore invisibles
- | otherwise = repeat False -- Ignore nothing
- -- The repeat False is necessary because tycons
- -- can legitimately be oversaturated
- where
- bndrs = tyConBinders tc
- inviss = map isInvisibleTyConBinder bndrs
-
- orig_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [orig_ty1, orig_ty2]
-
-{-# INLINE tc_eq_type #-} -- See Note [Specialising tc_eq_type].
+isDefaultableBndr :: ForAllTyBinder -> Bool
+-- This function should line up with the defaulting done
+-- by GHC.Iface.Type.defaultIfaceTyVarsOfKind
+-- See Note [Showing invisible bits of types in error messages]
+-- in GHC.Tc.Errors.Ppr
+isDefaultableBndr (Bndr tv vis)
+ = isInvisibleForAllTyFlag vis && is_defaultable (tyVarKind tv)
+ where
+ is_defaultable ki = isLevityTy ki || isRuntimeRepTy ki || isMultiplicityTy ki
-- | Do these denote the same level of visibility? 'Required'
-- arguments are visible, others are not. So this function
@@ -543,7 +602,7 @@ nonDetCmpTypeX env orig_t1 orig_t2 =
-- Returns both the resulting ordering relation between
-- the two types and whether either contains a cast.
go :: RnEnv2 -> Type -> Type -> TypeOrdering
- -- See Note [Comparing nullary type synonyms].
+ -- See Note [Comparing nullary type synonyms]
go _ (TyConApp tc1 []) (TyConApp tc2 [])
| tc1 == tc2
= TEQ
=====================================
compiler/GHC/Core/TyCo/Ppr.hs
=====================================
@@ -14,7 +14,7 @@ module GHC.Core.TyCo.Ppr
pprTyVar, pprTyVars,
pprThetaArrowTy, pprClassPred,
pprKind, pprParendKind, pprTyLit,
- pprDataCons, pprWithExplicitKindsWhen,
+ pprDataCons, pprWithInvisibleBitsWhen,
pprWithTYPE, pprSourceTyCon,
@@ -330,13 +330,14 @@ pprTypeApp tc tys
-- TODO: toIfaceTcArgs seems rather wasteful here
------------------
--- | Display all kind information (with @-fprint-explicit-kinds@) when the
--- provided 'Bool' argument is 'True'.
--- See @Note [Kind arguments in error messages]@ in "GHC.Tc.Errors".
-pprWithExplicitKindsWhen :: Bool -> SDoc -> SDoc
-pprWithExplicitKindsWhen b
+-- | Display all foralls, runtime-reps, and kind information
+-- when provided 'Bool' argument is 'True'. See GHC.Tc.Errors.Ppr
+-- Note [Showing invisible bits of types in error messages]
+pprWithInvisibleBitsWhen :: Bool -> SDoc -> SDoc
+pprWithInvisibleBitsWhen b
= updSDocContext $ \ctx ->
- if b then ctx { sdocPrintExplicitKinds = True }
+ if b then ctx { sdocPrintExplicitKinds = True
+ , sdocPrintExplicitRuntimeReps = True }
else ctx
-- | This variant preserves any use of TYPE in a type, effectively
=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -1066,7 +1066,7 @@ unify_ty :: UMEnv
-- Respects newtypes, PredTypes
-- See Note [Computing equality on types] in GHC.Core.Type
unify_ty _env (TyConApp tc1 []) (TyConApp tc2 []) _kco
- -- See Note [Comparing nullary type synonyms] in GHC.Core.Type.
+ -- See Note [Comparing nullary type synonyms] in GHC.Core.TyCo.Compare
| tc1 == tc2
= return ()
=====================================
compiler/GHC/HsToCore/Match.hs
=====================================
@@ -29,7 +29,7 @@ import Language.Haskell.Syntax.Basic (Boxity(..))
import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr)
-import GHC.Types.Basic ( Origin(..), requiresPMC, isDoExpansionGenerated )
+import GHC.Types.Basic ( Origin(..), requiresPMC )
import GHC.Types.SourceText
( FractionalLit,
@@ -765,20 +765,11 @@ one pattern, and match simply only accepts one pattern.
JJQC 30-Nov-1997
-}
-matchWrapper ctxt scrs (MG { mg_alts = L _ matches'
+matchWrapper ctxt scrs (MG { mg_alts = L _ matches
, mg_ext = MatchGroupTc arg_tys rhs_ty origin
})
= do { dflags <- getDynFlags
; locn <- getSrcSpanDs
- ; let matches
- = if any (is_pat_syn_match origin) matches'
- then filter (non_gen_wc origin) matches'
- -- filter out the wild pattern fail alternatives
- -- which have a do expansion origin
- -- They generate spurious overlapping warnings
- -- Due to pattern synonyms treated as refutable patterns
- -- See Part 1's Wrinkle 1 in Note [Expanding HsDo with XXExprGhcRn] in GHC.Tc.Gen.Do
- else matches'
; new_vars <- case matches of
[] -> newSysLocalsDs arg_tys
(m:_) ->
@@ -797,6 +788,8 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches'
, text "matchPmChecked" <+> ppr (isMatchContextPmChecked dflags origin ctxt)])
; matches_nablas <-
if isMatchContextPmChecked dflags origin ctxt
+ -- See Note [Expanding HsDo with XXExprGhcRn] Part 1. Wrinkle 1 for
+ -- pmc for pattern synonyms
-- See Note [Long-distance information] in GHC.HsToCore.Pmc
then addHsScrutTmCs (concat scrs) new_vars $
@@ -843,16 +836,6 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches'
$ NEL.nonEmpty
$ replicate (length (grhssGRHSs m)) ldi_nablas
- is_pat_syn_match :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool
- is_pat_syn_match origin (L _ (Match _ _ [L _ (VisPat _ l_pat)] _)) | isDoExpansionGenerated origin
- = isPatSyn l_pat
- is_pat_syn_match _ _ = False
- -- generated match pattern that is not a wildcard
- non_gen_wc :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool
- non_gen_wc origin (L _ (Match _ _ ([L _ (VisPat _ (L _ (WildPat _)))]) _))
- = not . isDoExpansionGenerated $ origin
- non_gen_wc _ _ = True
-
{- Note [Long-distance information in matchWrapper]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The pattern match checking in matchWrapper is done conditionally, depending
=====================================
compiler/GHC/Iface/Type.hs
=====================================
@@ -1189,7 +1189,7 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty
-> IfaceType
go subs True (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty)
| isInvisibleForAllTyFlag argf -- Don't default *visible* quantification
- -- or we get the mess in #13963
+ -- or we get the mess in #13963
, Just substituted_ty <- check_substitution var_kind
= let subs' = extendFsEnv subs var substituted_ty
-- Record that we should replace it with LiftedRep/Lifted/Many,
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -2094,10 +2094,9 @@ mkMismatchMsg item ty1 ty2 =
case orig of
TypeEqOrigin { uo_actual, uo_expected, uo_thing = mb_thing } ->
(TypeEqMismatch
- { teq_mismatch_ppr_explicit_kinds = ppr_explicit_kinds
- , teq_mismatch_item = item
- , teq_mismatch_ty1 = ty1
- , teq_mismatch_ty2 = ty2
+ { teq_mismatch_item = item
+ , teq_mismatch_ty1 = ty1
+ , teq_mismatch_ty2 = ty2
, teq_mismatch_actual = uo_actual
, teq_mismatch_expected = uo_expected
, teq_mismatch_what = mb_thing
@@ -2121,25 +2120,6 @@ mkMismatchMsg item ty1 ty2 =
where
orig = errorItemOrigin item
mb_same_occ = sameOccExtras ty2 ty1
- ppr_explicit_kinds = shouldPprWithExplicitKinds ty1 ty2 orig
-
--- | Whether to print explicit kinds (with @-fprint-explicit-kinds@)
--- in an 'SDoc' when a type mismatch occurs to due invisible kind arguments.
---
--- This function first checks to see if the 'CtOrigin' argument is a
--- 'TypeEqOrigin'. If so, it first checks whether the equality is a visible
--- equality; if it's not, definitely print the kinds. Even if the equality is
--- a visible equality, check the expected/actual types to see if the types
--- have equal visible components. If the 'CtOrigin' is
--- not a 'TypeEqOrigin', fall back on the actual mismatched types themselves.
-shouldPprWithExplicitKinds :: Type -> Type -> CtOrigin -> Bool
-shouldPprWithExplicitKinds _ty1 _ty2 (TypeEqOrigin { uo_actual = act
- , uo_expected = exp
- , uo_visible = vis })
- | not vis = True -- See tests T15870, T16204c
- | otherwise = tcEqTypeVis act exp -- See tests T9171, T9144.
-shouldPprWithExplicitKinds ty1 ty2 _ct
- = tcEqTypeVis ty1 ty2
{- Note [Insoluble mis-match]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2403,29 +2383,6 @@ results in
in the import of ‘Data.Monoid’
-}
-{-
-Note [Kind arguments in error messages]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-It can be terribly confusing to get an error message like (#9171)
-
- Couldn't match expected type ‘GetParam Base (GetParam Base Int)’
- with actual type ‘GetParam Base (GetParam Base Int)’
-
-The reason may be that the kinds don't match up. Typically you'll get
-more useful information, but not when it's as a result of ambiguity.
-
-To mitigate this, GHC attempts to enable the -fprint-explicit-kinds flag
-whenever any error message arises due to a kind mismatch. This means that
-the above error message would instead be displayed as:
-
- Couldn't match expected type
- ‘GetParam @* @k2 @* Base (GetParam @* @* @k2 Base Int)’
- with actual type
- ‘GetParam @* @k20 @* Base (GetParam @* @* @k20 Base Int)’
-
-Which makes it clearer that the culprit is the mismatch between `k2` and `k20`.
--}
-
-----------------------
-- relevantBindings looks at the value environment and finds values whose
-- types mention any of the offending type variables. It has to be
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -54,8 +54,8 @@ import GHC.Core.ConLike
import GHC.Core.FamInstEnv ( FamInst(..), famInstAxiom, pprFamInst )
import GHC.Core.InstEnv
import GHC.Core.TyCo.Rep (Type(..))
-import GHC.Core.TyCo.Ppr (pprWithExplicitKindsWhen,
- pprSourceTyCon, pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType)
+import GHC.Core.TyCo.Ppr (pprWithInvisibleBitsWhen, pprSourceTyCon,
+ pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType)
import GHC.Core.PatSyn ( patSynName, pprPatSynType )
import GHC.Core.Predicate
import GHC.Core.Type
@@ -536,7 +536,7 @@ instance Diagnostic TcRnMessage where
, text "cannot be inferred from the right-hand side." ]
in (injectivityErrorHerald $$ body $$ text "In the type family equation:", show_kinds)
- in mkSimpleDecorated $ pprWithExplicitKindsWhen show_kinds $
+ in mkSimpleDecorated $ pprWithInvisibleBitsWhen show_kinds $
hang herald
2 (vcat (map (pprCoAxBranchUser fam_tc) (eqn1 : rest_eqns)))
TcRnBangOnUnliftedType ty
@@ -1182,7 +1182,7 @@ instance Diagnostic TcRnMessage where
ppr con <+> dcolon <+> ppr (dataConDisplayType True con))
IsGADT ->
(text "A newtype must not be a GADT",
- ppr con <+> dcolon <+> pprWithExplicitKindsWhen sneaky_eq_spec
+ ppr con <+> dcolon <+> pprWithInvisibleBitsWhen sneaky_eq_spec
(ppr $ dataConDisplayType show_linear_types con))
HasConstructorContext ->
(text "A newtype constructor must not have a context in its type",
@@ -1432,7 +1432,7 @@ instance Diagnostic TcRnMessage where
, text "Perhaps enable PolyKinds or add a kind signature" ])
TcRnUninferrableTyVar tidied_tvs context ->
mkSimpleDecorated $
- pprWithExplicitKindsWhen True $
+ pprWithInvisibleBitsWhen True $
vcat [ text "Uninferrable type variable"
<> plural tidied_tvs
<+> pprWithCommas pprTyVar tidied_tvs
@@ -1440,7 +1440,7 @@ instance Diagnostic TcRnMessage where
, pprUninferrableTyVarCtx context ]
TcRnSkolemEscape escapees tv orig_ty ->
mkSimpleDecorated $
- pprWithExplicitKindsWhen True $
+ pprWithInvisibleBitsWhen True $
vcat [ sep [ text "Cannot generalise type; skolem" <> plural escapees
, quotes $ pprTyVars escapees
, text "would escape" <+> itsOrTheir escapees <+> text "scope"
@@ -1884,7 +1884,7 @@ instance Diagnostic TcRnMessage where
TcRnInvalidDefaultedTyVar wanteds proposal bad_tvs ->
mkSimpleDecorated $
- pprWithExplicitKindsWhen True $
+ pprWithInvisibleBitsWhen True $
vcat [ text "Invalid defaulting proposal."
, hang (text "The following type variable" <> plural (NE.toList bad_tvs) <+> text "cannot be defaulted, as" <+> why <> colon)
2 (pprQuotedList (NE.toList bad_tvs))
@@ -4146,17 +4146,18 @@ pprMismatchMsg _
| otherwise = text "kind" <+> quotes (ppr exp)
pprMismatchMsg ctxt
- (TypeEqMismatch { teq_mismatch_ppr_explicit_kinds = ppr_explicit_kinds
- , teq_mismatch_item = item
+ (TypeEqMismatch { teq_mismatch_item = item
, teq_mismatch_ty1 = ty1 -- These types are the actual types
, teq_mismatch_ty2 = ty2 -- that don't match; may be swapped
, teq_mismatch_expected = exp -- These are the context of
, teq_mismatch_actual = act -- the mis-match
, teq_mismatch_what = mb_thing
, teq_mb_same_occ = mb_same_occ })
- = addArising ct_loc $ pprWithExplicitKindsWhen ppr_explicit_kinds msg
- $$ maybe empty pprSameOccInfo mb_same_occ
+ = addArising ct_loc $
+ pprWithInvisibleBitsWhen ppr_invis_bits msg
+ $$ maybe empty pprSameOccInfo mb_same_occ
where
+
msg | Just (torc, rep) <- sORTKind_maybe exp
= msg_for_exp_sort torc rep
@@ -4219,6 +4220,7 @@ pprMismatchMsg ctxt
ct_loc = errorItemCtLoc item
orig = errorItemOrigin item
level = ctLocTypeOrKind_maybe ct_loc `orElse` TypeLevel
+ ppr_invis_bits = shouldPprWithInvisibleBits ty1 ty2 orig
num_args_msg = case level of
KindLevel
@@ -4310,6 +4312,60 @@ pprMismatchMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extra)
_ -> pprTheta wanteds
+-- | Whether to print explicit kinds (with @-fprint-explicit-kinds@)
+-- in an 'SDoc' when a type mismatch occurs to due invisible parts of the types.
+-- See Note [Showing invisible bits of types in error messages]
+--
+-- This function first checks to see if the 'CtOrigin' argument is a
+-- 'TypeEqOrigin'. If so, it first checks whether the equality is a visible
+-- equality; if it's not, definitely print the kinds. Even if the equality is
+-- a visible equality, check the expected/actual types to see if the types
+-- have equal visible components. If the 'CtOrigin' is
+-- not a 'TypeEqOrigin', fall back on the actual mismatched types themselves.
+shouldPprWithInvisibleBits :: Type -> Type -> CtOrigin -> Bool
+shouldPprWithInvisibleBits _ty1 _ty2 (TypeEqOrigin { uo_actual = act
+ , uo_expected = exp
+ , uo_visible = vis })
+ | not vis = True -- See tests T15870, T16204c
+ | otherwise = mayLookIdentical act exp -- See tests T9171, T9144.
+shouldPprWithInvisibleBits ty1 ty2 _ct
+ = mayLookIdentical ty1 ty2
+
+{- Note [Showing invisible bits of types in error messages]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It can be terribly confusing to get an error message like (#9171)
+
+ Couldn't match expected type ‘GetParam Base (GetParam Base Int)’
+ with actual type ‘GetParam Base (GetParam Base Int)’
+
+The reason may be that the kinds don't match up. Typically you'll get
+more useful information, but not when it's as a result of ambiguity.
+
+To mitigate this, when we find a type or kind mis-match:
+
+* See if normally-visible parts of the type would make the two types
+ look different. This check is made by
+ `GHC.Core.TyCo.Compare.mayLookIdentical`
+
+* If not, display the types with their normally-visible parts made visible,
+ by setting flags in the `SDocContext":
+ Specifically:
+ - Display kind arguments: sdocPrintExplicitKinds
+ - Don't default away runtime-reps: sdocPrintExplicitRuntimeReps,
+ which controls `GHC.Iface.Type.hideNonStandardTypes`
+ (NB: foralls are always printed by pprType, it turns out.)
+
+As a result the above error message would instead be displayed as:
+
+ Couldn't match expected type
+ ‘GetParam @* @k2 @* Base (GetParam @* @* @k2 Base Int)’
+ with actual type
+ ‘GetParam @* @k20 @* Base (GetParam @* @* @k20 Base Int)’
+
+Which makes it clearer that the culprit is the mismatch between `k2` and `k20`.
+
+Another example of what goes wrong without this: #24553.
+-}
{- *********************************************************************
* *
@@ -6033,7 +6089,7 @@ pprIllegalInstance = \case
IllegalFamilyInstance reason ->
pprIllegalFamilyInstance reason
IllegalFamilyApplicationInInstance inst_ty invis_arg tf_tc tf_args ->
- pprWithExplicitKindsWhen invis_arg $
+ pprWithInvisibleBitsWhen invis_arg $
hang (text "Illegal type synonym family application"
<+> quotes (ppr tf_ty) <+> text "in instance" <> colon)
2 (ppr inst_ty)
@@ -6116,7 +6172,7 @@ pprNotCovered clas
, not_covered_invis_vis_tvs = undetermined_tvs
, not_covered_liberal = which_cc_failed
} =
- pprWithExplicitKindsWhen (isEmptyVarSet $ pSnd undetermined_tvs) $
+ pprWithInvisibleBitsWhen (isEmptyVarSet $ pSnd undetermined_tvs) $
vcat [ sep [ text "The"
<+> ppWhen liberal (text "liberal")
<+> text "coverage condition fails in class"
@@ -6378,7 +6434,7 @@ pprInvalidAssocInstance = \case
, text "mentions none of the type or kind variables of the class" <+>
quotes (ppr cls <+> hsep (map ppr (classTyVars cls)))]
AssocTyVarsDontMatch vis fam_tc exp_tys act_tys ->
- pprWithExplicitKindsWhen (isInvisibleForAllTyFlag vis) $
+ pprWithInvisibleBitsWhen (isInvisibleForAllTyFlag vis) $
vcat [ text "Type indexes must match class instance head"
, text "Expected:" <+> pp exp_tys
, text " Actual:" <+> pp act_tys ]
@@ -6402,7 +6458,7 @@ pprInvalidAssocDefault = \case
let (pat_tv, pat_vis) = NE.head dups
in (pat_vis,
text "Illegal duplicate variable" <+> quotes (ppr pat_tv) <+> text "in:")
- in pprWithExplicitKindsWhen (isInvisibleForAllTyFlag pat_vis) $
+ in pprWithInvisibleBitsWhen (isInvisibleForAllTyFlag pat_vis) $
hang main_msg
2 (vcat [ppr_eqn, suggestion])
where
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -5508,8 +5508,7 @@ data MismatchMsg
--
-- Test cases: T1470, tcfail212.
| TypeEqMismatch
- { teq_mismatch_ppr_explicit_kinds :: Bool
- , teq_mismatch_item :: ErrorItem
+ { teq_mismatch_item :: ErrorItem
, teq_mismatch_ty1 :: Type
, teq_mismatch_ty2 :: Type
, teq_mismatch_expected :: Type -- ^ The overall expected type
=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -212,7 +212,7 @@ mk_failable_expr doFlav pat@(L loc _) expr fail_op =
mk_fail_block :: HsDoFlavour -> LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (HsExpr GhcRn)
mk_fail_block doFlav pat@(L ploc _) e (Just (SyntaxExprRn fail_op)) =
do dflags <- getDynFlags
- return $ HsLam noAnn LamSingle $ mkMatchGroup (doExpansionOrigin doFlav) -- \
+ return $ HsLam noAnn LamCases $ mkMatchGroup (doExpansionOrigin doFlav) -- \
(wrapGenSpan [ genHsCaseAltDoExp doFlav (mkVisPat pat) e -- pat -> expr
, fail_alt_case dflags pat fail_op -- _ -> fail "fail pattern"
])
@@ -356,25 +356,42 @@ The `fail`-block wrapping is done by `GHC.Tc.Gen.Do.mk_failable_expr`.
of do-notation is that if the pattern match fails, we fail in the monad, *not* just crash
at runtime.
-* That call of `fail` will (rightly) automatically generate a `MonadFail` constraint. So if the
- pattern is irrefuable, we don't want to generate that `fail` alternative, else we'll generate
- a `MonadFail` constraint that isn't needed.
+* According to the language specification, when the pattern is irrefutable,
+ we should not add the `fail` alternative. This is important because
+ the occurrence of `fail` means that the typechecker will generate a `MonadFail` constraint,
+ and irrefutable patterns shouldn't need a fail alternative.
-* _Wrinkle 1_: For pattern synonyms, we always wrap it with a `fail`-block.
- When the pattern is irrefutable, we do not add the fail block.
- This is important because the occurrence of `fail` means that the typechecker
- will generate a `MonadFail` constraint, and the language spec says that
- we should not do that for irrefutable patterns.
+* _Wrinkel 1_: Note that pattern synonyms count as refutable during type checking,
+ (see `GHC.Tc.Gen.Pat.isIrrefutableHsPatRnTcM`). They will hence generate a
+ `MonadFail` constraint and they will always be wrapped in a `fail`able-block.
- Note that pattern synonyms count as refutable (see `isIrrefutableHsPat`), and hence will generate
- a `MonadFail` constraint, also, we would get a pattern match checker's redundant pattern warnings.
- because after desugaring, it is marked as irrefutable! To avoid such
- spurious warnings and type checker errors, we filter out those patterns that appear
- in a do expansion generated match in `HsToCore.Match.matchWrapper`. (see testcase Typeable1.hs)
+ Consider a patten synonym declaration (testcase T24552):
+
+ pattern MyJust :: a -> Maybe a
+ pattern MyJust x <- Just x where MyJust = Just
+
+ and a `do`-block with the following bind and return statement
+
+ do { MyJust x <- [MyNothing, MyJust ()]
+ ; return x }
+
+ The `do`-expansion will generate the expansion
+
+ (>>=) ([MyNothing, MyJust ()])
+ (\case MyJust x -> return x -- (1)
+ _ -> fail "failable pattern .. " -- (2)
+ )
+
+ This code (specifically the `match` spanning lines (1) and (2)) is a compiler generated code;
+ the associated `Origin` in tagged `Generated`
+ The alternative statements will thus be ignored by the pattern match check (c.f. `isMatchContextPmChecked`).
+ This ensures we do not generate spurious redundant-pattern-match warnings due to the line (2) above.
+ See Note [Generated code and pattern-match checking]
+ See Note [Long-distance information in matchWrapper]
* _Wrinkle 2_: The call to `fail` will give rise to a `MonadFail` constraint. What `CtOrigin` do we
- attach to that constraint? It should be a good one, because it'll show up in error
- messages when the `MonadFail` constraint can't be solved. Ideally, it should identify the
+ attach to that constraint? When the `MonadFail` constraint can't be solved, it'll show up in error
+ messages and it needs to be a good location. Ideally, it should identify the
pattern `p`. Hence, we wrap the `fail` alternative expression with a `ExpandedPat`
that tags the fail expression with the failable pattern. (See testcase MonadFailErrors.hs)
=====================================
compiler/GHC/Tc/Solver/Equality.hs
=====================================
@@ -311,7 +311,7 @@ can_eq_nc
-> Type -> Type -- RHS, after and before type-synonym expansion, resp
-> TcS (StopOrContinue (Either IrredCt EqCt))
--- See Note [Comparing nullary type synonyms] in GHC.Core.Type.
+-- See Note [Comparing nullary type synonyms] in GHC.Core.TyCo.Compare
can_eq_nc _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2
| tc1 == tc2
= canEqReflexive ev eq_rel ty1
=====================================
compiler/GHC/Tc/Utils/TcType.hs
=====================================
@@ -95,7 +95,7 @@ module GHC.Tc.Utils.TcType (
-- Re-exported from GHC.Core.TyCo.Compare
-- mainly just for back-compat reasons
eqType, eqTypes, nonDetCmpType, nonDetCmpTypes, eqTypeX,
- pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck, tcEqTypeVis,
+ pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck, mayLookIdentical,
tcEqTyConApps, eqForAllVis, eqVarBndrs,
---------------------------------
@@ -888,7 +888,8 @@ tcTyFamInsts = map (\(_,b,c) -> (b,c)) . tcTyFamInstsAndVis
-- to @C@, whereas @F Bool@ is paired with 'False' since it appears an a
-- /visible/ argument to @C at .
--
--- See also @Note [Kind arguments in error messages]@ in "GHC.Tc.Errors".
+-- See also Note [Showing invisible bits of types in error messages]
+-- in "GHC.Tc.Errors.Ppr".
tcTyFamInstsAndVis :: Type -> [(Bool, TyCon, [Type])]
tcTyFamInstsAndVis = tcTyFamInstsAndVisX False
=====================================
docs/users_guide/hints.rst
=====================================
@@ -273,22 +273,6 @@ Use ``foreign import`` (a GHC extension) to plug into fast libraries:
:ref:`ffi` describes the foreign function interface.
-Don't use ``Float``\s:
- If you're using ``Complex``, definitely use ``Complex Double``
- rather than ``Complex Float`` (the former is specialised heavily,
- but the latter isn't).
-
- ``Floats`` (probably 32-bits) are almost always a bad idea, anyway,
- unless you Really Know What You Are Doing. Use ``Double``\s.
- There's rarely a speed disadvantage—modern machines will use the
- same floating-point unit for both. With ``Double``\s, you are much
- less likely to hang yourself with numerical errors.
-
- One time when ``Float`` might be a good idea is if you have a *lot*
- of them, say a giant array of ``Float``\s. They take up half the
- space in the heap compared to ``Doubles``. However, this isn't true
- on a 64-bit machine.
-
Use unboxed arrays (``UArray``)
GHC supports arrays of unboxed elements, for several basic
arithmetic element types including ``Int`` and ``Char``: see the
=====================================
libraries/base/changelog.md
=====================================
@@ -1,5 +1,8 @@
# Changelog for [`base` package](http://hackage.haskell.org/package/base)
+## 4.21.0.0 *TBA*
+ * Improve `toInteger :: Word32 -> Integer` on 64-bit platforms ([CLC proposal #259](https://github.com/haskell/core-libraries-committee/issues/259))
+
## 4.20.0.0 *TBA*
* Export `foldl'` from `Prelude` ([CLC proposal #167](https://github.com/haskell/core-libraries-committee/issues/167))
* The top-level handler for uncaught exceptions now displays the output of `displayException` rather than `show` ([CLC proposal #198](https://github.com/haskell/core-libraries-committee/issues/198))
=====================================
libraries/ghc-internal/src/GHC/Internal/Word.hs
=====================================
@@ -592,7 +592,13 @@ instance Integral Word32 where
mod x y = rem x y
divMod x y = quotRem x y
- toInteger (W32# x#) = integerFromWord# (word32ToWord# x#)
+ toInteger (W32# x#) =
+#if WORD_SIZE_IN_BITS > 32
+ -- In this case the conversion to Int# cannot overflow.
+ IS (word2Int# (word32ToWord# x#))
+#else
+ integerFromWord# (word32ToWord# x#)
+#endif
-- | @since base-2.01
instance Bits Word32 where
=====================================
testsuite/tests/patsyn/should_run/T24552.hs
=====================================
@@ -0,0 +1,14 @@
+{-# language PatternSynonyms #-}
+
+module Main where
+
+import Prelude
+import qualified Prelude as P
+
+pattern MyNothing :: Maybe a
+pattern MyNothing <- Nothing where MyNothing = Nothing
+
+pattern MyJust :: a -> Maybe a
+pattern MyJust x <- Just x where MyJust = Just
+
+main = print $ do MyJust x <- [MyNothing, MyJust ()] ; return x
=====================================
testsuite/tests/patsyn/should_run/T24552.stdout
=====================================
@@ -0,0 +1 @@
+[()]
=====================================
testsuite/tests/patsyn/should_run/all.T
=====================================
@@ -17,3 +17,4 @@ test('T11224', normal, compile_and_run, ['-Wincomplete-patterns -Woverlapping-pa
test('T13688', req_th, multimod_compile_and_run, ['T13688', '-v0'])
test('T14228', normal, compile_and_run, [''])
test('records-poly-update', normal, compile_and_run, [''])
+test('T24552', normal, compile_and_run, [''])
\ No newline at end of file
=====================================
testsuite/tests/typecheck/should_fail/T24553.hs
=====================================
@@ -0,0 +1,8 @@
+module T24553 where
+
+import GHC.Exts
+
+type Foo :: * -> forall r. TYPE r -> *
+newtype Foo m a = MkFoo ()
+
+type Bar = Foo :: forall r. * -> TYPE r -> *
=====================================
testsuite/tests/typecheck/should_fail/T24553.stderr
=====================================
@@ -0,0 +1,6 @@
+
+T24553.hs:8:12: error: [GHC-83865]
+ • Expected kind ‘forall (r :: RuntimeRep). * -> TYPE r -> *’,
+ but ‘Foo’ has kind ‘* -> forall (r :: RuntimeRep). TYPE r -> *’
+ • In the type ‘Foo :: forall r. * -> TYPE r -> *’
+ In the type declaration for ‘Bar’
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -724,3 +724,5 @@ test('T17594d', normal, compile_fail, [''])
test('T17594g', normal, compile_fail, [''])
test('T24470a', normal, compile_fail, [''])
+test('T24553', normal, compile_fail, [''])
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3acfad971a52062ee289fa8238f334045ad83ee9...08876875de854728a2146f8bc582ba5a0dc2abf6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3acfad971a52062ee289fa8238f334045ad83ee9...08876875de854728a2146f8bc582ba5a0dc2abf6
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/20240322/a5a8ff3a/attachment-0001.html>
More information about the ghc-commits
mailing list