diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2020-05-25 16:11:10 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2020-06-13 15:58:37 -0400 |
| commit | a31218f7737a65b6333ec7905e88dc094703f025 (patch) | |
| tree | ac5c9a2a8161da0c44605ac4d7ffe5df1719461c /compiler/GHC/ThToHs.hs | |
| parent | 7a773f169cfe072c7b29924c53075e4dfa4e2adb (diff) | |
| download | haskell-a31218f7737a65b6333ec7905e88dc094703f025.tar.gz | |
Use HsForAllTelescope to avoid inferred, visible foralls
Currently, `HsForAllTy` permits the combination of `ForallVis` and
`Inferred`, but you can't actually typecheck code that uses it
(e.g., `forall {a} ->`). This patch refactors `HsForAllTy` to use a
new `HsForAllTelescope` data type that makes a type-level distinction
between visible and invisible `forall`s such that visible `forall`s
do not track `Specificity`. That part of the patch is actually quite
small; the rest is simply changing consumers of `HsType` to
accommodate this new type.
Fixes #18235. Bumps the `haddock` submodule.
Diffstat (limited to 'compiler/GHC/ThToHs.hs')
| -rw-r--r-- | compiler/GHC/ThToHs.hs | 33 |
1 files changed, 16 insertions, 17 deletions
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs index 9dea719093..1a74f417d8 100644 --- a/compiler/GHC/ThToHs.hs +++ b/compiler/GHC/ThToHs.hs @@ -1490,19 +1490,19 @@ cvtTypeKind ty_str ty ; cxt' <- cvtContext funPrec cxt ; ty' <- cvtType ty ; loc <- getL - ; let hs_ty = mkHsForAllTy loc ForallInvis tvs' rho_ty + ; let tele = mkHsForAllInvisTele tvs' + hs_ty = mkHsForAllTy loc tele rho_ty rho_ty = mkHsQualTy cxt loc cxt' ty' ; return hs_ty } ForallVisT tvs ty | null tys' - -> do { let tvs_spec = map (TH.SpecifiedSpec <$) tvs - -- see Note [Specificity in HsForAllTy] in GHC.Hs.Type - ; tvs_spec' <- cvtTvs tvs_spec - ; ty' <- cvtType ty - ; loc <- getL - ; pure $ mkHsForAllTy loc ForallVis tvs_spec' ty' } + -> do { tvs' <- cvtTvs tvs + ; ty' <- cvtType ty + ; loc <- getL + ; let tele = mkHsForAllVisTele tvs' + ; pure $ mkHsForAllTy loc tele ty' } SigT ty ki -> do { ty' <- cvtType ty @@ -1735,8 +1735,7 @@ cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty)) ; univs' <- cvtTvs univs ; ty' <- cvtType (ForallT exis provs ty) ; let forTy = HsForAllTy - { hst_fvf = ForallInvis - , hst_bndrs = univs' + { hst_tele = mkHsForAllInvisTele univs' , hst_xforall = noExtField , hst_body = L l cxtTy } cxtTy = HsQualTy { hst_ctxt = L l [] @@ -1788,21 +1787,21 @@ unboxedSumChecks alt arity mkHsForAllTy :: SrcSpan -- ^ The location of the returned 'LHsType' if it needs an -- explicit forall - -> ForallVisFlag - -- ^ Whether this is @forall@ is visible (e.g., @forall a ->@) - -- or invisible (e.g., @forall a.@) - -> [LHsTyVarBndr Hs.Specificity GhcPs] + -> HsForAllTelescope GhcPs -- ^ The converted type variable binders -> LHsType GhcPs -- ^ The converted rho type -> LHsType GhcPs -- ^ The complete type, quantified with a forall if necessary -mkHsForAllTy loc fvf tvs rho_ty - | null tvs = rho_ty - | otherwise = L loc $ HsForAllTy { hst_fvf = fvf - , hst_bndrs = tvs +mkHsForAllTy loc tele rho_ty + | no_tvs = rho_ty + | otherwise = L loc $ HsForAllTy { hst_tele = tele , hst_xforall = noExtField , hst_body = rho_ty } + where + no_tvs = case tele of + HsForAllVis { hsf_vis_bndrs = bndrs } -> null bndrs + HsForAllInvis { hsf_invis_bndrs = bndrs } -> null bndrs -- | If passed an empty 'TH.Cxt', this simply returns the third argument -- (an 'LHsType'). Otherwise, return an 'HsQualTy' using the provided |