diff options
| -rw-r--r-- | compiler/main/DynFlags.hs | 2 | ||||
| -rw-r--r-- | compiler/typecheck/TcBinds.lhs | 10 |
2 files changed, 8 insertions, 4 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index d764b6db28..d3887c1fbd 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -198,6 +198,7 @@ data DynFlag | Opt_IncoherentInstances | Opt_MonomorphismRestriction | Opt_MonoPatBinds + | Opt_MonoLocalBinds | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting | Opt_ForeignFunctionInterface | Opt_UnliftedFFITypes @@ -1781,6 +1782,7 @@ xFlags = [ ( "MonomorphismRestriction", Opt_MonomorphismRestriction, const Supported ), -- On by default (which is not strictly H98): ( "MonoPatBinds", Opt_MonoPatBinds, const Supported ), + ( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ), ( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ), ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ), ( "ImplicitParams", Opt_ImplicitParams, const Supported ), diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 59cd315e0b..4fd3ae0c89 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -734,7 +734,7 @@ generalise :: DynFlags -> TopLevelFlag -- The returned [TyVar] are all ready to quantify generalise dflags top_lvl bind_list sig_fn mono_infos lie_req - | isMonoGroup dflags bind_list + | isMonoGroup dflags top_lvl bind_list sigs = do { extendLIEs lie_req ; return ([], [], emptyBag) } @@ -1157,10 +1157,12 @@ tcInstSig use_skols name sig_loc = loc }) } ------------------- -isMonoGroup :: DynFlags -> [LHsBind Name] -> Bool +isMonoGroup :: DynFlags -> TopLevelFlag -> [LHsBind Name] + -> [TcSigInfo] -> Bool -- No generalisation at all -isMonoGroup dflags binds - = dopt Opt_MonoPatBinds dflags && any is_pat_bind binds +isMonoGroup dflags top_lvl binds sigs + = (dopt Opt_MonoPatBinds dflags && any is_pat_bind binds) + || (dopt Opt_MonoLocalBinds dflags && null sigs && not (isTopLevel top_lvl)) where is_pat_bind (L _ (PatBind {})) = True is_pat_bind _ = False |