summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/main/DynFlags.hs3
-rw-r--r--compiler/typecheck/TcErrors.hs55
-rw-r--r--docs/users_guide/flags.xml13
-rw-r--r--docs/users_guide/glasgow_exts.xml3
-rw-r--r--docs/users_guide/using.xml11
-rw-r--r--testsuite/tests/typecheck/should_compile/T10283.hs23
-rw-r--r--testsuite/tests/typecheck/should_compile/all.T1
7 files changed, 86 insertions, 23 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index cf5091431a..23a5fedda5 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -524,6 +524,7 @@ data WarningFlag =
| Opt_WarnMissingExportedSigs
| Opt_WarnUntickedPromotedConstructors
| Opt_WarnDerivingTypeable
+ | Opt_WarnDeferredTypeErrors
deriving (Eq, Show, Enum)
data Language = Haskell98 | Haskell2010
@@ -2848,6 +2849,7 @@ fWarningFlags = [
flagSpec' "warn-amp" Opt_WarnAMP
(\_ -> deprecate "it has no effect, and will be removed in GHC 7.12"),
flagSpec "warn-auto-orphans" Opt_WarnAutoOrphans,
+ flagSpec "warn-deferred-type-errors" Opt_WarnDeferredTypeErrors,
flagSpec "warn-deprecations" Opt_WarnWarningsDeprecations,
flagSpec "warn-deprecated-flags" Opt_WarnDeprecatedFlags,
flagSpec "warn-deriving-typeable" Opt_WarnDerivingTypeable,
@@ -3344,6 +3346,7 @@ standardWarnings -- see Note [Documenting warning flags]
= [ Opt_WarnOverlappingPatterns,
Opt_WarnWarningsDeprecations,
Opt_WarnDeprecatedFlags,
+ Opt_WarnDeferredTypeErrors,
Opt_WarnTypedHoles,
Opt_WarnPartialTypeSignatures,
Opt_WarnUnrecognisedPragmas,
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 032af20b16..9809db83f5 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -101,8 +101,12 @@ compilation. The errors are turned into warnings in `reportUnsolved`.
-- deferred run-time errors if `-fdefer-type-errors` is on.
reportUnsolved :: WantedConstraints -> TcM (Bag EvBind)
reportUnsolved wanted
- = do { binds_var <- newTcEvBinds
- ; defer_errs <- goptM Opt_DeferTypeErrors
+ = do { binds_var <- newTcEvBinds
+ ; defer_errors <- goptM Opt_DeferTypeErrors
+ ; warn_errors <- woptM Opt_WarnDeferredTypeErrors -- implement #10283
+ ; let type_errors | not defer_errors = TypeError
+ | warn_errors = TypeWarn
+ | otherwise = TypeDefer
; defer_holes <- goptM Opt_DeferTypedHoles
; warn_holes <- woptM Opt_WarnTypedHoles
@@ -116,30 +120,30 @@ reportUnsolved wanted
| warn_partial_sigs = HoleWarn
| otherwise = HoleDefer
- ; report_unsolved (Just binds_var) False defer_errs expr_holes type_holes wanted
+ ; report_unsolved (Just binds_var) False type_errors expr_holes type_holes wanted
; getTcEvBinds binds_var }
-- | Report *all* unsolved goals as errors, even if -fdefer-type-errors is on
-- See Note [Deferring coercion errors to runtime]
reportAllUnsolved :: WantedConstraints -> TcM ()
reportAllUnsolved wanted
- = report_unsolved Nothing False False HoleError HoleError wanted
+ = report_unsolved Nothing False TypeError HoleError HoleError wanted
-- | Report all unsolved goals as warnings (but without deferring any errors to
-- run-time). See Note [Safe Haskell Overlapping Instances Implementation] in
-- TcSimplify
warnAllUnsolved :: WantedConstraints -> TcM ()
warnAllUnsolved wanted
- = report_unsolved Nothing True False HoleWarn HoleWarn wanted
+ = report_unsolved Nothing True TypeWarn HoleWarn HoleWarn wanted
-- | Report unsolved goals as errors or warnings.
report_unsolved :: Maybe EvBindsVar -- cec_binds
-> Bool -- Errors as warnings
- -> Bool -- cec_defer_type_errors
+ -> TypeErrorChoice -- Deferred type errors
-> HoleChoice -- Expression holes
-> HoleChoice -- Type holes
-> WantedConstraints -> TcM ()
-report_unsolved mb_binds_var err_as_warn defer_errs expr_holes type_holes wanted
+report_unsolved mb_binds_var err_as_warn type_errors expr_holes type_holes wanted
| isEmptyWC wanted
= return ()
| otherwise
@@ -159,7 +163,7 @@ report_unsolved mb_binds_var err_as_warn defer_errs expr_holes type_holes wanted
; warn_redundant <- woptM Opt_WarnRedundantConstraints
; let err_ctxt = CEC { cec_encl = []
, cec_tidy = tidy_env
- , cec_defer_type_errors = defer_errs
+ , cec_defer_type_errors = type_errors
, cec_errors_as_warns = err_as_warn
, cec_expr_holes = expr_holes
, cec_type_holes = type_holes
@@ -174,6 +178,11 @@ report_unsolved mb_binds_var err_as_warn defer_errs expr_holes type_holes wanted
-- Internal functions
--------------------------------------------
+data TypeErrorChoice -- What to do for type errors found by the type checker
+ = TypeError -- A type error aborts compilation with an error message
+ | TypeWarn -- A type error is deferred to runtime, plus a compile-time warning
+ | TypeDefer -- A type error is deferred to runtime; no error or warning at compile time
+
data HoleChoice
= HoleError -- A hole is a compile-time error
| HoleWarn -- Defer to runtime, emit a compile-time warning
@@ -194,9 +203,8 @@ data ReportErrCtxt
-- (except for Holes, which are
-- controlled by cec_type_holes and
-- cec_expr_holes)
- , cec_defer_type_errors :: Bool -- True <=> -fdefer-type-errors
- -- Defer type errors until runtime
- -- Irrelevant if cec_binds = Nothing
+ , cec_defer_type_errors :: TypeErrorChoice -- Defer type errors until runtime
+ -- Irrelevant if cec_binds = Nothing
, cec_expr_holes :: HoleChoice -- Holes in expressions
, cec_type_holes :: HoleChoice -- Holes in types
@@ -472,13 +480,14 @@ maybeReportHoleError ctxt ct err
maybeReportError :: ReportErrCtxt -> ErrMsg -> TcM ()
-- Report the error and/or make a deferred binding for it
maybeReportError ctxt err
- -- See Note [Always warn with -fdefer-type-errors]
- | cec_defer_type_errors ctxt || cec_errors_as_warns ctxt
+ | cec_errors_as_warns ctxt
= reportWarning err
- | cec_suppress ctxt
- = return ()
| otherwise
- = reportError err
+ = case cec_defer_type_errors ctxt of
+ TypeDefer -> return ()
+ TypeWarn -> reportWarning err
+ -- handle case when suppress is on like in the original code
+ TypeError -> if cec_suppress ctxt then return () else reportError err
addDeferredBinding :: ReportErrCtxt -> ErrMsg -> Ct -> TcM ()
-- See Note [Deferring coercion errors to runtime]
@@ -509,11 +518,13 @@ maybeAddDeferredHoleBinding ctxt err ct
= return ()
maybeAddDeferredBinding :: ReportErrCtxt -> ErrMsg -> Ct -> TcM ()
-maybeAddDeferredBinding ctxt err ct
- | cec_defer_type_errors ctxt
- = addDeferredBinding ctxt err ct
- | otherwise
- = return ()
+maybeAddDeferredBinding ctxt err ct =
+ case cec_defer_type_errors ctxt of
+ TypeDefer -> deferred
+ TypeWarn -> deferred
+ TypeError -> return ()
+ where
+ deferred = addDeferredBinding ctxt err ct
tryReporters :: ReportErrCtxt -> [ReporterSpec] -> [Ct] -> TcM (ReportErrCtxt, [Ct])
-- Use the first reporter in the list whose predicate says True
@@ -611,6 +622,8 @@ To be consistent, we should also report multiple warnings from a single
location in mkGroupReporter, when -fdefer-type-errors is on. But that
is perhaps a bit *over*-consistent! Again, an easy choice to change.
+With #10283, you can now opt out of deferred type error warnings.
+
Note [Do not report derived but soluble errors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 26822fe110..928c6275b9 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -1497,7 +1497,8 @@
<entry>
Turn type errors into warnings, <link linkend="defer-type-errors">
deferring the error until runtime</link>. Implies
- <option>-fdefer-typed-holes</option>.
+ <option>-fdefer-typed-holes</option>. See also
+ <option>-fwarn-deferred-type-errors</option>
</entry>
<entry>dynamic</entry>
<entry><option>-fno-defer-type-errors</option></entry>
@@ -1804,6 +1805,16 @@
</row>
<row>
+ <entry><option>-fwarn-deferred-type-errors</option></entry>
+ <entry>
+ Report warnings when <link linkend="defer-type-errors">deferred type errors</link>
+ are enabled. This option is enabled by default. See <option>-fdefer-type-errors</option>.
+ </entry>
+ <entry>dynamic</entry>
+ <entry><option>-fno-warn-deferred-type-errors</option></entry>
+ </row>
+
+ <row>
<entry><option>-fwarn-typed-holes</option></entry>
<entry>
Report warnings when <link linkend="typed-holes">typed hole</link>
diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml
index 462509290a..95f814f0d0 100644
--- a/docs/users_guide/glasgow_exts.xml
+++ b/docs/users_guide/glasgow_exts.xml
@@ -9182,7 +9182,8 @@ main = print "b"
<para>
The flag <literal>-fdefer-type-errors</literal> controls whether type
errors are deferred to runtime. Type errors will still be emitted as
- warnings, but will not prevent compilation.
+ warnings, but will not prevent compilation. You can use
+ <literal>-fno-warn-deferred-type-errors</literal> to suppress these warnings.
</para>
<para>
This flag implies the <literal>-fdefer-typed-holes</literal> flag,
diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml
index 5642ea52c9..58008a2ade 100644
--- a/docs/users_guide/using.xml
+++ b/docs/users_guide/using.xml
@@ -1152,6 +1152,17 @@ test.hs:(5,4)-(6,7):
</listitem>
</varlistentry>
+ <varlistentry>
+ <term><option>-fwarn-type-errors</option>:</term>
+ <listitem>
+ <indexterm><primary><option>-fwarn-type-errors</option></primary>
+ </indexterm>
+ <indexterm><primary>warnings</primary></indexterm>
+ <para>Causes a warning to be reported when a type error is deferred
+ until runtime. See <xref linkend="defer-type-errors"/></para>
+ <para>This warning is on by default.</para>
+ </listitem>
+ </varlistentry>
<varlistentry>
<term><option>-fdefer-type-errors</option>:</term>
diff --git a/testsuite/tests/typecheck/should_compile/T10283.hs b/testsuite/tests/typecheck/should_compile/T10283.hs
new file mode 100644
index 0000000000..e623b1cb0a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T10283.hs
@@ -0,0 +1,23 @@
+{-# OPTIONS_GHC -fdefer-type-errors -fno-warn-deferred-type-errors #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+
+module T9834 where
+import Control.Applicative
+import Data.Functor.Identity
+
+type Nat f g = forall a. f a -> g a
+
+newtype Comp p q a = Comp (p (q a))
+
+liftOuter :: (Functor p, Applicative q) => p a -> (Comp p q) a
+liftOuter pa = Comp (pure <$> pa)
+
+runIdComp :: Functor p => Comp p Identity a -> p a
+runIdComp (Comp p) = runIdentity <$> p
+
+wrapIdComp :: Applicative p => (forall q. Applicative q => Nat (Comp p q) (Comp p q)) -> p a -> p a
+wrapIdComp f = runIdComp . f . liftOuter
+
+class Applicative p => ApplicativeFix p where
+ afix :: (forall q. Applicative q => (Comp p q) a -> (Comp p q) a) -> p a
+ afix = wrapIdComp
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 2863db5dbe..070da887bf 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -449,6 +449,7 @@ test('T10177', normal, compile, [''])
test('T10185', expect_broken(10185), compile, [''])
test('T10195', normal, compile, [''])
test('T10109', normal, compile, [''])
+test('T10283', normal, compile, [''])
test('TcCustomSolverSuper', normal, compile, [''])
test('T10335', normal, compile, [''])
test('Improvement', normal, compile, [''])
View Lorry Controller Status