Fixes to dealing with the export of mainwip/T19397-backport

It's surprisingly tricky to deal with 'main' (#19397). This
patch does quite bit of refactoring do to it right. Well,
more-right anyway!

The moving parts are documented in GHC.Tc.Module
   Note [Dealing with main]

Some other oddments:

* Rename tcRnExports to rnExports; no typechecking here!

* rnExports now uses checkNoErrs rather than failIfErrsM;
  the former fails only if rnExports itself finds errors

* Small improvements to tcTyThingCategory, which ultimately
  weren't important to the patch, but I've retained as
  a minor improvement.

47 files changed, 516 insertions, 395 deletions

diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 2b0a2e5ae9..2257ab3545 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -606,7 +606,7 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name
   -- `checkPatSynParent`.
   traceRn "parent" (ppr parent)
   traceRn "lookupExportChild original_gres:" (ppr original_gres)
-  traceRn "lookupExportChild picked_gres:" (ppr $ picked_gres original_gres)
+  traceRn "lookupExportChild picked_gres:" (ppr (picked_gres original_gres) $$ ppr must_have_parent)
   case picked_gres original_gres of
     NoOccurrence ->
       noMatchingParentErr original_gres
@@ -647,6 +647,7 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name
         --     constructors, neither of which is the parent.
         noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
         noMatchingParentErr original_gres = do
+          traceRn "npe" (ppr original_gres)
           overload_ok <- xoptM LangExt.DuplicateRecordFields
           case original_gres of
             [] ->  return NameNotFound
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index 3aed54a802..3bd3daa72d 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -5,7 +5,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
 
-module GHC.Tc.Gen.Export (tcRnExports, exports_from_avail) where
+module GHC.Tc.Gen.Export (rnExports, exports_from_avail) where
 
 import GHC.Prelude
 
@@ -151,45 +151,47 @@ type ExportOccMap = OccEnv (Name, IE GhcPs)
         --   it came from.  It's illegal to export two distinct things
         --   that have the same occurrence name
 
-tcRnExports :: Bool       -- False => no 'module M(..) where' header at all
+rnExports :: Bool       -- False => no 'module M(..) where' header at all
           -> Maybe (Located [LIE GhcPs]) -- Nothing => no explicit export list
-          -> TcGblEnv
           -> RnM TcGblEnv
 
         -- Complains if two distinct exports have same OccName
         -- Warns about identical exports.
         -- Complains about exports items not in scope
 
-tcRnExports explicit_mod exports
-          tcg_env@TcGblEnv { tcg_mod     = this_mod,
-                              tcg_rdr_env = rdr_env,
-                              tcg_imports = imports,
-                              tcg_src     = hsc_src }
- = unsetWOptM Opt_WarnWarningsDeprecations $
+rnExports explicit_mod exports
+ = checkNoErrs $   -- Fail if anything in rnExports finds
+                   -- an error fails, to avoid error cascade
+   unsetWOptM Opt_WarnWarningsDeprecations $
        -- Do not report deprecations arising from the export
        -- list, to avoid bleating about re-exporting a deprecated
        -- thing (especially via 'module Foo' export item)
-   do   {
-        ; dflags <- getDynFlags
-        ; let is_main_mod = mainModIs dflags == this_mod
-        ; let default_main = case mainFunIs dflags of
-                 Just main_fun
-                     | is_main_mod -> mkUnqual varName (fsLit main_fun)
-                 _                 -> main_RDR_Unqual
+   do   { dflags <- getDynFlags
+        ; tcg_env <- getGblEnv
+        ; let TcGblEnv { tcg_mod     = this_mod
+                       , tcg_rdr_env = rdr_env
+                       , tcg_imports = imports
+                       , tcg_src     = hsc_src } = tcg_env
+              default_main | mainModIs dflags == this_mod
+                           , Just main_fun <- mainFunIs dflags
+                           = mkUnqual varName (fsLit main_fun)
+                           | otherwise
+                           = main_RDR_Unqual
         ; has_main <- (not . null) <$> lookupInfoOccRn default_main -- #17832
+
         -- If a module has no explicit header, and it has one or more main
         -- functions in scope, then add a header like
         -- "module Main(main) where ..."                               #13839
         -- See Note [Modules without a module header]
         ; let real_exports
                  | explicit_mod = exports
-                 | has_main
-                          = Just (noLoc [noLoc (IEVar noExtField
+                 | has_main = Just (noLoc [noLoc (IEVar noExtField
                                      (noLoc (IEName $ noLoc default_main)))])
-                        -- ToDo: the 'noLoc' here is unhelpful if 'main'
-                        --       turns out to be out of scope
+                              -- ToDo: the 'noLoc' here is unhelpful if 'main'
+                              --       turns out to be out of scope
                  | otherwise = Nothing
 
+        -- Rename the export list
         ; let do_it = exports_from_avail real_exports rdr_env imports this_mod
         ; (rn_exports, final_avails)
             <- if hsc_src == HsigFile
@@ -198,19 +200,18 @@ tcRnExports explicit_mod exports
                             Just r  -> return r
                             Nothing -> addMessages msgs >> failM
                 else checkNoErrs do_it
-        ; let final_ns     = availsToNameSetWithSelectors final_avails
+
+        -- Final processing
+        ; let final_ns = availsToNameSetWithSelectors final_avails
 
         ; traceRn "rnExports: Exports:" (ppr final_avails)
 
-        ; let new_tcg_env =
-                  tcg_env { tcg_exports    = final_avails,
-                             tcg_rn_exports = case tcg_rn_exports tcg_env of
+        ; return (tcg_env { tcg_exports    = final_avails
+                          , tcg_rn_exports = case tcg_rn_exports tcg_env of
                                                 Nothing -> Nothing
-                                                Just _  -> rn_exports,
-                            tcg_dus = tcg_dus tcg_env `plusDU`
-                                      usesOnly final_ns }
-        ; failIfErrsM
-        ; return new_tcg_env }
+                                                Just _  -> rn_exports
+                          , tcg_dus = tcg_dus tcg_env `plusDU`
+                                      usesOnly final_ns }) }
 
 exports_from_avail :: Maybe (Located [LIE GhcPs])
                          -- ^ 'Nothing' means no explicit export list
@@ -616,7 +617,7 @@ checkPatSynParent parent NoParent mpat_syn
   = return ()
 
   | otherwise
-  = do { parent_ty_con <- tcLookupTyCon parent
+  = do { parent_ty_con  <- tcLookupTyCon parent
        ; mpat_syn_thing <- tcLookupGlobal mpat_syn
 
         -- 1. Check that the Id was actually from a thing associated with patsyns
@@ -806,7 +807,7 @@ dcErrMsg ty_con what_is thing parents =
                 <+> text "is not the parent of the" <+> text what_is
                 <+> quotes thing <> char '.'
                 $$ text (capitalise what_is)
-                <> text "s can only be exported with their parent type constructor."
+                   <> text "s can only be exported with their parent type constructor."
                 $$ (case parents of
                       [] -> empty
                       [_] -> text "Parent:"
@@ -815,13 +816,13 @@ dcErrMsg ty_con what_is thing parents =
 failWithDcErr :: Name -> Name -> SDoc -> [Name] -> TcM a
 failWithDcErr parent thing thing_doc parents = do
   ty_thing <- tcLookupGlobal thing
-  failWithTc $ dcErrMsg parent (tyThingCategory' ty_thing)
+  failWithTc $ dcErrMsg parent (pp_category ty_thing)
                         thing_doc (map ppr parents)
   where
-    tyThingCategory' :: TyThing -> String
-    tyThingCategory' (AnId i)
+    pp_category :: TyThing -> String
+    pp_category (AnId i)
       | isRecordSelector i = "record selector"
-    tyThingCategory' i = tyThingCategory i
+    pp_category i = tyThingCategory i
 
 
 exportClashErr :: GlobalRdrEnv -> OccName
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index ecb2e4241e..e9cca205d1 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -13,6 +13,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE MultiWayIf #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
@@ -56,7 +57,7 @@ import GHC.Iface.Env     ( externaliseName )
 import GHC.Tc.Gen.HsType
 import GHC.Tc.Validity( checkValidType )
 import GHC.Tc.Gen.Match
-import GHC.Tc.Utils.Unify( checkConstraints )
+import GHC.Tc.Utils.Unify( checkConstraints, tcSubTypeSigma )
 import GHC.Rename.HsType
 import GHC.Rename.Expr
 import GHC.Rename.Utils  ( HsDocContext(..) )
@@ -129,7 +130,7 @@ import GHC.Core.Class
 import GHC.Types.Basic hiding( SuccessFlag(..) )
 import GHC.Core.Coercion.Axiom
 import GHC.Types.Annotations
-import Data.List ( find, sortBy, sort )
+import Data.List ( sortBy, sort )
 import Data.Ord
 import GHC.Data.FastString
 import GHC.Data.Maybe
@@ -266,9 +267,16 @@ tcRnModuleTcRnM hsc_env mod_sum
           $ do { -- Rename and type check the declarations
                  traceRn "rn1a" empty
                ; tcg_env <- if isHsBootOrSig hsc_src
-                            then tcRnHsBootDecls hsc_src local_decls
+                            then do {
+                              ; tcg_env <- tcRnHsBootDecls hsc_src local_decls
+                              ; traceRn "rn4a: before exports" empty
+                              ; tcg_env <- setGblEnv tcg_env $
+                                           rnExports explicit_mod_hdr export_ies
+                              ; traceRn "rn4b: after exports" empty
+                              ; return tcg_env
+                              }
                             else {-# SCC "tcRnSrcDecls" #-}
-                                 tcRnSrcDecls explicit_mod_hdr local_decls export_ies
+                                 tcRnSrcDecls explicit_mod_hdr export_ies local_decls
 
                ; whenM (goptM Opt_DoCoreLinting) $
                  do { let (warns, errs) = lintGblEnv (hsc_dflags hsc_env) tcg_env
@@ -278,12 +286,7 @@ tcRnModuleTcRnM hsc_env mod_sum
                                      -- going to get in deeper trouble by proceeding
 
                ; setGblEnv tcg_env
-                 $ do { -- Process the export list
-                        traceRn "rn4a: before exports" empty
-                      ; tcg_env <- tcRnExports explicit_mod_hdr export_ies
-                                     tcg_env
-                      ; traceRn "rn4b: after exports" empty
-                      ; -- Compare hi-boot iface (if any) with the real thing
+                 $ do { -- Compare hi-boot iface (if any) with the real thing
                         -- Must be done after processing the exports
                         tcg_env <- checkHiBootIface tcg_env boot_info
                       ; -- The new type env is already available to stuff
@@ -407,104 +410,117 @@ tcRnImports hsc_env import_decls
 -}
 
 tcRnSrcDecls :: Bool  -- False => no 'module M(..) where' header at all
-             -> [LHsDecl GhcPs]               -- Declarations
              -> Maybe (Located [LIE GhcPs])
+             -> [LHsDecl GhcPs]               -- Declarations
              -> TcM TcGblEnv
-tcRnSrcDecls explicit_mod_hdr decls export_ies
+tcRnSrcDecls explicit_mod_hdr export_ies decls
  = do { -- Do all the declarations
       ; (tcg_env, tcl_env, lie) <- tc_rn_src_decls decls
 
-        -- Check for the 'main' declaration
-        -- Must do this inside the captureTopConstraints
-        -- NB: always set envs *before* captureTopConstraints
-      ; (tcg_env, lie_main) <- setEnvs (tcg_env, tcl_env) $
-                               captureTopConstraints $
-                               checkMain explicit_mod_hdr export_ies
-
-      ; setEnvs (tcg_env, tcl_env) $ do {
-
-             --         Simplify constraints
-             --
-             -- We do this after checkMain, so that we use the type info
-             -- that checkMain adds
-             --
-             -- We do it with both global and local env in scope:
-             --  * the global env exposes the instances to simplifyTop
-             --  * the local env exposes the local Ids to simplifyTop,
-             --    so that we get better error messages (monomorphism restriction)
+      ------ Simplify constraints ---------
+      --
+      -- We do this after checkMainType, so that we use the type
+      -- info that checkMainType adds
+      --
+      -- We do it with both global and local env in scope:
+      --  * the global env exposes the instances to simplifyTop,
+      --    and affects how names are rendered in error messages
+      --  * the local env exposes the local Ids to simplifyTop,
+      --    so that we get better error messages (monomorphism restriction)
       ; new_ev_binds <- {-# SCC "simplifyTop" #-}
-                        simplifyTop (lie `andWC` lie_main)
+                        setEnvs (tcg_env, tcl_env) $
+                        do { lie_main <- checkMainType tcg_env
+                           ; simplifyTop (lie `andWC` lie_main) }
 
         -- Emit Typeable bindings
-      ; tcg_env <- mkTypeableBinds
-
+      ; tcg_env <- setGblEnv tcg_env $
+                   mkTypeableBinds
 
       ; traceTc "Tc9" empty
 
-      ; failIfErrsM     -- Don't zonk if there have been errors
-                        -- It's a waste of time; and we may get debug warnings
-                        -- about strangely-typed TyCons!
-      ; traceTc "Tc10" empty
-
         -- Zonk the final code.  This must be done last.
         -- Even simplifyTop may do some unification.
         -- This pass also warns about missing type signatures
-      ; (bind_env, ev_binds', binds', fords', imp_specs', rules')
+      ; (id_env, ev_binds', binds', fords', imp_specs', rules')
             <- zonkTcGblEnv new_ev_binds tcg_env
 
-        -- Finalizers must run after constraints are simplified, or some types
-        -- might not be complete when using reify (see #12777).
-        -- and also after we zonk the first time because we run typed splices
-        -- in the zonker which gives rise to the finalisers.
-      ; (tcg_env_mf, _) <- setGblEnv (clearTcGblEnv tcg_env)
-                                     run_th_modfinalizers
+      --------- Run finalizers --------------
+      -- Finalizers must run after constraints are simplified, lest types
+      --    might not be complete when using reify (see #12777).
+      -- and also after we zonk the first time because we run typed splices
+      --    in the zonker which gives rise to the finalisers.
+      ; let -- init_tcg_env:
+            --   * Remove accumulated bindings, rules and so on from
+            --     TcGblEnv.  They are now in ev_binds', binds', etc.
+            --   * Add the zonked Ids from the value bindings to tcg_type_env
+            --     Up to now these Ids are only in tcl_env's type-envt
+            init_tcg_env = tcg_env { tcg_binds     = emptyBag
+                                   , tcg_ev_binds  = emptyBag
+                                   , tcg_imp_specs = []
+                                   , tcg_rules     = []
+                                   , tcg_fords     = []
+                                   , tcg_type_env  = tcg_type_env tcg_env
+                                                     `plusTypeEnv` id_env }
+      ; (tcg_env, tcl_env) <- setGblEnv init_tcg_env
+                              run_th_modfinalizers
       ; finishTH
       ; traceTc "Tc11" empty
 
-      ; -- zonk the new bindings arising from running the finalisers.
-        -- This won't give rise to any more finalisers as you can't nest
-        -- finalisers inside finalisers.
-      ; (bind_env_mf, ev_binds_mf, binds_mf, fords_mf, imp_specs_mf, rules_mf)
-            <- zonkTcGblEnv emptyBag tcg_env_mf
-
-
-      ; let { final_type_env = plusTypeEnv (tcg_type_env tcg_env)
-                                (plusTypeEnv bind_env_mf bind_env)
-            ; tcg_env' = tcg_env_mf
-                          { tcg_binds    = binds' `unionBags` binds_mf,
-                            tcg_ev_binds = ev_binds' `unionBags` ev_binds_mf ,
-                            tcg_imp_specs = imp_specs' ++ imp_specs_mf ,
-                            tcg_rules    = rules' ++ rules_mf ,
-                            tcg_fords    = fords' ++ fords_mf } } ;
+      --------- Deal with the exports ----------
+      -- Can't be done earlier, because the export list must "see"
+      -- the declarations created by the finalizers
+      ; tcg_env <- setEnvs (tcg_env, tcl_env) $
+                   rnExports explicit_mod_hdr export_ies
+
+      --------- Emit the ':Main.main = runMainIO main' declaration ----------
+      -- Do this /after/ rnExports, so that it can consult
+      -- the tcg_exports created by rnExports
+      ; (tcg_env, main_ev_binds)
+           <- setEnvs (tcg_env, tcl_env) $
+              do { (tcg_env, lie) <- captureTopConstraints $
+                                     checkMain explicit_mod_hdr export_ies
+                 ; ev_binds <- simplifyTop lie
+                 ; return (tcg_env, ev_binds) }
+
+      ---------- Final zonking ---------------
+      -- Zonk the new bindings arising from running the finalisers,
+      -- and main. This won't give rise to any more finalisers as you
+      -- can't nest finalisers inside finalisers.
+      ; (id_env_mf, ev_binds_mf, binds_mf, fords_mf, imp_specs_mf, rules_mf)
+            <- zonkTcGblEnv main_ev_binds tcg_env
+
+      ; let { !final_type_env = tcg_type_env tcg_env
+                                `plusTypeEnv` id_env_mf
+              -- Add the zonked Ids from the value bindings (they were in tcl_env)
+              -- Force !final_type_env, lest we retain an old reference
+              -- to the previous tcg_env
+
+            ; tcg_env' = tcg_env
+                          { tcg_binds     = binds'    `unionBags` binds_mf
+                          , tcg_ev_binds  = ev_binds' `unionBags` ev_binds_mf
+                          , tcg_imp_specs = imp_specs' ++ imp_specs_mf
+                          , tcg_rules     = rules'     ++ rules_mf
+                          , tcg_fords     = fords'     ++ fords_mf } } ;
 
       ; setGlobalTypeEnv tcg_env' final_type_env
-
-   } }
+   }
 
 zonkTcGblEnv :: Bag EvBind -> TcGblEnv
              -> TcM (TypeEnv, Bag EvBind, LHsBinds GhcTc,
                        [LForeignDecl GhcTc], [LTcSpecPrag], [LRuleDecl GhcTc])
-zonkTcGblEnv new_ev_binds tcg_env =
-  let TcGblEnv {   tcg_binds     = binds,
-                   tcg_ev_binds  = cur_ev_binds,
-                   tcg_imp_specs = imp_specs,
-                   tcg_rules     = rules,
-                   tcg_fords     = fords } = tcg_env
-
-      all_ev_binds = cur_ev_binds `unionBags` new_ev_binds
-
-  in {-# SCC "zonkTopDecls" #-}
-      zonkTopDecls all_ev_binds binds rules imp_specs fords
-
-
--- | Remove accumulated bindings, rules and so on from TcGblEnv
-clearTcGblEnv :: TcGblEnv -> TcGblEnv
-clearTcGblEnv tcg_env
-  = tcg_env { tcg_binds    = emptyBag,
-              tcg_ev_binds = emptyBag ,
-              tcg_imp_specs = [],
-              tcg_rules    = [],
-              tcg_fords    = [] }
+zonkTcGblEnv ev_binds tcg_env@(TcGblEnv { tcg_binds     = binds
+                                        , tcg_ev_binds  = cur_ev_binds
+                                        , tcg_imp_specs = imp_specs
+                                        , tcg_rules     = rules
+                                        , tcg_fords     = fords })
+  = {-# SCC "zonkTopDecls" #-}
+    setGblEnv tcg_env $ -- This sets the GlobalRdrEnv which is used when rendering
+                        --   error messages during zonking (notably levity errors)
+    do { failIfErrsM    -- Don't zonk if there have been errors
+                        -- It's a waste of time; and we may get debug warnings
+                        -- about strangely-typed TyCons!
+       ; let all_ev_binds = cur_ev_binds `unionBags` ev_binds
+       ; zonkTopDecls all_ev_binds binds rules imp_specs fords }
 
 -- | Runs TH finalizers and renames and typechecks the top-level declarations
 -- that they could introduce.
@@ -608,12 +624,9 @@ tc_rn_src_decls ds
                ; (spliced_decls, splice_fvs) <- rnTopSpliceDecls splice
 
                  -- Glue them on the front of the remaining decls and loop
-               ; (tcg_env, tcl_env, lie2) <-
-                   setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
-                   addTopEvBinds ev_binds1 $
-                   tc_rn_src_decls (spliced_decls ++ rest_ds)
-
-               ; return (tcg_env, tcl_env, lie2)
+               ; setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
+                 addTopEvBinds ev_binds1                             $
+                 tc_rn_src_decls (spliced_decls ++ rest_ds)
                }
           }
       }
@@ -1722,185 +1735,233 @@ tcTyClsInstDecls tycl_decls deriv_decls binds
 ************************************************************************
 -}
 
+checkMainType :: TcGblEnv -> TcRn WantedConstraints
+-- If this is the Main module, and it defines a function main,
+--   check that its type is of form IO tau.
+-- If not, do nothing
+-- See Note [Dealing with main]
+checkMainType tcg_env
+  = do { dflags <- getDynFlags
+       ; if tcg_mod tcg_env /= mainModIs dflags
+         then return emptyWC else
+
+    do { rdr_env <- getGlobalRdrEnv
+       ; let main_occ  = getMainOcc dflags
+             main_gres = lookupGlobalRdrEnv rdr_env main_occ
+       ; case filter isLocalGRE main_gres of {
+            []         -> return emptyWC ;
+            (_:_:_)    -> return emptyWC ;
+            [main_gre] ->
+
+    do { let main_name = gre_name main_gre
+             ctxt      = FunSigCtxt main_name False
+       ; main_id   <- tcLookupId main_name
+       ; (io_ty,_) <- getIOType
+       ; (_, lie)  <- captureTopConstraints       $
+                      setMainCtxt main_name io_ty $
+                      tcSubTypeSigma ctxt (idType main_id) io_ty
+       ; return lie } } } }
+
 checkMain :: Bool  -- False => no 'module M(..) where' header at all
           -> Maybe (Located [LIE GhcPs])  -- Export specs of Main module
           -> TcM TcGblEnv
--- If we are in module Main, check that 'main' is defined and exported.
+-- If we are in module Main, check that 'main' is exported,
+-- and generate the runMainIO binding that calls it
+-- See Note [Dealing with main]
 checkMain explicit_mod_hdr export_ies
- = do   { dflags  <- getDynFlags
-        ; tcg_env <- getGblEnv
-        ; check_main dflags tcg_env explicit_mod_hdr export_ies }
-
-check_main :: DynFlags -> TcGblEnv -> Bool -> Maybe (Located [LIE GhcPs])
-           -> TcM TcGblEnv
-check_main dflags tcg_env explicit_mod_hdr export_ies
- | mod /= main_mod
- = traceTc "checkMain not" (ppr main_mod <+> ppr mod) >>
-   return tcg_env
-
- | otherwise
-   -- Compare the list of main functions in scope with those
-   --   specified in the export list.
- = do mains_all <- lookupInfoOccRn main_fn
-                    -- get all 'main' functions in scope
-                    -- They may also be imported from other modules!
-      case exportedMains of -- check the main(s) specified in the export list
-        [ ] -> do
-          -- The module has no main functions in the export spec, so we must give
-          -- some kind of error message. The tricky part is giving an error message
-          -- that accurately characterizes what the problem is.
-          -- See Note [Main module without a main function in the export spec]
-          traceTc "checkMain no main module exported" ppr_mod_mainfn
-          complain_no_main
-          -- In order to reduce the number of potential error messages, we check
-          -- to see if there are any main functions defined (but not exported)...
-          case getSomeMain mains_all of
-            Nothing -> return tcg_env
-              -- ...if there are no such main functions, there is nothing we can do...
-            Just some_main -> use_as_main some_main
-                -- ...if there is such a main function, then communicate this to the
-                -- typechecker. This can prevent a spurious "Ambiguous type variable"
-                -- error message in certain cases, as described in
-                -- Note [Main module without a main function in the export spec].
-        _ -> do    -- The module has one or more main functions in the export spec
-          let mains = filterInsMains exportedMains mains_all
-          case mains of
-            [] -> do  --
-              traceTc "checkMain fail" ppr_mod_mainfn
-              complain_no_main
-              return tcg_env
-            [main_name] -> use_as_main main_name
-            _ -> do           -- multiple main functions are exported
-              addAmbiguousNameErr main_fn          -- issue error msg
+ = do { dflags <- getDynFlags
+      ; tcg_env <- getGblEnv
+
+      ; let main_mod    = mainModIs dflags
+            main_occ    = getMainOcc dflags
+
+            exported_mains :: [Name]
+            -- Exported things that are called 'main'
+            exported_mains  = [ name | avail <- tcg_exports tcg_env
+                                     , name  <- availNames avail
+                                     , nameOccName name == main_occ ]
+
+      ; if | tcg_mod tcg_env /= main_mod
+           -> -- Not the main module
               return tcg_env
+
+           | [main_name] <- exported_mains
+           -> -- The module indeed exports a function called 'main'
+              generateMainBinding tcg_env main_name
+
+           | otherwise
+           -> ASSERT( null exported_mains )
+              -- A fully-checked export list can't contain more
+              -- than one function with the same OccName
+              do { complain_no_main dflags main_mod main_occ
+                 ; return tcg_env } }
   where
-    mod         = tcg_mod tcg_env
-    main_mod    = mainModIs dflags
-    main_mod_nm = moduleName main_mod
-    main_fn     = getMainFun dflags
-    occ_main_fn = occName main_fn
-    interactive = ghcLink dflags == LinkInMemory
-    exportedMains = selExportMains export_ies
-    ppr_mod_mainfn = ppr main_mod <+> ppr main_fn
-
-    -- There is a single exported 'main' function.
-    use_as_main :: Name -> TcM TcGblEnv
-    use_as_main main_name = do
-        { traceTc "checkMain found" (ppr main_mod <+> ppr main_fn)
-        ; let loc       = srcLocSpan (getSrcLoc main_name)
-        ; ioTyCon <- tcLookupTyCon ioTyConName
-        ; res_ty <- newFlexiTyVarTy liftedTypeKind
-        ; let io_ty = mkTyConApp ioTyCon [res_ty]
-              skol_info = SigSkol (FunSigCtxt main_name False) io_ty []
-              main_expr_rn = L loc (HsVar noExtField (L loc main_name))
-        ; (ev_binds, main_expr)
-               <- checkConstraints skol_info [] [] $
-                  addErrCtxt mainCtxt    $
-                  tcCheckMonoExpr main_expr_rn io_ty
-
-                -- See Note [Root-main Id]
-                -- Construct the binding
-                --      :Main.main :: IO res_ty = runMainIO res_ty main
-        ; run_main_id <- tcLookupId runMainIOName
-        ; let { root_main_name =  mkExternalName rootMainKey rOOT_MAIN
-                                   (mkVarOccFS (fsLit "main"))
-                                   (getSrcSpan main_name)
-              ; root_main_id = Id.mkExportedVanillaId root_main_name
-                                                      (mkTyConApp ioTyCon [res_ty])
-              ; co  = mkWpTyApps [res_ty]
-              -- The ev_binds of the `main` function may contain deferred
-              -- type error when type of `main` is not `IO a`. The `ev_binds`
-              -- must be put inside `runMainIO` to ensure the deferred type
-              -- error can be emitted correctly. See #13838.
-              ; rhs = nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) $
-                        mkHsDictLet ev_binds main_expr
-              ; main_bind = mkVarBind root_main_id rhs }
-
-        ; return (tcg_env { tcg_main  = Just main_name,
-                            tcg_binds = tcg_binds tcg_env
-                                        `snocBag` main_bind,
-                            tcg_dus   = tcg_dus tcg_env
-                                        `plusDU` usesOnly (unitFV main_name)
-                        -- Record the use of 'main', so that we don't
-                        -- complain about it being defined but not used
-        })}
-
-    complain_no_main = unless (interactive && not explicit_mod_hdr)
-                              (addErrTc noMainMsg)                  -- #12906
-        -- Without an explicit module header...
-          -- in interactive mode, don't worry about the absence of 'main'.
-          -- in other modes, add error message and go on with typechecking.
-
-    mainCtxt  = text "When checking the type of the" <+> pp_main_fn
-    noMainMsg = text "The" <+> pp_main_fn
-                <+> text "is not" <+> text defOrExp <+> text "module"
-                <+> quotes (ppr main_mod)
-    defOrExp  = if null exportedMains then "exported by" else "defined in"
-
-    pp_main_fn = ppMainFn main_fn
-
-    -- Select the main functions from the export list.
-    -- Only the module name is needed, the function name is fixed.
-    selExportMains :: Maybe (Located [LIE GhcPs]) -> [ModuleName]    -- #16453
-    selExportMains Nothing = [main_mod_nm]
-        -- no main specified, but there is a header.
-    selExportMains (Just exps) = fmap fst $
-        filter (\(_,n) -> n == occ_main_fn ) texp
-      where
-        ies = fmap unLoc $ unLoc exps
-        texp = mapMaybe transExportIE ies
-
-    -- Filter all main functions in scope that match the export specs
-    filterInsMains :: [ModuleName] -> [Name] -> [Name]               -- #16453
-    filterInsMains export_mains inscope_mains =
-      [mod | mod <- inscope_mains,
-          (moduleName . nameModule) mod `elem` export_mains]
-
-    -- Transform an export_ie to a (ModuleName, OccName) pair.
-    -- 'IEVar' constructors contain exported values (functions), eg '(Main.main)'
-    -- 'IEModuleContents' constructors contain fully exported modules, eg '(Main)'
-    -- All other 'IE...' constructors are not used and transformed to Nothing.
-    transExportIE :: IE GhcPs -> Maybe (ModuleName, OccName)         -- #16453
-    transExportIE (IEVar _  var) = isQual_maybe $
-         upqual $ ieWrappedName $ unLoc var
-       where
-         -- A module name is always needed, so qualify 'UnQual' rdr names.
-         upqual (Unqual occ) = Qual main_mod_nm occ
-         upqual rdr = rdr
-    transExportIE (IEModuleContents _ mod) = Just (unLoc mod, occ_main_fn)
-    transExportIE _ = Nothing
-
-    -- Get a main function that is in scope.
-    -- See Note [Main module without a main function in the export spec]
-    getSomeMain :: [Name] -> Maybe Name                            -- #16453
-    getSomeMain all_mains = case all_mains of
-        []  -> Nothing                -- No main function in scope
-        [m] -> Just m                 -- Just one main function in scope
-        _   -> case mbMainOfMain of
-          Nothing -> listToMaybe all_mains -- Take the first main function in scope or Nothing
-          _       -> mbMainOfMain          -- Take the Main module's main function or Nothing
+    complain_no_main dflags main_mod main_occ
+      = unless (interactive && not explicit_mod_hdr) $
+        addErrTc (noMainMsg main_mod main_occ)          -- #12906
       where
-        mbMainOfMain = find (\n -> (moduleName . nameModule) n == main_mod_nm )
-                          all_mains         -- the main function of the Main module
+        interactive = ghcLink dflags == LinkInMemory
+        -- Without an explicit module header...
+        -- in interactive mode, don't worry about the absence of 'main'.
+        -- in other modes, add error message and go on with typechecking.
+
+    noMainMsg main_mod main_occ
+      = text "The" <+> ppMainFn main_occ
+        <+> text "is not" <+> text defOrExp <+> text "module"
+        <+> quotes (ppr main_mod)
+
+    defOrExp | explicit_export_list = "exported by"
+             | otherwise            = "defined in"
+    explicit_export_list = explicit_mod_hdr && isJust export_ies
 
 -- | Get the unqualified name of the function to use as the \"main\" for the main module.
 -- Either returns the default name or the one configured on the command line with -main-is
-getMainFun :: DynFlags -> RdrName
-getMainFun dflags = case mainFunIs dflags of
-                      Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn))
-                      Nothing -> main_RDR_Unqual
-
-ppMainFn :: RdrName -> SDoc
-ppMainFn main_fn
-  | rdrNameOcc main_fn == mainOcc
-  = text "IO action" <+> quotes (ppr main_fn)
+getMainOcc :: DynFlags -> OccName
+getMainOcc dflags = case mainFunIs dflags of
+                      Just fn -> mkVarOccFS (mkFastString fn)
+                      Nothing -> mainOcc
+
+ppMainFn :: OccName -> SDoc
+ppMainFn main_occ
+  | main_occ == mainOcc
+  = text "IO action" <+> quotes (ppr main_occ)
   | otherwise
-  = text "main IO action" <+> quotes (ppr main_fn)
+  = text "main IO action" <+> quotes (ppr main_occ)
 
 mainOcc :: OccName
 mainOcc = mkVarOccFS (fsLit "main")
 
-{-
+generateMainBinding :: TcGblEnv -> Name -> TcM TcGblEnv
+-- There is a single exported 'main' function, called 'foo' (say),
+-- which may be locally defined or imported
+-- Define and typecheck the binding
+--     :Main.main :: IO res_ty = runMainIO res_ty foo
+-- This wraps the user's main function in the top-level stuff
+-- defined in runMainIO (eg catching otherwise un-caught exceptions)
+-- See Note [Dealing with main]
+generateMainBinding tcg_env main_name = do
+    { traceTc "checkMain found" (ppr main_name)
+    ; (io_ty, res_ty) <- getIOType
+    ; let loc = getSrcSpan main_name
+          main_expr_rn = L loc (HsVar noExtField (L loc main_name))
+    ; (ev_binds, main_expr) <- setMainCtxt main_name io_ty $
+                               tcCheckMonoExpr main_expr_rn io_ty
+
+            -- See Note [Root-main Id]
+            -- Construct the binding
+            --      :Main.main :: IO res_ty = runMainIO res_ty main
+    ; run_main_id <- tcLookupId runMainIOName
+    ; let { root_main_name =  mkExternalName rootMainKey rOOT_MAIN
+                               (mkVarOccFS (fsLit "main"))
+                               (getSrcSpan main_name)
+          ; root_main_id = Id.mkExportedVanillaId root_main_name io_ty
+          ; co  = mkWpTyApps [res_ty]
+          -- The ev_binds of the `main` function may contain deferred
+          -- type errors when type of `main` is not `IO a`. The `ev_binds`
+          -- must be put inside `runMainIO` to ensure the deferred type
+          -- error can be emitted correctly. See #13838.
+          ; rhs = nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) $
+                    mkHsDictLet ev_binds main_expr
+          ; main_bind = mkVarBind root_main_id rhs }
+
+    ; return (tcg_env { tcg_main  = Just main_name
+                      , tcg_binds = tcg_binds tcg_env
+                                    `snocBag` main_bind
+                      , tcg_dus   = tcg_dus tcg_env
+                                    `plusDU` usesOnly (unitFV main_name) })
+                    -- Record the use of 'main', so that we don't
+                    -- complain about it being defined but not used
+    }
+
+getIOType :: TcM (TcType, TcType)
+-- Return (IO alpha, alpha) for fresh alpha
+getIOType = do { ioTyCon <- tcLookupTyCon ioTyConName
+               ; res_ty <- newFlexiTyVarTy liftedTypeKind
+               ; return (mkTyConApp ioTyCon [res_ty], res_ty) }
+
+setMainCtxt :: Name -> TcType -> TcM a -> TcM (TcEvBinds, a)
+setMainCtxt main_name io_ty thing_inside
+  = setSrcSpan (getSrcSpan main_name) $
+    addErrCtxt main_ctxt              $
+    checkConstraints skol_info [] []  $  -- Builds an implication if necessary
+    thing_inside                         -- e.g. with -fdefer-type-errors
+  where
+    skol_info = SigSkol (FunSigCtxt main_name False) io_ty []
+    main_ctxt = text "When checking the type of the"
+                <+> ppMainFn (nameOccName main_name)
+
+{- Note [Dealing with main]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Dealing with the 'main' declaration is surprisingly tricky. Here are
+the moving parts:
+
+* The flag -main-is=M.foo allows you to set the main module to 'M',
+  and the main function to 'foo'.  We access them through
+      mainModIs  :: DynFlags -> Module   -- returns M
+      getMainOcc :: DynFlags -> OccName  -- returns foo
+  Of course usually M = Main, and foo = main.
+
+* checkMainType: when typechecking module M, we add an extra check that
+    foo :: IO tau, for some type tau.
+  This avoids getting ambiguous-type errors from the monomorphism restriction
+  applying to things like
+      main = return ()
+  Note that checkMainType does not consult the export list because
+  we have not yet done rnExports (and can't do it until later).
+
+* rnExports: checks the export list.  Very annoyingly, we can only do
+  this after running any finalisers, which may add new declarations.
+  That's why checkMainType and checkMain have to be separate.
+
+* checkMain: does two things:
+  - check that the export list does indeed export something called 'foo'
+  - generateMainBinding: generate the root-main binding
+       :Main.main = runMainIO M.foo
+  See Note [Root-main id]
+
+An annoying consequence of having both checkMainType and checkMain is
+that, when (but only when) -fdefer-type-errors is on, we may report an
+ill-typed 'main' twice (as warnings): once in checkMainType and once
+in checkMain. See test typecheck/should_fail/T13292.
+
+We have the following tests to check this processing:
+----------------+----------------------------------------------------------------------------------+
+                |                                  Module Header:                                  |
+                +-------------+-------------+-------------+-------------+-------------+------------+
+                | module      | module Main | <No Header> | module Main |module       |module Main |
+                |  Main(main) |             |             |   (module X)|   Main ()   |  (Sub.main)|
+----------------+==================================================================================+
+`main` function | ERROR:      | Main.main   | ERROR:      | Main.main   | ERROR:      | Sub.main   |
+in Main module  |  Ambiguous  |             |  Ambiguous  |             |  `main` not |            |
+and in imported |             |             |             |             |  exported   |            |
+module Sub.     | T19397E1    | T16453M0    | T19397E2    | T16453M3    |             | T16453M1   |
+                |             |             |             | X = Main    | Remark 2)   |            |
+----------------+-------------+-------------+-------------+-------------+-------------+------------+
+`main`function  | Sub.main    | ERROR:      | Sub.main    | Sub.main    | ERROR:      | Sub.main   |
+only in imported|             | No `main` in|             |             |  `main` not |            |
+submodule Sub.  |             |   `Main`    |             |             |  exported   |            |
+                | T19397M0    | T16453E1    | T19397M1    | T16453M4    |             | T16453M5   |
+                |             |             |             | X = Sub     | Remark 2)   |            |
+----------------+-------------+-------------+-------------+-------------+-------------+------------+
+`foo` function  | Sub.foo     | ERROR:      | Sub.foo     | Sub.foo     | ERROR:      | Sub.foo    |
+in submodule    |             | No `foo` in |             |             |  `foo` not  |            |
+Sub.            |             |   `Main`    |             |             |  exported   |            |
+GHC option:     |             |             |             |             |             |            |
+  -main-is foo  | T19397M2    | T19397E3    | T19397M3    | T19397M4    | T19397E4    | T16453M6   |
+                | Remark 1)   |             |             | X = Sub     |             | Remark 3)  |
+----------------+-------------+-------------+-------------+-------------+-------------+------------+
+
+Remarks:
+* The first line shows the exported `main` function or the error.
+* The second line shows the coresponding test case.
+* The module `Sub` contains the following functions:
+     main :: IO ()
+     foo :: IO ()
+* Remark 1) Here the header is `Main (foo)`.
+* Remark 2) Here we have no extra test case. It would exercise the same code path as `T19397E4`.
+* Remark 3) Here the header is `Main (Sub.foo)`.
+
+
 Note [Root-main Id]
 ~~~~~~~~~~~~~~~~~~~
 The function that the RTS invokes is always :Main.main, which we call
@@ -1914,53 +1975,6 @@ module. Tiresomely, we must filter it out again in GHC.Iface.Make, less we
 get two defns for 'main' in the interface file!
 
 
-Note [Main module without a main function in the export spec]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Giving accurate error messages for a Main module that does not export a main
-function is surprisingly tricky. To see why, consider a module in a file
-`Foo.hs` that has no `main` function in the explicit export specs of the module
-header:
-
-    module Main () where
-    foo = return ()
-
-This does not export a main function and therefore should be rejected, per
-chapter 5 of the Haskell Report 2010:
-
-   A Haskell program is a collection of modules, one of which, by convention,
-   must be called Main and must export the value main. The value of the
-   program is the value of the identifier main in module Main, which must be
-   a computation of type IO τ for some type τ.
-
-In fact, when you compile the program above using `ghc Foo.hs`, you will
-actually get *two* errors:
-
- - The IO action ‘main’ is not defined in module ‘Main’
-
- - Ambiguous type variable ‘m0’ arising from a use of ‘return’
-   prevents the constraint ‘(Monad m0)’ from being solved.
-
-The first error is self-explanatory, while the second error message occurs
-due to the monomorphism restriction.
-
-Now consider what would happen if the program above were compiled with
-`ghc -main-is foo Foo`. The has the effect of `foo` being designated as the
-main function. The program will still be rejected since it does not export
-`foo` (and therefore does not export its main function), but there is one
-important difference: `foo` will be checked against the type `IO τ`. As a
-result, we would *not* expect the monomorphism restriction error message
-to occur, since the typechecker should have no trouble figuring out the type
-of `foo`. In other words, we should only throw the former error message,
-not the latter.
-
-The implementation uses the function `getSomeMain` to find a potential main
-function that is defined but not exported. If one is found, it is passed to
-`use_as_main` to inform the typechecker that the main function should be of
-type `IO τ`. See also the `T414` and `T17171a` test cases for similar examples
-of programs whose error messages are influenced by the situation described in
-this Note.
-
-
 *********************************************************
 *                                                       *
                 GHCi stuff
@@ -2715,7 +2729,7 @@ tcRnDeclsi :: HscEnv
            -> IO (Messages, Maybe TcGblEnv)
 tcRnDeclsi hsc_env local_decls
   = runTcInteractive hsc_env $
-    tcRnSrcDecls False local_decls Nothing
+    tcRnSrcDecls False Nothing local_decls
 
 externaliseAndTidyId :: Module -> Id -> TcM Id
 externaliseAndTidyId this_mod id
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index 611d89954b..04c75c22fd 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -45,7 +45,9 @@ module GHC.Tc.Types(
         IdBindingInfo(..), ClosedTypeId, RhsNames,
         IsGroupClosed(..),
         SelfBootInfo(..),
-        pprTcTyThingCategory, pprPECategory, CompleteMatch(..),
+        tcTyThingCategory, pprTcTyThingCategory,
+        peCategory, pprPECategory,
+        CompleteMatch(..),
 
         -- Desugaring types
         DsM, DsLclEnv(..), DsGblEnv(..),
@@ -1298,22 +1300,30 @@ instance Outputable PromotionErr where
   ppr NoDataKindsTC               = text "NoDataKindsTC"
   ppr NoDataKindsDC               = text "NoDataKindsDC"
 
+--------------
 pprTcTyThingCategory :: TcTyThing -> SDoc
-pprTcTyThingCategory (AGlobal thing)    = pprTyThingCategory thing
-pprTcTyThingCategory (ATyVar {})        = text "Type variable"
-pprTcTyThingCategory (ATcId {})         = text "Local identifier"
-pprTcTyThingCategory (ATcTyCon {})     = text "Local tycon"
-pprTcTyThingCategory (APromotionErr pe) = pprPECategory pe
+pprTcTyThingCategory = text . capitalise . tcTyThingCategory
 
+tcTyThingCategory :: TcTyThing -> String
+tcTyThingCategory (AGlobal thing)    = tyThingCategory thing
+tcTyThingCategory (ATyVar {})        = "type variable"
+tcTyThingCategory (ATcId {})         = "local identifier"
+tcTyThingCategory (ATcTyCon {})      = "local tycon"
+tcTyThingCategory (APromotionErr pe) = peCategory pe
+
+--------------
 pprPECategory :: PromotionErr -> SDoc
-pprPECategory ClassPE                = text "Class"
-pprPECategory TyConPE                = text "Type constructor"
-pprPECategory PatSynPE               = text "Pattern synonym"
-pprPECategory FamDataConPE           = text "Data constructor"
-pprPECategory ConstrainedDataConPE{} = text "Data constructor"
-pprPECategory RecDataConPE           = text "Data constructor"
-pprPECategory NoDataKindsTC          = text "Type constructor"
-pprPECategory NoDataKindsDC          = text "Data constructor"
+pprPECategory = text . capitalise . peCategory
+
+peCategory :: PromotionErr -> String
+peCategory ClassPE                = "class"
+peCategory TyConPE                = "type constructor"
+peCategory PatSynPE               = "pattern synonym"
+peCategory FamDataConPE           = "data constructor"
+peCategory ConstrainedDataConPE{} = "data constructor"
+peCategory RecDataConPE           = "data constructor"
+peCategory NoDataKindsTC          = "type constructor"
+peCategory NoDataKindsDC          = "data constructor"
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index 166b5e3560..5bc2fe01a1 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -422,7 +422,7 @@ tcLookup name = do
     local_env <- getLclTypeEnv
     case lookupNameEnv local_env name of
         Just thing -> return thing
-        Nothing    -> AGlobal <$> tcLookupGlobal name
+        Nothing    -> (AGlobal <$> tcLookupGlobal name)
 
 tcLookupTyVar :: Name -> TcM TcTyVar
 tcLookupTyVar name
diff --git a/testsuite/tests/module/T11970B.hs b/testsuite/tests/module/T11970B.hs
index 70a091f141..c3a502f5f2 100644
--- a/testsuite/tests/module/T11970B.hs
+++ b/testsuite/tests/module/T11970B.hs
@@ -1,5 +1,5 @@
 module T11970B ( A(f) ) where
 
-data A = A
+data A = MkA
 
-f = A
+f = MkA
diff --git a/testsuite/tests/patsyn/should_fail/records-mixing-fields.stderr b/testsuite/tests/patsyn/should_fail/records-mixing-fields.stderr
index 7928c74258..866d1468cd 100644
--- a/testsuite/tests/patsyn/should_fail/records-mixing-fields.stderr
+++ b/testsuite/tests/patsyn/should_fail/records-mixing-fields.stderr
@@ -1,17 +1,14 @@
 
-records-mixing-fields.hs:1:1: error:
-    The IO action ‘main’ is not defined in module ‘Main’
-
 records-mixing-fields.hs:10:14: error:
-    Cannot use a mixture of pattern synonym and record selectors
-    Record selectors defined by ‘MyRec’: qux
-    Pattern synonym selectors defined by ‘HisRec’: f1
-    In the expression: a {f1 = 1, qux = "two"}
-    In an equation for ‘updater1’: updater1 a = a {f1 = 1, qux = "two"}
+    • Cannot use a mixture of pattern synonym and record selectors
+      Record selectors defined by ‘MyRec’: qux
+      Pattern synonym selectors defined by ‘HisRec’: f1
+    • In the expression: a {f1 = 1, qux = "two"}
+      In an equation for ‘updater1’: updater1 a = a {f1 = 1, qux = "two"}
 
 records-mixing-fields.hs:12:14: error:
-    Cannot use a mixture of pattern synonym and record selectors
-    Record selectors defined by ‘MyRec’: foo
-    Pattern synonym selectors defined by ‘HisRec’: f1
-    In the expression: a {f1 = 1, foo = 2}
-    In an equation for ‘updater2’: updater2 a = a {f1 = 1, foo = 2}
+    • Cannot use a mixture of pattern synonym and record selectors
+      Record selectors defined by ‘MyRec’: foo
+      Pattern synonym selectors defined by ‘HisRec’: f1
+    • In the expression: a {f1 = 1, foo = 2}
+      In an equation for ‘updater2’: updater2 a = a {f1 = 1, foo = 2}
diff --git a/testsuite/tests/quantified-constraints/T17267e.stderr b/testsuite/tests/quantified-constraints/T17267e.stderr
index b497fa1009..f94ba1e872 100644
--- a/testsuite/tests/quantified-constraints/T17267e.stderr
+++ b/testsuite/tests/quantified-constraints/T17267e.stderr
@@ -1,7 +1,4 @@
 
-T17267e.hs:1:1: error:
-    The IO action ‘main’ is not defined in module ‘Main’
-
 T17267e.hs:16:14: error:
     • Reduction stack overflow; size = 201
       When simplifying the following type: Show a
diff --git a/testsuite/tests/quotes/T18263.hs b/testsuite/tests/quotes/T18263.hs
index 10e923480b..57f20fbf49 100644
--- a/testsuite/tests/quotes/T18263.hs
+++ b/testsuite/tests/quotes/T18263.hs
@@ -13,14 +13,21 @@ When looking up something with 'lookupGlobalOccRn_maybe', which is called by
 
 This should still fail to compile though, as reify should complain that "x"
 isn't in the type environment, albeit with one less error.
+
+Later (March 2021): actually this should really compile fine:
+  * The [d| ... |] splices in a top-level binding for x
+  * The reify looks for that binding
+It was really a bug that it didn't work, now fixed.
+
 -}
 
 module T18263 where
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax
+import System.IO
 
 do
   n <- newName "x"
-  addModFinalizer $ reify n >>= runIO . print
+  addModFinalizer $ reify n >>= runIO . hPrint stderr
   [d| $(varP n) = 42 |]
diff --git a/testsuite/tests/quotes/T18263.stderr b/testsuite/tests/quotes/T18263.stderr
index 023432c85b..f8a7aab415 100644
--- a/testsuite/tests/quotes/T18263.stderr
+++ b/testsuite/tests/quotes/T18263.stderr
@@ -1,3 +1 @@
-
-T18263.hs:1:1:
-    ‘x’ is not in the type environment at a reify
+VarI T18263.x (ConT GHC.Num.Integer.Integer) Nothing
diff --git a/testsuite/tests/quotes/all.T b/testsuite/tests/quotes/all.T
index b0e5274761..68a13ca5ab 100644
--- a/testsuite/tests/quotes/all.T
+++ b/testsuite/tests/quotes/all.T
@@ -18,7 +18,7 @@ test('T10384', normal, compile_fail, [''])
 test('T16384', req_th, compile, [''])
 test('T17857', normal, compile, [''])
 test('T18103', normal, compile, [''])
-test('T18263', normal, compile_fail, [''])
+test('T18263', normal, compile, [''])
 test('T18521', normal, compile, [''])
 
 test('TH_tf2', normal, compile, ['-v0'])
diff --git a/testsuite/tests/th/TH_finalizer2M.hs b/testsuite/tests/th/TH_finalizer2M.hs
index 7eea2d8f46..037c648d2a 100644
--- a/testsuite/tests/th/TH_finalizer2M.hs
+++ b/testsuite/tests/th/TH_finalizer2M.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
-module TH_finalizer2M where
+module TH_finalizer2M( f, g) where
 
 import Language.Haskell.TH.Syntax
 
diff --git a/testsuite/tests/typecheck/should_fail/T12906.stderr b/testsuite/tests/typecheck/should_fail/T12906.stderr
index f1f245c912..0de9794533 100644
--- a/testsuite/tests/typecheck/should_fail/T12906.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12906.stderr
@@ -1,7 +1,4 @@
 
-T12906.hs:1:1: error:
-    The IO action ‘main’ is not defined in module ‘Main’
-
 T12906.hs:2:7: error:
     • Couldn't match type: IO ()
                      with: [Char]
diff --git a/testsuite/tests/typecheck/should_fail/T13292.hs b/testsuite/tests/typecheck/should_fail/T13292.hs
index efc71b6539..c727812a2c 100644
--- a/testsuite/tests/typecheck/should_fail/T13292.hs
+++ b/testsuite/tests/typecheck/should_fail/T13292.hs
@@ -4,3 +4,8 @@ import T13292a
 
 -- main :: IO ()
 main = someFunc
+
+-- This one is compiled with -fdefer-type-errors, and
+-- annoyingly reports the ill-typed twice. It is awkward
+-- to prevent this, and it's very much a corner case,
+-- so I'm accepting it. See Note [Dealing with main]
diff --git a/testsuite/tests/typecheck/should_fail/T13292.stderr b/testsuite/tests/typecheck/should_fail/T13292.stderr
index 7607505d0e..a3a7ba3bae 100644
--- a/testsuite/tests/typecheck/should_fail/T13292.stderr
+++ b/testsuite/tests/typecheck/should_fail/T13292.stderr
@@ -19,5 +19,11 @@ T13292.hs:6:1: warning: [-Wdeferred-type-errors (in -Wdefault)]
     • Couldn't match type ‘GHC.Types.Any’ with ‘IO’
       Expected: IO ()
         Actual: GHC.Types.Any ()
+    • When checking the type of the IO action ‘main’
+
+T13292.hs:6:1: warning: [-Wdeferred-type-errors (in -Wdefault)]
+    • Couldn't match type ‘GHC.Types.Any’ with ‘IO’
+      Expected: IO ()
+        Actual: GHC.Types.Any ()
     • In the expression: main
       When checking the type of the IO action ‘main’
diff --git a/testsuite/tests/typecheck/should_fail/T16453E2.stderr b/testsuite/tests/typecheck/should_fail/T16453E2.stderr
index 4999d60cc7..b7beedb511 100644
--- a/testsuite/tests/typecheck/should_fail/T16453E2.stderr
+++ b/testsuite/tests/typecheck/should_fail/T16453E2.stderr
@@ -1,9 +1,9 @@
-T16453E2.hs:1:1:
-    Ambiguous occurrence ‘main’
-    It could refer to
-       either ‘T16453T.main’,
-              imported from ‘T16453T’ at T16453E2.hs:2:1-14
-              (and originally defined at T16453T.hs:2:1-4)
-           or ‘T16453S.main’,
-              imported from ‘T16453S’ at T16453E2.hs:3:1-14
-              (and originally defined at T16453S.hs:2:1-4)
+
+T16453E2.hs:1:28: error:
+    Conflicting exports for ‘main’:
+       ‘T16453T.main’ exports ‘T16453T.main’
+         imported from ‘T16453T’ at T16453E2.hs:2:1-14
+         (and originally defined at T16453T.hs:2:1-4)
+       ‘T16453S.main’ exports ‘T16453S.main’
+         imported from ‘T16453S’ at T16453E2.hs:3:1-14
+         (and originally defined at T16453S.hs:2:1-4)
diff --git a/testsuite/tests/typecheck/should_fail/T19397E1.hs b/testsuite/tests/typecheck/should_fail/T19397E1.hs
new file mode 100644
index 0000000000..e4b02ceb30
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T19397E1.hs
@@ -0,0 +1,5 @@
+module Main (main) where
+import T19397S
+
+main :: IO ()
+main = putStrLn "T19397E1"
diff --git a/testsuite/tests/typecheck/should_fail/T19397E1.stderr b/testsuite/tests/typecheck/should_fail/T19397E1.stderr
new file mode 100644
index 0000000000..00c13f2eca
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T19397E1.stderr
@@ -0,0 +1,8 @@
+
+T19397E1.hs:1:14: error:
+    Ambiguous occurrence ‘main’
+    It could refer to
+       either ‘T19397S.main’,
+              imported from ‘T19397S’ at T19397E1.hs:2:1-14
+              (and originally defined at T19397S.hs:4:1-4)
+           or ‘Main.main’, defined at T19397E1.hs:5:1
diff --git a/testsuite/tests/typecheck/should_fail/T19397E2.hs b/testsuite/tests/typecheck/should_fail/T19397E2.hs
new file mode 100644
index 0000000000..3fb2b9dfca
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T19397E2.hs
@@ -0,0 +1,5 @@
+
+import T19397S
+
+main :: IO ()
+main = putStrLn "T19397E2"
diff --git a/testsuite/tests/typecheck/should_fail/T19397E2.stderr b/testsuite/tests/typecheck/should_fail/T19397E2.stderr
new file mode 100644
index 0000000000..4fc5073310
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T19397E2.stderr
@@ -0,0 +1,8 @@
+
+T19397E2.hs:1:1: error:
+    Ambiguous occurrence ‘main’
+    It could refer to
+       either ‘T19397S.main’,
+              imported from ‘T19397S’ at T19397E2.hs:2:1-14
+              (and originally defined at T19397S.hs:4:1-4)
+           or ‘Main.main’, defined at T19397E2.hs:5:1
diff --git a/testsuite/tests/typecheck/should_fail/T19397E3.hs b/testsuite/tests/typecheck/should_fail/T19397E3.hs
new file mode 100644
index 0000000000..7836ea0f6a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T19397E3.hs
@@ -0,0 +1,2 @@
+module Main where
+import T19397S (foo)
diff --git a/testsuite/tests/typecheck/should_fail/T19397E3.stderr b/testsuite/tests/typecheck/should_fail/T19397E3.stderr
new file mode 100644
index 0000000000..2359ec171a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T19397E3.stderr
@@ -0,0 +1,3 @@
+
+T19397E3.hs:1:1: error:
+    The main IO action ‘foo’ is not defined in module ‘Main’
diff --git a/testsuite/tests/typecheck/should_fail/T19397E4.hs b/testsuite/tests/typecheck/should_fail/T19397E4.hs
new file mode 100644
index 0000000000..1b4b9cf2b1
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T19397E4.hs
@@ -0,0 +1,5 @@
+module Main () where
+import T19397S
+
+main :: IO ()
+main = putStrLn "T19397E4"
diff --git a/testsuite/tests/typecheck/should_fail/T19397E4.stderr b/testsuite/tests/typecheck/should_fail/T19397E4.stderr
new file mode 100644
index 0000000000..3f9eec7bf0
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T19397E4.stderr
@@ -0,0 +1,3 @@
+
+T19397E4.hs:1:1: error:
+    The main IO action ‘foo’ is not exported by module ‘Main’
diff --git a/testsuite/tests/typecheck/should_fail/T19397S.hs b/testsuite/tests/typecheck/should_fail/T19397S.hs
new file mode 100644
index 0000000000..9316d7d99a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T19397S.hs
@@ -0,0 +1,7 @@
+module T19397S where
+
+main :: IO ()
+main = putStrLn "T19379S-main"
+
+foo :: IO ()
+foo = putStrLn "T19379S-foo"
diff --git a/testsuite/tests/typecheck/should_fail/T2354.stderr b/testsuite/tests/typecheck/should_fail/T2354.stderr
index 5c5fcfcf0e..e21eca081e 100644
--- a/testsuite/tests/typecheck/should_fail/T2354.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2354.stderr
@@ -1,6 +1,6 @@
 
-T2354.hs:4:3:
+T2354.hs:4:3: error:
     The NOINLINE pragma for default method ‘toInt’ lacks an accompanying binding
 
-T2354.hs:6:3:
+T2354.hs:6:3: error:
     The NOINLINE pragma for default method ‘fromInt’ lacks an accompanying binding
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 7b4d6d1899..1573441532 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -578,3 +578,11 @@ test('T18357', normal, compile_fail, [''])
 test('T18357a', normal, compile_fail, [''])
 test('T18357b', normal, compile_fail, [''])
 test('T18455', normal, compile_fail, [''])
+test('T19397E1', extra_files(['T19397S.hs']), multimod_compile_fail,
+    ['T19397E1.hs', '-v0'])
+test('T19397E2', extra_files(['T19397S.hs']), multimod_compile_fail,
+    ['T19397E2.hs', '-v0'])
+test('T19397E3', extra_files(['T19397S.hs']), multimod_compile_fail,
+    ['T19397E3.hs', '-v0 -main-is foo'])
+test('T19397E4', extra_files(['T19397S.hs']), multimod_compile_fail,
+    ['T19397E4.hs', '-v0 -main-is foo'])
diff --git a/testsuite/tests/typecheck/should_fail/tcfail199.stderr b/testsuite/tests/typecheck/should_fail/tcfail199.stderr
index 50fc8e5f44..5ef1ebab33 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail199.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail199.stderr
@@ -4,5 +4,4 @@ tcfail199.hs:5:1: error:
                      with: IO t0
       Expected: IO t0
         Actual: String
-    • In the expression: main
-      When checking the type of the IO action ‘main’
+    • When checking the type of the IO action ‘main’
diff --git a/testsuite/tests/typecheck/should_run/T16453M1.stdout b/testsuite/tests/typecheck/should_run/T16453M1.stdout
index e4dfbcd44f..3c86130b45 100644
--- a/testsuite/tests/typecheck/should_run/T16453M1.stdout
+++ b/testsuite/tests/typecheck/should_run/T16453M1.stdout
@@ -1 +1 @@
-T16453T
+T16453T.main
diff --git a/testsuite/tests/typecheck/should_run/T16453M4.stdout b/testsuite/tests/typecheck/should_run/T16453M4.stdout
index e4dfbcd44f..3c86130b45 100644
--- a/testsuite/tests/typecheck/should_run/T16453M4.stdout
+++ b/testsuite/tests/typecheck/should_run/T16453M4.stdout
@@ -1 +1 @@
-T16453T
+T16453T.main
diff --git a/testsuite/tests/typecheck/should_run/T16453M5.hs b/testsuite/tests/typecheck/should_run/T16453M5.hs
new file mode 100644
index 0000000000..a79a33003d
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T16453M5.hs
@@ -0,0 +1,2 @@
+module Main (T16453T.main)  where
+import T16453T
diff --git a/testsuite/tests/typecheck/should_run/T16453M5.stdout b/testsuite/tests/typecheck/should_run/T16453M5.stdout
new file mode 100644
index 0000000000..3c86130b45
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T16453M5.stdout
@@ -0,0 +1 @@
+T16453T.main
diff --git a/testsuite/tests/typecheck/should_run/T16453M6.hs b/testsuite/tests/typecheck/should_run/T16453M6.hs
new file mode 100644
index 0000000000..b013e857cd
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T16453M6.hs
@@ -0,0 +1,2 @@
+module Main (T16453T.foo)  where
+import T16453T
diff --git a/testsuite/tests/typecheck/should_run/T16453M6.stdout b/testsuite/tests/typecheck/should_run/T16453M6.stdout
new file mode 100644
index 0000000000..72252ffbd0
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T16453M6.stdout
@@ -0,0 +1 @@
+T16453T.foo
diff --git a/testsuite/tests/typecheck/should_run/T16453T.hs b/testsuite/tests/typecheck/should_run/T16453T.hs
index 98ea6255f7..b8dd8923c4 100644
--- a/testsuite/tests/typecheck/should_run/T16453T.hs
+++ b/testsuite/tests/typecheck/should_run/T16453T.hs
@@ -1,2 +1,4 @@
 module T16453T where
-main = putStrLn "T16453T"
+main = putStrLn "T16453T.main"
+foo  = putStrLn "T16453T.foo"
+
diff --git a/testsuite/tests/typecheck/should_run/T19397M0.hs b/testsuite/tests/typecheck/should_run/T19397M0.hs
new file mode 100644
index 0000000000..fcc08716d5
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T19397M0.hs
@@ -0,0 +1,2 @@
+module Main (main) where
+import T19397S
diff --git a/testsuite/tests/typecheck/should_run/T19397M0.stdout b/testsuite/tests/typecheck/should_run/T19397M0.stdout
new file mode 100644
index 0000000000..4ff016fc0e
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T19397M0.stdout
@@ -0,0 +1 @@
+T19379S-main
diff --git a/testsuite/tests/typecheck/should_run/T19397M1.hs b/testsuite/tests/typecheck/should_run/T19397M1.hs
new file mode 100644
index 0000000000..75413537c8
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T19397M1.hs
@@ -0,0 +1 @@
+import T19397S
diff --git a/testsuite/tests/typecheck/should_run/T19397M1.stdout b/testsuite/tests/typecheck/should_run/T19397M1.stdout
new file mode 100644
index 0000000000..4ff016fc0e
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T19397M1.stdout
@@ -0,0 +1 @@
+T19379S-main
diff --git a/testsuite/tests/typecheck/should_run/T19397M2.hs b/testsuite/tests/typecheck/should_run/T19397M2.hs
new file mode 100644
index 0000000000..71a75a102b
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T19397M2.hs
@@ -0,0 +1,2 @@
+module Main(foo) where
+import T19397S (foo)
diff --git a/testsuite/tests/typecheck/should_run/T19397M2.stdout b/testsuite/tests/typecheck/should_run/T19397M2.stdout
new file mode 100644
index 0000000000..3fe3b9aac6
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T19397M2.stdout
@@ -0,0 +1 @@
+T19379S-foo
diff --git a/testsuite/tests/typecheck/should_run/T19397M3.hs b/testsuite/tests/typecheck/should_run/T19397M3.hs
new file mode 100644
index 0000000000..fd817a8176
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T19397M3.hs
@@ -0,0 +1 @@
+import T19397S (foo)
diff --git a/testsuite/tests/typecheck/should_run/T19397M3.stdout b/testsuite/tests/typecheck/should_run/T19397M3.stdout
new file mode 100644
index 0000000000..3fe3b9aac6
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T19397M3.stdout
@@ -0,0 +1 @@
+T19379S-foo
diff --git a/testsuite/tests/typecheck/should_run/T19397M4.hs b/testsuite/tests/typecheck/should_run/T19397M4.hs
new file mode 100644
index 0000000000..544242c2f5
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T19397M4.hs
@@ -0,0 +1,2 @@
+module Main(module T19397S) where
+import T19397S (foo)
diff --git a/testsuite/tests/typecheck/should_run/T19397M4.stdout b/testsuite/tests/typecheck/should_run/T19397M4.stdout
new file mode 100644
index 0000000000..3fe3b9aac6
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T19397M4.stdout
@@ -0,0 +1 @@
+T19379S-foo
diff --git a/testsuite/tests/typecheck/should_run/T19397S.hs b/testsuite/tests/typecheck/should_run/T19397S.hs
new file mode 100644
index 0000000000..9316d7d99a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T19397S.hs
@@ -0,0 +1,7 @@
+module T19397S where
+
+main :: IO ()
+main = putStrLn "T19379S-main"
+
+foo :: IO ()
+foo = putStrLn "T19379S-foo"
diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T
index f69cc71352..7468511779 100755
--- a/testsuite/tests/typecheck/should_run/all.T
+++ b/testsuite/tests/typecheck/should_run/all.T
@@ -140,6 +140,8 @@ test('T16453M1', extra_files(['T16453T.hs']), compile_and_run, [''])
 test('T16453M2', extra_files(['T16453T.hs']), compile_and_run, [''])
 test('T16453M3', extra_files(['T16453T.hs']), compile_and_run, [''])
 test('T16453M4', extra_files(['T16453T.hs']), compile_and_run, [''])
+test('T16453M5', extra_files(['T16453T.hs']), compile_and_run, [''])
+test('T16453M6', extra_files(['T16453T.hs']), compile_and_run, ['-main-is foo'])
 test('UnliftedNewtypesRun', normal, compile_and_run, [''])
 test('UnliftedNewtypesFamilyRun', normal, compile_and_run, [''])
 test('UnliftedNewtypesDependentFamilyRun', normal, compile_and_run, [''])
@@ -147,3 +149,8 @@ test('UnliftedNewtypesIdentityRun', normal, compile_and_run, [''])
 test('UnliftedNewtypesCoerceRun', normal, compile_and_run, [''])
 test('T17104', normal, compile_and_run, [''])
 test('T18627', normal, compile_and_run, ['-O'])  # Optimisation shows up the bug
+test('T19397M0', extra_files(['T19397S.hs']), compile_and_run, [''])
+test('T19397M1', extra_files(['T19397S.hs']), compile_and_run, [''])
+test('T19397M2', extra_files(['T19397S.hs']), compile_and_run, ['-main-is foo'])
+test('T19397M3', extra_files(['T19397S.hs']), compile_and_run, ['-main-is foo'])
+test('T19397M4', extra_files(['T19397S.hs']), compile_and_run, ['-main-is foo'])