Add PatternGuards flag

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index b9d693f..cda06e5 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -193,6 +193,7 @@ data DynFlag
    | Opt_ParallelListComp
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo
+   | Opt_PatternGuards
 
    -- optimisation opts
    | Opt_Strictness
@@ -1102,6 +1103,7 @@ fFlags = [
 -- These -X<blah> flags can all be reversed with -Xno-<blah>
 xFlags :: [(String, DynFlag)]
 xFlags = [
+  ( "PatternGuards",                    Opt_PatternGuards ),
   ( "MagicHash",                        Opt_MagicHash ),
   ( "KindSignatures",                   Opt_KindSignatures ),
   ( "EmptyDataDecls",                   Opt_EmptyDataDecls ),
@@ -1160,6 +1162,7 @@ glasgowExtsFlags = [ Opt_GlasgowExts
            , Opt_MultiParamTypeClasses
            , Opt_FunctionalDependencies
                   , Opt_MagicHash
+           , Opt_PatternGuards
            , Opt_RecursiveDo
            , Opt_ParallelListComp
            , Opt_EmptyDataDecls

diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index 029f51c..ff0629a 100644 (file)
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -596,11 +596,11 @@ rnGRHS :: HsMatchContext Name -> LGRHS RdrName -> RnM (LGRHS Name, FreeVars)
 rnGRHS ctxt = wrapLocFstM (rnGRHS' ctxt)
 
 rnGRHS' ctxt (GRHS guards rhs)
-  = do { opt_GlasgowExts <- doptM Opt_GlasgowExts
+  = do { pattern_guards_allowed <- doptM Opt_PatternGuards
        ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) guards $
                                    rnLExpr rhs
 
-       ; checkM (opt_GlasgowExts || is_standard_guard guards')
+       ; checkM (pattern_guards_allowed || is_standard_guard guards')
                 (addWarn (nonStdGuardErr guards'))
 
        ; return (GRHS guards' rhs', fvs) }
@@ -653,6 +653,6 @@ bindsInHsBootFile mbinds
        2 (ppr mbinds)
 
 nonStdGuardErr guards
-  = hang (ptext SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)"))
+  = hang (ptext SLIT("accepting non-standard pattern guards (use -XPatternGuards to suppress this message)"))
        4 (interpp'SP guards)
 \end{code}