[Git][ghc/ghc][wip/T16762-chunks-2-and-3] WIP: Factor out HsPatSigType for pat sigs/RULE term sigs (#16762)
Ryan Scott
gitlab at gitlab.haskell.org
Tue May 5 23:26:03 UTC 2020
Ryan Scott pushed to branch wip/T16762-chunks-2-and-3 at Glasgow Haskell Compiler / GHC
Commits:
de54a099 by Ryan Scott at 2020-05-05T19:25:44-04:00
WIP: Factor out HsPatSigType for pat sigs/RULE term sigs (#16762)
This implements chunks (2) and (3) of
https://gitlab.haskell.org/ghc/ghc/issues/16762#note_270170. Namely,
it introduces a dedicated `HsPatSigType` AST type, which represents
the types that can appear in pattern signatures and term-level `RULE`
binders. Previously, these were represented with `LHsSigWcType`.
Although `LHsSigWcType` is isomorphic to `HsPatSigType`, the intended
semantics of the two types are slightly different, as evidenced by
the fact that they have different code paths in the renamer and
typechecker. See also my additions to `Note [HsType binders]`.
- - - - -
17 changed files:
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Extension.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Types.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/ThToHs.hs
- testsuite/tests/hiefile/should_compile/hie007.hs
Changes:
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -2244,7 +2244,7 @@ type LRuleBndr pass = Located (RuleBndr pass)
-- | Rule Binder
data RuleBndr pass
= RuleBndr (XCRuleBndr pass) (Located (IdP pass))
- | RuleBndrSig (XRuleBndrSig pass) (Located (IdP pass)) (LHsSigWcType pass)
+ | RuleBndrSig (XRuleBndrSig pass) (Located (IdP pass)) (HsPatSigType pass)
| XRuleBndr !(XXRuleBndr pass)
-- ^
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
@@ -2256,7 +2256,7 @@ type instance XCRuleBndr (GhcPass _) = NoExtField
type instance XRuleBndrSig (GhcPass _) = NoExtField
type instance XXRuleBndr (GhcPass _) = NoExtCon
-collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass]
+collectRuleBndrSigTys :: [RuleBndr pass] -> [HsPatSigType pass]
collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs]
pprFullRuleName :: Located (SourceText, RuleName) -> SDoc
=====================================
compiler/GHC/Hs/Extension.hs
=====================================
@@ -685,6 +685,11 @@ type family XXHsWildCardBndrs x b
-- -------------------------------------
+type family XHsPS x
+type family XXHsPatSigType x
+
+-- -------------------------------------
+
type family XForAllTy x
type family XQualTy x
type family XTyVar x
=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -386,6 +386,11 @@ deriving instance (Data thing) => Data (HsWildCardBndrs GhcPs thing)
deriving instance (Data thing) => Data (HsWildCardBndrs GhcRn thing)
deriving instance (Data thing) => Data (HsWildCardBndrs GhcTc thing)
+-- deriving instance (DataIdLR p p) => Data (HsPatSigType p)
+deriving instance Data (HsPatSigType GhcPs)
+deriving instance Data (HsPatSigType GhcRn)
+deriving instance Data (HsPatSigType GhcTc)
+
-- deriving instance (DataIdLR p p) => Data (HsTyVarBndr p)
deriving instance Data (HsTyVarBndr GhcPs)
deriving instance Data (HsTyVarBndr GhcRn)
=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -240,7 +240,7 @@ data Pat p
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| SigPat (XSigPat p) -- After typechecker: Type
(LPat p) -- Pattern with a type signature
- (LHsSigWcType (NoGhcTc p)) -- Signature can bind both
+ (HsPatSigType (NoGhcTc p)) -- Signature can bind both
-- kind and type vars
-- ^ Pattern with a type signature
=====================================
compiler/GHC/Hs/Types.hs
=====================================
@@ -23,6 +23,7 @@ module GHC.Hs.Types (
LHsQTyVars(..),
HsImplicitBndrs(..),
HsWildCardBndrs(..),
+ HsPatSigType(..), HsPSRn(..),
LHsSigType, LHsSigWcType, LHsWcType,
HsTupleSort(..),
HsContext, LHsContext, noLHsContext,
@@ -47,7 +48,7 @@ module GHC.Hs.Types (
mkAnonWildCardTy, pprAnonWildCard,
- mkHsImplicitBndrs, mkHsWildCardBndrs, hsImplicitBody,
+ mkHsImplicitBndrs, mkHsWildCardBndrs, mkHsPatSigType, hsImplicitBody,
mkEmptyImplicitBndrs, mkEmptyWildCardBndrs,
mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, isEmptyLHsQTvs,
isHsKindedTyVar, hsTvbAllKinded, isLHsForAllTy,
@@ -59,7 +60,7 @@ module GHC.Hs.Types (
splitLHsForAllTyInvis, splitLHsQualTy, splitLHsSigmaTyInvis,
splitHsFunType, hsTyGetAppHead_maybe,
mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy,
- ignoreParens, hsSigType, hsSigWcType,
+ ignoreParens, hsSigType, hsSigWcType, hsPatSigType,
hsLTyVarBndrToType, hsLTyVarBndrsToTypes,
hsTyKindSig,
hsConDetailsArgs,
@@ -184,6 +185,18 @@ is a bit complicated. Here's how it works.
f :: _a -> _
The enclosing HsWildCardBndrs binds the wildcards _a and _.
+* HsSigPatType describes types that appear in pattern signatures and
+ the signatures of term-level binders in RULES. Like
+ HsWildCardBndrs/HsImplicitBndrs, they track the names of wildcard
+ variables and implicitly quantified type variables. Unlike
+ HsImplicitBndrs, however, HsSigPatTypes do not obey the
+ forall-or-nothing rule. For example, in this pattern signature:
+
+ f (g :: forall a. a -> b) x = g x :: b
+
+ The type variable `b` is in scope on the RHS, even though it was
+ not explicitly quantified by the @forall@ in the pattern signature.
+
* The explicit presence of these wrappers specifies, in the HsSyn,
exactly where implicit quantification is allowed, and where
wildcards are allowed.
@@ -225,13 +238,15 @@ Note carefully:
Here _a is an ordinary forall'd binder, but (With NamedWildCards)
_b is a named wildcard. (See the comments in #10982)
-* Named wildcards are bound by the HsWildCardBndrs construct, which wraps
- types that are allowed to have wildcards. Unnamed wildcards however are left
- unchanged until typechecking, where we give them fresh wild tyavrs and
- determine whether or not to emit hole constraints on each wildcard
- (we don't if it's a visible type/kind argument or a type family pattern).
- See related notes Note [Wildcards in visible kind application]
- and Note [Wildcards in visible type application] in GHC.Tc.Gen.HsType
+* Named wildcards are bound by the HsWildCardBndrs (for types that obey the
+ forall-or-nothing rule) and HsPatSigType (for type signatures in patterns
+ and term-level binders in RULES), which wrap types that are allowed to have
+ wildcards. Unnamed wildcards, however are left unchanged until typechecking,
+ where we give them fresh wild tyvars and determine whether or not to emit
+ hole constraints on each wildcard (we don't if it's a visible type/kind
+ argument or a type family pattern). See related notes
+ Note [Wildcards in visible kind application] and
+ Note [Wildcards in visible type application] in GHC.Tc.Gen.HsType.
* After type checking is done, we report what types the wildcards
got unified with.
@@ -399,6 +414,30 @@ type instance XHsWC GhcTc b = [Name]
type instance XXHsWildCardBndrs (GhcPass _) b = NoExtCon
+-- | Types that can appear in pattern signatures, as well as the signatures for
+-- term-level binders in RULES. This is very similar to 'HsSigWcType', but with
+-- slightly different semantics: see @Note [HsType binders]@.
+-- See also @Note [The wildcard story for types]@.
+data HsPatSigType pass
+ = HsPS { hsps_ext :: XHsPS pass -- ^ After renamer: 'HsPSRn'
+ , hsps_body :: LHsType pass -- ^ Main payload (the type itself)
+ }
+ | XHsPatSigType !(XXHsPatSigType pass)
+
+-- | The extension field for 'HsPatSigType', which is only used in the
+-- renamer onwards.
+data HsPSRn = HsPSRn
+ { hsps_nwcs :: [Name] -- ^ Wildcard names
+ , hsps_imp_tvs :: [Name] -- ^ Implicitly quantified variable names
+ }
+ deriving Data
+
+type instance XHsPS GhcPs = NoExtField
+type instance XHsPS GhcRn = HsPSRn
+type instance XHsPS GhcTc = HsPSRn
+
+type instance XXHsPatSigType (GhcPass _) = NoExtCon
+
-- | Located Haskell Signature Type
type LHsSigType pass = HsImplicitBndrs pass (LHsType pass) -- Implicit only
@@ -419,6 +458,9 @@ hsSigType = hsImplicitBody
hsSigWcType :: LHsSigWcType pass -> LHsType pass
hsSigWcType sig_ty = hsib_body (hswc_body sig_ty)
+hsPatSigType :: HsPatSigType pass -> LHsType pass
+hsPatSigType = hsps_body
+
dropWildCards :: LHsSigWcType pass -> LHsSigType pass
-- Drop the wildcard part of a LHsSigWcType
dropWildCards sig_ty = hswc_body sig_ty
@@ -451,6 +493,10 @@ mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs x = HsWC { hswc_body = x
, hswc_ext = noExtField }
+mkHsPatSigType :: LHsType GhcPs -> HsPatSigType GhcPs
+mkHsPatSigType x = HsPS { hsps_ext = noExtField
+ , hsps_body = x }
+
-- Add empty binders. This is a bit suspicious; what if
-- the wrapped thing had free type variables?
mkEmptyImplicitBndrs :: thing -> HsImplicitBndrs GhcRn thing
@@ -1408,6 +1454,10 @@ instance Outputable thing
=> Outputable (HsWildCardBndrs (GhcPass p) thing) where
ppr (HsWC { hswc_body = ty }) = ppr ty
+instance OutputableBndrId p
+ => Outputable (HsPatSigType (GhcPass p)) where
+ ppr (HsPS { hsps_body = ty }) = ppr ty
+
pprAnonWildCard :: SDoc
pprAnonWildCard = char '_'
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -821,7 +821,7 @@ repRuleD (L loc (HsRule { rd_name = n
ruleBndrNames :: LRuleBndr GhcRn -> [Name]
ruleBndrNames (L _ (RuleBndr _ n)) = [unLoc n]
ruleBndrNames (L _ (RuleBndrSig _ n sig))
- | HsWC { hswc_body = HsIB { hsib_ext = vars }} <- sig
+ | HsPS { hsps_ext = HsPSRn { hsps_imp_tvs = vars }} <- sig
= unLoc n : vars
repRuleBndr :: LRuleBndr GhcRn -> MetaM (Core (M TH.RuleBndr))
@@ -830,7 +830,7 @@ repRuleBndr (L _ (RuleBndr _ n))
; rep2 ruleVarName [n'] }
repRuleBndr (L _ (RuleBndrSig _ n sig))
= do { MkC n' <- lookupLBinder n
- ; MkC ty' <- repLTy (hsSigWcType sig)
+ ; MkC ty' <- repLTy (hsPatSigType sig)
; rep2 typedRuleVarName [n', ty'] }
repAnnD :: LAnnDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
@@ -1935,7 +1935,7 @@ repP (NPat _ (L _ l) Nothing _) = do { a <- repOverloadedLiteral l
repP (ViewPat _ e p) = do { e' <- repLE e; p' <- repLP p; repPview e' p' }
repP p@(NPat _ _ (Just _) _) = notHandled "Negative overloaded patterns" (ppr p)
repP (SigPat _ p t) = do { p' <- repLP p
- ; t' <- repLTy (hsSigWcType t)
+ ; t' <- repLTy (hsPatSigType t)
; repPsig p' t' }
repP (SplicePat _ splice) = repSplice splice
repP other = notHandled "Exotic pattern" (ppr other)
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -833,7 +833,7 @@ instance ( a ~ GhcPass p
[ toHie $ PS rsp scope pscope pat
, let cscope = mkLScope pat in
toHie $ TS (ResolvedScopes [cscope, scope, pscope])
- (protectSig @a cscope sig)
+ (protectSig @a cscope undefined) -- TODO RGS: Help me wz1000!
-- See Note [Scoping Rules for SigPat]
]
XPat e -> case ghcPass @p of
@@ -1847,7 +1847,7 @@ instance ToHie (RScoped (LRuleBndr GhcRn)) where
]
RuleBndrSig _ var typ ->
[ toHie $ C (ValBind RegularBind sc Nothing) var
- , toHie $ TS (ResolvedScopes [sc]) typ
+ , toHie $ TS (ResolvedScopes [sc]) (undefined :: LHsSigWcType GhcRn) -- TODO RGS: Help me wz1000!
]
instance ToHie (LImportDecl GhcRn) where
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -874,7 +874,7 @@ mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]
mkRuleBndrs = fmap (fmap cvt_one)
where cvt_one (RuleTyTmVar v Nothing) = RuleBndr noExtField v
cvt_one (RuleTyTmVar v (Just sig)) =
- RuleBndrSig noExtField v (mkLHsSigWcType sig)
+ RuleBndrSig noExtField v (mkHsPatSigType sig)
-- turns RuleTyTmVars into HsTyVarBndrs - this is more interesting
mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr GhcPs]
@@ -2033,7 +2033,7 @@ instance DisambECP (PatBuilder GhcPs) where
mkHsWildCardPV l = return $ L l (PatBuilderPat (WildPat noExtField))
mkHsTySigPV l b sig = do
p <- checkLPat b
- return $ L l (PatBuilderPat (SigPat noExtField p (mkLHsSigWcType sig)))
+ return $ L l (PatBuilderPat (SigPat noExtField p (mkHsPatSigType sig)))
mkHsExplicitListPV l xs = do
ps <- traverse checkLPat xs
return (L l (PatBuilderPat (ListPat noExtField ps)))
=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -962,7 +962,7 @@ renameSig _ (IdSig _ x)
renameSig ctxt sig@(TypeSig _ vs ty)
= do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
; let doc = TypeSigCtx (ppr_sig_bndrs vs)
- ; (new_ty, fvs) <- rnHsSigWcType BindUnlessForall doc ty
+ ; (new_ty, fvs) <- rnHsSigWcType doc ty
; return (TypeSig noExtField new_vs new_ty, fvs) }
renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty)
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -316,7 +316,7 @@ rnExpr (RecordUpd { rupd_expr = expr, rupd_flds = rbinds })
, fvExpr `plusFV` fvRbinds) }
rnExpr (ExprWithTySig _ expr pty)
- = do { (pty', fvTy) <- rnHsSigWcType BindUnlessForall ExprWithTySigCtx pty
+ = do { (pty', fvTy) <- rnHsSigWcType ExprWithTySigCtx pty
; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $
rnLExpr expr
; return (ExprWithTySig noExtField expr' pty', fvExpr `plusFV` fvTy) }
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -13,7 +13,7 @@ module GHC.Rename.HsType (
rnHsType, rnLHsType, rnLHsTypes, rnContext,
rnHsKind, rnLHsKind, rnLHsTypeArgs,
rnHsSigType, rnHsWcType,
- HsSigWcTypeScoping(..), rnHsSigWcType, rnHsSigWcTypeScoped,
+ HsSigWcTypeScoping(..), rnHsSigWcType, rnHsPatSigType,
newTyVarNameRn,
rnConDeclFields,
rnLTyVar,
@@ -71,58 +71,85 @@ import Control.Monad ( unless, when )
{-
These type renamers are in a separate module, rather than in (say) GHC.Rename.Module,
-to break several loop.
+to break several loops.
*********************************************************
* *
- HsSigWcType (i.e with wildcards)
+ HsSigWcType and HsPatSigType (i.e with wildcards)
* *
*********************************************************
-}
-data HsSigWcTypeScoping = AlwaysBind
- -- ^ Always bind any free tyvars of the given type,
- -- regardless of whether we have a forall at the top
- | BindUnlessForall
- -- ^ Unless there's forall at the top, do the same
- -- thing as 'AlwaysBind'
- | NeverBind
- -- ^ Never bind any free tyvars
-
-rnHsSigWcType :: HsSigWcTypeScoping -> HsDocContext -> LHsSigWcType GhcPs
+data HsSigWcTypeScoping
+ = AlwaysBind
+ -- ^ Always bind any free tyvars of the given type, regardless of whether we
+ -- have a forall at the top.
+ --
+ -- For pattern type sigs and rules we /do/ want to bring those type
+ -- variables into scope, even if there's a forall at the top which usually
+ -- stops that happening, e.g:
+ --
+ -- > \ (x :: forall a. a-> b) -> e
+ --
+ -- Here we do bring 'b' into scope.
+ | BindUnlessForall
+ -- ^ Unless there's forall at the top, do the same thing as 'AlwaysBind'.
+ -- This is only ever used in places where the \"@forall at -or-nothing\" rule
+ -- is in effect.
+ | NeverBind
+ -- ^ Never bind any free tyvars. This is only used for RULES that have both
+ -- type and term variabls binders, e.g.:
+ --
+ -- > {-# RULES "id" forall a. forall (x :: a) y. const x y = x #-}
+ --
+ -- The presence of the type variable binder @forall a.@ implies that the
+ -- free variables in the types of the term variable binders @x@ and @y@
+ -- are /not/ bound. In the example above, there are no such free variables,
+ -- but if the user had written @(y :: b)@ instead of @y@ in the term
+ -- variable binders, then @b@ would be rejected for being out of scope.
+ -- If the user had omitted the type variable binder, however:
+ --
+ -- > {-# RULES "id" forall (x :: a) (y :: b). const x y = x #-}
+ --
+ -- Then @(y :: b)@ would be fine, as it would be implicitly quantified.
+ -- In other words, omitting type variable binders caused 'AlwaysBind',
+ -- not 'NeverBind', to be picked.
+
+rnHsSigWcType :: HsDocContext -> LHsSigWcType GhcPs
-> RnM (LHsSigWcType GhcRn, FreeVars)
-rnHsSigWcType scoping doc sig_ty
- = rn_hs_sig_wc_type scoping doc sig_ty $ \sig_ty' ->
- return (sig_ty', emptyFVs)
-
-rnHsSigWcTypeScoped :: HsSigWcTypeScoping
- -- AlwaysBind: for pattern type sigs and rules we /do/ want
- -- to bring those type variables into scope, even
- -- if there's a forall at the top which usually
- -- stops that happening
- -- e.g \ (x :: forall a. a-> b) -> e
- -- Here we do bring 'b' into scope
- -> HsDocContext -> LHsSigWcType GhcPs
- -> (LHsSigWcType GhcRn -> RnM (a, FreeVars))
- -> RnM (a, FreeVars)
+rnHsSigWcType doc (HsWC { hswc_body = HsIB { hsib_body = hs_ty }})
+ = rn_hs_sig_wc_type BindUnlessForall doc hs_ty $ \nwcs imp_tvs body ->
+ let ib_ty = HsIB { hsib_ext = imp_tvs, hsib_body = body }
+ wc_ty = HsWC { hswc_ext = nwcs, hswc_body = ib_ty } in
+ pure (wc_ty, emptyFVs)
+
+rnHsPatSigType :: HsSigWcTypeScoping
+ -> HsDocContext -> HsPatSigType GhcPs
+ -> (HsPatSigType GhcRn -> RnM (a, FreeVars))
+ -> RnM (a, FreeVars)
-- Used for
--- - Signatures on binders in a RULE
--- - Pattern type signatures
+-- - Pattern type signatures, which are only allowed with ScopedTypeVariables
+-- - Signatures on binders in a RULE, which are allowed even if
+-- ScopedTypeVariables isn't enabled
-- Wildcards are allowed
--- type signatures on binders only allowed with ScopedTypeVariables
-rnHsSigWcTypeScoped scoping ctx sig_ty thing_inside
+rnHsPatSigType scoping ctx sig_ty thing_inside
= do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables
- ; checkErr ty_sig_okay (unexpectedTypeSigErr sig_ty)
- ; rn_hs_sig_wc_type scoping ctx sig_ty thing_inside
- }
-
-rn_hs_sig_wc_type :: HsSigWcTypeScoping -> HsDocContext -> LHsSigWcType GhcPs
- -> (LHsSigWcType GhcRn -> RnM (a, FreeVars))
+ ; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty)
+ ; rn_hs_sig_wc_type scoping ctx (hsPatSigType sig_ty) $
+ \nwcs imp_tvs body ->
+ do { let sig_names = HsPSRn { hsps_nwcs = nwcs, hsps_imp_tvs = imp_tvs }
+ sig_ty' = HsPS { hsps_ext = sig_names, hsps_body = body }
+ ; thing_inside sig_ty'
+ } }
+
+-- The workhorse for rnHsSigWcType and rnHsPatSigType.
+rn_hs_sig_wc_type :: HsSigWcTypeScoping -> HsDocContext -> LHsType GhcPs
+ -> ([Name] -- Wildcard names
+ -> [Name] -- Implicitly quantified type variable names
+ -> LHsType GhcRn
+ -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
--- rn_hs_sig_wc_type is used for source-language type signatures
-rn_hs_sig_wc_type scoping ctxt
- (HsWC { hswc_body = HsIB { hsib_body = hs_ty }})
- thing_inside
+rn_hs_sig_wc_type scoping ctxt hs_ty thing_inside
= do { free_vars <- extractFilteredRdrTyVarsDups hs_ty
; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars
; let nwc_rdrs = nubL nwc_rdrs'
@@ -132,10 +159,7 @@ rn_hs_sig_wc_type scoping ctxt
NeverBind -> False
; rnImplicitBndrs bind_free_tvs tv_rdrs $ \ vars ->
do { (wcs, hs_ty', fvs1) <- rnWcBody ctxt nwc_rdrs hs_ty
- ; let sig_ty' = HsWC { hswc_ext = wcs, hswc_body = ib_ty' }
- ib_ty' = HsIB { hsib_ext = vars
- , hsib_body = hs_ty' }
- ; (res, fvs2) <- thing_inside sig_ty'
+ ; (res, fvs2) <- thing_inside wcs vars hs_ty'
; return (res, fvs1 `plusFV` fvs2) } }
rnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars)
@@ -1376,8 +1400,8 @@ ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity)
* *
***************************************************** -}
-unexpectedTypeSigErr :: LHsSigWcType GhcPs -> SDoc
-unexpectedTypeSigErr ty
+unexpectedPatSigTypeErr :: HsPatSigType GhcPs -> SDoc
+unexpectedPatSigTypeErr ty
= hang (text "Illegal type signature:" <+> quotes (ppr ty))
2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables")
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -958,7 +958,7 @@ rnSrcDerivDecl (DerivDecl _ ty mds overlap)
; unless standalone_deriv_ok (addErr standaloneDerivErr)
; (mds', ty', fvs)
<- rnLDerivStrategy DerivDeclCtx mds $
- rnHsSigWcType BindUnlessForall DerivDeclCtx ty
+ rnHsSigWcType DerivDeclCtx ty
; warnNoDerivStrat mds' loc
; return (DerivDecl noExtField ty' mds' overlap, fvs) }
where
@@ -1029,7 +1029,7 @@ bindRuleTmVars doc tyvs vars names thing_inside
go ((L l (RuleBndrSig _ (L loc _) bsig)) : vars)
(n : ns) thing_inside
- = rnHsSigWcTypeScoped bind_free_tvs doc bsig $ \ bsig' ->
+ = rnHsPatSigType bind_free_tvs doc bsig $ \ bsig' ->
go vars ns $ \ vars' ->
thing_inside (L l (RuleBndrSig noExtField (L loc n) bsig') : vars')
=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -218,9 +218,6 @@ matchNameMaker ctxt = LamMk report_unused
ThPatQuote -> False
_ -> True
-rnHsSigCps :: LHsSigWcType GhcPs -> CpsRn (LHsSigWcType GhcRn)
-rnHsSigCps sig = CpsRn (rnHsSigWcTypeScoped AlwaysBind PatCtx sig)
-
newPatLName :: NameMaker -> Located RdrName -> CpsRn (Located Name)
newPatLName name_maker rdr_name@(L loc _)
= do { name <- newPatName name_maker rdr_name
@@ -410,9 +407,12 @@ rnPatAndThen mk (SigPat x pat sig)
-- f ((Just (x :: a) :: Maybe a)
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~^ `a' is first bound here
-- ~~~~~~~~~~~~~~~^ the same `a' then used here
- = do { sig' <- rnHsSigCps sig
+ = do { sig' <- rnHsPatSigTypeAndThen sig
; pat' <- rnLPatAndThen mk pat
; return (SigPat x pat' sig' ) }
+ where
+ rnHsPatSigTypeAndThen :: HsPatSigType GhcPs -> CpsRn (HsPatSigType GhcRn)
+ rnHsPatSigTypeAndThen sig = CpsRn (rnHsPatSigType AlwaysBind PatCtx sig)
rnPatAndThen mk (LitPat x lit)
| HsString src s <- lit
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -3338,7 +3338,7 @@ Result works fine, but it may eventually bite us.
********************************************************************* -}
tcHsPatSigType :: UserTypeCtxt
- -> LHsSigWcType GhcRn -- The type signature
+ -> HsPatSigType GhcRn -- The type signature
-> TcM ( [(Name, TcTyVar)] -- Wildcards
, [(Name, TcTyVar)] -- The new bit of type environment, binding
-- the scoped type variables
@@ -3349,10 +3349,9 @@ tcHsPatSigType :: UserTypeCtxt
--
-- This may emit constraints
-- See Note [Recipe for checking a signature]
-tcHsPatSigType ctxt sig_ty
- | HsWC { hswc_ext = sig_wcs, hswc_body = ib_ty } <- sig_ty
- , HsIB { hsib_ext = sig_ns
- , hsib_body = hs_ty } <- ib_ty
+tcHsPatSigType ctxt
+ (HsPS { hsps_ext = HsPSRn { hsps_nwcs = sig_wcs, hsps_imp_tvs = sig_ns }
+ , hsps_body = hs_ty })
= addSigCtxt ctxt hs_ty $
do { sig_tkv_prs <- mapM new_implicit_tv sig_ns
; (wcs, sig_ty)
=====================================
compiler/GHC/Tc/Gen/Pat.hs
=====================================
@@ -690,7 +690,7 @@ because they won't be in scope when we do the desugaring
-}
tcPatSig :: Bool -- True <=> pattern binding
- -> LHsSigWcType GhcRn
+ -> HsPatSigType GhcRn
-> ExpSigmaType
-> TcM (TcType, -- The type to use for "inside" the signature
[(Name,TcTyVar)], -- The new bit of type environment, binding
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -830,7 +830,7 @@ cvtRuleBndr (RuleVar n)
cvtRuleBndr (TypedRuleVar n ty)
= do { n' <- vNameL n
; ty' <- cvtType ty
- ; return $ noLoc $ Hs.RuleBndrSig noExtField n' $ mkLHsSigWcType ty' }
+ ; return $ noLoc $ Hs.RuleBndrSig noExtField n' $ mkHsPatSigType ty' }
---------------------------------------------------
-- Declarations
@@ -1307,7 +1307,7 @@ cvtp (ListP ps) = do { ps' <- cvtPats ps
; return
$ ListPat noExtField ps'}
cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t
- ; return $ SigPat noExtField p' (mkLHsSigWcType t') }
+ ; return $ SigPat noExtField p' (mkHsPatSigType t') }
cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
; return $ ViewPat noExtField e' p'}
=====================================
testsuite/tests/hiefile/should_compile/hie007.hs
=====================================
@@ -64,3 +64,6 @@ thud f x =
(x :: a, y) :: (a, b)
where
y = (f :: a -> b) x :: b
+
+rankn :: (forall a1. a1 -> b) -> a2 -> b
+rankn (g :: forall a1. a1 -> b) x = g x :: b
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/de54a0994e83f4f7ddaa8e9a0ae7510e99c153d2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/de54a0994e83f4f7ddaa8e9a0ae7510e99c153d2
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/20200505/922322d6/attachment-0001.html>
More information about the ghc-commits
mailing list