7 files changed, 26 insertions, 117 deletions
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index a02ce1297d..fe43fa9b46 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -87,7 +87,6 @@ Library
     GHC-Options: -Wall
                  -Wno-name-shadowing
                  -Wnoncanonical-monad-instances
-                 -Wnoncanonical-monadfail-instances
                  -Wnoncanonical-monoid-instances
 
     if flag(ghci)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index ba4cfe726a..fdc83fa94e 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -823,7 +823,7 @@ data WarningFlag =
    | Opt_WarnDeferredTypeErrors
    | Opt_WarnDeferredOutOfScopeVariables
    | Opt_WarnNonCanonicalMonadInstances   -- since 8.0
-   | Opt_WarnNonCanonicalMonadFailInstances -- since 8.0
+   | Opt_WarnNonCanonicalMonadFailInstances   -- since 8.0, removed 8.8
    | Opt_WarnNonCanonicalMonoidInstances  -- since 8.0
    | Opt_WarnMissingPatternSynonymSignatures -- since 8.0
    | Opt_WarnUnrecognisedWarningFlags     -- since 8.0
@@ -2245,7 +2245,6 @@ languageExtensions (Just Haskell98)
     = [LangExt.ImplicitPrelude,
        -- See Note [When is StarIsType enabled]
        LangExt.StarIsType,
-       LangExt.MonadFailDesugaring,
        LangExt.MonomorphismRestriction,
        LangExt.NPlusKPatterns,
        LangExt.DatatypeContexts,
@@ -2262,7 +2261,6 @@ languageExtensions (Just Haskell2010)
     = [LangExt.ImplicitPrelude,
        -- See Note [When is StarIsType enabled]
        LangExt.StarIsType,
-       LangExt.MonadFailDesugaring,
        LangExt.MonomorphismRestriction,
        LangExt.DatatypeContexts,
        LangExt.TraditionalRecordSyntax,
@@ -4007,8 +4005,9 @@ wWarningFlagsDeps = [
   flagSpec "name-shadowing"              Opt_WarnNameShadowing,
   flagSpec "noncanonical-monad-instances"
                                          Opt_WarnNonCanonicalMonadInstances,
-  flagSpec "noncanonical-monadfail-instances"
-                                         Opt_WarnNonCanonicalMonadFailInstances,
+  depFlagSpec "noncanonical-monadfail-instances"
+                                         Opt_WarnNonCanonicalMonadInstances
+    "fail is no longer a method of Monad",
   flagSpec "noncanonical-monoid-instances"
                                          Opt_WarnNonCanonicalMonoidInstances,
   flagSpec "orphans"                     Opt_WarnOrphans,
@@ -4392,7 +4391,8 @@ xFlagsDeps = [
   flagSpec "LiberalTypeSynonyms"              LangExt.LiberalTypeSynonyms,
   flagSpec "MagicHash"                        LangExt.MagicHash,
   flagSpec "MonadComprehensions"              LangExt.MonadComprehensions,
-  flagSpec "MonadFailDesugaring"              LangExt.MonadFailDesugaring,
+  depFlagSpec "MonadFailDesugaring"           LangExt.MonadFailDesugaring
+    "MonadFailDesugaring is now the default behavior",
   flagSpec "MonoLocalBinds"                   LangExt.MonoLocalBinds,
   depFlagSpecCond "MonoPatBinds"              LangExt.MonoPatBinds
     id
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index 600eb2ba4d..4a104c63a9 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -314,7 +314,7 @@ basicKnownKeyNames
         returnMName, joinMName,
 
         -- MonadFail
-        monadFailClassName, failMName, failMName_preMFP,
+        monadFailClassName, failMName,
 
         -- MonadFix
         monadFixClassName, mfixName,
@@ -669,13 +669,12 @@ map_RDR, append_RDR :: RdrName
 map_RDR                 = nameRdrName mapName
 append_RDR              = nameRdrName appendName
 
-foldr_RDR, build_RDR, returnM_RDR, bindM_RDR, failM_RDR_preMFP,
-  failM_RDR :: RdrName
+foldr_RDR, build_RDR, returnM_RDR, bindM_RDR, failM_RDR
+    :: RdrName
 foldr_RDR               = nameRdrName foldrName
 build_RDR               = nameRdrName buildName
 returnM_RDR             = nameRdrName returnMName
 bindM_RDR               = nameRdrName bindMName
-failM_RDR_preMFP        = nameRdrName failMName_preMFP
 failM_RDR               = nameRdrName failMName
 
 left_RDR, right_RDR :: RdrName
@@ -1018,12 +1017,11 @@ functorClassName  = clsQual gHC_BASE    (fsLit "Functor") functorClassKey
 fmapName          = varQual gHC_BASE    (fsLit "fmap")    fmapClassOpKey
 
 -- Class Monad
-monadClassName, thenMName, bindMName, returnMName, failMName_preMFP :: Name
+monadClassName, thenMName, bindMName, returnMName :: Name
 monadClassName     = clsQual gHC_BASE (fsLit "Monad")  monadClassKey
 thenMName          = varQual gHC_BASE (fsLit ">>")     thenMClassOpKey
 bindMName          = varQual gHC_BASE (fsLit ">>=")    bindMClassOpKey
 returnMName        = varQual gHC_BASE (fsLit "return") returnMClassOpKey
-failMName_preMFP   = varQual gHC_BASE (fsLit "fail")   failMClassOpKey_preMFP
 
 -- Class MonadFail
 monadFailClassName, failMName :: Name
@@ -2253,8 +2251,7 @@ unboundKey                    = mkPreludeMiscIdUnique 158
 fromIntegerClassOpKey, minusClassOpKey, fromRationalClassOpKey,
     enumFromClassOpKey, enumFromThenClassOpKey, enumFromToClassOpKey,
     enumFromThenToClassOpKey, eqClassOpKey, geClassOpKey, negateClassOpKey,
-    failMClassOpKey_preMFP, bindMClassOpKey, thenMClassOpKey, returnMClassOpKey,
-    fmapClassOpKey
+    bindMClassOpKey, thenMClassOpKey, returnMClassOpKey, fmapClassOpKey
     :: Unique
 fromIntegerClassOpKey         = mkPreludeMiscIdUnique 160
 minusClassOpKey               = mkPreludeMiscIdUnique 161
@@ -2266,7 +2263,6 @@ enumFromThenToClassOpKey      = mkPreludeMiscIdUnique 166
 eqClassOpKey                  = mkPreludeMiscIdUnique 167
 geClassOpKey                  = mkPreludeMiscIdUnique 168
 negateClassOpKey              = mkPreludeMiscIdUnique 169
-failMClassOpKey_preMFP        = mkPreludeMiscIdUnique 170
 bindMClassOpKey               = mkPreludeMiscIdUnique 171 -- (>>=)
 thenMClassOpKey               = mkPreludeMiscIdUnique 172 -- (>>)
 fmapClassOpKey                = mkPreludeMiscIdUnique 173
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index b74b557f49..dd38feb367 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -2100,11 +2100,6 @@ badIpBinds what binds
 
 ---------
 
-lookupSyntaxMonadFailOpName :: Bool -> RnM (SyntaxExpr GhcRn, FreeVars)
-lookupSyntaxMonadFailOpName monadFailEnabled
-  | monadFailEnabled = lookupSyntaxName failMName
-  | otherwise        = lookupSyntaxName failMName_preMFP
-
 monadFailOp :: LPat GhcPs
             -> HsStmtContext Name
             -> RnM (SyntaxExpr GhcRn, FreeVars)
@@ -2146,14 +2141,14 @@ So, in this case, we synthesize the function
 -}
 getMonadFailOp :: RnM (SyntaxExpr GhcRn, FreeVars) -- Syntax expr fail op
 getMonadFailOp
- = do { xMonadFailEnabled <- fmap (xopt LangExt.MonadFailDesugaring) getDynFlags
-      ; xOverloadedStrings <- fmap (xopt LangExt.OverloadedStrings) getDynFlags
+ = do { xOverloadedStrings <- fmap (xopt LangExt.OverloadedStrings) getDynFlags
       ; xRebindableSyntax <- fmap (xopt LangExt.RebindableSyntax) getDynFlags
-      ; reallyGetMonadFailOp xRebindableSyntax xOverloadedStrings xMonadFailEnabled }
+      ; reallyGetMonadFailOp xRebindableSyntax xOverloadedStrings
+      }
   where
-    reallyGetMonadFailOp rebindableSyntax overloadedStrings monadFailEnabled
+    reallyGetMonadFailOp rebindableSyntax overloadedStrings
       | rebindableSyntax && overloadedStrings = do
-        (failExpr, failFvs) <- lookupSyntaxMonadFailOpName monadFailEnabled
+        (failExpr, failFvs) <- lookupSyntaxName failMName
         (fromStringExpr, fromStringFvs) <- lookupSyntaxName fromStringName
         let arg_lit = fsLit "arg"
             arg_name = mkSystemVarName (mkVarOccUnique arg_lit) arg_lit
@@ -2167,4 +2162,4 @@ getMonadFailOp
         let failAfterFromStringSynExpr :: SyntaxExpr GhcRn =
               mkSyntaxExpr failAfterFromStringExpr
         return (failAfterFromStringSynExpr, failFvs `plusFV` fromStringFvs)
-      | otherwise = lookupSyntaxMonadFailOpName monadFailEnabled
+      | otherwise = lookupSyntaxName failMName
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 5181b7f2ed..e7ff909c02 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -43,7 +43,6 @@ import Module
 import HscTypes         ( Warnings(..), plusWarns )
 import PrelNames        ( applicativeClassName, pureAName, thenAName
                         , monadClassName, returnMName, thenMName
-                        , monadFailClassName, failMName, failMName_preMFP
                         , semigroupClassName, sappendName
                         , monoidClassName, mappendName
                         )
@@ -457,9 +456,6 @@ checkCanonicalInstances cls poly_ty mbinds = do
     whenWOptM Opt_WarnNonCanonicalMonadInstances
         checkCanonicalMonadInstances
 
-    whenWOptM Opt_WarnNonCanonicalMonadFailInstances
-        checkCanonicalMonadFailInstances
-
     whenWOptM Opt_WarnNonCanonicalMonoidInstances
         checkCanonicalMonoidInstances
 
@@ -510,45 +506,6 @@ checkCanonicalInstances cls poly_ty mbinds = do
 
       | otherwise = return ()
 
-    -- | Warn about unsound/non-canonical 'Monad'/'MonadFail' instance
-    -- declarations. Specifically, the following conditions are verified:
-    --
-    -- In 'Monad' instances declarations:
-    --
-    --  * If 'fail' is overridden it must be canonical
-    --    (i.e. @fail = Control.Monad.Fail.fail@)
-    --
-    -- In 'MonadFail' instance declarations:
-    --
-    --  * Warn if 'fail' is defined backwards
-    --    (i.e. @fail = Control.Monad.fail@).
-    --
-    checkCanonicalMonadFailInstances
-      | cls == monadFailClassName  = do
-          forM_ (bagToList mbinds) $ \(dL->L loc mbind) -> setSrcSpan loc $ do
-              case mbind of
-                  FunBind { fun_id = (dL->L _ name)
-                          , fun_matches = mg }
-                      | name == failMName, isAliasMG mg == Just failMName_preMFP
-                      -> addWarnNonCanonicalMethod1
-                            Opt_WarnNonCanonicalMonadFailInstances "fail"
-                            "Control.Monad.fail"
-
-                  _ -> return ()
-
-      | cls == monadClassName  = do
-          forM_ (bagToList mbinds) $ \(dL->L loc mbind) -> setSrcSpan loc $ do
-              case mbind of
-                  FunBind { fun_id      = (dL->L _ name)
-                          , fun_matches = mg }
-                      | name == failMName_preMFP, isAliasMG mg /= Just failMName
-                      -> addWarnNonCanonicalMethod2
-                            Opt_WarnNonCanonicalMonadFailInstances "fail"
-                            "Control.Monad.Fail.fail"
-                  _ -> return ()
-
-      | otherwise = return ()
-
     -- | Check whether Monoid(mappend) is defined in terms of
     -- Semigroup((<>)) (and not the other way round). Specifically,
     -- the following conditions are verified:
diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs
index 7f2a0ea589..ade9816a1b 100644
--- a/compiler/simplCore/SimplCore.hs
+++ b/compiler/simplCore/SimplCore.hs
@@ -943,18 +943,18 @@ shortOutIndirections binds
 
 makeIndEnv :: [CoreBind] -> IndEnv
 makeIndEnv binds
-  = foldr add_bind emptyVarEnv binds
+  = foldl' add_bind emptyVarEnv binds
   where
-    add_bind :: CoreBind -> IndEnv -> IndEnv
-    add_bind (NonRec exported_id rhs) env = add_pair (exported_id, rhs) env
-    add_bind (Rec pairs)              env = foldr add_pair env pairs
+    add_bind :: IndEnv -> CoreBind -> IndEnv
+    add_bind env (NonRec exported_id rhs) = add_pair env (exported_id, rhs)
+    add_bind env (Rec pairs)              = foldl' add_pair env pairs
 
-    add_pair :: (Id,CoreExpr) -> IndEnv -> IndEnv
-    add_pair (exported_id, exported) env
+    add_pair :: IndEnv -> (Id,CoreExpr) -> IndEnv
+    add_pair env (exported_id, exported)
         | (ticks, Var local_id) <- stripTicksTop tickishFloatable exported
         , shortMeOut env exported_id local_id
         = extendVarEnv env local_id (exported_id, ticks)
-    add_pair _ env = env
+    add_pair env _ = env
 
 -----------------
 shortMeOut :: IndEnv -> Id -> Id -> Bool
diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs
index 48410e0a7c..6b727ed5aa 100644
--- a/compiler/typecheck/TcMatches.hs
+++ b/compiler/typecheck/TcMatches.hs
@@ -42,9 +42,6 @@ import TcEvidence
 import Outputable
 import Util
 import SrcLoc
-import DynFlags
-import PrelNames (monadFailClassName)
-import qualified GHC.LanguageExtensions as LangExt
 
 -- Create chunkified tuple tybes for monad comprehensions
 import MkCore
@@ -940,43 +937,8 @@ tcMonadFailOp orig pat fail_op res_ty
   = return noSyntaxExpr
 
   | otherwise
-  = do { -- Issue MonadFail warnings
-         rebindableSyntax <- xoptM LangExt.RebindableSyntax
-       ; desugarFlag      <- xoptM LangExt.MonadFailDesugaring
-       ; missingWarning   <- woptM Opt_WarnMissingMonadFailInstances
-       ; if | rebindableSyntax && desugarFlag && missingWarning
-              -> warnRebindableClash pat
-            | not desugarFlag && missingWarning
-              -> emitMonadFailConstraint pat res_ty
-            | otherwise
-              -> return ()
-
-        -- Get the fail op itself
-        ; snd <$> (tcSyntaxOp orig fail_op [synKnownType stringTy]
-                             (mkCheckExpType res_ty) $ \_ -> return ()) }
-
-emitMonadFailConstraint :: LPat GhcTcId -> TcType -> TcRn ()
-emitMonadFailConstraint pat res_ty
-  = do { -- We expect res_ty to be of form (monad_ty arg_ty)
-         (_co, (monad_ty, _arg_ty)) <- matchExpectedAppTy res_ty
-
-         -- Emit (MonadFail m), but ignore the evidence; it's
-         -- just there to generate a warning
-       ; monadFailClass <- tcLookupClass monadFailClassName
-       ; _ <- emitWanted (FailablePattern pat)
-                         (mkClassPred monadFailClass [monad_ty])
-       ; return () }
-
-warnRebindableClash :: LPat GhcTcId -> TcRn ()
-warnRebindableClash pattern = addWarnAt
-    (Reason Opt_WarnMissingMonadFailInstances)
-    (getLoc pattern)
-    (text "The failable pattern" <+> quotes (ppr pattern)
-     $$
-     nest 2 (text "is used together with -XRebindableSyntax."
-             <+> text "If this is intentional,"
-             $$
-             text "compile with -Wno-missing-monadfail-instances."))
+  = snd <$> (tcSyntaxOp orig fail_op [synKnownType stringTy]
+                             (mkCheckExpType res_ty) $ \_ -> return ())
 
 {-
 Note [Treat rebindable syntax first]