Canonicalise MonoidFail instances in GHC
authorHerbert Valerio Riedel <hvr@gnu.org>
Sat, 9 Sep 2017 14:29:23 +0000 (16:29 +0200)
committerHerbert Valerio Riedel <hvr@gnu.org>
Sat, 9 Sep 2017 14:43:36 +0000 (16:43 +0200)
IOW, code compiles -Wnoncanonical-monoidfail-instances clean now

This is easy now since we require GHC 8.0/base-4.9 or later
for bootstrapping.

Note that we can easily enable `MonadFail` via

  default-extensions: MonadFailDesugaring

in compiler/ghc.cabal.in

which currently would point out that NatM doesn't have
a proper `fail` method, even though failable patterns
are made use of:

  compiler/nativeGen/SPARC/CodeGen.hs:425:25: error:
    * No instance for (Control.Monad.Fail.MonadFail NatM)
        arising from a do statement
        with the failable pattern ‘(dyn_c, [dyn_r])’

12 files changed:
compiler/cmm/CmmMonad.hs
compiler/coreSyn/CoreLint.hs
compiler/ghc.cabal.in
compiler/parser/Lexer.x
compiler/prelude/PrelRules.hs
compiler/specialise/Specialise.hs
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcSMonad.hs
compiler/types/Unify.hs
compiler/utils/IOEnv.hs
compiler/utils/ListT.hs
ghc/ghc-bin.cabal.in

index c035577..e225d7d 100644 (file)
@@ -29,7 +29,7 @@ instance Applicative PD where
 
 instance Monad PD where
   (>>=) = thenPD
-  fail = failPD
+  fail = MonadFail.fail
 
 instance MonadFail.MonadFail PD where
   fail = failPD
index 92c14bc..6195e67 100644 (file)
@@ -1948,7 +1948,7 @@ instance Applicative LintM where
       (<*>) = ap
 
 instance Monad LintM where
-  fail err = failWithL (text err)
+  fail = MonadFail.fail
   m >>= k  = LintM (\ env errs ->
                        let (res, errs') = unLintM m env errs in
                          case res of
index 30592d1..247d2ee 100644 (file)
@@ -76,6 +76,7 @@ Library
     GHC-Options: -Wall
                  -Wno-name-shadowing
                  -Wnoncanonical-monad-instances
+                 -Wnoncanonical-monadfail-instances
                  -Wnoncanonical-monoid-instances
 
     if flag(ghci)
index c5332fb..5d3d65d 100644 (file)
@@ -77,7 +77,7 @@ module Lexer (
 
 -- base
 import Control.Monad
-import Control.Monad.Fail
+import Control.Monad.Fail as MonadFail
 import Data.Bits
 import Data.Char
 import Data.List
@@ -1890,7 +1890,7 @@ instance Applicative P where
 
 instance Monad P where
   (>>=) = thenP
-  fail = failP
+  fail = MonadFail.fail
 
 instance MonadFail P where
   fail = failP
index 13f4f12..d2b8d87 100644 (file)
@@ -647,7 +647,7 @@ instance Monad RuleM where
   RuleM f >>= g = RuleM $ \dflags iu e -> case f dflags iu e of
     Nothing -> Nothing
     Just r -> runRuleM (g r) dflags iu e
-  fail _ = mzero
+  fail = MonadFail.fail
 
 instance MonadFail.MonadFail RuleM where
     fail _ = mzero
index a0844b7..dfbb16a 100644 (file)
@@ -2285,7 +2285,7 @@ instance Monad SpecM where
                                case f y of
                                    SpecM z ->
                                        z
-    fail str = SpecM $ fail str
+    fail = MonadFail.fail
 
 instance MonadFail.MonadFail SpecM where
     fail str = SpecM $ fail str
index 0eff63d..0a76d23 100644 (file)
@@ -3513,7 +3513,7 @@ instance Applicative TcPluginM where
   (<*>) = ap
 
 instance Monad TcPluginM where
-  fail x   = TcPluginM (const $ fail x)
+  fail = MonadFail.fail
   TcPluginM m >>= k =
     TcPluginM (\ ev -> do a <- m ev
                           runTcPluginM (k a) ev)
index c168c08..932237c 100644 (file)
@@ -2291,7 +2291,7 @@ instance Applicative TcS where
   (<*>) = ap
 
 instance Monad TcS where
-  fail err  = TcS (\_ -> fail err)
+  fail = MonadFail.fail
   m >>= k   = TcS (\ebs -> unTcS m ebs >>= \r -> unTcS (k r) ebs)
 
 instance MonadFail.MonadFail TcS where
index 80cccb3..c5b7e66 100644 (file)
@@ -1034,7 +1034,7 @@ instance Applicative UM where
       (<*>)  = ap
 
 instance Monad UM where
-  fail _   = UM (\_ -> SurelyApart) -- failed pattern match
+  fail     = MonadFail.fail
   m >>= k  = UM (\state ->
                   do { (state', v) <- unUM m state
                      ; unUM (k v) state' })
index 5a7ccd9..6fc5f9d 100644 (file)
@@ -56,7 +56,7 @@ unIOEnv (IOEnv m) = m
 instance Monad (IOEnv m) where
     (>>=)  = thenM
     (>>)   = (*>)
-    fail _ = failM -- Ignore the string
+    fail   = MonadFail.fail
 
 instance MonadFail.MonadFail (IOEnv m) where
     fail _ = failM -- Ignore the string
index 2b81db1..7dc1aa3 100644 (file)
@@ -32,6 +32,7 @@ module ListT (
 import Control.Applicative
 
 import Control.Monad
+import Control.Monad.Fail as MonadFail
 
 -------------------------------------------------------------------------
 -- | A monad transformer for performing backtracking computations
@@ -64,6 +65,9 @@ instance Alternative (ListT f) where
 
 instance Monad (ListT m) where
     m >>= f = ListT $ \sk fk -> unListT m (\a fk' -> unListT (f a) sk fk') fk
+    fail = MonadFail.fail
+
+instance MonadFail (ListT m) where
     fail _ = ListT $ \_ fk -> fk
 
 instance MonadPlus (ListT m) where
index 06e6fc3..5fe7c9d 100644 (file)
@@ -46,6 +46,7 @@ Executable ghc
 
     GHC-Options: -Wall
                  -Wnoncanonical-monad-instances
+                 -Wnoncanonical-monadfail-instances
                  -Wnoncanonical-monoid-instances
 
     if flag(ghci)