[commit: ghc] master: Do not use defaulting in ambiguity check (edf54d7)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/edf54d72b5b8a6dd0deafa036dc16dcfc3fcb29f/ghc

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

commit edf54d72b5b8a6dd0deafa036dc16dcfc3fcb29f
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Apr 21 13:03:29 2016 +0100

    Do not use defaulting in ambiguity check
    
    This fixes Trac #11947.  See TcSimplify
    Note [No defaulting in the ambiguity check]


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

edf54d72b5b8a6dd0deafa036dc16dcfc3fcb29f
 compiler/typecheck/TcSimplify.hs                     | 14 +++++++++++++-
 testsuite/tests/typecheck/should_compile/T11947.hs   | 10 ++++++++++
 testsuite/tests/typecheck/should_compile/all.T       |  1 +
 testsuite/tests/typecheck/should_fail/T11947a.hs     |  6 ++++++
 testsuite/tests/typecheck/should_fail/T11947a.stderr | 12 ++++++++++++
 testsuite/tests/typecheck/should_fail/all.T          |  1 +
 6 files changed, 43 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index 1f7c984..8cd7bf4 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -384,13 +384,25 @@ How is this implemented? It's complicated! So we'll step through it all:
  7) `HscMain.tcRnModule'` -- Reads `tcg_safeInfer` after type-checking, calling
     `HscMain.markUnsafeInfer` (passing the reason along) when safe-inferrence
     failed.
+
+Note [No defaulting in the ambiguity check]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When simplifying constraints for the ambiguity check, we use
+solveWantedsAndDrop, not simpl_top, so that we do no defaulting.
+Trac #11947 was an example:
+   f :: Num a => Int -> Int
+This is ambiguous of course, but we don't want to default the
+(Num alpha) constraint to (Num Int)!  Doing so gives a defaulting
+warning, but no error.
 -}
 
 ------------------
 simplifyAmbiguityCheck :: Type -> WantedConstraints -> TcM ()
 simplifyAmbiguityCheck ty wanteds
   = do { traceTc "simplifyAmbiguityCheck {" (text "type = " <+> ppr ty $$ text "wanted = " <+> ppr wanteds)
-       ; (final_wc, _) <- runTcS $ simpl_top wanteds
+       ; (final_wc, _) <- runTcS $ solveWantedsAndDrop wanteds
+             -- NB: no defaulting!  See Note [No defaulting in the ambiguity check]
+
        ; traceTc "End simplifyAmbiguityCheck }" empty
 
        -- Normally report all errors; but with -XAllowAmbiguousTypes
diff --git a/testsuite/tests/typecheck/should_compile/T11947.hs b/testsuite/tests/typecheck/should_compile/T11947.hs
new file mode 100644
index 0000000..75817c8
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T11947.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeApplications, ScopedTypeVariables, AllowAmbiguousTypes #-}
+module T11947 where
+
+theFloatDigits :: forall a. RealFloat a => Int
+-- The type is ambiguous
+theFloatDigits = floatDigits (undefined @_ @a)
+
+foo :: IO ()
+foo = print (theFloatDigits @Double, theFloatDigits @Float)
+-- But the applications are not
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index ebc68eb..e58feae 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -514,3 +514,4 @@ test('T11754', normal, compile, [''])
 test('T11811', normal, compile, [''])
 test('T11793', normal, compile, [''])
 test('T11348', normal, compile, [''])
+test('T11947', normal, compile, [''])
diff --git a/testsuite/tests/typecheck/should_fail/T11947a.hs b/testsuite/tests/typecheck/should_fail/T11947a.hs
new file mode 100644
index 0000000..0d8a0d9
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T11947a.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TypeApplications, ScopedTypeVariables #-}
+module T11947 where
+
+theFloatDigits :: forall a. RealFloat a => Int
+-- The type is ambiguous, despite potential defaulting
+theFloatDigits = floatDigits (undefined @_ @a)
diff --git a/testsuite/tests/typecheck/should_fail/T11947a.stderr b/testsuite/tests/typecheck/should_fail/T11947a.stderr
new file mode 100644
index 0000000..4f6a4a7
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T11947a.stderr
@@ -0,0 +1,12 @@
+
+T11947a.hs:4:19: error:
+    • Could not deduce (RealFloat a0)
+      from the context: RealFloat a
+        bound by the type signature for:
+                   theFloatDigits :: RealFloat a => Int
+        at T11947a.hs:4:19-46
+      The type variable ‘a0’ is ambiguous
+    • In the ambiguity check for ‘theFloatDigits’
+      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+      In the type signature:
+        theFloatDigits :: forall a. RealFloat a => Int
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index fe40ca2..3903f4b 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -414,3 +414,4 @@ test('T11723', normal, compile_fail, [''])
 test('T11724', normal, compile_fail, [''])
 test('BadUnboxedTuple', normal, compile_fail, [''])
 test('T11698', normal, compile_fail, [''])
+test('T11947a', normal, compile_fail, [''])