[Git][ghc/ghc][wip/T24676] Two small bu tsignificant changes to try:
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Fri Jun 7 16:32:10 UTC 2024
Simon Peyton Jones pushed to branch wip/T24676 at Glasgow Haskell Compiler / GHC
Commits:
499a71b2 by Simon Peyton Jones at 2024-06-07T17:30:21+01:00
Two small bu tsignificant changes to try:
* Use simpleUnifyCheck in qlUnify rather than duplicating it.
* Allow qlUnify to unify regular unification variables, if it
finds an opportunity to do so.
- - - - -
3 changed files:
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Utils/Unify.hs
Changes:
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -1897,7 +1897,8 @@ qlUnify ty1 ty2
-- The TyVarSets give the variables bound by enclosing foralls
-- for the corresponding type. Don't unify with these.
go (TyVarTy tv) ty2
- | isQLInstTyVar tv = go_kappa tv ty2
+-- | isQLInstTyVar tv = go_kappa tv ty2
+ | isMetaTyVar tv = go_kappa tv ty2
-- Only unify QL instantiation variables
-- See (UQL3) in Note [QuickLook unification]
go ty1 (TyVarTy tv)
@@ -1961,17 +1962,15 @@ qlUnify ty1 ty2
-- otherwise we'll fail to unify and emit a coercion.
-- Just an optimisation: emitting a coercion is fine
go_flexi kappa (TyVarTy tv2)
- | isQLInstTyVar tv2, lhsPriority tv2 > lhsPriority kappa
+-- | isQLInstTyVar tv2, lhsPriority tv2 > lhsPriority kappa
+ | lhsPriority tv2 > lhsPriority kappa
= go_flexi1 tv2 (TyVarTy kappa)
go_flexi kappa ty2
= go_flexi1 kappa ty2
go_flexi1 kappa ty2 -- ty2 is zonked
| -- See Note [QuickLook unification] (UQL1)
- Just ty2 <- occCheckExpand [kappa] ty2
- -- Passes the occurs check
- , not (isConcreteTyVar kappa) || isConcreteType ty2
- -- Don't unify a concrete instantiation variable with a non-concrete type
+ simpleUnifyCheck UC_QuickLook kappa ty2
= do { co <- unifyKind (Just (TypeThing ty2)) ty2_kind kappa_kind
-- unifyKind: see (UQL2) in Note [QuickLook unification]
; let ty2' = mkCastTy ty2 co
@@ -2020,7 +2019,7 @@ That is the entire point of qlUnify! Wrinkles:
(UQL3) qlUnify (and Quick Look generally) is only unifies instantiation
variables, not regular unification variables. Why? Nothing fundamental.
- We would need to
+ ToDo: unfinished
Because instantiation variables don't really have a settled level yet;
they have level QLInstVar (see Note [The QLInstVar TcLevel] in GHC.Tc.Utils.TcType.
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -2087,8 +2087,7 @@ checkTouchableTyVarEq
-- with extra wanteds 'cts'
-- If it returns (PuFail reason) we can't unify, and the reason explains why.
checkTouchableTyVarEq ev lhs_tv rhs
- | simpleUnifyCheck True lhs_tv rhs
- -- True <=> type families are ok on the RHS
+ | simpleUnifyCheck UC_Solver lhs_tv rhs
= do { traceTcS "checkTouchableTyVarEq: simple-check wins" (ppr lhs_tv $$ ppr rhs)
; return (pure (mkReflRedn Nominal rhs)) }
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -42,7 +42,8 @@ module GHC.Tc.Utils.Unify (
checkTyEqRhs, recurseIntoTyConApp,
PuResult(..), failCheckWith, okCheckRefl, mapCheck,
TyEqFlags(..), TyEqFamApp(..), AreUnifying(..), LevelCheck(..), FamAppBreaker,
- famAppArgFlags, simpleUnifyCheck, checkPromoteFreeVars,
+ famAppArgFlags, checkPromoteFreeVars,
+ simpleUnifyCheck, UnifyCheckCaller(..),
fillInferResult,
) where
@@ -2449,7 +2450,7 @@ uUnfilledVar2 env@(UE { u_defer = def_eq_ref }) swapped tv1 ty2
-- Here we don't know about given equalities here; so we treat
-- /any/ level outside this one as untouchable. Hence cur_lvl.
; if not (touchabilityAndShapeTest cur_lvl tv1 ty2
- && simpleUnifyCheck False tv1 ty2)
+ && simpleUnifyCheck UC_OnTheFly tv1 ty2)
then not_ok_so_defer cur_lvl
else
do { def_eqs <- readTcRef def_eq_ref -- Capture current state of def_eqs
@@ -2487,7 +2488,7 @@ uUnfilledVar2 env@(UE { u_defer = def_eq_ref }) swapped tv1 ty2
do { traceTc "uUnfilledVar2 not ok" $
vcat [ text "tv1:" <+> ppr tv1
, text "ty2:" <+> ppr ty2
- , text "simple-unify-chk:" <+> ppr (simpleUnifyCheck False tv1 ty2)
+ , text "simple-unify-chk:" <+> ppr (simpleUnifyCheck UC_OnTheFly tv1 ty2)
, text "touchability:" <+> ppr (touchabilityAndShapeTest cur_lvl tv1 ty2)]
-- Occurs check or an untouchable: just defer
-- NB: occurs check isn't necessarily fatal:
@@ -2876,10 +2877,13 @@ matchExpectedFunKind hs_ty n k = go n k
* *
********************************************************************* -}
-simpleUnifyCheck :: Bool -- True <=> called from constraint solver
- -- False <=> called from on-the-fly unifier
- -> TcTyVar -> TcType -> Bool
--- A fast check: True <=> unification is OK
+data UnifyCheckCaller
+ = UC_OnTheFly -- Called from the on-the-fly unifier
+ | UC_QuickLook -- Called from Quick Look
+ | UC_Solver -- Called from constraint solver
+
+simpleUnifyCheck :: UnifyCheckCaller -> TcTyVar -> TcType -> Bool
+-- simpleUnifyCheck does a fast check: True <=> unification is OK
-- If it says 'False' then unification might still be OK, but
-- it'll take more work to do -- use the full checkTypeEq
--
@@ -2891,7 +2895,7 @@ simpleUnifyCheck :: Bool -- True <=> called from constraint solver
-- * Does a level-check for type variables
--
-- This function is pretty heavily used, so it's optimised not to allocate
-simpleUnifyCheck called_from_solver lhs_tv rhs
+simpleUnifyCheck caller lhs_tv rhs
= go rhs
where
@@ -2899,8 +2903,15 @@ simpleUnifyCheck called_from_solver lhs_tv rhs
lhs_tv_lvl = tcTyVarLevel lhs_tv
lhs_tv_is_concrete = isConcreteTyVar lhs_tv
- forall_ok = isRuntimeUnkTyVar lhs_tv
- fam_ok = called_from_solver
+
+ forall_ok = case caller of
+ UC_QuickLook -> isQLInstTyVar lhs_tv
+ _ -> isRuntimeUnkTyVar lhs_tv
+
+ fam_ok = case caller of
+ UC_Solver -> True
+ UC_QuickLook -> False
+ UC_OnTheFly -> False
go (TyVarTy tv)
| lhs_tv == tv = False
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/499a71b2f9db6b2c1c43b0b0c91aaa1364bf0196
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/499a71b2f9db6b2c1c43b0b0c91aaa1364bf0196
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/20240607/fb878bcf/attachment-0001.html>
More information about the ghc-commits
mailing list