Simon Peyton Jones pushed to branch wip/T26003 at Glasgow Haskell Compiler / GHC Commits: cdcced46 by Simon Peyton Jones at 2025-05-08T12:40:30+01:00 Wibbles - - - - - 8 changed files: - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Types/Error/Codes.hs Changes: ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -14,7 +14,7 @@ module GHC.Core.Predicate ( EqRel(..), eqRelRole, isEqPred, isReprEqPred, isEqClassPred, isCoVarType, getEqPredTys, getEqPredTys_maybe, getEqPredRole, - predTypeEqRel, + predTypeEqRel, pprPredType, mkNomEqPred, mkReprEqPred, mkEqPred, mkEqPredRole, -- Class predicates @@ -50,6 +50,7 @@ import GHC.Core.TyCo.Compare( tcEqTyConApps ) import GHC.Core.TyCo.FVs( tyCoVarsOfTypeList, tyCoVarsOfTypesList ) import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk +import GHC.Types.Name( getOccName ) import GHC.Types.Var import GHC.Types.Var.Set import GHC.Core.Multiplicity ( scaledThing ) @@ -246,6 +247,16 @@ predTypeEqRel ty | isReprEqPred ty = ReprEq | otherwise = NomEq +pprPredType :: PredType -> SDoc +-- Special case for (t1 ~# t2) and (t1 ~R# t2) +pprPredType pred + = case classifyPredType pred of + EqPred eq_rel t1 t2 -> sep [ ppr t1, ppr (getOccName eq_tc) <+> ppr t2 ] + where + eq_tc = case eq_rel of + NomEq -> eqPrimTyCon + ReprEq -> eqReprPrimTyCon + _ -> ppr pred {- ********************************************************************* * * ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1741,12 +1741,12 @@ mkEqErr_help :: SolverReportErrCtxt -> ErrorItem -> TcType -> TcType -> TcM TcSolverReportMsg mkEqErr_help ctxt item ty1 ty2 - | Just casted_tv1 <- getCastedTyVar_maybe ty1 - = mkTyVarEqErr ctxt item casted_tv1 ty2 + | Just (tv1, _co) <- getCastedTyVar_maybe ty1 + = mkTyVarEqErr ctxt item tv1 ty2 -- ToDo: explain.. Cf T2627b Dual (Dual a) ~ a - | Just casted_tv2 <- getCastedTyVar_maybe ty2 - = mkTyVarEqErr ctxt item casted_tv2 ty1 + | Just (tv2, _co) <- getCastedTyVar_maybe ty2 + = mkTyVarEqErr ctxt item tv2 ty1 | otherwise = reportEqErr ctxt item ty1 ty2 @@ -1779,16 +1779,15 @@ coercible_msg ty1 ty2 return $ mkCoercibleExplanation rdr_env fam_envs ty1 ty2 mkTyVarEqErr :: SolverReportErrCtxt -> ErrorItem - -> (TcTyVar, TcCoercionN) -> TcType -> TcM TcSolverReportMsg + -> TcTyVar -> TcType -> TcM TcSolverReportMsg -- tv1 and ty2 are already tidied -mkTyVarEqErr ctxt item casted_tv1 ty2 - = do { traceTc "mkTyVarEqErr" (ppr item $$ ppr casted_tv1 $$ ppr ty2) - ; mkTyVarEqErr' ctxt item casted_tv1 ty2 } +mkTyVarEqErr ctxt item tv1 ty2 + = do { traceTc "mkTyVarEqErr" (ppr item $$ ppr tv1 $$ ppr ty2) + ; mkTyVarEqErr' ctxt item tv1 ty2 } mkTyVarEqErr' :: SolverReportErrCtxt -> ErrorItem - -> (TcTyVar, TcCoercionN) -> TcType -> TcM TcSolverReportMsg -mkTyVarEqErr' ctxt item (tv1, _co1) ty2 - -- ToDo: eliminate _co1??? + -> TcTyVar -> TcType -> TcM TcSolverReportMsg +mkTyVarEqErr' ctxt item tv1 ty2 -- Is this a representation-polymorphism error, e.g. -- alpha[conc] ~# rr[sk] ? If so, handle that first. @@ -2003,16 +2002,6 @@ misMatchOrCND ctxt item ty1 ty2 -- Keep only UserGivens that have some equalities. -- See Note [Suppress redundant givens during error reporting] -{- --- These are for the "blocked" equalities, as described in GHC.Tc.Solver.Equality --- Note [Equalities with incompatible kinds], wrinkle (EIK2). There should --- always be another unsolved wanted around, which will ordinarily suppress --- this message. But this can still be printed out with -fdefer-type-errors --- (sigh), so we must produce a message. -mkBlockedEqErr :: ErrorItem -> TcSolverReportMsg -mkBlockedEqErr item = BlockedEquality item --} - {- Note [Suppress redundant givens during error reporting] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -4060,10 +4060,6 @@ pprTcSolverReportMsg _ (FixedRuntimeRepError frr_origs) = = quotes (text "Levity") | otherwise = text "type" -pprTcSolverReportMsg _ (BlockedEquality item) = - vcat [ hang (text "Cannot use equality for substitution:") - 2 (ppr (errorItemPred item)) - , text "Doing so would be ill-kinded." ] pprTcSolverReportMsg _ (ExpectingMoreArguments n thing) = text "Expecting" <+> speakN (abs n) <+> more <+> quotes (ppr thing) @@ -5071,8 +5067,6 @@ tcSolverReportMsgHints ctxt = \case -> mismatchMsgHints ctxt mismatch_msg FixedRuntimeRepError {} -> noHints - BlockedEquality {} - -> noHints ExpectingMoreArguments {} -> noHints UnboundImplicitParams {} @@ -7465,4 +7459,4 @@ pprErrCtxtMsg = \case -------------------------------------------------------------------------------- pprThBindLevel :: Set.Set ThLevelIndex -> SDoc -pprThBindLevel levels_set = text "level" <> pluralSet levels_set <+> pprUnquotedSet levels_set \ No newline at end of file +pprThBindLevel levels_set = text "level" <> pluralSet levels_set <+> pprUnquotedSet levels_set ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -5583,17 +5583,6 @@ data TcSolverReportMsg -- See 'FixedRuntimeRepErrorInfo' and 'FixedRuntimeRepContext' for more information. | FixedRuntimeRepError [FixedRuntimeRepErrorInfo] - -- | An equality between two types is blocked on a kind equality - -- between their kinds. - -- - -- Test cases: none. - | BlockedEquality ErrorItem - -- These are for the "blocked" equalities, as described in - -- Note [Equalities with incompatible kinds] in GHC.Tc.Solver.Equality, - -- wrinkle (EIK2). There should always be another unsolved wanted around, - -- which will ordinarily suppress this message. But this can still be printed out - -- with -fdefer-type-errors (sigh), so we must produce a message. - -- | Something was not applied to sufficiently many arguments. -- -- Example: ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1328,6 +1328,7 @@ canDecomposableTyConAppOK ev eq_rel tc (ty1,tys1) (ty2,tys2) -- guaranteed that cos has the same length as tys1 and tys2 -- See Note [Fast path when decomposing TyConApps] -> do { (co, _, _) <- wrapUnifierTcS ev role $ \uenv -> +-- do { cos <- zipWith4M (u_arg uenv) new_locs tc_roles (reverse tys1) (reverse tys2) do { cos <- zipWith4M (u_arg uenv) new_locs tc_roles tys1 tys2 -- zipWith4M: see Note [Work-list ordering] -- in GHC.Tc.Solved.Equality @@ -2094,7 +2095,7 @@ Wrinkles: the kind of the parent type-equality. See the calls to `mkKindEqLoc` in `canEqCanLHSHetero`. - * We /also/ these unsolved kind equalities to the `RewriterSet` of the + * We /also/ add these unsolved kind equalities to the `RewriterSet` of the parent constraint; see `do_rewrite` in `canEqCanLHSHetero`. * When filling a coercion hole we kick out any equality constraints whose ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -2314,9 +2314,9 @@ instance Outputable WantedCtEvidence where instance Outputable CtEvidence where ppr ev = ppr (ctEvFlavour ev) - <+> pp_ev <+> braces (ppr (ctl_depth (ctEvLoc ev)) <> pp_rewriters) + <+> hang (pp_ev <+> braces (ppr (ctl_depth (ctEvLoc ev)) <> pp_rewriters)) -- Show the sub-goal depth too - <> dcolon <+> ppr (ctEvPred ev) + 2 (dcolon <+> pprPredType (ctEvPred ev)) where pp_ev = case ev of CtGiven ev -> ppr (ctev_evar ev) ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -3578,11 +3578,6 @@ But there are several cases we need to be wary of: (2) We must still make sure that no variable in a coercion is at too high a level. But, when unifying, we can promote any variables we encounter. -{- Don't do this -(3) We do not unify variables with a type with a free coercion hole. - See (COERCION-HOLE) in Note [Unification preconditions]. --} - Note [Promotion and level-checking] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ "Promotion" happens when we have this: ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -411,7 +411,6 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "UnsatisfiableError" = 22250 GhcDiagnosticCode "ReportHoleError" = 88464 GhcDiagnosticCode "FixedRuntimeRepError" = 55287 - GhcDiagnosticCode "BlockedEquality" = 06200 GhcDiagnosticCode "ExpectingMoreArguments" = 81325 GhcDiagnosticCode "UnboundImplicitParams" = 91416 GhcDiagnosticCode "AmbiguityPreventsSolvingCt" = 78125 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cdcced46c4af29510537707a190f6bc3... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cdcced46c4af29510537707a190f6bc3... You're receiving this email because of your account on gitlab.haskell.org.