[commit: ghc] ghc-8.2: Be less aggressive about fragile-context warrnings (da17a35)

git at git.haskell.org git at git.haskell.org
Thu Apr 6 22:29:42 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.2
Link       : http://ghc.haskell.org/trac/ghc/changeset/da17a35a80a2075a76163375175f15b3119b9711/ghc

>---------------------------------------------------------------

commit da17a35a80a2075a76163375175f15b3119b9711
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Apr 6 12:27:43 2017 +0100

    Be less aggressive about fragile-context warrnings
    
    In the implementation of WarnSimplifiableClassConstraints, be
    less aggressive about reporting a problem. We were complaining
    about a "fragile" case that in fact was not fragile.
    
    See Note [Simplifiable given constraints] in TcValidity.
    
    This fixes Trac #13526.
    
    (cherry picked from commit 65b185d4886b4efa3efe3cc5ecc8dd6e07d89afe)


>---------------------------------------------------------------

da17a35a80a2075a76163375175f15b3119b9711
 compiler/typecheck/TcValidity.hs                   | 50 ++++++++++++++--------
 .../should_compile/SomethingShowable.stderr        | 10 +++--
 testsuite/tests/typecheck/should_compile/T13526.hs | 22 ++++++++++
 .../tests/typecheck/should_compile/T13526.stderr   |  7 +++
 testsuite/tests/typecheck/should_compile/all.T     |  1 +
 5 files changed, 69 insertions(+), 21 deletions(-)

diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs
index dda8b4f..48fd84d 100644
--- a/compiler/typecheck/TcValidity.hs
+++ b/compiler/typecheck/TcValidity.hs
@@ -41,7 +41,7 @@ import HsSyn            -- HsType
 import TcRnMonad        -- TcType, amongst others
 import TcEnv       ( tcGetInstEnvs )
 import FunDeps
-import InstEnv     ( ClsInst, lookupInstEnv, isOverlappable )
+import InstEnv     ( InstMatch, lookupInstEnv )
 import FamInstEnv  ( isDominatedBy, injectiveBranches,
                      InjectivityCheckResult(..) )
 import FamInst     ( makeInjectivityErrors )
@@ -810,7 +810,8 @@ check_class_pred env dflags ctxt pred cls tys
 
   | otherwise
   = do { check_arity
-       ; check_simplifiable_class_constraint
+       ; warn_simp <- woptM Opt_WarnSimplifiableClassConstraints
+       ; when warn_simp check_simplifiable_class_constraint
        ; checkTcM arg_tys_ok (predTyVarErr env pred) }
   where
     check_arity = checkTc (classArity cls == length tys)
@@ -833,25 +834,22 @@ check_class_pred env dflags ctxt pred cls tys
        | DataTyCtxt {} <- ctxt   -- Don't do this check for the "stupid theta"
        = return ()               -- of a data type declaration
        | otherwise
-       = do { instEnvs <- tcGetInstEnvs
-            ; let (matches, _, _) = lookupInstEnv False instEnvs cls tys
-                  bad_matches = [ inst | (inst,_) <- matches
-                                       , not (isOverlappable inst) ]
-            ; warnIf (Reason Opt_WarnSimplifiableClassConstraints)
-                     (not (null bad_matches))
-                     (simplifiable_constraint_warn bad_matches) }
-
-    simplifiable_constraint_warn :: [ClsInst] -> SDoc
-    simplifiable_constraint_warn (match : _)
+       = do { envs <- tcGetInstEnvs
+            ; case lookupInstEnv False envs cls tys of
+                 ([m], [], _) -> addWarnTc (Reason Opt_WarnSimplifiableClassConstraints)
+                                           (simplifiable_constraint_warn m)
+                 _ -> return () }
+
+    simplifiable_constraint_warn :: InstMatch -> SDoc
+    simplifiable_constraint_warn (match, _)
      = vcat [ hang (text "The constraint" <+> quotes (ppr (tidyType env pred)))
                  2 (text "matches an instance declaration")
             , ppr match
             , hang (text "This makes type inference for inner bindings fragile;")
                  2 (text "either use MonoLocalBinds, or simplify it using the instance") ]
-    simplifiable_constraint_warn [] = pprPanic "check_class_pred" (ppr pred)
 
 {- Note [Simplifiable given constraints]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 A type signature like
    f :: Eq [(a,b)] => a -> b
 is very fragile, for reasons described at length in TcInteract
@@ -862,9 +860,27 @@ fragility. But if we /infer/ the type of a local let-binding, things
 can go wrong (Trac #11948 is an example, discussed in the Note).
 
 So this warning is switched on only if we have NoMonoLocalBinds; in
-that case the warning discourages uses from writing simplifiable class
-constraints, at least unless the top-level instance is explicitly
-declared as OVERLAPPABLE.
+that case the warning discourages users from writing simplifiable
+class constraints.
+
+The warning only fires if the constraint in the signature
+matches the top-level instances in only one way, and with no
+unifiers -- that is, under the same circumstances that
+TcInteract.matchInstEnv fires an interaction with the top
+level instances.  For example (Trac #13526), consider
+
+  instance {-# OVERLAPPABLE #-} Eq (T a) where ...
+  instance                   Eq (T Char) where ..
+  f :: Eq (T a) => ...
+
+We don't want to complain about this, even though the context
+(Eq (T a)) matches an instance, because the user may be
+deliberately deferring the choice so that the Eq (T Char)
+has a chance to fire when 'f' is called.  And the fragility
+only matters when there's a risk that the instance might
+fire instead of the local 'given'; and there is no such
+risk in this case.  Just use the same rules as for instance
+firing!
 -}
 
 -------------------------
diff --git a/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr b/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr
index 9f0ea1f..ca06301 100644
--- a/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr
@@ -7,7 +7,9 @@ Dependent packages: [base-4.10.0.0, ghc-prim-0.5.0.0,
                      integer-gmp-1.0.0.1]
 
 SomethingShowable.hs:5:1: warning: [-Wsimplifiable-class-constraints (in -Wdefault)]
-    The constraint ‘Show Bool’ matches an instance declaration
-    instance Show Bool -- Defined in ‘GHC.Show’
-    This makes type inference for inner bindings fragile;
-      either use MonoLocalBinds, or simplify it using the instance
+    • The constraint ‘Show Bool’ matches an instance declaration
+      instance Show Bool -- Defined in ‘GHC.Show’
+      This makes type inference for inner bindings fragile;
+        either use MonoLocalBinds, or simplify it using the instance
+    • When checking the inferred type
+        somethingShowable :: Show Bool => Bool -> String
diff --git a/testsuite/tests/typecheck/should_compile/T13526.hs b/testsuite/tests/typecheck/should_compile/T13526.hs
new file mode 100644
index 0000000..efe32bd
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T13526.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}
+
+module T13526 where
+
+class C a where
+  op :: a -> a
+
+instance {-# OVERLAPPING #-} C [Char] where
+  op x = x
+
+instance C a => C [a] where
+  op (x:xs) = [op x]
+
+instance C a => C (Maybe a) where
+  op x = error "urk"
+
+-- We should get no complaint
+foo :: C [a] => a -> [a]
+foo x = op [x]
+
+bar :: C (Maybe a) => a -> Maybe a
+bar x = op (Just x)
diff --git a/testsuite/tests/typecheck/should_compile/T13526.stderr b/testsuite/tests/typecheck/should_compile/T13526.stderr
new file mode 100644
index 0000000..7a0f2ae
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T13526.stderr
@@ -0,0 +1,7 @@
+
+T13526.hs:21:8: warning: [-Wsimplifiable-class-constraints (in -Wdefault)]
+    • The constraint ‘C (Maybe a)’ matches an instance declaration
+      instance C a => C (Maybe a) -- Defined at T13526.hs:14:10
+      This makes type inference for inner bindings fragile;
+        either use MonoLocalBinds, or simplify it using the instance
+    • In the type signature: bar :: C (Maybe a) => a -> Maybe a
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 6ceb87d..9d9c7de 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -547,3 +547,4 @@ test('T13381', normal, compile_fail, [''])
 test('T13337', normal, compile, [''])
 test('T13343', normal, compile, [''])
 test('T13474', normal, compile, [''])
+test('T13526', normal, compile, [''])



More information about the ghc-commits mailing list