[Git][ghc/ghc][wip/int-index/decl-invis-binders] Update comments, define updateHsTyVarBndrFlag
Vladislav Zavialov (@int-index)
gitlab at gitlab.haskell.org
Thu Jan 26 15:09:17 UTC 2023
Vladislav Zavialov pushed to branch wip/int-index/decl-invis-binders at Glasgow Haskell Compiler / GHC
Commits:
0e898256 by Vladislav Zavialov at 2023-01-26T18:08:39+03:00
Update comments, define updateHsTyVarBndrFlag
- - - - -
4 changed files:
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/TyCl.hs
Changes:
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -81,7 +81,7 @@ module GHC.Hs.Type (
mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy,
ignoreParens, hsSigWcType, hsPatSigType,
hsTyKindSig,
- setHsTyVarBndrFlag, hsTyVarBndrFlag,
+ setHsTyVarBndrFlag, hsTyVarBndrFlag, updateHsTyVarBndrFlag,
-- Printing
pprHsType, pprHsForAll,
@@ -293,6 +293,14 @@ setHsTyVarBndrFlag :: flag -> HsTyVarBndr flag' (GhcPass pass)
setHsTyVarBndrFlag f (UserTyVar x _ l) = UserTyVar x f l
setHsTyVarBndrFlag f (KindedTyVar x _ l k) = KindedTyVar x f l k
+-- | Update the attached flag
+updateHsTyVarBndrFlag
+ :: (flag -> flag')
+ -> HsTyVarBndr flag (GhcPass pass)
+ -> HsTyVarBndr flag' (GhcPass pass)
+updateHsTyVarBndrFlag f (UserTyVar x flag name) = UserTyVar x (f flag) name
+updateHsTyVarBndrFlag f (KindedTyVar x flag name ki) = KindedTyVar x (f flag) name ki
+
-- | Do all type variables in this 'LHsQTyVars' come with kind annotations?
hsTvbAllKinded :: LHsQTyVars (GhcPass p) -> Bool
hsTvbAllKinded = all (isHsKindedTyVar . unLoc) . hsQTvExplicit
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -1240,16 +1240,21 @@ bindLHsTyVarBndr doc mb_assoc (L loc (KindedTyVar x fl lrdr@(L lv _) kind))
$ thing_inside (L loc (KindedTyVar x fl (L lv tv_nm) kind'))
; return (b, fvs1 `plusFV` fvs2) }
+-- Check for TypeAbstractions and update the type parameter of HsBndrVis.
+-- The binder itself is already renamed and is returned unmodified.
rnLHsTyVarBndrVisFlag
:: LHsTyVarBndr (HsBndrVis GhcPs) GhcRn
-> RnM (LHsTyVarBndr (HsBndrVis GhcRn) GhcRn)
rnLHsTyVarBndrVisFlag (L loc bndr) = do
- let flag = rnHsBndrVis (hsTyVarBndrFlag bndr)
- lbndr = L loc (setHsTyVarBndrFlag flag bndr)
- unlessXOptM LangExt.TypeAbstractions $ do
- when (isHsBndrInvisible flag) $ addErr (TcRnIllegalInvisTyVarBndr lbndr)
+ let lbndr = L loc (updateHsTyVarBndrFlag rnHsBndrVis bndr)
+ unlessXOptM LangExt.TypeAbstractions $
+ when (isHsBndrInvisible (hsTyVarBndrFlag bndr)) $
+ addErr (TcRnIllegalInvisTyVarBndr lbndr)
return lbndr
+-- No-op. This could be a 'coerce' in an ideal world, but GHC can't crack this
+-- nut because type families are involved: HsBndrInvisible stores (LHsToken "@" pass),
+-- which is defined via XRec.
rnHsBndrVis :: HsBndrVis GhcPs -> HsBndrVis GhcRn
rnHsBndrVis HsBndrRequired = HsBndrRequired
rnHsBndrVis (HsBndrInvisible at) = HsBndrInvisible at
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -2512,6 +2512,43 @@ By using emptyVarSet, we end up with AnonTCB even for dependent variables.
But no worries: we can compute the dep_set later, in generaliseTcTyCon,
and use anonToRequiredTcb to change AnonTCB to NamedTCB Required.
+Consider:
+ data T (k :: Type) (a :: k) @(j :: Type) (b :: j)
+
+1. kcInferDeclHeader returns a MonoTcTyCon with the following tyConBinders:
+ AnonTCB k[tyv:1] :: Type
+ AnonTCB a[tyv:1] :: k[tyv:1]
+ NamedTCB Specified j[tyv:1] :: Type
+ AnonTCB b[tyv:1] :: j[tyv:1]
+ The invisible binder is NamedTCB from the get go, but the visible binder
+ starts out as AnonTCB.
+
+2. generaliseTcTyCon skolemises the variables and computes the dep_set:
+ req_tvs = k[sk:1] :: Type
+ a[sk:1] :: k[sk:1]
+ j[sk:1] :: Type
+ b[sk:1] :: j[sk:1]
+ dep_set = { k[sk:1], j[sk:1] }
+
+3. generaliseTcTyCon transfers the binder flags (ForAllTyFlag) from tyConBinders
+ to the skolemised variables, relying on the 1-1 correspondence
+ between tyConBinders and req_tvs:
+ AnonTCB k[sk:1] :: Type
+ AnonTCB a[sk:1] :: k[sk:1]
+ NamedTCB Specified j[sk:1] :: Type
+ AnonTCB b[sk:1] :: j[sk:1]
+
+4. generaliseTcTyCon changes AnonTCB to NamedTCB Required for dependent binders
+ (i.e. binders whose bound variable is in the dep_set):
+ NamedTCB Required k[sk:1] :: Type
+ AnonTCB a[sk:1] :: k[sk:1]
+ NamedTCB Specified j[sk:1] :: Type
+ AnonTCB b[sk:1] :: j[sk:1]
+ That is:
+ * The dependent variable 'k' was updated from AnonTCB to NamedTCB Required.
+ * The dependent variable 'j' was left intact because it is already NamedTCB Specified.
+ * The non-dependent variables 'a' and 'b' were left intact.
+
See also: Note [No polymorphic recursion]
-}
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -930,7 +930,7 @@ generaliseTcTyCon (tc, skol_info, scoped_prs, tc_res_kind)
inferred_tcbs = mkNamedTyConBinders Inferred inferred
specified_tcbs = mkNamedTyConBinders Specified sorted_spec_tvs
explicit_tcbs =
- map (anonToRequiredTcb dep_fv_set) $
+ map (anonToRequiredTcb dep_fv_set) $ -- See Note [Empty dep_set in kcInferDeclHeader] in GHC.Tc.Gen.HsType
setBndrVars "explicit_tcbs" req_tvs (tyConBinders tc)
-- Step 5: Assemble the final list.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e898256f45c064b874658cee6242f6a5067cfa7
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e898256f45c064b874658cee6242f6a5067cfa7
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/20230126/dc333990/attachment-0001.html>
More information about the ghc-commits
mailing list