Simon Peyton Jones pushed to branch wip/T23162-part2 at Glasgow Haskell Compiler / GHC Commits: dd4dc342 by Simon Peyton Jones at 2025-11-19T00:26:12+00:00 Wibbles Fix to niFixSubst - - - - - 2 changed files: - compiler/GHC/Core/Unify.hs - compiler/GHC/Tc/Solver/FunDeps.hs Changes: ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -844,9 +844,10 @@ tcUnifyTysForInjectivity unif tys1 tys2 -- in-scope set is never looked at, so this free-var stuff -- should never actually be done - maybe_fix | unif = niFixSubst in_scope - | otherwise = mkTvSubst in_scope -- when matching, don't confuse - -- domain with range + maybe_fix tv_subst + | unif = niFixSubst in_scope tv_subst + | otherwise = mkTvSubst in_scope tv_subst + -- When matching, don't confuse domain with range; no fixpoint! ----------------- tcUnifyTys :: BindTvFun @@ -1125,10 +1126,10 @@ So, we work as follows: , rest :-> rest :: G b (z :: b) ] Note that rest now has the right kind - 7. Apply this extended substitution (once) to the range of - the /original/ substitution. (Note that we do the - extended substitution would go on forever if you tried - to find its fixpoint, because it maps z to z.) + 7. Apply this extended substitution (once) to the range of the + /original/ substitution. (Note that the extended substitution + would go on forever if you tried to find its fixpoint, because it + maps z to z.) 8. And go back to step 1 @@ -1147,8 +1148,10 @@ niFixSubst :: InScopeSet -> TvSubstEnv -> Subst -- ToDo: use laziness instead of iteration? niFixSubst in_scope tenv | not_fixpoint = niFixSubst in_scope (mapVarEnv (substTy subst) tenv) - | otherwise = subst + | otherwise = tenv_subst where + tenv_subst = mkTvSubst in_scope tenv -- This is our starting point + range_fvs :: FV range_fvs = tyCoFVsOfTypes (nonDetEltsUFM tenv) -- It's OK to use nonDetEltsUFM here because the @@ -1163,9 +1166,7 @@ niFixSubst in_scope tenv free_tvs = scopedSort (filterOut in_domain range_tvs) -- See Note [Finding the substitution fixpoint], Step 6 - subst = foldl' add_free_tv - (mkTvSubst in_scope tenv) - free_tvs + subst = foldl' add_free_tv tenv_subst free_tvs add_free_tv :: Subst -> TyVar -> Subst add_free_tv subst tv ===================================== compiler/GHC/Tc/Solver/FunDeps.hs ===================================== @@ -592,13 +592,12 @@ getRelevantBranches ax work_args work_rhs Nothing -> go (branch:preceding) branches where is_relevant (CoAxBranch { cab_tvs = qtvs, cab_lhs = lhs_tys, cab_rhs = rhs_ty }) - | Just subst <- tcUnifyTysForInjectivity True work_tys (rhs_ty:lhs_tys) + | Just subst <- tcUnifyTysForInjectivity True (rhs_ty:lhs_tys) work_tys , let (subst', qtvs') = trim_qtvs subst qtvs lhs_tys' = substTys subst' lhs_tys rhs_ty' = substTy subst' rhs_ty , all (no_match lhs_tys') preceding - = pprTrace "grb" (ppr qtvs $$ ppr subst $$ ppr qtvs' $$ ppr subst' $$ ppr lhs_tys $$ ppr lhs_tys') $ - Just (FDEqns { fd_qtvs = qtvs' + = Just (FDEqns { fd_qtvs = qtvs' , fd_eqs = zipWith Pair (rhs_ty':lhs_tys') work_tys }) | otherwise = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd4dc342d7dcc697d7c438250aeba137... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd4dc342d7dcc697d7c438250aeba137... You're receiving this email because of your account on gitlab.haskell.org.