Allow deferred type error warnings to be suppressed
authorDavid Kraeutmann <kane@kane.cx>
Tue, 7 Jul 2015 14:59:34 +0000 (16:59 +0200)
committerBen Gamari <ben@smart-cactus.org>
Tue, 7 Jul 2015 14:59:34 +0000 (16:59 +0200)
Adds a flag -fwarn-deferred-type-errors similar to -fwarn-typed-holes.
Changes the boolean flag of -fdefer-type-errors to a 3-state flag
similar to the one used by -fdefer-typed-holes/-fwarn-typed-holes.

Test Plan: Since only the absence of deferred type error warnings when
-fno-warn-deferred-type-errors is passed has to be tested, I duplicated
a test case checking -fdefer-type-errors and adjusted it accordingly.

Reviewers: nomeata, simonpj, austin, thomie, bgamari, hvr

Reviewed By: nomeata, simonpj, austin, thomie, bgamari, hvr

Subscribers: bgamari, simonpj, nomeata, thomie

Projects: #ghc

Differential Revision: https://phabricator.haskell.org/D864

GHC Trac Issues: #10283

compiler/main/DynFlags.hs
compiler/typecheck/TcErrors.hs
docs/users_guide/flags.xml
docs/users_guide/glasgow_exts.xml
docs/users_guide/using.xml
testsuite/tests/typecheck/should_compile/T10283.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/all.T

index cf50914..23a5fed 100644 (file)
@@ -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,
index 032af20..9809db8 100644 (file)
@@ -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]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
index 26822fe..928c627 100644 (file)
             <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>
           </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>
index 4625092..95f814f 100644 (file)
@@ -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,
index 5642ea5..58008a2 100644 (file)
@@ -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 (file)
index 0000000..e623b1c
--- /dev/null
@@ -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
index 2863db5..070da88 100644 (file)
@@ -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, [''])