[commit: ghc] master: Canonicalise MonoidFail instances in GHC (346e562)
git at git.haskell.org
git at git.haskell.org
Sat Sep 9 15:26:13 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/346e562adffd44edd8c31328c0280543d7dd75c1/ghc
>---------------------------------------------------------------
commit 346e562adffd44edd8c31328c0280543d7dd75c1
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date: Sat Sep 9 16:29:23 2017 +0200
Canonicalise MonoidFail instances in GHC
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])’
>---------------------------------------------------------------
346e562adffd44edd8c31328c0280543d7dd75c1
compiler/cmm/CmmMonad.hs | 2 +-
compiler/coreSyn/CoreLint.hs | 2 +-
compiler/ghc.cabal.in | 1 +
compiler/parser/Lexer.x | 4 ++--
compiler/prelude/PrelRules.hs | 2 +-
compiler/specialise/Specialise.hs | 2 +-
compiler/typecheck/TcRnTypes.hs | 2 +-
compiler/typecheck/TcSMonad.hs | 2 +-
compiler/types/Unify.hs | 2 +-
compiler/utils/IOEnv.hs | 2 +-
compiler/utils/ListT.hs | 4 ++++
ghc/ghc-bin.cabal.in | 1 +
12 files changed, 16 insertions(+), 10 deletions(-)
diff --git a/compiler/cmm/CmmMonad.hs b/compiler/cmm/CmmMonad.hs
index c035577..e225d7d 100644
--- a/compiler/cmm/CmmMonad.hs
+++ b/compiler/cmm/CmmMonad.hs
@@ -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
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index 92c14bc..6195e67 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -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
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 30592d1..247d2ee 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -76,6 +76,7 @@ Library
GHC-Options: -Wall
-Wno-name-shadowing
-Wnoncanonical-monad-instances
+ -Wnoncanonical-monadfail-instances
-Wnoncanonical-monoid-instances
if flag(ghci)
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index c5332fb..5d3d65d 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -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
diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs
index 13f4f12..d2b8d87 100644
--- a/compiler/prelude/PrelRules.hs
+++ b/compiler/prelude/PrelRules.hs
@@ -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
diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs
index a0844b7..dfbb16a 100644
--- a/compiler/specialise/Specialise.hs
+++ b/compiler/specialise/Specialise.hs
@@ -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
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 0eff63d..0a76d23 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -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)
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index c168c08..932237c 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -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
diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs
index 80cccb3..c5b7e66 100644
--- a/compiler/types/Unify.hs
+++ b/compiler/types/Unify.hs
@@ -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' })
diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs
index 5a7ccd9..6fc5f9d 100644
--- a/compiler/utils/IOEnv.hs
+++ b/compiler/utils/IOEnv.hs
@@ -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
diff --git a/compiler/utils/ListT.hs b/compiler/utils/ListT.hs
index 2b81db1..7dc1aa3 100644
--- a/compiler/utils/ListT.hs
+++ b/compiler/utils/ListT.hs
@@ -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
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index 06e6fc3..5fe7c9d 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -46,6 +46,7 @@ Executable ghc
GHC-Options: -Wall
-Wnoncanonical-monad-instances
+ -Wnoncanonical-monadfail-instances
-Wnoncanonical-monoid-instances
if flag(ghci)
More information about the ghc-commits
mailing list