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_ParallelListComp
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo

+   | Opt_PatternGuards

 
    -- optimisation opts
    | Opt_Strictness
 
    -- optimisation opts
    | Opt_Strictness

@@ -1102,6 +1103,7 @@ fFlags = [
 -- These -X<blah> flags can all be reversed with -Xno-<blah>
 xFlags :: [(String, DynFlag)]
 xFlags = [
 -- 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 ),
   ( "MagicHash",                        Opt_MagicHash ),
   ( "KindSignatures",                   Opt_KindSignatures ),
   ( "EmptyDataDecls",                   Opt_EmptyDataDecls ),

@@ -1160,6 +1162,7 @@ glasgowExtsFlags = [ Opt_GlasgowExts
            , Opt_MultiParamTypeClasses
            , Opt_FunctionalDependencies
                   , Opt_MagicHash
            , Opt_MultiParamTypeClasses
            , Opt_FunctionalDependencies
                   , Opt_MagicHash

+           , Opt_PatternGuards

            , Opt_RecursiveDo
            , Opt_ParallelListComp
            , Opt_EmptyDataDecls
            , 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)
 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
 
        ; ((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) }
                 (addWarn (nonStdGuardErr guards'))
 
        ; return (GRHS guards' rhs', fvs) }

@@ -653,6 +653,6 @@ bindsInHsBootFile mbinds
        2 (ppr mbinds)
 
 nonStdGuardErr guards
        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}
        4 (interpp'SP guards)
 \end{code}