summaryrefslogtreecommitdiff
path: root/compiler/GHC/Rename
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Rename')
-rw-r--r--compiler/GHC/Rename/Bind.hs9
-rw-r--r--compiler/GHC/Rename/Expr.hs2
-rw-r--r--compiler/GHC/Rename/HsType.hs45
-rw-r--r--compiler/GHC/Rename/Module.hs2
4 files changed, 38 insertions, 20 deletions
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 73af997a2e..80736c0a34 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -519,7 +519,7 @@ rnBind sig_fn bind@(FunBind { fun_id = name
-- invariant: no free vars here when it's a FunBind
= do { let plain_name = unLoc name
- ; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
+ ; (matches', rhs_fvs) <- bindSigTyVarsFVExtended (sig_fn plain_name) $
-- bindSigTyVars tests for LangExt.ScopedTyVars
rnMatchGroup (mkPrefixFunRhs name)
rnLExpr matches
@@ -726,7 +726,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
; unless pattern_synonym_ok (addErr TcRnIllegalPatternSynonymDecl)
; let scoped_tvs = sig_fn name
- ; ((pat', details'), fvs1) <- bindSigTyVarsFV scoped_tvs $
+ ; ((pat', details'), fvs1) <- bindSigTyVarsFVExtended scoped_tvs $
rnPat PatSyn pat $ \pat' ->
-- We check the 'RdrName's instead of the 'Name's
-- so that the binding locations are reported
@@ -763,7 +763,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
Unidirectional -> return (Unidirectional, emptyFVs)
ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs)
ExplicitBidirectional mg ->
- do { (mg', fvs) <- bindSigTyVarsFV scoped_tvs $
+ do { (mg', fvs) <- bindSigTyVarsFVExtended scoped_tvs $
rnMatchGroup (mkPrefixFunRhs (L l name))
rnLExpr mg
; return (ExplicitBidirectional mg', fvs) }
@@ -920,7 +920,8 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs
-- Rename the bindings RHSs. Again there's an issue about whether the
-- type variables from the class/instance head are in scope.
-- Answer no in Haskell 2010, but yes if you have -XScopedTypeVariables
- ; (binds'', bind_fvs) <- bindSigTyVarsFV ktv_names $
+ -- or -XMethodTypeVariables
+ ; (binds'', bind_fvs) <- bindSigTyVarsFVMethod ktv_names $
do { binds_w_dus <- mapBagM (rnLBind (mkScopedTvFn other_sigs')) binds'
; let bind_fvs = foldr (\(_,_,fv1) fv2 -> fv1 `plusFV` fv2)
emptyFVs binds_w_dus
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 2afc0f0fa6..184b5f8550 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -521,7 +521,7 @@ rnExpr (HsRecSel x _) = dataConCantHappen x
rnExpr (ExprWithTySig _ expr pty)
= do { (pty', fvTy) <- rnHsSigWcType ExprWithTySigCtx pty
- ; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $
+ ; (expr', fvExpr) <- bindSigTyVarsFVExtended (hsWcScopedTvs pty') $
rnLExpr expr
; return (ExprWithTySig noExtField expr' pty', fvExpr `plusFV` fvTy) }
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index 049bbe2c22..7ab390615a 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -31,7 +31,8 @@ module GHC.Rename.HsType (
-- Binding related stuff
bindHsOuterTyVarBndrs, bindHsForAllTelescope,
bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..),
- rnImplicitTvOccs, bindSigTyVarsFV, bindHsQTyVars,
+ rnImplicitTvOccs, bindSigTyVarsFVExtended, bindSigTyVarsFVMethod,
+ bindHsQTyVars,
FreeKiTyVars, filterInScopeM,
extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars,
extractHsTysRdrTyVars, extractRdrKindSigVars,
@@ -150,14 +151,14 @@ rnHsPatSigType :: HsPatSigTypeScoping
-> (HsPatSigType GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
-- Used for
--- - Pattern type signatures, which are only allowed with ScopedTypeVariables
+-- - Pattern type signatures, which are only allowed with PatternSignatures
-- - Signatures on binders in a RULE, which are allowed even if
--- ScopedTypeVariables isn't enabled
+-- PatternSignatures isn't enabled
-- Wildcards are allowed
--
-- See Note [Pattern signature binders and scoping] in GHC.Hs.Type
rnHsPatSigType scoping ctx sig_ty thing_inside
- = do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables
+ = do { ty_sig_okay <- xoptM LangExt.PatternSignatures
; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty)
; free_vars <- filterInScopeM (extractHsTyRdrTyVars pat_sig_ty)
; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars
@@ -165,6 +166,9 @@ rnHsPatSigType scoping ctx sig_ty thing_inside
implicit_bndrs = case scoping of
AlwaysBind -> tv_rdrs
NeverBind -> []
+ ; let i_bndrs = nubN implicit_bndrs in
+ unless (null i_bndrs) $
+ addDiagnostic (TcRnPatternSignatureBinds i_bndrs)
; rnImplicitTvOccs Nothing implicit_bndrs $ \ imp_tvs ->
do { (nwcs, pat_sig_ty', fvs1) <- rnWcBody ctx nwc_rdrs pat_sig_ty
; let sig_names = HsPSRn { hsps_nwcs = nwcs, hsps_imp_tvs = imp_tvs }
@@ -386,6 +390,10 @@ rnImplicitTvOccs :: Maybe assoc
-> RnM (a, FreeVars)
rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside
= do { let implicit_vs = nubN implicit_vs_with_dups
+ ; unlessXOptM LangExt.ImplicitForAll $
+ unless (null implicit_vs) $
+ addErr (TcRnImplicitForAll implicit_vs)
+
; mapM_ warn_term_var_capture implicit_vs
; traceRn "rnImplicitTvOccs" $
@@ -900,18 +908,27 @@ notInKinds _ _ = return ()
* *
***************************************************** -}
-bindSigTyVarsFV :: [Name]
- -> RnM (a, FreeVars)
- -> RnM (a, FreeVars)
+bindSigTyVarsFVExtended, bindSigTyVarsFVMethod :: [Name]
+ -> RnM (a, FreeVars)
+ -> RnM (a, FreeVars)
-- Used just before renaming the defn of a function
-- with a separate type signature, to bring its tyvars into scope
--- With no -XScopedTypeVariables, this is a no-op
-bindSigTyVarsFV tvs thing_inside
- = do { scoped_tyvars <- xoptM LangExt.ScopedTypeVariables
- ; if not scoped_tyvars then
- thing_inside
- else
- bindLocalNamesFV tvs thing_inside }
+-- With no -XExtendedForAllScope/-XMethodTypeVariables, this is a no-op
+(bindSigTyVarsFVExtended, bindSigTyVarsFVMethod)
+ = ( bindSigTyVarsFVIfEnabled LangExt.ExtendedForAllScope
+ , bindSigTyVarsFVIfEnabled LangExt.MethodTypeVariables
+ )
+ where
+ bindSigTyVarsFVIfEnabled :: LangExt.Extension
+ -> [Name]
+ -> RnM (a, FreeVars)
+ -> RnM (a, FreeVars)
+ bindSigTyVarsFVIfEnabled lang_ext tvs thing_inside
+ = do { can_tyvars_be_in_scope <- xoptM lang_ext
+ ; if not can_tyvars_be_in_scope then
+ thing_inside
+ else
+ bindLocalNamesFV tvs thing_inside }
---------------
bindHsQTyVars :: forall a b.
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 319dececdd..69e312a6e3 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -198,7 +198,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls,
-- (H) Rename Everything else
- (rn_rule_decls, src_fvs2) <- setXOptM LangExt.ScopedTypeVariables $
+ (rn_rule_decls, src_fvs2) <- setXOptM LangExt.PatternSignatures $
rnList rnHsRuleDecls rule_decls ;
-- Inside RULES, scoped type variables are on
(rn_foreign_decls, src_fvs3) <- rnList rnHsForeignDecl foreign_decls ;
View Lorry Controller Status