diff options
| -rw-r--r-- | compiler/typecheck/TcSimplify.hs | 14 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/T11947.hs | 10 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/all.T | 1 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/T11947a.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/T11947a.stderr | 12 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/all.T | 1 |
6 files changed, 43 insertions, 1 deletions
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 1f7c984902..8cd7bf4ccc 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 0000000000..75817c8daf --- /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 ebc68eb941..e58feaecf7 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 0000000000..0d8a0d921e --- /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 0000000000..4f6a4a7505 --- /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 fe40ca29b2..3903f4b443 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, ['']) |