Make the MR warning more accurage
authorSimon Peyton Jones <simonpj@microsoft.com>
Mon, 5 Jun 2017 10:16:16 +0000 (11:16 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Mon, 5 Jun 2017 10:16:16 +0000 (11:16 +0100)
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.

compiler/typecheck/TcSimplify.hs
testsuite/tests/typecheck/should_compile/T10935.hs
testsuite/tests/typecheck/should_compile/T10935.stderr
testsuite/tests/typecheck/should_compile/T13785.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/T13785.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/all.T

index dcb146a..2e49f2a 100644 (file)
@@ -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
index 9817ec8..7dde736 100644 (file)
@@ -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)
index b8db0fb..31f1243 100644 (file)
@@ -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 (file)
index 0000000..f02f04d
--- /dev/null
@@ -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 (file)
index 0000000..b86e7da
--- /dev/null
@@ -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
index 4bfaf90..c381fe1 100644 (file)
@@ -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, [''])