[Git][ghc/ghc][wip/T16762] Working towards doing it better
Simon Peyton Jones
gitlab at gitlab.haskell.org
Tue Sep 22 14:31:27 UTC 2020
Simon Peyton Jones pushed to branch wip/T16762 at Glasgow Haskell Compiler / GHC
Commits:
ef6dfbaa by Simon Peyton Jones at 2020-09-22T15:28:51+01:00
Working towards doing it better
* Make OuterTyVarBndrs into (essentially) just Either
* Define tcOuterSigTKBndrs to
- push level, capture constraints etc for Explicit
- return the new OuterTyVarBnrs
* Define zonkAndSortOuter to do the right thing for
the OuterTyVarBndrs returned by tcOuterSigTKBndrs
- - - - -
16 changed files:
- compiler/GHC/Hs/Extension.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/ThToHs.hs
Changes:
=====================================
compiler/GHC/Hs/Extension.hs
=====================================
@@ -731,8 +731,6 @@ type family XXLHsQTyVars x
-- -------------------------------------
type family XHsOuterImplicit x
-type family XHsOuterExplicit x
-type family XXHsOuterTyVarBndrs x
-- -------------------------------------
=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -398,11 +398,6 @@ deriving instance Data (LHsQTyVars GhcPs)
deriving instance Data (LHsQTyVars GhcRn)
deriving instance Data (LHsQTyVars GhcTc)
--- deriving instance (DataIdLR p p, Data flag) => Data (HsOuterTyVarBndrs flag p)
-deriving instance Data flag => Data (HsOuterTyVarBndrs flag GhcPs)
-deriving instance Data flag => Data (HsOuterTyVarBndrs flag GhcRn)
-deriving instance Data flag => Data (HsOuterTyVarBndrs flag GhcTc)
-
-- deriving instance (DataIsLR p p) => Data (HsSigType p)
deriving instance Data (HsSigType GhcPs)
deriving instance Data (HsSigType GhcRn)
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -30,7 +30,7 @@ module GHC.Hs.Type (
HsType(..), NewHsTypeX(..), LHsType, HsKind, LHsKind,
HsForAllTelescope(..), HsTyVarBndr(..), LHsTyVarBndr,
LHsQTyVars(..),
- HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs,
+ OuterTyVarBndrs(..), HsOuterTyVarBndrs, HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs,
HsWildCardBndrs(..),
HsPatSigType(..), HsPSRn(..),
HsSigType(..), LHsSigType, LHsSigWcType, LHsWcType,
@@ -412,46 +412,46 @@ emptyLHsQTvs :: LHsQTyVars GhcRn
emptyLHsQTvs = HsQTvs { hsq_ext = [], hsq_explicit = [] }
------------------------------------------------
--- HsImplicitBndrs (TODO RGS: We need a different title here)
+-- OuterTyVarBndrs
-- Used to quantify the implicit binders of a type
-- * Implicit binders of a type signature (LHsSigType/LHsSigWcType)
-- * Patterns in a type/data family instance (HsTyPats)
--
-- We support two forms:
--- HsOuterImplicit (implicit quantification, added by renamer)
+-- OuterImplicit (implicit quantification, added by renamer)
-- f :: a -> a -- Short for f :: forall {a}. a->a
--- HsOuterExplicit (explicit user quantifiation):
+-- OuterExplicit (explicit user quantifiation):
-- f :: forall a. a->a
--
--- When the user writes /visible/ quanitification
+-- In constrast, when the user writes /visible/ quanitification
-- T :: forall k -> k -> Type
--- we use use HsOuterImplicit, wrapped around a HsForAllTy
+-- we use use OuterImplicit, wrapped around a HsForAllTy
-- for the visible quantification
--- | TODO RGS: Docs
-data HsOuterTyVarBndrs flag pass
- = HsOuterImplicit
- { hso_ximplicit :: XHsOuterImplicit pass
- }
- | HsOuterExplicit
- { hso_xexplicit :: XHsOuterExplicit pass
- , hso_bndrs :: [LHsTyVarBndr flag pass]
- }
- | XHsOuterTyVarBndrs !(XXHsOuterTyVarBndrs pass)
-
--- | TODO RGS: Docs
-type HsOuterFamEqnTyVarBndrs = HsOuterTyVarBndrs ()
--- | TODO RGS: Docs
-type HsOuterSigTyVarBndrs = HsOuterTyVarBndrs Specificity
+-- | An explicitly-named Either type
+data OuterTyVarBndrs implicit explicit
+ = OuterImplicit implicit -- Implicit forall
+ -- f :: a -> b -> b
+ | OuterExplicit explicit -- Implicit forall
+ -- f :: forall a b. a -> b-> b
+ deriving( Data )
+
+type HsOuterTyVarBndrs flag pass
+ = OuterTyVarBndrs
+ (XHsOuterImplicit pass) -- Implicit bndrs: null in Ps, [Name] in Rn and Tc
+ [LHsTyVarBndr flag pass] -- Explicit bndrs: LHsTyVarBndr
+
+-- HsOuterSigTyVarBndrs: used for signatures
+-- f :: forall a {b}. blahg
+-- HsOuterFamEqnTyVarBndrs: use for type-family inststance eqns
+-- type instance forall a. F [a] = Tree a
+type HsOuterSigTyVarBndrs pass = HsOuterTyVarBndrs Specificity pass
+type HsOuterFamEqnTyVarBndrs pass = HsOuterTyVarBndrs () pass
type instance XHsOuterImplicit GhcPs = NoExtField
type instance XHsOuterImplicit GhcRn = [Name]
type instance XHsOuterImplicit GhcTc = [Name]
-type instance XHsOuterExplicit (GhcPass _) = NoExtField
-
-type instance XXHsOuterTyVarBndrs (GhcPass _) = NoExtCon
-
-- | Haskell Wildcard Binders
data HsWildCardBndrs pass thing
-- See Note [HsType binders]
@@ -620,24 +620,20 @@ variables so that they can be brought into scope during renaming and
typechecking.
-}
-mkHsOuterImplicit :: HsOuterTyVarBndrs flag GhcPs
-mkHsOuterImplicit = HsOuterImplicit { hso_ximplicit = noExtField }
+mkHsOuterImplicit :: OuterTyVarBndrs NoExtField explicit
+mkHsOuterImplicit = OuterImplicit noExtField
-mkHsOuterExplicit :: [LHsTyVarBndr flag GhcPs] -> HsOuterTyVarBndrs flag GhcPs
-mkHsOuterExplicit exp_bndrs = HsOuterExplicit { hso_xexplicit = noExtField
- , hso_bndrs = exp_bndrs }
+mkHsOuterExplicit :: explicit -> OuterTyVarBndrs implicit explicit
+mkHsOuterExplicit = OuterExplicit
-mapXHsOuterImplicit ::
- (XHsOuterImplicit pass -> XHsOuterImplicit pass)
- -> HsOuterTyVarBndrs flag pass -> HsOuterTyVarBndrs flag pass
-mapXHsOuterImplicit f (HsOuterImplicit { hso_ximplicit = ximplicit }) =
- HsOuterImplicit { hso_ximplicit = f ximplicit }
-mapXHsOuterImplicit _ hso at HsOuterExplicit{} = hso
-mapXHsOuterImplicit _ hso at XHsOuterTyVarBndrs{} = hso
+mapXHsOuterImplicit :: (implicit -> implicit) -> OuterTyVarBndrs implicit explicit
+ -> OuterTyVarBndrs implicit explicit
+mapXHsOuterImplicit f (OuterImplicit imp) = OuterImplicit (f imp)
+mapXHsOuterImplicit _ hso@(OuterExplicit {}) = hso
mkHsImplicitSigType :: LHsType GhcPs -> HsSigType GhcPs
mkHsImplicitSigType body =
- HsSig { sig_ext = noExtField
+ HsSig { sig_ext = noExtField
, sig_bndrs = mkHsOuterImplicit, sig_body = body }
mkHsExplicitSigType :: [LHsTyVarBndr Specificity GhcPs] -> LHsType GhcPs
@@ -1218,18 +1214,15 @@ hsWcScopedTvs sig_wc_ty
| HsWC { hswc_ext = nwcs, hswc_body = sig_ty } <- sig_wc_ty
, L _ (HsSig{sig_bndrs = outer_bndrs}) <- sig_ty
= case outer_bndrs of
- HsOuterImplicit{} ->
- nwcs
- HsOuterExplicit{hso_bndrs = tvs} ->
- nwcs ++ hsLTyVarNames tvs -- See Note [hsScopedTvs vis_flag]
+ OuterImplicit{} -> nwcs
+ OuterExplicit tvs -> nwcs ++ hsLTyVarNames tvs
+ -- See Note [hsScopedTvs vis_flag]
hsScopedTvs :: LHsSigType GhcRn -> [Name]
-- Same as hsWcScopedTvs, but for a LHsSigType
hsScopedTvs (L _ (HsSig{sig_bndrs = outer_bndrs})) = case outer_bndrs of
- HsOuterImplicit{} ->
- []
- HsOuterExplicit{hso_bndrs = tvs} ->
- hsLTyVarNames tvs -- See Note [hsScopedTvs vis_flag]
+ OuterImplicit{} -> []
+ OuterExplicit tvs -> hsLTyVarNames tvs -- See Note [hsScopedTvs vis_flag]
{- Note [Scoping of named wildcards]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1474,9 +1467,9 @@ splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4)
-> ([LHsTyVarBndr Specificity (GhcPass p)], LHsType (GhcPass p))
split_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) =
case outer_bndrs of
- HsOuterImplicit{} -> ([], ignoreParens body)
+ OuterImplicit{} -> ([], ignoreParens body)
-- TODO RGS: Sigh. Explain why ignoreParens is necessary here.
- HsOuterExplicit{hso_bndrs = exp_bndrs} -> (exp_bndrs, body)
+ OuterExplicit exp_bndrs -> (exp_bndrs, body)
(univs, ty1) = split_sig_ty ty
(reqs, ty2) = splitLHsQualTy ty1
@@ -1507,8 +1500,8 @@ splitLHsSigmaTyInvis ty
-- | Decompose a GADT type into its constituent parts.
-- Returns @(outer_bndrs, mb_ctxt, body)@, where:
--
--- * @outer_bndrs@ are 'HsOuterExplicit' if the type has explicit, outermost
--- type variable binders. Otherwise, they are 'HsOuterImplicit'.
+-- * @outer_bndrs@ are 'OuterExplicit' if the type has explicit, outermost
+-- type variable binders. Otherwise, they are 'OuterImplicit'.
--
-- * @mb_ctxt@ is @Just@ the context, if it is provided.
-- Otherwise, it is @Nothing at .
@@ -1608,10 +1601,8 @@ splitLHsInstDeclTy :: LHsSigType GhcRn
-> ([Name], LHsContext GhcRn, LHsType GhcRn)
splitLHsInstDeclTy (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = inst_ty})) =
case outer_bndrs of
- HsOuterImplicit{hso_ximplicit = imp_tkvs} ->
- (imp_tkvs, ctxt, body_ty)
- HsOuterExplicit{hso_bndrs = exp_bndrs} ->
- (hsLTyVarNames exp_bndrs, ctxt, body_ty)
+ OuterImplicit imp_tkvs -> (imp_tkvs, ctxt, body_ty)
+ OuterExplicit exp_bndrs -> (hsLTyVarNames exp_bndrs, ctxt, body_ty)
where
(mb_cxt, body_ty) = splitLHsQualTy_KP inst_ty
ctxt = fromMaybe noLHsContext mb_cxt
@@ -1843,15 +1834,10 @@ instance OutputableBndrId p
=> Outputable (LHsQTyVars (GhcPass p)) where
ppr (HsQTvs { hsq_explicit = tvs }) = interppSP tvs
-instance forall flag p. (OutputableBndrFlag flag, OutputableBndrId p)
- => Outputable (HsOuterTyVarBndrs flag (GhcPass p)) where
- ppr (HsOuterImplicit { hso_ximplicit = implicit_vars }) =
- text "HsOuterImplicit" <> case ghcPass @p of
- GhcPs -> empty
- GhcRn -> colon <+> ppr implicit_vars
- GhcTc -> colon <+> ppr implicit_vars
- ppr (HsOuterExplicit { hso_bndrs = bndrs }) =
- text "HsOuterExplicit:" <+> ppr bndrs
+instance (Outputable implicit, Outputable explicit)
+ => Outputable (OuterTyVarBndrs implicit explicit) where
+ ppr (OuterImplicit implicit) = text "OuterImplicit:" <+> ppr implicit
+ ppr (OuterExplicit explicit) = text "OuterExplicit:" <+> ppr explicit
instance OutputableBndrId p
=> Outputable (HsForAllTelescope (GhcPass p)) where
@@ -1880,16 +1866,15 @@ pprAnonWildCard = char '_'
-- TODO RGS: Update the Haddocks, as they're now out of date.
pprHsOuterFamEqnTyVarBndrs :: OutputableBndrId p
=> HsOuterFamEqnTyVarBndrs (GhcPass p) -> SDoc
-pprHsOuterFamEqnTyVarBndrs (HsOuterImplicit{}) = empty
-pprHsOuterFamEqnTyVarBndrs (HsOuterExplicit{hso_bndrs = qtvs}) =
- forAllLit <+> interppSP qtvs <> dot
+pprHsOuterFamEqnTyVarBndrs (OuterImplicit{}) = empty
+pprHsOuterFamEqnTyVarBndrs (OuterExplicit qtvs) = forAllLit <+> interppSP qtvs <> dot
-- | TODO RGS: Docs
pprHsOuterSigTyVarBndrs :: OutputableBndrId p
=> HsOuterSigTyVarBndrs (GhcPass p) -> SDoc
-pprHsOuterSigTyVarBndrs (HsOuterImplicit{}) = empty
-pprHsOuterSigTyVarBndrs (HsOuterExplicit{hso_bndrs = bndrs}) =
- pprHsForAll (mkHsForAllInvisTele bndrs) noLHsContext
+pprHsOuterSigTyVarBndrs (OuterImplicit{}) = empty
+pprHsOuterSigTyVarBndrs (OuterExplicit bndrs) = pprHsForAll (mkHsForAllInvisTele bndrs)
+ noLHsContext
-- TODO RGS: The use of mkHsForAllInvisTele above is a mite bit fishy.
-- Consider carefully if this is the best design.
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -362,8 +362,8 @@ get_scoped_tvs_from_sig :: LHsSigType GhcRn -> [Name]
--
-- See also Note [Scoped type variables in quotes]
get_scoped_tvs_from_sig (L _ (HsSig{sig_bndrs = outer_bndrs})) = case outer_bndrs of
- HsOuterImplicit{hso_ximplicit = imp_tv_names} -> imp_tv_names
- HsOuterExplicit{hso_bndrs = exp_tvs} -> hsLTyVarNames exp_tvs
+ OuterImplicit imp_tv_names -> imp_tv_names
+ OuterExplicit exp_tvs -> hsLTyVarNames exp_tvs
{- Notes
@@ -1012,9 +1012,9 @@ rep_ty_sig_tvs explicit_tvs
-- and Note [Don't quantify implicit type variables in quotes]
rep_ty_sig_outer_tvs :: HsOuterSigTyVarBndrs GhcRn
-> MetaM (Core [M TH.TyVarBndrSpec])
-rep_ty_sig_outer_tvs (HsOuterImplicit{}) =
+rep_ty_sig_outer_tvs (OuterImplicit{}) =
coreListM tyVarBndrSpecTyConName []
-rep_ty_sig_outer_tvs (HsOuterExplicit{hso_bndrs = explicit_tvs}) =
+rep_ty_sig_outer_tvs (OuterExplicit explicit_tvs) =
rep_ty_sig_tvs explicit_tvs
-- Desugar a top-level type signature. Unlike 'repHsSigType', this
@@ -1168,12 +1168,10 @@ addHsOuterFamEqnTyVarBinds ::
addHsOuterFamEqnTyVarBinds outer_bndrs thing_inside = do
elt_ty <- wrapName tyVarBndrUnitTyConName
case outer_bndrs of
- HsOuterImplicit{hso_ximplicit = imp_tvs} ->
- addTyClTyVarBinds (mk_qtvs imp_tvs []) $ \_th_exp_bndrs ->
- thing_inside $ coreNothingList elt_ty
- HsOuterExplicit{hso_bndrs = exp_bndrs} ->
- addTyClTyVarBinds (mk_qtvs [] exp_bndrs) $ \th_exp_bndrs ->
- thing_inside $ coreJustList elt_ty th_exp_bndrs
+ OuterImplicit imp_tvs -> addTyClTyVarBinds (mk_qtvs imp_tvs []) $ \_th_exp_bndrs ->
+ thing_inside $ coreNothingList elt_ty
+ OuterExplicit exp_bndrs -> addTyClTyVarBinds (mk_qtvs [] exp_bndrs) $ \th_exp_bndrs ->
+ thing_inside $ coreJustList elt_ty th_exp_bndrs
where
mk_qtvs imp_tvs exp_tvs = HsQTvs { hsq_ext = imp_tvs
, hsq_explicit = exp_tvs }
@@ -1183,22 +1181,20 @@ addHsOuterSigTyVarBinds ::
-> (Core [M TH.TyVarBndrSpec] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsOuterSigTyVarBinds outer_bndrs thing_inside = case outer_bndrs of
- HsOuterImplicit{hso_ximplicit = imp_tvs} -> do
- th_nil <- coreListM tyVarBndrSpecTyConName []
- addSimpleTyVarBinds imp_tvs $ thing_inside th_nil
- HsOuterExplicit{hso_bndrs = exp_bndrs} ->
- addHsTyVarBinds exp_bndrs thing_inside
+ OuterImplicit imp_tvs -> do th_nil <- coreListM tyVarBndrSpecTyConName []
+ addSimpleTyVarBinds imp_tvs $ thing_inside th_nil
+ OuterExplicit exp_bndrs -> addHsTyVarBinds exp_bndrs thing_inside
-- TODO RGS: Docs
nullOuterImplicit :: HsOuterSigTyVarBndrs GhcRn -> Bool
-nullOuterImplicit (HsOuterImplicit{hso_ximplicit = imp_bndrs}) = null imp_bndrs
-nullOuterImplicit (HsOuterExplicit{}) = True
+nullOuterImplicit (OuterImplicit imp_bndrs) = null imp_bndrs
+nullOuterImplicit (OuterExplicit{}) = True
-- Vacuously true, as there is no implicit quantification
-- TODO RGS: Docs
nullOuterExplicit :: HsOuterSigTyVarBndrs GhcRn -> Bool
-nullOuterExplicit (HsOuterExplicit{hso_bndrs = exp_bndrs}) = null exp_bndrs
-nullOuterExplicit (HsOuterImplicit{}) = True
+nullOuterExplicit (OuterExplicit exp_bndrs) = null exp_bndrs
+nullOuterExplicit (OuterImplicit {}) = True
-- Vacuously true, as there is no outermost explicit quantification
addSimpleTyVarBinds :: [Name] -- the binders to be added
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -546,10 +546,8 @@ instance HasLoc a => HasLoc [a] where
instance HasLoc a => HasLoc (FamEqn (GhcPass s) a) where
loc (FamEqn _ a outer_bndrs b _ c) = case outer_bndrs of
- HsOuterImplicit{} -> foldl1' combineSrcSpans
- [loc a, loc b, loc c]
- HsOuterExplicit{hso_bndrs = tvs} -> foldl1' combineSrcSpans
- [loc a, loc tvs, loc b, loc c]
+ OuterImplicit{} -> foldl1' combineSrcSpans [loc a, loc b, loc c]
+ OuterExplicit tvs -> foldl1' combineSrcSpans [loc a, loc tvs, loc b, loc c]
instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg tm ty) where
loc (HsValArg tm) = loc tm
loc (HsTypeArg _ ty) = loc ty
@@ -1551,11 +1549,10 @@ instance ToHie (Located (ConDecl GhcRn)) where
, con_mb_cxt = ctx, con_args = args, con_res_ty = typ } ->
[ toHie $ map (C (Decl ConDec $ getRealSpan span)) names
, case outer_bndrs of
- HsOuterImplicit{hso_ximplicit = imp_vars} ->
- bindingsOnly $ map (C $ TyVarBind (mkScope outer_bndrs_loc) resScope)
- imp_vars
- HsOuterExplicit{hso_bndrs = exp_bndrs} ->
- toHie $ tvScopes resScope NoScope exp_bndrs
+ OuterImplicit imp_vars -> bindingsOnly $
+ map (C $ TyVarBind (mkScope outer_bndrs_loc) resScope)
+ imp_vars
+ OuterExplicit exp_bndrs -> toHie $ tvScopes resScope NoScope exp_bndrs
, toHie ctx
, toHie args
, toHie typ
=====================================
compiler/GHC/Parser/PostProcess/Haddock.hs
=====================================
@@ -941,8 +941,8 @@ instance HasHaddock (Located (HsSigType GhcPs)) where
-- HasHaddock instance for HsType. Is this right? Need Vlad to check.
extendHdkA l $ do
case outer_bndrs of
- HsOuterImplicit{} -> pure ()
- HsOuterExplicit{hso_bndrs = bndrs} -> registerLocHdkA (getLHsTyVarBndrsLoc bndrs)
+ OuterImplicit{} -> pure ()
+ OuterExplicit bndrs -> registerLocHdkA (getLHsTyVarBndrsLoc bndrs)
body' <- addHaddock body
pure $ L l $ HsSig noExtField outer_bndrs body'
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -1056,17 +1056,16 @@ bindHsOuterTyVarBndrs :: OutputableBndrFlag flag
-> RnM (a, FreeVars)
bindHsOuterTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside =
case outer_bndrs of
- HsOuterImplicit{} ->
+ OuterImplicit{} ->
rnImplicitBndrs mb_cls implicit_vars $ \implicit_vars' ->
- thing_inside $ HsOuterImplicit{ hso_ximplicit = implicit_vars' }
- HsOuterExplicit{hso_bndrs = exp_bndrs} ->
+ thing_inside $ OuterImplicit implicit_vars'
+ OuterExplicit exp_bndrs ->
-- Note: If we pass mb_cls instead of Nothing below, bindLHsTyVarBndrs
-- will use class variables for any names the user meant to bring in
-- scope here. This is an explicit forall, so we want fresh names, not
-- class variables. Thus: always pass Nothing.
bindLHsTyVarBndrs doc WarnUnusedForalls Nothing exp_bndrs $ \exp_bndrs' ->
- thing_inside $ HsOuterExplicit{ hso_xexplicit = noExtField
- , hso_bndrs = exp_bndrs' }
+ thing_inside $ OuterExplicit exp_bndrs'
bindHsForAllTelescope :: HsDocContext
-> HsForAllTelescope GhcPs
@@ -1888,10 +1887,8 @@ extractHsOuterTvBndrs :: HsOuterTyVarBndrs flag GhcPs
-> FreeKiTyVars -- Free in result
extractHsOuterTvBndrs outer_bndrs body_fvs =
case outer_bndrs of
- HsOuterImplicit{} ->
- body_fvs
- HsOuterExplicit { hso_bndrs = bndrs } ->
- extract_hs_tv_bndrs bndrs [] body_fvs
+ OuterImplicit{} -> body_fvs
+ OuterExplicit bndrs -> extract_hs_tv_bndrs bndrs [] body_fvs
extract_hs_tv_bndrs :: [LHsTyVarBndr flag GhcPs]
-> FreeKiTyVars -- Accumulator
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -753,8 +753,8 @@ rnFamEqn doc atfi rhs_kvars
; let nms_used = extendNameSetList rhs_fvs $
inst_tvs ++ nms_dups
all_nms = case rn_outer_bndrs' of
- HsOuterImplicit{hso_ximplicit = imp_var_nms} -> imp_var_nms
- HsOuterExplicit{hso_bndrs = bndrs} -> hsLTyVarNames bndrs
+ OuterImplicit imp_var_nms -> imp_var_nms
+ OuterExplicit bndrs -> hsLTyVarNames bndrs
; warnUnusedTypePatterns all_nms nms_used
; let eqn_fvs = rhs_fvs `plusFV` pat_fvs
@@ -1956,8 +1956,8 @@ rnLDerivStrategy doc mds thing_inside
-- Consider factoring this out into its own function in the same
-- vein as hsScopedTvs.
via_tvs = case via_outer_bndrs of
- HsOuterImplicit{hso_ximplicit = imp_tvs} -> imp_tvs
- HsOuterExplicit{hso_bndrs = exp_bndrs} -> hsLTyVarNames exp_bndrs
+ OuterImplicit imp_tvs -> imp_tvs
+ OuterExplicit exp_bndrs -> hsLTyVarNames exp_bndrs
-- Check if there are any nested `forall`s, which are illegal in a
-- `via` type.
-- See Note [No nested foralls or contexts in instance types]
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -202,8 +202,8 @@ checkInferredVars ctxt (Just msg) ty =
where
sig_ty_bndrs :: LHsSigType GhcPs -> [HsTyVarBndr Specificity GhcPs]
sig_ty_bndrs (L _ (HsSig{sig_bndrs = outer_bndrs})) = case outer_bndrs of
- HsOuterImplicit{} -> []
- HsOuterExplicit{hso_bndrs = exp_bndrs} -> map unLoc exp_bndrs
+ OuterImplicit{} -> []
+ OuterExplicit exp_bndrs -> map unLoc exp_bndrs
{-
Note [Unobservably inferred type variables]
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -502,7 +502,7 @@ warnRedundantConstraints ctxt env info ev_vars
= any isImprovementPred (pred : transSuperClasses pred)
reportBadTelescope :: ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [TcTyVar] -> TcM ()
-reportBadTelescope ctxt env (ForAllSkol _ telescope) skols
+reportBadTelescope ctxt env (ForAllSkol telescope) skols
= do { msg <- mkErrorReport ctxt env (important doc)
; reportError msg }
where
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -29,9 +29,11 @@ module GHC.Tc.Gen.HsType (
bindImplicitTKBndrs_Q_Tv, bindImplicitTKBndrs_Q_Skol,
bindExplicitTKBndrs_Tv, bindExplicitTKBndrs_Skol,
bindExplicitTKBndrs_Q_Tv, bindExplicitTKBndrs_Q_Skol,
+
+ tcOuterSigTKBndrs, zonkAndSortOuter,
+
bindOuterFamEqnTKBndrs_Q_Skol, bindOuterFamEqnTKBndrs_Q_Tv,
bindOuterSigTKBndrs_Tv, bindOuterSigTKBndrs_Skol,
- ContextKind(..),
-- Type checking type and class decls, and instances thereof
bindTyClTyVars, tcFamTyPats,
@@ -44,6 +46,7 @@ module GHC.Tc.Gen.HsType (
-- No kind generalisation, no checkValidType
InitialKindStrategy(..),
SAKS_or_CUSK(..),
+ ContextKind(..),
kcDeclHeader,
tcNamedWildCardBinders,
tcHsLiftedType, tcHsOpenType,
@@ -387,31 +390,19 @@ tc_hs_sig_type skol_info (L loc (HsSig { sig_bndrs = outer_bndrs
-- f :: a -> t a -> t a
-- then bring those implicit binders into scope here.
- let body_hs_ty :: LHsType GhcRn
- implicit_bndrs :: [Name]
- (implicit_bndrs, body_hs_ty)
- = case outer_bndrs of
- HsOuterExplicit { hso_bndrs = bndrs }
- -> ([], L loc $
- HsForAllTy { hst_xforall = noExtField
- , hst_tele = HsForAllInvis { hsf_xinvis = noExtField
- , hsf_invis_bndrs = bndrs }
- , hst_body = hs_ty })
- HsOuterImplicit { hso_ximplicit = implicit_bndrs }
- -> (implicit_bndrs, hs_ty)
-
- ; (tc_lvl, (wanted, (implicit_tkvs, ty)))
+ ; (tc_lvl, (wanted, (outer_bndrs, ty)))
<- pushTcLevelM $
solveLocalEqualitiesX "tc_hs_sig_type" $
-- See Note [Failure in local type signatures]
- bindImplicitTKBndrs_Skol implicit_bndrs $
+ tcOuterSigTKBndrs outer_bndrs $
do { kind <- newExpectedKind ctxt_kind
- ; tcLHsType body_hs_ty kind }
+ ; tcLHsType hs_ty kind }
-- Any remaining variables (unsolved in the solveLocalEqualities)
-- should be in the global tyvars, and therefore won't be quantified
- ; implicit_tkvs <- zonkAndScopedSort implicit_tkvs
- ; let ty1 = mkSpecForAllTys implicit_tkvs ty
+ ; (outer_tv_bndrs :: [InvisTVBinder]) <- zonkAndSortOuter outer_bndrs
+
+ ; let ty1 = mkInvisForAllTys outer_tv_bndrs ty
-- This bit is very much like decideMonoTyVars in GHC.Tc.Solver,
-- but constraints are so much simpler in kinds, it is much
@@ -424,7 +415,8 @@ tc_hs_sig_type skol_info (L loc (HsSig { sig_bndrs = outer_bndrs
-- Build an implication for any as-yet-unsolved kind equalities
-- See Note [Skolem escape in type signatures]
- ; implic <- buildTvImplication skol_info (kvs ++ implicit_tkvs) tc_lvl wanted
+ ; let skol_tvs = kvs ++ binderVars outer_tv_bndrs
+ ; implic <- buildTvImplication skol_info skol_tvs tc_lvl wanted
; return (implic, mkInfForAllTys kvs ty1) }
@@ -1020,10 +1012,9 @@ tc_hs_type mode (HsOpTy _ ty1 (L _ op) ty2) exp_kind
= tc_fun_type mode HsUnrestrictedArrow ty1 ty2 exp_kind
--------- Foralls
-tc_hs_type mode forall@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind
- = do { (tclvl, wanted, (tv_bndrs, ty'))
- <- pushLevelAndCaptureConstraints $
- bindExplicitTKTele_Skol_M mode tele $
+tc_hs_type mode (HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind
+ = do { (tv_bndrs, ty')
+ <- tcTKTelescope mode tele $
-- The _M variant passes on the mode from the type, to
-- any wildcards in kind signatures on the forall'd variables
-- e.g. f :: _ -> Int -> forall (a :: _). blah
@@ -1032,18 +1023,6 @@ tc_hs_type mode forall@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind
-- Do not kind-generalise here! See Note [Kind generalisation]
- ; let skol_info = ForAllSkol (ppr forall) $ sep $ case tele of
- HsForAllVis { hsf_vis_bndrs = hs_tvs } ->
- map ppr hs_tvs
- HsForAllInvis { hsf_invis_bndrs = hs_tvs } ->
- map ppr hs_tvs
- skol_tvs = binderVars tv_bndrs
- ; implic <- buildTvImplication skol_info skol_tvs tclvl wanted
- ; emitImplication implic
- -- /Always/ emit this implication even if wanted is empty
- -- We need the implication so that we check for a bad telescope
- -- See Note [Skolem escape and forall-types]
-
; return (mkForAllTys tv_bndrs ty') }
tc_hs_type mode (HsQualTy { hst_ctxt = ctxt, hst_body = rn_ty }) exp_kind
@@ -2982,25 +2961,71 @@ cloneFlexiKindedTyVarTyVar = newFlexiKindedTyVar cloneTyVarTyVar
-- Explicit binders
--------------------------------------
--- | Skolemise the 'HsTyVarBndr's in an 'HsForAllTelescope' with the supplied
--- 'TcTyMode'.
-bindExplicitTKTele_Skol_M
- :: TcTyMode
- -> HsForAllTelescope GhcRn
- -> TcM a
- -> TcM ([TcTyVarBinder], a)
-bindExplicitTKTele_Skol_M mode tele thing_inside = case tele of
+tcTKTelescope :: TcTyMode
+ -> HsForAllTelescope GhcRn
+ -> TcM a
+ -> TcM ([TcTyVarBinder], a)
+tcTKTelescope mode tele thing_inside = case tele of
HsForAllVis { hsf_vis_bndrs = bndrs }
- -> do { (req_tv_bndrs, thing) <- bindExplicitTKBndrs_Skol_M mode bndrs thing_inside
+ -> do { (req_tv_bndrs, thing) <- tcExplicitTKBndrs mode bndrs thing_inside
-- req_tv_bndrs :: [VarBndr TyVar ()],
-- but we want [VarBndr TyVar ArgFlag]
; return (tyVarReqToBinders req_tv_bndrs, thing) }
HsForAllInvis { hsf_invis_bndrs = bndrs }
- -> do { (inv_tv_bndrs, thing) <- bindExplicitTKBndrs_Skol_M mode bndrs thing_inside
+ -> do { (inv_tv_bndrs, thing) <- tcExplicitTKBndrs mode bndrs thing_inside
-- inv_tv_bndrs :: [VarBndr TyVar Specificity],
-- but we want [VarBndr TyVar ArgFlag]
; return (tyVarSpecToBinders inv_tv_bndrs, thing) }
+zonkAndSortOuter :: OuterTyVarBndrs [TcTyVar] [TcInvisTVBinder]
+ -> TcM [TcInvisTVBinder]
+zonkAndSortOuter (OuterImplicit imp_tvs)
+ = do { imp_tvs <- zonkAndScopedSort imp_tvs
+ ; return [Bndr tv SpecifiedSpec | tv <- imp_tvs] }
+zonkAndSortOuter (OuterExplicit exp_tvs)
+ = -- No need to dependency-sort explicit quantifiers
+ return exp_tvs
+
+tcOuterSigTKBndrs
+ :: HsOuterSigTyVarBndrs GhcRn
+ -> TcM a
+ -> TcM ( OuterTyVarBndrs [TcTyVar] -- Implicit
+ [TcInvisTVBinder] -- Explicit, with Specificity
+ , a)
+tcOuterSigTKBndrs (OuterImplicit implicit_nms) thing_inside
+ = -- Implicit: just bind the variables; no push levels, no capturing constraints
+ do { (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_nms thing_inside
+ ; return (OuterImplicit imp_tvs, thing) }
+tcOuterSigTKBndrs (OuterExplicit hs_bndrs) thing_inside
+ = -- Explicit: push level, capture constraints, make implication
+ do { (bndrs, thing) <- tcExplicitTKBndrs (mkMode TypeLevel) hs_bndrs thing_inside
+ ; return (OuterExplicit bndrs, thing) }
+
+tcExplicitTKBndrs :: OutputableBndrFlag flag
+ => TcTyMode
+ -> [LHsTyVarBndr flag GhcRn]
+ -> TcM a
+ -> TcM ([VarBndr TyVar flag], a)
+-- Push level, capture constraints, solve them, and emit an
+-- implication constraint with a ForAllSkol ic_info, so that it
+-- is subject to a telescope test.
+tcExplicitTKBndrs mode bndrs thing_inside
+ = do { (tclvl, wanted, (skol_tvs, res))
+ <- pushLevelAndCaptureConstraints $
+ bindExplicitTKBndrs_Skol_M mode bndrs $
+ thing_inside
+
+ ; let skol_info = ForAllSkol (ppr bndrs)
+ ; implic <- buildTvImplication skol_info (binderVars skol_tvs) tclvl wanted
+ ; emitImplication implic
+ -- /Always/ emit this implication even if wanted is empty
+ -- We need the implication so that we check for a bad telescope
+ -- See Note [Skolem escape and forall-types]
+
+ ; return (skol_tvs, res) }
+
+-- | Skolemise the 'HsTyVarBndr's in an 'HsForAllTelescope' with the supplied
+-- 'TcTyMode'.
bindExplicitTKBndrs_Skol, bindExplicitTKBndrs_Tv
:: (OutputableBndrFlag flag)
=> [LHsTyVarBndr flag GhcRn]
@@ -3068,6 +3093,7 @@ bindExplicitTKBndrsX tc_tv hs_tvs thing_inside
-- Outer type variable binders
--------------------------------------
+
-- TODO RGS: Which of these do we actually need?
-- TODO RGS: Docs(?)
@@ -3078,9 +3104,9 @@ bindOuterFamEqnTKBndrs_Q_Skol :: ContextKind
-> TcM a
-> TcM ([TcTyVar], a)
bindOuterFamEqnTKBndrs_Q_Skol ctxt_kind outer_bndrs thing_inside = case outer_bndrs of
- HsOuterImplicit{hso_ximplicit = implicit_tkv_nms} -> do
+ OuterImplicit implicit_tkv_nms -> do
bindImplicitTKBndrs_Q_Skol implicit_tkv_nms thing_inside
- HsOuterExplicit{hso_bndrs = exp_bndrs} -> do
+ OuterExplicit exp_bndrs -> do
bindExplicitTKBndrs_Q_Skol ctxt_kind exp_bndrs thing_inside
-- TODO RGS: Docs(?)
@@ -3091,9 +3117,9 @@ bindOuterFamEqnTKBndrs_Q_Tv :: ContextKind
-> TcM a
-> TcM ([TcTyVar], a)
bindOuterFamEqnTKBndrs_Q_Tv ctxt_kind outer_bndrs thing_inside = case outer_bndrs of
- HsOuterImplicit{hso_ximplicit = implicit_tkv_nms}
+ OuterImplicit implicit_tkv_nms
-> bindImplicitTKBndrs_Q_Tv implicit_tkv_nms thing_inside
- HsOuterExplicit{hso_bndrs = exp_bndrs}
+ OuterExplicit exp_bndrs
-> bindExplicitTKBndrs_Q_Tv ctxt_kind exp_bndrs thing_inside
-- TODO RGS: Docs(?)
@@ -3103,10 +3129,10 @@ bindOuterSigTKBndrs_Skol :: HsOuterSigTyVarBndrs GhcRn
-> TcM a
-> TcM (Either [TcTyVar] [TcInvisTVBinder], a)
bindOuterSigTKBndrs_Skol outer_bndrs thing_inside = case outer_bndrs of
- HsOuterImplicit{hso_ximplicit = implicit_tkv_nms}
+ OuterImplicit implicit_tkv_nms
-> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_tkv_nms thing_inside
; pure (Left imp_tvs, thing) }
- HsOuterExplicit{hso_bndrs = exp_bndrs}
+ OuterExplicit exp_bndrs
-> do { (exp_bndrs', thing) <- bindExplicitTKBndrs_Skol exp_bndrs thing_inside
; pure (Right exp_bndrs', thing) }
@@ -3117,10 +3143,10 @@ bindOuterSigTKBndrs_Tv :: HsOuterSigTyVarBndrs GhcRn
-> TcM a
-> TcM (Either [TcTyVar] [TcInvisTVBinder], a)
bindOuterSigTKBndrs_Tv outer_bndrs thing_inside = case outer_bndrs of
- HsOuterImplicit{hso_ximplicit = implicit_tv_names}
+ OuterImplicit implicit_tv_names
-> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Tv implicit_tv_names thing_inside
; pure (Left imp_tvs, thing) }
- HsOuterExplicit{hso_bndrs = exp_bndrs}
+ OuterExplicit exp_bndrs
-> do { (exp_bndrs', thing) <- bindExplicitTKBndrs_Tv exp_bndrs thing_inside
; pure (Right exp_bndrs', thing) }
@@ -3132,10 +3158,10 @@ bindOuterSigTKBndrs_Skol_M :: TcTyMode
-> TcM a
-> TcM (Either [TcTyVar] [TcInvisTVBinder], a)
bindOuterSigTKBndrs_Skol_M mode outer_bndrs thing_inside = case outer_bndrs of
- HsOuterImplicit{hso_ximplicit = implicit_tkv_nms}
+ OuterImplicit implicit_tkv_nms
-> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_tkv_nms thing_inside
; pure (Left imp_tvs, thing) }
- HsOuterExplicit{hso_bndrs = exp_bndrs}
+ OuterExplicit exp_bndrs
-> do { (exp_bndrs', thing) <- bindExplicitTKBndrs_Skol_M mode exp_bndrs thing_inside
; pure (Right exp_bndrs', thing) }
@@ -3147,10 +3173,10 @@ bindOuterSigTKBndrs_Tv_M :: TcTyMode
-> TcM a
-> TcM ([TcInvisTVBinder], a)
bindOuterSigTKBndrs_Tv_M mode outer_bndrs thing_inside = case outer_bndrs of
- HsOuterImplicit{hso_ximplicit = implicit_tkv_nms}
+ OuterImplicit implicit_tkv_nms
-> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Tv implicit_tkv_nms thing_inside
; pure (mkTyVarBinders SpecifiedSpec imp_tvs, thing) }
- HsOuterExplicit{hso_bndrs = exp_bndrs}
+ OuterExplicit exp_bndrs
-> do { (exp_bndrs', thing) <- bindExplicitTKBndrs_Tv_M mode exp_bndrs thing_inside
; pure (exp_bndrs', thing) }
@@ -3659,8 +3685,8 @@ tcHsPartialSigType ctxt sig_ty
-- we bring the right name into scope in the function body.
-- Test case: partial-sigs/should_compile/LocalDefinitionBug
; let imp_or_exp_hs_tvs = case outer_bndrs of
- HsOuterImplicit{hso_ximplicit = imp_tvs} -> imp_tvs
- HsOuterExplicit{hso_bndrs = exp_tvs} -> hsLTyVarNames exp_tvs
+ OuterImplicit imp_tvs -> imp_tvs
+ OuterExplicit exp_tvs -> hsLTyVarNames exp_tvs
tv_prs = imp_or_exp_hs_tvs `zip` imp_or_exp_tvbndrs
-- NB: checkValidType on the final inferred type will be
=====================================
compiler/GHC/Tc/Gen/Sig.hs
=====================================
@@ -270,8 +270,8 @@ isCompleteHsSig (HsWC { hswc_ext = wcs, hswc_body = hs_sig_ty })
no_anon_wc_sig_ty :: LHsSigType GhcRn -> Bool
no_anon_wc_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) =
case outer_bndrs of
- HsOuterImplicit{} -> no_anon_wc_ty body
- HsOuterExplicit{hso_bndrs = ltvs} -> all no_anon_wc_tvb ltvs && no_anon_wc_ty body
+ OuterImplicit{} -> no_anon_wc_ty body
+ OuterExplicit ltvs -> all no_anon_wc_tvb ltvs && no_anon_wc_ty body
no_anon_wc_ty :: LHsType GhcRn -> Bool
no_anon_wc_ty lty = go lty
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -2451,7 +2451,7 @@ getGhciStepIO = do
step_ty :: LHsSigType GhcRn
step_ty = noLoc $ HsSig
- { sig_bndrs = HsOuterImplicit{hso_ximplicit = [a_tv]}
+ { sig_bndrs = OuterImplicit [a_tv]
, sig_ext = noExtField
, sig_body = nlHsFunTy HsUnrestrictedArrow ghciM ioM }
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -3252,11 +3252,11 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data
do { traceTc "tcConDecl 1 gadt" (ppr names)
; let (L _ name : _) = names
- ; (imp_or_exp_tvs, (ctxt, arg_tys, res_ty, field_lbls, stricts))
+ ; (outer_bndrs, (ctxt, arg_tys, res_ty, field_lbls, stricts))
<- pushTcLevelM_ $ -- We are going to generalise
solveEqualities $ -- We won't get another crack, and we don't
-- want an error cascade
- bindOuterSigTKBndrs_Skol outer_bndrs $
+ tcOuterSigTKBndrs outer_bndrs $
do { ctxt <- tcHsMbContext cxt
; (res_ty, res_kind) <- tcInferLHsTypeKind hs_res_ty
-- See Note [GADT return kinds]
@@ -3269,16 +3269,14 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data
; field_lbls <- lookupConstructorFields name
; return (ctxt, arg_tys, res_ty, field_lbls, stricts)
}
- ; imp_or_exp_tvs <- bitraverse zonkAndScopedSort pure imp_or_exp_tvs
+ ; (outer_tv_bndrs :: [TcInvisTVBinder]) <- zonkAndSortOuter outer_bndrs
- ; tkvs <- kindGeneralizeAll (either mkSpecForAllTys mkInvisForAllTys
- imp_or_exp_tvs $
+ ; tkvs <- kindGeneralizeAll (mkInvisForAllTys outer_tv_bndrs $
mkPhiTy ctxt $
mkVisFunTys arg_tys $
res_ty)
- ; let tvbndrs = (mkTyVarBinders InferredSpec tkvs)
- ++ either (mkTyVarBinders SpecifiedSpec) id imp_or_exp_tvs
+ ; let tvbndrs = mkTyVarBinders InferredSpec tkvs ++ outer_tv_bndrs
-- Zonk to Types
; (ze, tvbndrs) <- zonkTyVarBinders tvbndrs
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -189,7 +189,6 @@ data SkolemInfo
-- hence, we have less info
| ForAllSkol -- Bound by a user-written "forall".
- SDoc -- Shows the entire forall type
SDoc -- Shows just the binders, used when reporting a bad telescope
-- See Note [Checking telescopes] in GHC.Tc.Types.Constraint
@@ -249,7 +248,7 @@ pprSkolInfo :: SkolemInfo -> SDoc
-- Complete the sentence "is a rigid type variable bound by..."
pprSkolInfo (SigSkol cx ty _) = pprSigSkolInfo cx ty
pprSkolInfo (SigTypeSkol cx) = pprUserTypeCtxt cx
-pprSkolInfo (ForAllSkol pt _) = quotes pt
+pprSkolInfo (ForAllSkol tvs) = text "an explicit forall" <+> tvs
pprSkolInfo (IPSkol ips) = text "the implicit-parameter binding" <> plural ips <+> text "for"
<+> pprWithCommas ppr ips
pprSkolInfo (DerivSkol pred) = text "the deriving clause for" <+> quotes (ppr pred)
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -613,8 +613,8 @@ cvtConstr (ForallC tvs ctxt con)
all_tvs = tvs' ++ outer_exp_tvs
outer_exp_tvs = case outer_bndrs of
- HsOuterImplicit{} -> []
- HsOuterExplicit{hso_bndrs = bndrs} -> bndrs
+ OuterImplicit{} -> []
+ OuterExplicit bndrs -> bndrs
add_forall tvs' cxt' con@(ConDeclH98 { con_ex_tvs = ex_tvs, con_mb_cxt = cxt })
= con { con_forall = noLoc $ not (null all_tvs)
@@ -1412,7 +1412,7 @@ cvtDerivClauseTys tys
-- unless the TH.Cxt is a singleton list whose type is a bare type
-- constructor with no arguments.
; case tys' of
- [ty'@(L l (HsSig { sig_bndrs = HsOuterImplicit{}
+ [ty'@(L l (HsSig { sig_bndrs = OuterImplicit{}
, sig_body = L _ (HsTyVar _ NotPromoted _) }))]
-> return $ L l $ DctSingle noExtField ty'
_ -> returnL $ DctMulti noExtField tys' }
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef6dfbaacffbaddc0a20a28fb00141f327f63761
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef6dfbaacffbaddc0a20a28fb00141f327f63761
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/20200922/c9b079e6/attachment-0001.html>
More information about the ghc-commits
mailing list