[Git][ghc/ghc][wip/T25647] remove NonStandardDefaultingStrategy
Patrick (@soulomoon)
gitlab at gitlab.haskell.org
Mon Feb 10 10:36:50 UTC 2025
Patrick pushed to branch wip/T25647 at Glasgow Haskell Compiler / GHC
Commits:
aa692f48 by Patrick at 2025-02-10T18:36:26+08:00
remove NonStandardDefaultingStrategy
and update Note [NoDefTauTv]
- - - - -
7 changed files:
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Rule.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Types/Basic.hs
Changes:
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -2402,8 +2402,7 @@ kcCheckDeclHeader_cusk name flav
-- skolemise and then quantify over. We do not include spec_req_tvs
-- because they are /already/ skolems
- ; inferred <- quantifyTyVars skol_info DefaultNonStandardTyVars $
- candidates `delCandidates` spec_req_tkvs
+ ; inferred <- quantifyTyVars skol_info $ candidates `delCandidates` spec_req_tkvs
-- NB: 'inferred' comes back sorted in dependency order
; (scoped_kvs, tc_bndrs, res_kind) <- liftZonkM $
@@ -3765,7 +3764,7 @@ kindGeneralizeSome skol_info wanted kind_or_type
vcat [ text "type:" <+> ppr kind_or_type
, text "dvs:" <+> ppr dvs
, text "filtered_dvs:" <+> ppr filtered_dvs ]
- ; quantifyTyVars skol_info DefaultNonStandardTyVars filtered_dvs }
+ ; quantifyTyVars skol_info filtered_dvs }
filterConstrainedCandidates
:: WantedConstraints -- Don't quantify over variables free in these
@@ -3793,7 +3792,7 @@ kindGeneralizeAll :: SkolemInfo -> TcType -> TcM [KindVar]
kindGeneralizeAll skol_info kind_or_type
= do { traceTc "kindGeneralizeAll" (ppr kind_or_type)
; dvs <- candidateQTyVarsOfKind kind_or_type
- ; quantifyTyVars skol_info DefaultNonStandardTyVars dvs }
+ ; quantifyTyVars skol_info dvs }
-- | Specialized version of 'kindGeneralizeSome', but where no variables
-- can be generalized, but perhaps some may need to be promoted.
=====================================
compiler/GHC/Tc/Gen/Rule.hs
=====================================
@@ -35,7 +35,7 @@ import GHC.Core.Predicate
import GHC.Types.Id
import GHC.Types.Var( EvVar, tyVarName )
import GHC.Types.Var.Set
-import GHC.Types.Basic ( RuleName, NonStandardDefaultingStrategy(..) )
+import GHC.Types.Basic ( RuleName )
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Utils.Panic
@@ -160,7 +160,7 @@ tcRule (HsRule { rd_ext = ext
; let weed_out = (`dVarSetMinusVarSet` dont_default)
quant_cands = forall_tkvs { dv_kvs = weed_out (dv_kvs forall_tkvs)
, dv_tvs = weed_out (dv_tvs forall_tkvs) }
- ; qtkvs <- quantifyTyVars skol_info DefaultNonStandardTyVars quant_cands
+ ; qtkvs <- quantifyTyVars skol_info quant_cands
; traceTc "tcRule" (vcat [ pprFullRuleName (snd ext) rname
, text "forall_tkvs:" <+> ppr forall_tkvs
, text "quant_cands:" <+> ppr quant_cands
=====================================
compiler/GHC/Tc/Solver.hs
=====================================
@@ -909,7 +909,7 @@ simplifyInfer top_lvl rhs_tclvl infer_mode sigs name_taus wanteds
; dep_vars <- candidateQTyVarsOfTypes (psig_tv_tys ++ psig_theta ++ map snd name_taus)
; skol_info <- mkSkolemInfo (InferSkol name_taus)
- ; qtkvs <- quantifyTyVars skol_info DefaultNonStandardTyVars dep_vars
+ ; qtkvs <- quantifyTyVars skol_info dep_vars
; traceTc "simplifyInfer: empty WC" (ppr name_taus $$ ppr qtkvs)
; return (qtkvs, [], emptyTcEvBinds, False) }
@@ -1795,7 +1795,7 @@ defaultTyVarsAndSimplify rhs_tclvl candidates
; poly_kinds <- xoptM LangExt.PolyKinds
; let default_kv | poly_kinds = default_tv
| otherwise = defaultTyVar DefaultKindVars
- default_tv = defaultTyVar (NonStandardDefaulting DefaultNonStandardTyVars)
+ default_tv = defaultTyVar NonStandardDefaulting
; mapM_ default_kv (dVarSetElems cand_kvs)
; mapM_ default_tv (dVarSetElems (cand_tvs `minusDVarSet` cand_kvs))
@@ -1857,7 +1857,7 @@ decideQuantifiedTyVars skol_info name_taus psigs candidates
, text "grown_tcvs =" <+> ppr grown_tcvs
, text "dvs =" <+> ppr dvs_plus])
- ; quantifyTyVars skol_info DefaultNonStandardTyVars dvs_plus }
+ ; quantifyTyVars skol_info dvs_plus }
------------------
getSeedTys :: [(Name,TcType)] -- The type of each RHS in the group
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -1101,7 +1101,7 @@ generaliseTcTyCon (tc, skol_info, scoped_prs, tc_res_kind)
-- Step 2b: quantify, mainly meaning skolemise the free variables
-- Returned 'inferred' are scope-sorted and skolemised
- ; inferred <- quantifyTyVars skol_info DefaultNonStandardTyVars dvs2
+ ; inferred <- quantifyTyVars skol_info dvs2
; traceTc "generaliseTcTyCon: pre zonk"
(vcat [ text "tycon =" <+> ppr tc
@@ -3451,7 +3451,7 @@ tcTyFamInstEqnGuts fam_tc mb_clsinfo outer_hs_bndrs hs_pats hs_rhs_ty
-- See Note [Generalising in tcTyFamInstEqnGuts]
; dvs <- candidateQTyVarsWithBinders outer_tvs lhs_ty
- ; qtvs <- quantifyTyVars skol_info DefaultNonStandardTyVars dvs
+ ; qtvs <- quantifyTyVars skol_info dvs
; let final_tvs = scopedSort (qtvs ++ outer_tvs)
-- This scopedSort is important: the qtvs may be /interleaved/ with
-- the outer_tvs. See Note [Generalising in tcTyFamInstEqnGuts]
=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -975,7 +975,7 @@ tcDataFamInstHeader mb_clsinfo skol_info fam_tc hs_outer_bndrs fixity
-- See GHC.Tc.TyCl Note [Generalising in tcTyFamInstEqnGuts]
; dvs <- candidateQTyVarsWithBinders outer_tvs lhs_ty
- ; qtvs <- quantifyTyVars skol_info DefaultNonStandardTyVars dvs
+ ; qtvs <- quantifyTyVars skol_info dvs
-- DefaultNonStandardTyVars: see (GT4) in
-- GHC.Tc.TyCl Note [Generalising in tcTyFamInstEqnGuts]
=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -141,8 +141,7 @@ import GHC.Builtin.Types
import GHC.Types.Var.Env
import GHC.Types.Unique.Set
import GHC.Types.Basic ( TypeOrKind(..)
- , NonStandardDefaultingStrategy(..)
- , DefaultingStrategy(..), defaultNonStandardTyVars )
+ , DefaultingStrategy(..))
import GHC.Data.FastString
import GHC.Data.Bag
@@ -694,18 +693,50 @@ 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.
+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
-
-We want to keep `_` polymorphic, so it behaves more like a named wildcard.
-
-NB. Should we default `_` if XNoPolyKind is on?
+ 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]
@@ -1765,7 +1796,6 @@ Note [Deterministic UniqFM] in GHC.Types.Unique.DFM.
-}
quantifyTyVars :: SkolemInfo
- -> NonStandardDefaultingStrategy
-> CandidatesQTvs -- See Note [Dependent type variables]
-- Already zonked
-> TcM [TcTyVar]
@@ -1776,7 +1806,7 @@ quantifyTyVars :: SkolemInfo
-- invariants on CandidateQTvs, we do not have to filter out variables
-- free in the environment here. Just quantify unconditionally, subject
-- to the restrictions in Note [quantifyTyVars].
-quantifyTyVars skol_info ns_strat dvs
+quantifyTyVars skol_info dvs
-- short-circuit common case
| isEmptyCandidates dvs
= do { traceTc "quantifyTyVars has nothing to quantify" empty
@@ -1784,10 +1814,9 @@ quantifyTyVars skol_info ns_strat dvs
| otherwise
= do { traceTc "quantifyTyVars {"
- ( vcat [ text "ns_strat =" <+> ppr ns_strat
- , text "dvs =" <+> ppr dvs ])
+ ( vcat [ text "dvs =" <+> ppr dvs ])
- ; undefaulted <- defaultTyVars ns_strat dvs
+ ; undefaulted <- defaultTyVars dvs
; final_qtvs <- liftZonkM $ mapMaybeM zonk_quant undefaulted
; traceTc "quantifyTyVars }"
@@ -1876,19 +1905,16 @@ defaultTyVar def_strat tv
= return False
| isRuntimeRepVar tv
- , default_ns_vars
= do { traceTc "Defaulting a RuntimeRep var to LiftedRep" (ppr tv)
; liftZonkM $ writeMetaTyVar tv liftedRepTy
; return True }
| isLevityVar tv
- , default_ns_vars
= do { traceTc "Defaulting a Levity var to Lifted" (ppr tv)
; liftZonkM $ writeMetaTyVar tv liftedDataConTy
; return True }
| isMultiplicityVar tv
- , default_ns_vars
= do { traceTc "Defaulting a Multiplicity var to Many" (ppr tv)
; liftZonkM $ writeMetaTyVar tv manyDataConTy
; return True }
@@ -1911,8 +1937,6 @@ defaultTyVar def_strat tv
= return False
where
- default_ns_vars :: Bool
- default_ns_vars = defaultNonStandardTyVars def_strat
default_kind_var :: TyVar -> TcM Bool
-- defaultKindVar is used exclusively with -XNoPolyKinds
-- See Note [Defaulting with -XNoPolyKinds]
@@ -1943,14 +1967,13 @@ defaultTyVar def_strat tv
-- - 'Multiplicity' tyvars default to 'Many'
-- - 'Type' tyvars from dv_kvs default to 'Type', when -XNoPolyKinds
-- (under -XNoPolyKinds, non-defaulting vars in dv_kvs is an error)
-defaultTyVars :: NonStandardDefaultingStrategy
- -> CandidatesQTvs -- ^ all candidates for quantification
+defaultTyVars :: CandidatesQTvs -- ^ all candidates for quantification
-> TcM [TcTyVar] -- ^ those variables not defaulted
-defaultTyVars ns_strat dvs
+defaultTyVars dvs
= do { poly_kinds <- xoptM LangExt.PolyKinds
; let
def_tvs, def_kvs :: DefaultingStrategy
- def_tvs = NonStandardDefaulting ns_strat
+ def_tvs = NonStandardDefaulting
def_kvs | poly_kinds = def_tvs
| otherwise = DefaultKindVars
-- As -XNoPolyKinds precludes polymorphic kind variables, we default them.
@@ -2132,7 +2155,7 @@ doNotQuantifyTyVars dvs where_found
| otherwise
= do { traceTc "doNotQuantifyTyVars" (ppr dvs)
- ; undefaulted <- defaultTyVars DefaultNonStandardTyVars dvs
+ ; undefaulted <- defaultTyVars dvs
-- could have regular TyVars here, in an associated type RHS, or
-- bound by a type declaration head. So filter looking only for
-- metavars. e.g. b and c in `class (forall a. a b ~ a c) => C b c`
=====================================
compiler/GHC/Types/Basic.hs
=====================================
@@ -116,8 +116,7 @@ module GHC.Types.Basic (
TyConFlavour(..), TypeOrData(..), NewOrData(..), tyConFlavourAssoc_maybe,
- NonStandardDefaultingStrategy(..),
- DefaultingStrategy(..), defaultNonStandardTyVars,
+ DefaultingStrategy(..),
ForeignSrcLang (..)
) where
@@ -2334,19 +2333,6 @@ GHC.Iface.Type.defaultIfaceTyVarsOfKind
-}
--- | Specify whether to default type variables of kind 'RuntimeRep'/'Levity'/'Multiplicity'.
-data NonStandardDefaultingStrategy
- -- | Default type variables of the given kinds:
- --
- -- - default 'RuntimeRep' variables to 'LiftedRep'
- -- - default 'Levity' variables to 'Lifted'
- -- - default 'Multiplicity' variables to 'Many'
- = DefaultNonStandardTyVars
- -- | Try not to default type variables of the kinds 'RuntimeRep'/'Levity'/'Multiplicity'.
- --
- -- Note that these might get defaulted anyway, if they are kind variables
- -- and `-XNoPolyKinds` is enabled.
- | TryNotToDefaultNonStandardTyVars
-- | Specify whether to default kind variables, and type variables
-- of kind 'RuntimeRep'/'Levity'/'Multiplicity'.
@@ -2362,19 +2348,12 @@ data DefaultingStrategy
--
-- Usually, we pass this option when -XNoPolyKinds is enabled.
= DefaultKindVars
- -- | Default (or don't default) non-standard variables, of kinds
+ -- | Default non-standard variables, of kinds
-- 'RuntimeRep', 'Levity' and 'Multiplicity'.
- | NonStandardDefaulting NonStandardDefaultingStrategy
+ | NonStandardDefaulting
-defaultNonStandardTyVars :: DefaultingStrategy -> Bool
-defaultNonStandardTyVars DefaultKindVars = True
-defaultNonStandardTyVars (NonStandardDefaulting DefaultNonStandardTyVars) = True
-defaultNonStandardTyVars (NonStandardDefaulting TryNotToDefaultNonStandardTyVars) = False
-instance Outputable NonStandardDefaultingStrategy where
- ppr DefaultNonStandardTyVars = text "DefaultOnlyNonStandardTyVars"
- ppr TryNotToDefaultNonStandardTyVars = text "TryNotToDefaultNonStandardTyVars"
instance Outputable DefaultingStrategy where
ppr DefaultKindVars = text "DefaultKindVars"
- ppr (NonStandardDefaulting ns) = text "NonStandardDefaulting" <+> ppr ns
+ ppr NonStandardDefaulting = text "NonStandardDefaulting"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa692f482f1b78783b19490fa34af084746773c2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa692f482f1b78783b19490fa34af084746773c2
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/20250210/98eec261/attachment-0001.html>
More information about the ghc-commits
mailing list