[Git][ghc/ghc][wip/cfuneqcan-refactor] Tiny little changes

[Richard Eisenberg]

Richard Eisenberg pushed to branch wip/cfuneqcan-refactor at Glasgow Haskell Compiler / GHC


Commits:
7a92bf45 by Richard Eisenberg at 2020-10-15T17:23:04-04:00
Tiny little changes

- - - - -


3 changed files:

- compiler/GHC/Core/Type.hs
- compiler/GHC/Tc/Solver/Canonical.hs
- compiler/GHC/Tc/Solver/Interact.hs


Changes:

=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -1974,7 +1974,8 @@ buildSynTyCon name binders res_kind roles rhs
   where
     is_tau       = isTauTy rhs
     is_fam_free  = isFamFreeTy rhs
-    is_forgetful = any (not . (`elemVarSet` tyCoVarsOfType rhs) . binderVar) binders
+    is_forgetful = any (not . (`elemVarSet` tyCoVarsOfType rhs) . binderVar) binders ||
+                   uniqSetAny isForgetfulSynTyCon (tyConsOfType rhs)
 
 {-
 ************************************************************************


=====================================
compiler/GHC/Tc/Solver/Canonical.hs
=====================================
@@ -2216,10 +2216,14 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco
                             | (arg1, arg2, True) <- zip3 fun_args1 fun_args2 inj ]
             | otherwise -> return ()
 
-       ; let tvs2 = tyCoVarsOfTypes fun_args2
+       ; let tvs1 = tyCoVarsOfTypes fun_args1
+             tvs2 = tyCoVarsOfTypes fun_args2
        ; tclvl <- getTcLevel
-       ; if anyVarSet (isTouchableMetaTyVar tclvl) tvs2
+       ; if anyVarSet (isTouchableMetaTyVar tclvl) tvs2 &&
             -- swap 'em: Note [Put touchable variables on the left]
+            not (anyVarSet (isTouchableMetaTyVar tclvl) tvs1)
+              -- this check is just to avoid unfruitful swapping
+
          then do { new_ev <- do_swap
                  ; canEqCanLHSFinish new_ev eq_rel IsSwapped lhs2 (ps_xi1 `mkCastTyMCo` sym_mco) }
          else finish_without_swapping }


=====================================
compiler/GHC/Tc/Solver/Interact.hs
=====================================
@@ -2439,7 +2439,7 @@ matchClassInst dflags inerts clas tys loc
 -- First check whether there is an in-scope Given that could
 -- match this constraint.  In that case, do not use any instance
 -- whether top level, or local quantified constraints.
--- ee Note [Instance and Given overlap]
+-- See Note [Instance and Given overlap]
   | not (xopt LangExt.IncoherentInstances dflags)
   , not (naturallyCoherentClass clas)
   , let matchable_givens = matchableGivens loc pred inerts



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a92bf457b225c58f3396cd950e75f42915ddb27

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a92bf457b225c58f3396cd950e75f42915ddb27
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/20201015/b5666062/attachment-0001.html>