GitLab

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:

@@ -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.)
 . 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