[commit: ghc] master: Make the MR warning more accurage (a65dfea)
git at git.haskell.org
git at git.haskell.org
Mon Jun 5 12:24:24 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/a65dfea535ddf3ca6aa2380ad38cb60cf5c0f1d8/ghc
>---------------------------------------------------------------
commit a65dfea535ddf3ca6aa2380ad38cb60cf5c0f1d8
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Mon Jun 5 11:16:16 2017 +0100
Make the MR warning more accurage
Trac #13785 showed that we were emitting monomorphism warnings
when we shouldn't. The fix turned out to be simple.
In fact test T10935 then turned out to be another example of
the over-noisy warning so I changed the test slightly.
>---------------------------------------------------------------
a65dfea535ddf3ca6aa2380ad38cb60cf5c0f1d8
compiler/typecheck/TcSimplify.hs | 22 +++++++++++++---------
testsuite/tests/typecheck/should_compile/T10935.hs | 2 +-
.../tests/typecheck/should_compile/T10935.stderr | 6 +++---
testsuite/tests/typecheck/should_compile/T13785.hs | 16 ++++++++++++++++
.../tests/typecheck/should_compile/T13785.stderr | 12 ++++++++++++
testsuite/tests/typecheck/should_compile/all.T | 1 +
6 files changed, 46 insertions(+), 13 deletions(-)
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index dcb146a..2e49f2a 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -818,16 +818,19 @@ decideMonoTyVars infer_mode name_taus psigs candidates
; gbl_tvs <- tcGetGlobalTyCoVars
; let eq_constraints = filter isEqPred candidates
- constrained_tvs = tyCoVarsOfTypes no_quant
- mono_tvs1 = growThetaTyVars eq_constraints $
- gbl_tvs `unionVarSet` constrained_tvs
+ mono_tvs1 = growThetaTyVars eq_constraints gbl_tvs
+ constrained_tvs = growThetaTyVars eq_constraints (tyCoVarsOfTypes no_quant)
+ `minusVarSet` mono_tvs1
+ mono_tvs2 = mono_tvs1 `unionVarSet` constrained_tvs
+ -- A type variable is only "constrained" (so that the MR bites)
+ -- if it is not free in the environment (Trac #13785)
-- Always quantify over partial-sig qtvs, so they are not mono
-- Need to zonk them because they are meta-tyvar SigTvs
-- Note [Quantification and partial signatures], wrinkle 3
; psig_qtvs <- mapM zonkTcTyVarToTyVar $
concatMap (map snd . sig_inst_skols) psigs
- ; let mono_tvs = mono_tvs1 `delVarSetList` psig_qtvs
+ ; let mono_tvs = mono_tvs2 `delVarSetList` psig_qtvs
-- Warn about the monomorphism restriction
; warn_mono <- woptM Opt_WarnMonomorphism
@@ -863,11 +866,12 @@ decideMonoTyVars infer_mode name_taus psigs candidates
= False
pp_bndrs = pprWithCommas (quotes . ppr . fst) name_taus
- mr_msg = hang (text "The Monomorphism Restriction applies to the binding"
- <> plural name_taus <+> text "for" <+> pp_bndrs)
- 2 (text "Consider giving a type signature for"
- <+> if isSingleton name_taus then pp_bndrs
- else text "these binders")
+ mr_msg = hang (sep [ text "The Monomorphism Restriction applies to the binding"
+ <> plural name_taus
+ , text "for" <+> pp_bndrs ])
+ 2 (hsep [ text "Consider giving"
+ , text (if isSingleton name_taus then "it" else "them")
+ , text "a type signature"])
-------------------
defaultTyVarsAndSimplify :: TcLevel
diff --git a/testsuite/tests/typecheck/should_compile/T10935.hs b/testsuite/tests/typecheck/should_compile/T10935.hs
index 9817ec8..7dde736 100644
--- a/testsuite/tests/typecheck/should_compile/T10935.hs
+++ b/testsuite/tests/typecheck/should_compile/T10935.hs
@@ -2,4 +2,4 @@
module T10935 where
-f x = let y = x+1 in (y,y)
+f x = let y = 1+1 in (y,y)
diff --git a/testsuite/tests/typecheck/should_compile/T10935.stderr b/testsuite/tests/typecheck/should_compile/T10935.stderr
index b8db0fb..31f1243 100644
--- a/testsuite/tests/typecheck/should_compile/T10935.stderr
+++ b/testsuite/tests/typecheck/should_compile/T10935.stderr
@@ -1,6 +1,6 @@
T10935.hs:5:11: warning: [-Wmonomorphism-restriction]
• The Monomorphism Restriction applies to the binding for ‘y’
- Consider giving a type signature for ‘y’
- • In the expression: let y = x + 1 in (y, y)
- In an equation for ‘f’: f x = let y = x + 1 in (y, y)
+ Consider giving it a type signature
+ • In the expression: let y = 1 + 1 in (y, y)
+ In an equation for ‘f’: f x = let y = 1 + 1 in (y, y)
diff --git a/testsuite/tests/typecheck/should_compile/T13785.hs b/testsuite/tests/typecheck/should_compile/T13785.hs
new file mode 100644
index 0000000..f02f04d
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T13785.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wmonomorphism-restriction #-}
+module Bug where
+
+class Monad m => C m where
+ c :: (m Char, m Char)
+
+foo :: forall m. C m => m Char
+foo = bar >> baz >> bar2
+ where
+ -- Should not get MR warning
+ bar, baz :: m Char
+ (bar, baz) = c
+
+ -- Should get MR warning
+ (bar2, baz2) = c
diff --git a/testsuite/tests/typecheck/should_compile/T13785.stderr b/testsuite/tests/typecheck/should_compile/T13785.stderr
new file mode 100644
index 0000000..b86e7da
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T13785.stderr
@@ -0,0 +1,12 @@
+
+T13785.hs:16:5: warning: [-Wmonomorphism-restriction]
+ • The Monomorphism Restriction applies to the bindings
+ for ‘bar2’, ‘baz2’
+ Consider giving them a type signature
+ • In an equation for ‘foo’:
+ foo
+ = bar >> baz >> bar2
+ where
+ bar, baz :: m Char
+ (bar, baz) = c
+ (bar2, baz2) = c
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 4bfaf90..c381fe1 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -561,3 +561,4 @@ test('T13603', normal, compile, [''])
test('T13333', normal, compile, [''])
test('T13585', [extra_files(['T13585.hs', 'T13585a.hs', 'T13585b.hs'])], run_command, ['$MAKE -s --no-print-directory T13585'])
test('T13651', normal, compile, [''])
+test('T13785', normal, compile, [''])
More information about the ghc-commits
mailing list