[Git][ghc/ghc][wip/T25647] cleanup NoDefTauTv
Patrick (@soulomoon)
gitlab at gitlab.haskell.org
Mon Feb 24 21:52:13 UTC 2025
Patrick pushed to branch wip/T25647 at Glasgow Haskell Compiler / GHC
Commits:
9869fe5d by Patrick at 2025-02-25T05:52:02+08:00
cleanup NoDefTauTv
- - - - -
4 changed files:
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
Changes:
=====================================
compiler/GHC/Tc/Solver/Default.hs
=====================================
@@ -176,8 +176,6 @@ defaultTyVarTcS the_tv
-- TyVarTvs should only be unified with a tyvar
-- never with a type; c.f. GHC.Tc.Utils.TcMType.defaultTyVar
-- and Note [Inferring kinds for type declarations] in GHC.Tc.TyCl
- || isNoDefTauMetaTyVar the_tv
- -- do not default NoDefTauTvs see Note [NoDefTauTv]
= return noUnification
| isRuntimeRepVar the_tv
= do { traceTcS "defaultTyVarTcS RuntimeRep" (ppr the_tv)
=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -692,53 +692,6 @@ the thinking.
* *
********************************************************************* -}
-{- Note [NoDefTauTv]
-~~~~~~~~~~~~~~~~~~~~
-A NoDefTauTv behaves like a TauTv, except that it should not be defaulted.
-Making it more polymorphic than a TauTv which can be defaulted.
-
-It is used for a anonymous wildcard in a type family, e.g. from T25647a
-
- -- anonymous wildcards
- type Dix8 :: RuntimeRep -> Type
- data family Dix8 r
- newtype instance Dix8 _ = Dix8 Int
- dix8 :: Dix8 FloatRep -> Int
- dix8 (Dix8 x) = x
-
- -- named wildcards
- type Dix9 :: RuntimeRep -> Type
- data family Dix9 r
- newtype instance Dix9 _r = Dix9 Int
- dix9 :: Dix9 FloatRep -> Int
- dix9 (Dix9 x) = x
-
-We would expect we accept both `Dix8 FloatRep` and `Dix9 FloatRep`,
-when type checking data family instance header in `tcDataFamInstHeader`,
-`_r` would be bind by bindOuterFamEqnTKBndrs as a skolem, while a `_`
-is not in the bndrs and left to be handled by `tcAnonWildCardOcc` and
-a fresh meta var would be introduced. But a TauTv would be defaulted
-to `LiftedRep`, which is not what we want.
-
-Previously we are branching the defaulting strategy in `defaultTyVar`
-in `tcDataFamInstHeader`, to avoid such defaulting.
-(`TryNotToDefaultNonStandardTyVars` verse `DefaultNonStandardTyVars`).
-
-Such branching is too coarse, as we may want to default other type variables
-while simultaneously preventing `_` from being defaulted. See (GT4) in GHC.Tc.TyCl,
-Note [Generalising in tcTyFamInstEqnGuts].
-
-A more philosophical perspective is that, in general, a TauTv is both defaultable
-and unifiable. Defaultability makes it less polymorphic, while unifiability makes
-it more polymorphic. In contrast, a skolem is neither defaultable nor unifiable.
-In this sense, TauTv is simultaneously less polymorphic and more polymorphic than
-a skolem. Meanwhile, NoDefTauTv can be strictly more polymorphic than a skolem.
-
-NoDefTauTv is introduced to solve this problem.
-
-NB. Should we default `_` in general if XNoPolyKind is on?
--}
-
{- Note [TyVarTv]
~~~~~~~~~~~~~~~~~
A TyVarTv can unify with type *variables* only, including other TyVarTvs and
@@ -787,7 +740,6 @@ metaInfoToTyVarName :: MetaInfo -> FastString
metaInfoToTyVarName meta_info =
case meta_info of
TauTv -> fsLit "t"
- NoDefTauTv -> fsLit "n"
TyVarTv -> fsLit "a"
RuntimeUnkTv -> fsLit "r"
CycleBreakerTv -> fsLit "b"
@@ -1895,8 +1847,6 @@ defaultTyVar :: DefaultingStrategy
-> TcM Bool -- True <=> defaulted away altogether
defaultTyVar def_strat tv
| not (isMetaTyVar tv )
- || isNoDefTauMetaTyVar tv
- -- do not default NoDefTauTvs see Note [NoDefTauTv]
|| isTyVarTyVar tv
-- Do not default TyVarTvs. Doing so would violate the invariants
-- on TyVarTvs; see Note [TyVarTv] in GHC.Tc.Utils.TcMType.
=====================================
compiler/GHC/Tc/Utils/TcType.hs
=====================================
@@ -51,7 +51,7 @@ module GHC.Tc.Utils.TcType (
TcTyVarDetails(..), pprTcTyVarDetails, vanillaSkolemTvUnk,
MetaDetails(Flexi, Indirect), MetaInfo(..), skolemSkolInfo,
isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isMetaTyVarTy, isTyVarTy,
- isNoDefTauMetaTyVar, tcIsTcTyVar, isTyVarTyVar, isOverlappableTyVar,
+ tcIsTcTyVar, isTyVarTyVar, isOverlappableTyVar,
isTyConableTyVar,
ConcreteTvOrigin(..), isConcreteTyVar_maybe, isConcreteTyVar,
isConcreteTyVarTy, isConcreteTyVarTy_maybe, concreteInfo_maybe,
@@ -641,8 +641,6 @@ data MetaInfo
= TauTv -- ^ This MetaTv is an ordinary unification variable
-- A TauTv is always filled in with a tau-type, which
-- never contains any ForAlls.
- | NoDefTauTv -- ^ A variant of TauTv, except that it should not be
- -- defaulted. See Note [NoDefTauTv]
| TyVarTv -- ^ A variant of TauTv, except that it should not be
-- unified with a type, only with a type variable
-- See Note [TyVarTv] in GHC.Tc.Utils.TcMType
@@ -672,7 +670,6 @@ instance Outputable MetaInfo where
ppr RuntimeUnkTv = text "rutv"
ppr CycleBreakerTv = text "cbv"
ppr (ConcreteTv {}) = text "conc"
- ppr (NoDefTauTv) = text "ndtau"
-- | What caused us to create a 'ConcreteTv' metavariable?
@@ -1183,7 +1180,7 @@ isImmutableTyVar :: TyVar -> Bool
isImmutableTyVar tv = isSkolemTyVar tv
isTyConableTyVar, isSkolemTyVar, isOverlappableTyVar,
- isMetaTyVar, isAmbiguousTyVar, isCycleBreakerTyVar, isNoDefTauMetaTyVar :: TcTyVar -> Bool
+ isMetaTyVar, isAmbiguousTyVar, isCycleBreakerTyVar :: TcTyVar -> Bool
isTyConableTyVar tv
-- True of a meta-type variable that can be filled in
@@ -1224,13 +1221,6 @@ isMetaTyVar tv
_ -> False
| otherwise = False
-isNoDefTauMetaTyVar tv
- | isTyVar tv -- See Note [Coercion variables in free variable lists]
- = case tcTyVarDetails tv of
- MetaTv { mtv_info = NoDefTauTv } -> True
- _ -> False
- | otherwise = False
-
-- isAmbiguousTyVar is used only when reporting type errors
-- It picks out variables that are unbound, namely meta
-- type variables and the RuntimeUnk variables created by
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -2575,13 +2575,7 @@ lhsPriority tv
TyVarTv -> 1
ConcreteTv {} -> 2
TauTv -> 3
- NoDefTauTv -> 4 -- when unifying with other, prefer to keep the other.
- -- Since NoDefTauTv is more polymorphic than tau,
- -- see Note [NoDefTauTv] for more details.
-
- -- NB. it is not clear to me(soulomoon), RuntimeUnkTv should
- -- be higher than NoDefTauTv or not.
- RuntimeUnkTv -> 5
+ RuntimeUnkTv -> 4
{- Note [Unification preconditions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9869fe5d2bda18d7d5624ebeeff7ab6e7ff0b0ac
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9869fe5d2bda18d7d5624ebeeff7ab6e7ff0b0ac
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/20250224/d8a360ee/attachment-0001.html>
More information about the ghc-commits
mailing list