Mark newtype constructors as used in the Coercible solver (#10347)

Currently, newtype constructors are not marked as used when they are
accessed under the hood by uses of `coerce`, as described in #10347.
This fixes #10347 by co-opting the `tcg_keep` field of `TcGblEnv`
to track uses of newtype constructors in the `Coercible` solver.
See `Note [Tracking unused binding and imports]` in `TcRnTypes`.

Since #10347 is fixed, I was able to simplify the code in `TcDeriv`
slightly, as the hack described in
`Note [Newtype deriving and unused constructors]`
is no longer necessary.

8 files changed, 95 insertions, 80 deletions

diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 7b9a385e48..bb7de4e3dd 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -1190,16 +1190,16 @@ lookupChildren all_kids rdr_items
 *********************************************************
 -}
 
-reportUnusedNames :: Maybe (Located [LIE GhcPs])  -- Export list
-                  -> TcGblEnv -> RnM ()
-reportUnusedNames _export_decls gbl_env
-  = do  { traceRn "RUN" (ppr (tcg_dus gbl_env))
+reportUnusedNames :: TcGblEnv -> RnM ()
+reportUnusedNames gbl_env
+  = do  { keep <- readTcRef (tcg_keep gbl_env)
+        ; traceRn "RUN" (ppr (tcg_dus gbl_env))
         ; warnUnusedImportDecls gbl_env
-        ; warnUnusedTopBinds unused_locals
+        ; warnUnusedTopBinds $ unused_locals keep
         ; warnMissingSignatures gbl_env }
   where
-    used_names :: NameSet
-    used_names = findUses (tcg_dus gbl_env) emptyNameSet
+    used_names :: NameSet -> NameSet
+    used_names keep = findUses (tcg_dus gbl_env) emptyNameSet `unionNameSet` keep
     -- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
     -- Hence findUses
 
@@ -1207,13 +1207,6 @@ reportUnusedNames _export_decls gbl_env
     defined_names :: [GlobalRdrElt]
     defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env)
 
-    -- Note that defined_and_used, defined_but_not_used
-    -- are both [GRE]; that's why we need defined_and_used
-    -- rather than just used_names
-    _defined_and_used, defined_but_not_used :: [GlobalRdrElt]
-    (_defined_and_used, defined_but_not_used)
-        = partition (gre_is_used used_names) defined_names
-
     kids_env = mkChildEnv defined_names
     -- This is done in mkExports too; duplicated work
 
@@ -1228,8 +1221,16 @@ reportUnusedNames _export_decls gbl_env
     --  (a) defined in this module, and
     --  (b) not defined by a 'deriving' clause
     -- The latter have an Internal Name, so we can filter them out easily
-    unused_locals :: [GlobalRdrElt]
-    unused_locals = filter is_unused_local defined_but_not_used
+    unused_locals :: NameSet -> [GlobalRdrElt]
+    unused_locals keep =
+      let -- Note that defined_and_used, defined_but_not_used
+          -- are both [GRE]; that's why we need defined_and_used
+          -- rather than just used_names
+          _defined_and_used, defined_but_not_used :: [GlobalRdrElt]
+          (_defined_and_used, defined_but_not_used)
+              = partition (gre_is_used (used_names keep)) defined_names
+
+      in filter is_unused_local defined_but_not_used
     is_unused_local :: GlobalRdrElt -> Bool
     is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre)
 
diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs
index e779c6794f..55054805ef 100644
--- a/compiler/typecheck/TcCanonical.hs
+++ b/compiler/typecheck/TcCanonical.hs
@@ -48,6 +48,7 @@ import Data.List  ( zip4 )
 import BasicTypes
 
 import Data.Bifunctor ( bimap )
+import Data.Foldable ( traverse_ )
 
 {-
 ************************************************************************
@@ -1267,13 +1268,22 @@ can_eq_newtype_nc ev swapped ty1 ((gres, co), ty1') ty2 ps_ty2
          -- check for blowing our stack:
          -- See Note [Newtypes can blow the stack]
        ; checkReductionDepth (ctEvLoc ev) ty1
-       ; addUsedGREs (bagToList gres)
-           -- we have actually used the newtype constructor here, so
-           -- make sure we don't warn about importing it!
+
+         -- Next, we record uses of newtype constructors, since coercing
+         -- through newtypes is tantamount to using their constructors.
+       ; addUsedGREs gre_list
+         -- If a newtype constructor was imported, don't warn about not
+         -- importing it...
+       ; traverse_ keepAlive $ map gre_name gre_list
+         -- ...and similarly, if a newtype constructor was defined in the same
+         -- module, don't warn about it being unused.
+         -- See Note [Tracking unused binding and imports] in TcRnTypes.
 
        ; new_ev <- rewriteEqEvidence ev swapped ty1' ps_ty2
                                      (mkTcSymCo co) (mkTcReflCo Representational ps_ty2)
        ; can_eq_nc False new_ev ReprEq ty1' ty1' ty2 ps_ty2 }
+  where
+    gre_list = bagToList gres
 
 ---------
 -- ^ Decompose a type application.
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index 5e68f2e587..6688ed7cbc 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -345,25 +345,6 @@ renameDeriv inst_infos bagBinds
               ; return (inst_info { iBinds = binds' }, fvs) }
 
 {-
-Note [Newtype deriving and unused constructors]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider this (see #1954):
-
-  module Bug(P) where
-  newtype P a = MkP (IO a) deriving Monad
-
-If you compile with -Wunused-binds you do not expect the warning
-"Defined but not used: data constructor MkP". Yet the newtype deriving
-code does not explicitly mention MkP, but it should behave as if you
-had written
-  instance Monad P where
-     return x = MkP (return x)
-     ...etc...
-
-So we want to signal a user of the data constructor 'MkP'.
-This is the reason behind the [Name] part of the return type
-of genInst.
-
 Note [Staging of tcDeriving]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Here's a tricky corner case for deriving (adapted from #2721):
@@ -2102,15 +2083,7 @@ genDerivStuff mechanism loc clas tycon inst_tys tyvars
   where
     gen_newtype_or_via ty = do
       (binds, faminsts) <- gen_Newtype_binds loc clas tyvars inst_tys ty
-      return (binds, faminsts, maybeToList unusedConName)
-
-    unusedConName :: Maybe Name
-    unusedConName
-      | isDerivSpecNewtype mechanism
-        -- See Note [Newtype deriving and unused constructors]
-      = Just $ getName $ head $ tyConDataCons tycon
-      | otherwise
-      = Nothing
+      return (binds, faminsts, [])
 
 {-
 Note [Bindings for Generalised Newtype Deriving]
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index c7f1cf62d5..cda34f07d8 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -294,7 +294,7 @@ tcRnModuleTcRnM hsc_env mod_sum
                         -- Do this /after/ typeinference, so that when reporting
                         -- a function with no type signature we can give the
                         -- inferred type
-                        reportUnusedNames export_ies tcg_env
+                        reportUnusedNames tcg_env
                       ; -- add extra source files to tcg_dependent_files
                         addDependentFiles src_files
                       ; tcg_env <- runTypecheckerPlugin mod_sum hsc_env tcg_env
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index a66143bf57..86b975859f 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -553,29 +553,11 @@ data TcGblEnv
           --      (mkIfaceTc, as well as in HscMain)
           --    - To create the Dependencies field in interface (mkDependencies)
 
-        tcg_dus       :: DefUses,   -- ^ What is defined in this module and what is used.
-        tcg_used_gres :: TcRef [GlobalRdrElt],  -- ^ Records occurrences of imported entities
-          -- One entry for each occurrence; but may have different GREs for
-          -- the same Name See Note [Tracking unused binding and imports]
-
-        tcg_keep :: TcRef NameSet,
-          -- ^ Locally-defined top-level names to keep alive.
-          --
-          -- "Keep alive" means give them an Exported flag, so that the
-          -- simplifier does not discard them as dead code, and so that they
-          -- are exposed in the interface file (but not to export to the
-          -- user).
-          --
-          -- Some things, like dict-fun Ids and default-method Ids are "born"
-          -- with the Exported flag on, for exactly the above reason, but some
-          -- we only discover as we go.  Specifically:
-          --
-          --   * The to/from functions for generic data types
-          --
-          --   * Top-level variables appearing free in the RHS of an orphan
-          --     rule
-          --
-          --   * Top-level variables appearing free in a TH bracket
+          -- These three fields track unused bindings and imports
+          -- See Note [Tracking unused binding and imports]
+        tcg_dus       :: DefUses,
+        tcg_used_gres :: TcRef [GlobalRdrElt],
+        tcg_keep      :: TcRef NameSet,
 
         tcg_th_used :: TcRef Bool,
           -- ^ @True@ <=> Template Haskell syntax used.
@@ -750,9 +732,11 @@ data SelfBootInfo
 
 {- Note [Tracking unused binding and imports]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We gather two sorts of usage information
+We gather three sorts of usage information
+
+ * tcg_dus :: DefUses (defs/uses)
+      Records what is defined in this module and what is used.
 
- * tcg_dus (defs/uses)
       Records *defined* Names (local, top-level)
           and *used*    Names (local or imported)
 
@@ -763,7 +747,9 @@ We gather two sorts of usage information
    This usage info is mainly gathered by the renamer's
    gathering of free-variables
 
- * tcg_used_gres
+ * tcg_used_gres :: TcRef [GlobalRdrElt]
+      Records occurrences of imported entities.
+
       Used only to report unused import declarations
 
       Records each *occurrence* an *imported* (not locally-defined) entity.
@@ -773,6 +759,46 @@ We gather two sorts of usage information
       /how that occurrence is in scope/.   See Note [GRE filtering] in
       RdrName.
 
+  * tcg_keep :: TcRef NameSet
+      Records names of the type constructors, data constructors, and Ids that
+      are used by the constraint solver.
+
+      The typechecker may use find that some imported or
+      locally-defined things are used, even though they
+      do not appear to be mentioned in the source code:
+
+      (a) The to/from functions for generic data types
+
+      (b) Top-level variables appearing free in the RHS of an
+          orphan rule
+
+      (c) Top-level variables appearing free in a TH bracket
+          See Note [Keeping things alive for Template Haskell]
+          in RnSplice
+
+      (d) The data constructor of a newtype that is used
+          to solve a Coercible instance (e.g. #10347). Example
+              module T10347 (N, mkN) where
+                import Data.Coerce
+                newtype N a = MkN Int
+                mkN :: Int -> N a
+                mkN = coerce
+
+          Then we wish to record `MkN` as used, since it is (morally)
+          used to perform the coercion in `mkN`. To do so, the
+          Coercible solver updates tcg_keep's TcRef whenever it
+          encounters a use of `coerce` that crosses newtype boundaries.
+
+      The tcg_keep field is used in two distinct ways:
+
+      * Desugar.addExportFlagsAndRules.  Where things like (a-c) are locally
+        defined, we should give them an an Exported flag, so that the
+        simplifier does not discard them as dead code, and so that they are
+        exposed in the interface file (but not to export to the user).
+
+      * RnNames.reportUnusedNames.  Where newtype data constructors like (d)
+        are imported, we don't want to report them as unused.
+
 
 ************************************************************************
 *                                                                      *
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index 0d15d26180..4c1fde0c41 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -19,7 +19,7 @@ module TcSMonad (
     nestTcS, nestImplicTcS, setEvBindsTcS,
     checkConstraintsTcS, checkTvConstraintsTcS,
 
-    runTcPluginTcS, addUsedGRE, addUsedGREs,
+    runTcPluginTcS, addUsedGRE, addUsedGREs, keepAlive,
     matchGlobalInst, TcM.ClsInstResult(..),
 
     QCInst(..),
@@ -3066,6 +3066,8 @@ addUsedGREs gres = wrapTcS  $ TcM.addUsedGREs gres
 addUsedGRE :: Bool -> GlobalRdrElt -> TcS ()
 addUsedGRE warn_if_deprec gre = wrapTcS $ TcM.addUsedGRE warn_if_deprec gre
 
+keepAlive :: Name -> TcS ()
+keepAlive = wrapTcS . TcM.keepAlive
 
 -- Various smaller utilities [TODO, maybe will be absorbed in the instance matcher]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/testsuite/tests/typecheck/should_compile/T10347.hs b/testsuite/tests/typecheck/should_compile/T10347.hs
index ca9fdd98cc..702a000bf3 100644
--- a/testsuite/tests/typecheck/should_compile/T10347.hs
+++ b/testsuite/tests/typecheck/should_compile/T10347.hs
@@ -1,10 +1,13 @@
-{-# OPTIONS_GHC -fwarn-unused-binds #-}
-
-module T10347 (N, mkN) where
+{-# OPTIONS_GHC -Wunused-imports -Wunused-top-binds #-}
+module T10347 (N, mkN, mkSum) where
 
 import Data.Coerce
+import Data.Monoid (Sum(Sum))
 
 newtype N a = MkN Int
 
 mkN :: Int -> N a
-mkN = coerce
+mkN = coerce -- Should mark MkN (a locally defined constructor) as used
+
+mkSum :: Int -> Sum Int
+mkSum = coerce -- Should mark Sum (an imported constructor) as used
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index ee38a1abea..7594265db6 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -476,7 +476,7 @@ test('T10632', normal, compile, ['-Wredundant-constraints'])
 test('T10642', normal, compile, [''])
 test('T10744', normal, compile, [''])
 test('update-existential', normal, compile, [''])
-test('T10347', expect_broken(10347), compile, [''])
+test('T10347', normal, compile, [''])
 test('T11056', normal, compile, [''])
 test('T10770a', expect_broken(10770), compile, [''])
 test('T10770b', expect_broken(10770), compile, [''])