never executed always true always false
    1 
    2 {-# LANGUAGE NondecreasingIndentation #-}
    3 {-# LANGUAGE ScopedTypeVariables      #-}
    4 {-# LANGUAGE TypeFamilies             #-}
    5 
    6 module GHC.Tc.Utils.Backpack (
    7     findExtraSigImports,
    8     implicitRequirements,
    9     implicitRequirementsShallow,
   10     checkUnit,
   11     tcRnCheckUnit,
   12     tcRnMergeSignatures,
   13     mergeSignatures,
   14     tcRnInstantiateSignature,
   15     instantiateSignature,
   16 ) where
   17 
   18 import GHC.Prelude
   19 
   20 
   21 import GHC.Driver.Config.Finder
   22 import GHC.Driver.Env
   23 import GHC.Driver.Ppr
   24 import GHC.Driver.Session
   25 
   26 import GHC.Types.Basic (TypeOrKind(..))
   27 import GHC.Types.Fixity (defaultFixity)
   28 import GHC.Types.Fixity.Env
   29 import GHC.Types.TypeEnv
   30 import GHC.Types.Name.Reader
   31 import GHC.Types.Id
   32 import GHC.Types.Name
   33 import GHC.Types.Name.Env
   34 import GHC.Types.Name.Set
   35 import GHC.Types.Avail
   36 import GHC.Types.SrcLoc
   37 import GHC.Types.SourceFile
   38 import GHC.Types.Var
   39 import GHC.Types.Unique.DSet
   40 import GHC.Types.Name.Shape
   41 import GHC.Types.PkgQual
   42 
   43 import GHC.Unit
   44 import GHC.Unit.Finder
   45 import GHC.Unit.Module.Warnings
   46 import GHC.Unit.Module.ModIface
   47 import GHC.Unit.Module.ModDetails
   48 import GHC.Unit.Module.Imported
   49 import GHC.Unit.Module.Deps
   50 
   51 import GHC.Tc.Errors.Types
   52 import GHC.Tc.Gen.Export
   53 import GHC.Tc.Solver
   54 import GHC.Tc.TyCl.Utils
   55 import GHC.Tc.Types.Constraint
   56 import GHC.Tc.Types.Origin
   57 import GHC.Tc.Utils.Monad
   58 import GHC.Tc.Utils.Instantiate
   59 import GHC.Tc.Utils.TcMType
   60 import GHC.Tc.Utils.TcType
   61 
   62 import GHC.Hs
   63 
   64 import GHC.Core.InstEnv
   65 import GHC.Core.FamInstEnv
   66 import GHC.Core.Type
   67 import GHC.Core.Multiplicity
   68 
   69 import GHC.IfaceToCore
   70 import GHC.Iface.Load
   71 import GHC.Iface.Rename
   72 import GHC.Iface.Syntax
   73 
   74 import GHC.Rename.Names
   75 import GHC.Rename.Fixity ( lookupFixityRn )
   76 
   77 import GHC.Tc.Utils.Env
   78 import GHC.Tc.Errors
   79 import GHC.Tc.Utils.Unify
   80 
   81 import GHC.Utils.Error
   82 import GHC.Utils.Outputable
   83 import GHC.Utils.Panic
   84 import GHC.Utils.Panic.Plain
   85 
   86 import GHC.Data.FastString
   87 import GHC.Data.Maybe
   88 
   89 import Control.Monad
   90 import Data.List (find)
   91 
   92 import {-# SOURCE #-} GHC.Tc.Module
   93 
   94 fixityMisMatch :: TyThing -> Fixity -> Fixity -> TcRnMessage
   95 fixityMisMatch real_thing real_fixity sig_fixity =
   96   TcRnUnknownMessage $ mkPlainError noHints $
   97     vcat [ppr real_thing <+> text "has conflicting fixities in the module",
   98           text "and its hsig file",
   99           text "Main module:" <+> ppr_fix real_fixity,
  100           text "Hsig file:" <+> ppr_fix sig_fixity]
  101   where
  102     ppr_fix f =
  103         ppr f <+>
  104         (if f == defaultFixity
  105             then parens (text "default")
  106             else empty)
  107 
  108 checkHsigDeclM :: ModIface -> TyThing -> TyThing -> TcRn ()
  109 checkHsigDeclM sig_iface sig_thing real_thing = do
  110     let name = getName real_thing
  111     -- TODO: Distinguish between signature merging and signature
  112     -- implementation cases.
  113     checkBootDeclM False sig_thing real_thing
  114     real_fixity <- lookupFixityRn name
  115     let sig_fixity = case mi_fix_fn (mi_final_exts sig_iface) (occName name) of
  116                         Nothing -> defaultFixity
  117                         Just f -> f
  118     when (real_fixity /= sig_fixity) $
  119       addErrAt (nameSrcSpan name)
  120         (fixityMisMatch real_thing real_fixity sig_fixity)
  121 
  122 -- | Given a 'ModDetails' of an instantiated signature (note that the
  123 -- 'ModDetails' must be knot-tied consistently with the actual implementation)
  124 -- and a 'GlobalRdrEnv' constructed from the implementor of this interface,
  125 -- verify that the actual implementation actually matches the original
  126 -- interface.
  127 --
  128 -- Note that it is already assumed that the implementation *exports*
  129 -- a sufficient set of entities, since otherwise the renaming and then
  130 -- typechecking of the signature 'ModIface' would have failed.
  131 checkHsigIface :: TcGblEnv -> GlobalRdrEnv -> ModIface -> ModDetails -> TcRn ()
  132 checkHsigIface tcg_env gr sig_iface
  133   ModDetails { md_insts = sig_insts, md_fam_insts = sig_fam_insts,
  134                md_types = sig_type_env, md_exports = sig_exports   } = do
  135     traceTc "checkHsigIface" $ vcat
  136         [ ppr sig_type_env, ppr sig_insts, ppr sig_exports ]
  137     mapM_ check_export (map availName sig_exports)
  138     failIfErrsM -- See Note [Fail before checking instances in checkHsigIface]
  139     unless (null sig_fam_insts) $
  140         panic ("GHC.Tc.Module.checkHsigIface: Cannot handle family " ++
  141                "instances in hsig files yet...")
  142     -- Delete instances so we don't look them up when
  143     -- checking instance satisfiability
  144     -- TODO: this should not be necessary
  145     tcg_env <- getGblEnv
  146     setGblEnv tcg_env { tcg_inst_env = emptyInstEnv,
  147                         tcg_fam_inst_env = emptyFamInstEnv,
  148                         tcg_insts = [],
  149                         tcg_fam_insts = [] } $ do
  150     mapM_ check_inst sig_insts
  151     failIfErrsM
  152   where
  153     -- NB: the Names in sig_type_env are bogus.  Let's say we have H.hsig
  154     -- in package p that defines T; and we implement with himpl:H.  Then the
  155     -- Name is p[himpl:H]:H.T, NOT himplH:H.T.  That's OK but we just
  156     -- have to look up the right name.
  157     sig_type_occ_env = mkOccEnv
  158                      . map (\t -> (nameOccName (getName t), t))
  159                      $ nonDetNameEnvElts sig_type_env
  160     dfun_names = map getName sig_insts
  161     check_export name
  162       -- Skip instances, we'll check them later
  163       -- TODO: Actually this should never happen, because DFuns are
  164       -- never exported...
  165       | name `elem` dfun_names = return ()
  166       -- See if we can find the type directly in the hsig ModDetails
  167       -- TODO: need to special case wired in names
  168       | Just sig_thing <- lookupOccEnv sig_type_occ_env (nameOccName name) = do
  169         -- NB: We use tcLookupImported_maybe because we want to EXCLUDE
  170         -- tcg_env (TODO: but maybe this isn't relevant anymore).
  171         r <- tcLookupImported_maybe name
  172         case r of
  173           Failed err -> addErr (TcRnUnknownMessage $ mkPlainError noHints err)
  174           Succeeded real_thing -> checkHsigDeclM sig_iface sig_thing real_thing
  175 
  176       -- The hsig did NOT define this function; that means it must
  177       -- be a reexport.  In this case, make sure the 'Name' of the
  178       -- reexport matches the 'Name exported here.
  179       | [gre] <- lookupGlobalRdrEnv gr (nameOccName name) = do
  180         let name' = greMangledName gre
  181         when (name /= name') $ do
  182             -- See Note [Error reporting bad reexport]
  183             -- TODO: Actually this error swizzle doesn't work
  184             let p (L _ ie) = name `elem` ieNames ie
  185                 loc = case tcg_rn_exports tcg_env of
  186                        Just es | Just e <- find p (map fst es)
  187                          -- TODO: maybe we can be a little more
  188                          -- precise here and use the Located
  189                          -- info for the *specific* name we matched.
  190                          -> getLocA e
  191                        _ -> nameSrcSpan name
  192             addErrAt loc
  193                 (badReexportedBootThing False name name')
  194       -- This should actually never happen, but whatever...
  195       | otherwise =
  196         addErrAt (nameSrcSpan name)
  197             (missingBootThing False name "exported by")
  198 
  199 -- Note [Fail before checking instances in checkHsigIface]
  200 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  201 -- We need to be careful about failing before checking instances if there happens
  202 -- to be an error in the exports.
  203 -- Otherwise, we might proceed with typechecking (and subsequently panic-ing) on
  204 -- ill-kinded types that are constructed while checking instances.
  205 -- This lead to #19244
  206 
  207 -- Note [Error reporting bad reexport]
  208 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  209 -- NB: You want to be a bit careful about what location you report on reexports.
  210 -- If the name was declared in the hsig file, 'nameSrcSpan name' is indeed the
  211 -- correct source location.  However, if it was *reexported*, obviously the name
  212 -- is not going to have the right location.  In this case, we need to grovel in
  213 -- tcg_rn_exports to figure out where the reexport came from.
  214 
  215 
  216 
  217 -- | Checks if a 'ClsInst' is "defined". In general, for hsig files we can't
  218 -- assume that the implementing file actually implemented the instances (they
  219 -- may be reexported from elsewhere).  Where should we look for the instances?
  220 -- We do the same as we would otherwise: consult the EPS.  This isn't perfect
  221 -- (we might conclude the module exports an instance when it doesn't, see
  222 -- #9422), but we will never refuse to compile something.
  223 check_inst :: ClsInst -> TcM ()
  224 check_inst sig_inst = do
  225     -- TODO: This could be very well generalized to support instance
  226     -- declarations in boot files.
  227     tcg_env <- getGblEnv
  228     -- NB: Have to tug on the interface, not necessarily
  229     -- tugged... but it didn't work?
  230     mapM_ tcLookupImported_maybe (nameSetElemsStable (orphNamesOfClsInst sig_inst))
  231     -- Based off of 'simplifyDeriv'
  232     let ty = idType (instanceDFunId sig_inst)
  233         skol_info = InstSkol
  234         -- Based off of tcSplitDFunTy
  235         (tvs, theta, pred) =
  236            case tcSplitForAllInvisTyVars ty of { (tvs, rho)    ->
  237            case splitFunTys rho             of { (theta, pred) ->
  238            (tvs, theta, pred) }}
  239         origin = InstProvidedOrigin (tcg_semantic_mod tcg_env) sig_inst
  240     (skol_subst, tvs_skols) <- tcInstSkolTyVars tvs -- Skolemize
  241     (tclvl,cts) <- pushTcLevelM $ do
  242        wanted <- newWanted origin
  243                            (Just TypeLevel)
  244                            (substTy skol_subst pred)
  245        givens <- forM theta $ \given -> do
  246            loc <- getCtLocM origin (Just TypeLevel)
  247            let given_pred = substTy skol_subst (scaledThing given)
  248            new_ev <- newEvVar given_pred
  249            return CtGiven { ctev_pred = given_pred
  250                           -- Doesn't matter, make something up
  251                           , ctev_evar = new_ev
  252                           , ctev_loc = loc
  253                           }
  254        return $ wanted : givens
  255     unsolved <- simplifyWantedsTcM cts
  256 
  257     (implic, _) <- buildImplicationFor tclvl skol_info tvs_skols [] unsolved
  258     reportAllUnsolved (mkImplicWC implic)
  259 
  260 -- | For a module @modname@ of type 'HscSource', determine the list
  261 -- of extra "imports" of other requirements which should be considered part of
  262 -- the import of the requirement, because it transitively depends on those
  263 -- requirements by imports of modules from other packages.  The situation
  264 -- is something like this:
  265 --
  266 --      unit p where
  267 --          signature X
  268 --          signature Y
  269 --              import X
  270 --
  271 --      unit q where
  272 --          dependency p[X=\<A>,Y=\<B>]
  273 --          signature A
  274 --          signature B
  275 --
  276 -- Although q's B does not directly import A, we still have to make sure we
  277 -- process A first, because the merging process will cause B to indirectly
  278 -- import A.  This function finds the TRANSITIVE closure of all such imports
  279 -- we need to make.
  280 findExtraSigImports :: HscEnv
  281                     -> HscSource
  282                     -> ModuleName
  283                     -> IO [ModuleName]
  284 findExtraSigImports hsc_env HsigFile modname = do
  285     let
  286       dflags     = hsc_dflags hsc_env
  287       ctx        = initSDocContext dflags defaultUserStyle
  288       unit_state = hsc_units hsc_env
  289       reqs       = requirementMerges unit_state modname
  290     holes <- forM reqs $ \(Module iuid mod_name) -> do
  291         initIfaceLoad hsc_env
  292             . withException ctx
  293             $ moduleFreeHolesPrecise (text "findExtraSigImports")
  294                 (mkModule (VirtUnit iuid) mod_name)
  295     return (uniqDSetToList (unionManyUniqDSets holes))
  296 
  297 findExtraSigImports _ _ _ = return []
  298 
  299 -- Given a list of 'import M' statements in a module, figure out
  300 -- any extra implicit requirement imports they may have.  For
  301 -- example, if they 'import M' and M resolves to p[A=<B>,C=D], then
  302 -- they actually also import the local requirement B.
  303 implicitRequirements :: HscEnv
  304                      -> [(PkgQual, Located ModuleName)]
  305                      -> IO [ModuleName]
  306 implicitRequirements hsc_env normal_imports
  307   = fmap concat $
  308     forM normal_imports $ \(mb_pkg, L _ imp) -> do
  309         found <- findImportedModule fc fopts units home_unit imp mb_pkg
  310         case found of
  311             Found _ mod | not (isHomeModule home_unit mod) ->
  312                 return (uniqDSetToList (moduleFreeHoles mod))
  313             _ -> return []
  314   where
  315     fc        = hsc_FC hsc_env
  316     home_unit = hsc_home_unit hsc_env
  317     units     = hsc_units hsc_env
  318     dflags    = hsc_dflags hsc_env
  319     fopts     = initFinderOpts dflags
  320 
  321 -- | Like @implicitRequirements'@, but returns either the module name, if it is
  322 -- a free hole, or the instantiated unit the imported module is from, so that
  323 -- that instantiated unit can be processed and via the batch mod graph (rather
  324 -- than a transitive closure done here) all the free holes are still reachable.
  325 implicitRequirementsShallow
  326   :: HscEnv
  327   -> [(PkgQual, Located ModuleName)]
  328   -> IO ([ModuleName], [InstantiatedUnit])
  329 implicitRequirementsShallow hsc_env normal_imports = go ([], []) normal_imports
  330  where
  331   fc        = hsc_FC hsc_env
  332   home_unit = hsc_home_unit hsc_env
  333   units     = hsc_units hsc_env
  334   dflags    = hsc_dflags hsc_env
  335   fopts        = initFinderOpts dflags
  336 
  337   go acc [] = pure acc
  338   go (accL, accR) ((mb_pkg, L _ imp):imports) = do
  339     found <- findImportedModule fc fopts units home_unit imp mb_pkg
  340     let acc' = case found of
  341           Found _ mod | not (isHomeModule home_unit mod) ->
  342               case moduleUnit mod of
  343                   HoleUnit -> (moduleName mod : accL, accR)
  344                   RealUnit _ -> (accL, accR)
  345                   VirtUnit u -> (accL, u:accR)
  346           _ -> (accL, accR)
  347     go acc' imports
  348 
  349 -- | Given a 'Unit', make sure it is well typed.  This is because
  350 -- unit IDs come from Cabal, which does not know if things are well-typed or
  351 -- not; a component may have been filled with implementations for the holes
  352 -- that don't actually fulfill the requirements.
  353 checkUnit :: Unit -> TcM ()
  354 checkUnit HoleUnit         = return ()
  355 checkUnit (RealUnit _)     = return () -- if it's already compiled, must be well-typed
  356 checkUnit (VirtUnit indef) = do
  357    let insts = instUnitInsts indef
  358    forM_ insts $ \(mod_name, mod) ->
  359        -- NB: direct hole instantiations are well-typed by construction
  360        -- (because we FORCE things to be merged in), so don't check them
  361        when (not (isHoleModule mod)) $ do
  362            checkUnit (moduleUnit mod)
  363            _ <- mod `checkImplements` Module indef mod_name
  364            return ()
  365 
  366 -- | Top-level driver for signature instantiation (run when compiling
  367 -- an @hsig@ file.)
  368 tcRnCheckUnit ::
  369     HscEnv -> Unit ->
  370     IO (Messages TcRnMessage, Maybe ())
  371 tcRnCheckUnit hsc_env uid =
  372    withTiming logger
  373               (text "Check unit id" <+> ppr uid)
  374               (const ()) $
  375    initTc hsc_env
  376           HsigFile -- bogus
  377           False
  378           (mainModIs hsc_env)
  379           (realSrcLocSpan (mkRealSrcLoc (fsLit loc_str) 0 0)) -- bogus
  380     $ checkUnit uid
  381   where
  382    dflags = hsc_dflags hsc_env
  383    logger = hsc_logger hsc_env
  384    loc_str = "Command line argument: -unit-id " ++ showSDoc dflags (ppr uid)
  385 
  386 -- TODO: Maybe lcl_iface0 should be pre-renamed to the right thing? Unclear...
  387 
  388 -- | Top-level driver for signature merging (run after typechecking
  389 -- an @hsig@ file).
  390 tcRnMergeSignatures :: HscEnv -> HsParsedModule -> TcGblEnv {- from local sig -} -> ModIface
  391                     -> IO (Messages TcRnMessage, Maybe TcGblEnv)
  392 tcRnMergeSignatures hsc_env hpm orig_tcg_env iface =
  393   withTiming logger
  394              (text "Signature merging" <+> brackets (ppr this_mod))
  395              (const ()) $
  396   initTc hsc_env HsigFile False this_mod real_loc $
  397     mergeSignatures hpm orig_tcg_env iface
  398  where
  399   logger   = hsc_logger hsc_env
  400   this_mod = mi_module iface
  401   real_loc = tcg_top_loc orig_tcg_env
  402 
  403 thinModIface :: [AvailInfo] -> ModIface -> ModIface
  404 thinModIface avails iface =
  405     iface {
  406         mi_exports = avails,
  407         -- mi_fixities = ...,
  408         -- mi_warns = ...,
  409         -- mi_anns = ...,
  410         -- TODO: The use of nameOccName here is a bit dodgy, because
  411         -- perhaps there might be two IfaceTopBndr that are the same
  412         -- OccName but different Name.  Requires better understanding
  413         -- of invariants here.
  414         mi_decls = exported_decls ++ non_exported_decls ++ dfun_decls
  415         -- mi_insts = ...,
  416         -- mi_fam_insts = ...,
  417     }
  418   where
  419     decl_pred occs decl = nameOccName (ifName decl) `elemOccSet` occs
  420     filter_decls occs = filter (decl_pred occs . snd) (mi_decls iface)
  421 
  422     exported_occs = mkOccSet [ occName n
  423                              | a <- avails
  424                              , n <- availNames a ]
  425     exported_decls = filter_decls exported_occs
  426 
  427     non_exported_occs = mkOccSet [ occName n
  428                                  | (_, d) <- exported_decls
  429                                  , n <- ifaceDeclNeverExportedRefs d ]
  430     non_exported_decls = filter_decls non_exported_occs
  431 
  432     dfun_pred IfaceId{ ifIdDetails = IfDFunId } = True
  433     dfun_pred _ = False
  434     dfun_decls = filter (dfun_pred . snd) (mi_decls iface)
  435 
  436 -- | The list of 'Name's of *non-exported* 'IfaceDecl's which this
  437 -- 'IfaceDecl' may refer to.  A non-exported 'IfaceDecl' should be kept
  438 -- after thinning if an *exported* 'IfaceDecl' (or 'mi_insts', perhaps)
  439 -- refers to it; we can't decide to keep it by looking at the exports
  440 -- of a module after thinning.  Keep this synchronized with
  441 -- 'rnIfaceDecl'.
  442 ifaceDeclNeverExportedRefs :: IfaceDecl -> [Name]
  443 ifaceDeclNeverExportedRefs d@IfaceFamily{} =
  444     case ifFamFlav d of
  445         IfaceClosedSynFamilyTyCon (Just (n, _))
  446             -> [n]
  447         _   -> []
  448 ifaceDeclNeverExportedRefs _ = []
  449 
  450 
  451 -- Note [Blank hsigs for all requirements]
  452 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  453 -- One invariant that a client of GHC must uphold is that there
  454 -- must be an hsig file for every requirement (according to
  455 -- @-this-unit-id@); this ensures that for every interface
  456 -- file (hi), there is a source file (hsig), which helps grease
  457 -- the wheels of recompilation avoidance which assumes that
  458 -- source files always exist.
  459 
  460 {-
  461 inheritedSigPvpWarning :: WarningTxt
  462 inheritedSigPvpWarning =
  463     WarningTxt (noLoc NoSourceText) [noLoc (StringLiteral NoSourceText (fsLit msg))]
  464   where
  465     msg = "Inherited requirements from non-signature libraries (libraries " ++
  466           "with modules) should not be used, as this mode of use is not " ++
  467           "compatible with PVP-style version bounds.  Instead, copy the " ++
  468           "declaration to the local hsig file or move the signature to a " ++
  469           "library of its own and add that library as a dependency."
  470 -}
  471 
  472 -- Note [Handling never-exported TyThings under Backpack]
  473 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  474 --   DEFINITION: A "never-exported TyThing" is a TyThing whose 'Name' will
  475 --   never be mentioned in the export list of a module (mi_avails).
  476 --   Unlike implicit TyThings (Note [Implicit TyThings]), non-exported
  477 --   TyThings DO have a standalone IfaceDecl declaration in their
  478 --   interface file.
  479 --
  480 -- Originally, Backpack was designed under the assumption that anything
  481 -- you could declare in a module could also be exported; thus, merging
  482 -- the export lists of two signatures is just merging the declarations
  483 -- of two signatures writ small.  Of course, in GHC Haskell, there are a
  484 -- few important things which are not explicitly exported but still can
  485 -- be used:  in particular, dictionary functions for instances, Typeable
  486 -- TyCon bindings, and coercion axioms for type families also count.
  487 --
  488 -- When handling these non-exported things, there two primary things
  489 -- we need to watch out for:
  490 --
  491 --  * Signature matching/merging is done by comparing each
  492 --    of the exported entities of a signature and a module.  These exported
  493 --    entities may refer to non-exported TyThings which must be tested for
  494 --    consistency.  For example, an instance (ClsInst) will refer to a
  495 --    non-exported DFunId.  In this case, 'checkBootDeclM' directly compares the
  496 --    embedded 'DFunId' in 'is_dfun'.
  497 --
  498 --    For this to work at all, we must ensure that pointers in 'is_dfun' refer
  499 --    to DISTINCT 'DFunId's, even though the 'Name's (may) be the same.
  500 --    Unfortunately, this is the OPPOSITE of how we treat most other references
  501 --    to 'Name's, so this case needs to be handled specially.
  502 --
  503 --    The details are in the documentation for 'typecheckIfacesForMerging'.
  504 --    and the Note [Resolving never-exported Names] in GHC.IfaceToCore.
  505 --
  506 --  * When we rename modules and signatures, we use the export lists to
  507 --    decide how the declarations should be renamed.  However, this
  508 --    means we don't get any guidance for how to rename non-exported
  509 --    entities.  Fortunately, we only need to rename these entities
  510 --    *consistently*, so that 'typecheckIfacesForMerging' can wire them
  511 --    up as needed.
  512 --
  513 --    The details are in Note [rnIfaceNeverExported] in 'GHC.Iface.Rename'.
  514 --
  515 -- The root cause for all of these complications is the fact that these
  516 -- logically "implicit" entities are defined indirectly in an interface
  517 -- file.  #13151 gives a proposal to make these *truly* implicit.
  518 
  519 merge_msg :: ModuleName -> [InstantiatedModule] -> SDoc
  520 merge_msg mod_name [] =
  521     text "while checking the local signature" <+> ppr mod_name <+>
  522     text "for consistency"
  523 merge_msg mod_name reqs =
  524   hang (text "while merging the signatures from" <> colon)
  525    2 (vcat [ bullet <+> ppr req | req <- reqs ] $$
  526       bullet <+> text "...and the local signature for" <+> ppr mod_name)
  527 
  528 -- | Given a local 'ModIface', merge all inherited requirements
  529 -- from 'requirementMerges' into this signature, producing
  530 -- a final 'TcGblEnv' that matches the local signature and
  531 -- all required signatures.
  532 mergeSignatures :: HsParsedModule -> TcGblEnv -> ModIface -> TcRn TcGblEnv
  533 mergeSignatures
  534   (HsParsedModule { hpm_module = L loc (HsModule { hsmodExports = mb_exports }),
  535                     hpm_src_files = src_files })
  536   orig_tcg_env lcl_iface0 = setSrcSpan loc $ do
  537     -- The lcl_iface0 is the ModIface for the local hsig
  538     -- file, which is guaranteed to exist, see
  539     -- Note [Blank hsigs for all requirements]
  540     hsc_env <- getTopEnv
  541 
  542     -- Copy over some things from the original TcGblEnv that
  543     -- we want to preserve
  544     updGblEnv (\env -> env {
  545         -- Renamed imports/declarations are often used
  546         -- by programs that use the GHC API, e.g., Haddock.
  547         -- These won't get filled by the merging process (since
  548         -- we don't actually rename the parsed module again) so
  549         -- we need to take them directly from the previous
  550         -- typechecking.
  551         --
  552         -- NB: the export declarations aren't in their final
  553         -- form yet.  We'll fill those in when we reprocess
  554         -- the export declarations.
  555         tcg_rn_imports = tcg_rn_imports orig_tcg_env,
  556         tcg_rn_decls   = tcg_rn_decls   orig_tcg_env,
  557         -- Annotations
  558         tcg_ann_env    = tcg_ann_env    orig_tcg_env,
  559         -- Documentation header
  560         tcg_doc_hdr    = tcg_doc_hdr orig_tcg_env
  561         -- tcg_dus?
  562         -- tcg_th_used           = tcg_th_used orig_tcg_env,
  563         -- tcg_th_splice_used    = tcg_th_splice_used orig_tcg_env
  564        }) $ do
  565     tcg_env <- getGblEnv
  566 
  567     let outer_mod  = tcg_mod tcg_env
  568     let inner_mod  = tcg_semantic_mod tcg_env
  569     let mod_name   = moduleName (tcg_mod tcg_env)
  570     let unit_state = hsc_units hsc_env
  571     let fc         = hsc_FC hsc_env
  572     let nc         = hsc_NC hsc_env
  573     let home_unit  = hsc_home_unit hsc_env
  574     let dflags     = hsc_dflags hsc_env
  575     let logger     = hsc_logger hsc_env
  576     let hooks      = hsc_hooks hsc_env
  577 
  578     -- STEP 1: Figure out all of the external signature interfaces
  579     -- we are going to merge in.
  580     let reqs = requirementMerges unit_state mod_name
  581 
  582     addErrCtxt (pprWithUnitState unit_state $ merge_msg mod_name reqs) $ do
  583 
  584     -- STEP 2: Read in the RAW forms of all of these interfaces
  585     ireq_ifaces0 <- liftIO $ forM reqs $ \(Module iuid mod_name) -> do
  586         let m = mkModule (VirtUnit iuid) mod_name
  587             im = fst (getModuleInstantiation m)
  588             ctx = initSDocContext dflags defaultUserStyle
  589         fmap fst
  590          . withException ctx
  591          $ findAndReadIface logger nc fc hooks unit_state home_unit dflags
  592                             (text "mergeSignatures") im m NotBoot
  593 
  594     -- STEP 3: Get the unrenamed exports of all these interfaces,
  595     -- thin it according to the export list, and do shaping on them.
  596     let extend_ns nsubst as = liftIO $ extendNameShape hsc_env nsubst as
  597         -- This function gets run on every inherited interface, and
  598         -- it's responsible for:
  599         --
  600         --  1. Merging the exports of the interface into @nsubst@,
  601         --  2. Adding these exports to the "OK to import" set (@oks@)
  602         --  if they came from a package with no exposed modules
  603         --  (this means we won't report a PVP error in this case), and
  604         --  3. Thinning the interface according to an explicit export
  605         --  list.
  606         --
  607         gen_subst (nsubst,oks,ifaces) (imod@(Module iuid _), ireq_iface) = do
  608             let insts = instUnitInsts iuid
  609                 isFromSignaturePackage =
  610                     let inst_uid = instUnitInstanceOf iuid
  611                         pkg = unsafeLookupUnitId unit_state inst_uid
  612                     in null (unitExposedModules pkg)
  613             -- 3(a). Rename the exports according to how the dependency
  614             -- was instantiated.  The resulting export list will be accurate
  615             -- except for exports *from the signature itself* (which may
  616             -- be subsequently updated by exports from other signatures in
  617             -- the merge.
  618             as1 <- tcRnModExports insts ireq_iface
  619             -- 3(b). Thin the interface if it comes from a signature package.
  620             (thinned_iface, as2) <- case mb_exports of
  621                     Just (L loc _)
  622                       -- Check if the package containing this signature is
  623                       -- a signature package (i.e., does not expose any
  624                       -- modules.)  If so, we can thin it.
  625                       | isFromSignaturePackage
  626                       -> setSrcSpanA loc $ do
  627                         -- Suppress missing errors; they might be used to refer
  628                         -- to entities from other signatures we are merging in.
  629                         -- If an identifier truly doesn't exist in any of the
  630                         -- signatures that are merged in, we will discover this
  631                         -- when we run exports_from_avail on the final merged
  632                         -- export list.
  633                         (mb_r, msgs) <- tryTc $ do
  634                             -- Suppose that we have written in a signature:
  635                             --  signature A ( module A ) where {- empty -}
  636                             -- If I am also inheriting a signature from a
  637                             -- signature package, does 'module A' scope over
  638                             -- all of its exports?
  639                             --
  640                             -- There are two possible interpretations:
  641                             --
  642                             --  1. For non self-reexports, a module reexport
  643                             --  is interpreted only in terms of the local
  644                             --  signature module, and not any of the inherited
  645                             --  ones.  The reason for this is because after
  646                             --  typechecking, module exports are completely
  647                             --  erased from the interface of a file, so we
  648                             --  have no way of "interpreting" a module reexport.
  649                             --  Thus, it's only useful for the local signature
  650                             --  module (where we have a useful GlobalRdrEnv.)
  651                             --
  652                             --  2. On the other hand, a common idiom when
  653                             --  you want to "export everything, plus a reexport"
  654                             --  in modules is to say module A ( module A, reex ).
  655                             --  This applies to signature modules too; and in
  656                             --  particular, you probably still want the entities
  657                             --  from the inherited signatures to be preserved
  658                             --  too.
  659                             --
  660                             -- We think it's worth making a special case for
  661                             -- self reexports to make use case (2) work.  To
  662                             -- do this, we take the exports of the inherited
  663                             -- signature @as1@, and bundle them into a
  664                             -- GlobalRdrEnv where we treat them as having come
  665                             -- from the import @import A@.  Thus, we will
  666                             -- pick them up if they are referenced explicitly
  667                             -- (@foo@) or even if we do a module reexport
  668                             -- (@module A@).
  669                             let ispec = ImpSpec ImpDeclSpec{
  670                                             -- NB: This needs to be mod name
  671                                             -- of the local signature, not
  672                                             -- the (original) module name of
  673                                             -- the inherited signature,
  674                                             -- because we need module
  675                                             -- LocalSig (from the local
  676                                             -- export list) to match it!
  677                                             is_mod  = mod_name,
  678                                             is_as   = mod_name,
  679                                             is_qual = False,
  680                                             is_dloc = locA loc
  681                                           } ImpAll
  682                                 rdr_env = mkGlobalRdrEnv (gresFromAvails (Just ispec) as1)
  683                             setGblEnv tcg_env {
  684                                 tcg_rdr_env = rdr_env
  685                             } $ exports_from_avail mb_exports rdr_env
  686                                     -- NB: tcg_imports is also empty!
  687                                     emptyImportAvails
  688                                     (tcg_semantic_mod tcg_env)
  689                         case mb_r of
  690                             Just (_, as2) -> return (thinModIface as2 ireq_iface, as2)
  691                             Nothing -> addMessages msgs >> failM
  692                     -- We can't think signatures from non signature packages
  693                     _ -> return (ireq_iface, as1)
  694             -- 3(c). Only identifiers from signature packages are "ok" to
  695             -- import (that is, they are safe from a PVP perspective.)
  696             -- (NB: This code is actually dead right now.)
  697             let oks' | isFromSignaturePackage
  698                      = extendOccSetList oks (exportOccs as2)
  699                      | otherwise
  700                      = oks
  701             -- 3(d). Extend the name substitution (performing shaping)
  702             mb_r <- extend_ns nsubst as2
  703             case mb_r of
  704                 Left err -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints err)
  705                 Right nsubst' -> return (nsubst',oks',(imod, thinned_iface):ifaces)
  706         nsubst0 = mkNameShape (moduleName inner_mod) (mi_exports lcl_iface0)
  707         ok_to_use0 = mkOccSet (exportOccs (mi_exports lcl_iface0))
  708     -- Process each interface, getting the thinned interfaces as well as
  709     -- the final, full set of exports @nsubst@ and the exports which are
  710     -- "ok to use" (we won't attach 'inheritedSigPvpWarning' to them.)
  711     (nsubst, ok_to_use, rev_thinned_ifaces)
  712         <- foldM gen_subst (nsubst0, ok_to_use0, []) (zip reqs ireq_ifaces0)
  713     let thinned_ifaces = reverse rev_thinned_ifaces
  714         exports        = nameShapeExports nsubst
  715         rdr_env        = mkGlobalRdrEnv (gresFromAvails Nothing exports)
  716         _warn_occs     = filter (not . (`elemOccSet` ok_to_use)) (exportOccs exports)
  717         warns          = NoWarnings
  718         {-
  719         -- TODO: Warnings are transitive, but this is not what we want here:
  720         -- if a module reexports an entity from a signature, that should be OK.
  721         -- Not supported in current warning framework
  722         warns | null warn_occs = NoWarnings
  723               | otherwise = WarnSome $ map (\o -> (o, inheritedSigPvpWarning)) warn_occs
  724         -}
  725     setGblEnv tcg_env {
  726         -- The top-level GlobalRdrEnv is quite interesting.  It consists
  727         -- of two components:
  728         --  1. First, we reuse the GlobalRdrEnv of the local signature.
  729         --     This is very useful, because it means that if we have
  730         --     to print a message involving some entity that the local
  731         --     signature imported, we'll qualify it accordingly.
  732         --  2. Second, we need to add all of the declarations we are
  733         --     going to merge in (as they need to be in scope for the
  734         --     final test of the export list.)
  735         tcg_rdr_env = rdr_env `plusGlobalRdrEnv` tcg_rdr_env orig_tcg_env,
  736         -- Inherit imports from the local signature, so that module
  737         -- reexports are picked up correctly
  738         tcg_imports = tcg_imports orig_tcg_env,
  739         tcg_exports = exports,
  740         tcg_dus     = usesOnly (availsToNameSetWithSelectors exports),
  741         tcg_warns   = warns
  742         } $ do
  743     tcg_env <- getGblEnv
  744 
  745     -- Make sure we didn't refer to anything that doesn't actually exist
  746     -- pprTrace "mergeSignatures: exports_from_avail" (ppr exports) $ return ()
  747     (mb_lies, _) <- exports_from_avail mb_exports rdr_env
  748                         (tcg_imports tcg_env) (tcg_semantic_mod tcg_env)
  749 
  750     {- -- NB: This is commented out, because warns above is disabled.
  751     -- If you tried to explicitly export an identifier that has a warning
  752     -- attached to it, that's probably a mistake.  Warn about it.
  753     case mb_lies of
  754       Nothing -> return ()
  755       Just lies ->
  756         forM_ (concatMap (\(L loc x) -> map (L loc) (ieNames x)) lies) $ \(L loc n) ->
  757           setSrcSpan loc $
  758             unless (nameOccName n `elemOccSet` ok_to_use) $
  759                 addWarn NoReason $ vcat [
  760                     text "Exported identifier" <+> quotes (ppr n) <+> text "will cause warnings if used.",
  761                     parens (text "To suppress this warning, remove" <+> quotes (ppr n) <+> text "from the export list of this signature.")
  762                     ]
  763     -}
  764 
  765     failIfErrsM
  766 
  767     -- Save the exports
  768     setGblEnv tcg_env { tcg_rn_exports = mb_lies } $ do
  769     tcg_env <- getGblEnv
  770 
  771     -- STEP 4: Rename the interfaces
  772     ext_ifaces <- forM thinned_ifaces $ \((Module iuid _), ireq_iface) ->
  773         tcRnModIface (instUnitInsts iuid) (Just nsubst) ireq_iface
  774     lcl_iface <- tcRnModIface (homeUnitInstantiations home_unit) (Just nsubst) lcl_iface0
  775     let ifaces = lcl_iface : ext_ifaces
  776 
  777     -- STEP 4.1: Merge fixities (we'll verify shortly) tcg_fix_env
  778     let fix_env = mkNameEnv [ (greMangledName rdr_elt, FixItem occ f)
  779                             | (occ, f) <- concatMap mi_fixities ifaces
  780                             , rdr_elt <- lookupGlobalRdrEnv rdr_env occ ]
  781 
  782     -- STEP 5: Typecheck the interfaces
  783     let type_env_var = tcg_type_env_var tcg_env
  784 
  785     -- typecheckIfacesForMerging does two things:
  786     --      1. It merges the all of the ifaces together, and typechecks the
  787     --      result to type_env.
  788     --      2. It typechecks each iface individually, but with their 'Name's
  789     --      resolving to the merged type_env from (1).
  790     -- See typecheckIfacesForMerging for more details.
  791     (type_env, detailss) <- initIfaceTcRn $
  792                             typecheckIfacesForMerging inner_mod ifaces type_env_var
  793     let infos = zip ifaces detailss
  794 
  795     -- Test for cycles
  796     checkSynCycles (homeUnitAsUnit home_unit) (typeEnvTyCons type_env) []
  797 
  798     -- NB on type_env: it contains NO dfuns.  DFuns are recorded inside
  799     -- detailss, and given a Name that doesn't correspond to anything real.  See
  800     -- also Note [Signature merging DFuns]
  801 
  802     -- Add the merged type_env to TcGblEnv, so that it gets serialized
  803     -- out when we finally write out the interface.
  804     --
  805     -- NB: Why do we set tcg_tcs/tcg_patsyns/tcg_type_env directly,
  806     -- rather than use tcExtendGlobalEnv (the normal method to add newly
  807     -- defined types to TcGblEnv?)  tcExtendGlobalEnv adds these
  808     -- TyThings to 'tcg_type_env_var', which is consulted when
  809     -- we read in interfaces to tie the knot.  But *these TyThings themselves
  810     -- come from interface*, so that would result in deadlock.  Don't
  811     -- update it!
  812     setGblEnv tcg_env {
  813         tcg_tcs = typeEnvTyCons type_env,
  814         tcg_patsyns = typeEnvPatSyns type_env,
  815         tcg_type_env = type_env,
  816         tcg_fix_env = fix_env
  817         } $ do
  818     tcg_env <- getGblEnv
  819 
  820     -- STEP 6: Check for compatibility/merge things
  821     tcg_env <- (\x -> foldM x tcg_env infos)
  822              $ \tcg_env (iface, details) -> do
  823 
  824         let check_export name
  825               | Just sig_thing <- lookupTypeEnv (md_types details) name
  826               = case lookupTypeEnv type_env (getName sig_thing) of
  827                   Just thing -> checkHsigDeclM iface sig_thing thing
  828                   Nothing -> panic "mergeSignatures: check_export"
  829               -- Oops! We're looking for this export but it's
  830               -- not actually in the type environment of the signature's
  831               -- ModDetails.
  832               --
  833               -- NB: This case happens because the we're iterating
  834               -- over the union of all exports, so some interfaces
  835               -- won't have everything.  Note that md_exports is nonsense
  836               -- (it's the same as exports); maybe we should fix this
  837               -- eventually.
  838               | otherwise
  839               = return ()
  840         mapM_ check_export (map availName exports)
  841 
  842         -- Note [Signature merging instances]
  843         -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  844         -- Merge instances into the global environment.  The algorithm here is
  845         -- dumb and simple: if an instance has exactly the same DFun type
  846         -- (tested by 'memberInstEnv') as an existing instance, we drop it;
  847         -- otherwise, we add it even, even if this would cause overlap.
  848         --
  849         -- Why don't we deduplicate instances with identical heads?  There's no
  850         -- good choice if they have premises:
  851         --
  852         --      instance K1 a => K (T a)
  853         --      instance K2 a => K (T a)
  854         --
  855         -- Why not eagerly error in this case?  The overlapping head does not
  856         -- necessarily mean that the instances are unimplementable: in fact,
  857         -- they may be implemented without overlap (if, for example, the
  858         -- implementing module has 'instance K (T a)'; both are implemented in
  859         -- this case.)  The implements test just checks that the wanteds are
  860         -- derivable assuming the givens.
  861         --
  862         -- Still, overlapping instances with hypotheses like above are going
  863         -- to be a bad deal, because instance resolution when we're typechecking
  864         -- against the merged signature is going to have a bad time when
  865         -- there are overlapping heads like this: we never backtrack, so it
  866         -- may be difficult to see that a wanted is derivable.  For now,
  867         -- we hope that we get lucky / the overlapping instances never
  868         -- get used, but it is not a very good situation to be in.
  869         --
  870         hsc_env <- getTopEnv
  871         let merge_inst (insts, inst_env) inst
  872                 | memberInstEnv inst_env inst -- test DFun Type equality
  873                 = (insts, inst_env)
  874                 | otherwise
  875                 -- NB: is_dfun_name inst is still nonsense here,
  876                 -- see Note [Signature merging DFuns]
  877                 = (inst:insts, extendInstEnv inst_env inst)
  878             (insts, inst_env) = foldl' merge_inst
  879                                     (tcg_insts tcg_env, tcg_inst_env tcg_env)
  880                                     (md_insts details)
  881             -- This is a HACK to prevent calculateAvails from including imp_mod
  882             -- in the listing.  We don't want it because a module is NOT
  883             -- supposed to include itself in its dep_orphs/dep_finsts.  See #13214
  884             iface' = iface { mi_final_exts = (mi_final_exts iface){ mi_orphan = False, mi_finsts = False } }
  885             home_unit = hsc_home_unit hsc_env
  886             avails = plusImportAvails (tcg_imports tcg_env) $
  887                         calculateAvails home_unit iface' False NotBoot ImportedBySystem
  888         return tcg_env {
  889             tcg_inst_env = inst_env,
  890             tcg_insts    = insts,
  891             tcg_imports  = avails,
  892             tcg_merged   =
  893                 if outer_mod == mi_module iface
  894                     -- Don't add ourselves!
  895                     then tcg_merged tcg_env
  896                     else (mi_module iface, mi_mod_hash (mi_final_exts iface)) : tcg_merged tcg_env
  897             }
  898 
  899     -- Note [Signature merging DFuns]
  900     -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  901     -- Once we know all of instances which will be defined by this merged
  902     -- signature, we go through each of the DFuns and rename them with a fresh,
  903     -- new, unique DFun Name, and add these DFuns to tcg_type_env (thus fixing
  904     -- up the "bogus" names that were setup in 'typecheckIfacesForMerging'.
  905     --
  906     -- We can't do this fixup earlier, because we need a way to identify each
  907     -- source DFun (from each of the signatures we are merging in) so that
  908     -- when we have a ClsInst, we can pull up the correct DFun to check if
  909     -- the types match.
  910     --
  911     -- See also Note [rnIfaceNeverExported] in GHC.Iface.Rename
  912     dfun_insts <- forM (tcg_insts tcg_env) $ \inst -> do
  913         n <- newDFunName (is_cls inst) (is_tys inst) (nameSrcSpan (is_dfun_name inst))
  914         let dfun = setVarName (is_dfun inst) n
  915         return (dfun, inst { is_dfun_name = n, is_dfun = dfun })
  916     tcg_env <- return tcg_env {
  917             tcg_insts = map snd dfun_insts,
  918             tcg_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) (map fst dfun_insts)
  919         }
  920 
  921     addDependentFiles src_files
  922 
  923     return tcg_env
  924 
  925 -- | Top-level driver for signature instantiation (run when compiling
  926 -- an @hsig@ file.)
  927 tcRnInstantiateSignature ::
  928     HscEnv -> Module -> RealSrcSpan ->
  929     IO (Messages TcRnMessage, Maybe TcGblEnv)
  930 tcRnInstantiateSignature hsc_env this_mod real_loc =
  931    withTiming logger
  932               (text "Signature instantiation"<+>brackets (ppr this_mod))
  933               (const ()) $
  934    initTc hsc_env HsigFile False this_mod real_loc $ instantiateSignature
  935   where
  936    logger = hsc_logger hsc_env
  937 
  938 exportOccs :: [AvailInfo] -> [OccName]
  939 exportOccs = concatMap (map occName . availNames)
  940 
  941 impl_msg :: UnitState -> Module -> InstantiatedModule -> SDoc
  942 impl_msg unit_state impl_mod (Module req_uid req_mod_name)
  943    = pprWithUnitState unit_state $
  944       text "while checking that" <+> ppr impl_mod <+>
  945       text "implements signature" <+> ppr req_mod_name <+>
  946       text "in" <+> ppr req_uid
  947 
  948 -- | Check if module implements a signature.  (The signature is
  949 -- always un-hashed, which is why its components are specified
  950 -- explicitly.)
  951 checkImplements :: Module -> InstantiatedModule -> TcRn TcGblEnv
  952 checkImplements impl_mod req_mod@(Module uid mod_name) = do
  953   hsc_env <- getTopEnv
  954   let unit_state = hsc_units hsc_env
  955       home_unit  = hsc_home_unit hsc_env
  956   addErrCtxt (impl_msg unit_state impl_mod req_mod) $ do
  957     let insts = instUnitInsts uid
  958 
  959     -- STEP 1: Load the implementing interface, and make a RdrEnv
  960     -- for its exports.  Also, add its 'ImportAvails' to 'tcg_imports',
  961     -- so that we treat all orphan instances it provides as visible
  962     -- when we verify that all instances are checked (see #12945), and so that
  963     -- when we eventually write out the interface we record appropriate
  964     -- dependency information.
  965     impl_iface <- initIfaceTcRn $
  966         loadSysInterface (text "checkImplements 1") impl_mod
  967     let impl_gr = mkGlobalRdrEnv
  968                     (gresFromAvails Nothing (mi_exports impl_iface))
  969         nsubst = mkNameShape (moduleName impl_mod) (mi_exports impl_iface)
  970 
  971     -- Load all the orphans, so the subsequent 'checkHsigIface' sees
  972     -- all the instances it needs to
  973     loadModuleInterfaces (text "Loading orphan modules (from implementor of hsig)")
  974                          (dep_orphs (mi_deps impl_iface))
  975 
  976     let avails = calculateAvails home_unit
  977                     impl_iface False{- safe -} NotBoot ImportedBySystem
  978         fix_env = mkNameEnv [ (greMangledName rdr_elt, FixItem occ f)
  979                             | (occ, f) <- mi_fixities impl_iface
  980                             , rdr_elt <- lookupGlobalRdrEnv impl_gr occ ]
  981     updGblEnv (\tcg_env -> tcg_env {
  982         -- Setting tcg_rdr_env to treat all exported entities from
  983         -- the implementing module as in scope improves error messages,
  984         -- as it reduces the amount of qualification we need.  Unfortunately,
  985         -- we still end up qualifying references to external modules
  986         -- (see bkpfail07 for an example); we'd need to record more
  987         -- information in ModIface to solve this.
  988         tcg_rdr_env = tcg_rdr_env tcg_env `plusGlobalRdrEnv` impl_gr,
  989         tcg_imports = tcg_imports tcg_env `plusImportAvails` avails,
  990         -- This is here so that when we call 'lookupFixityRn' for something
  991         -- directly implemented by the module, we grab the right thing
  992         tcg_fix_env = fix_env
  993         }) $ do
  994 
  995     -- STEP 2: Load the *unrenamed, uninstantiated* interface for
  996     -- the ORIGINAL signature.  We are going to eventually rename it,
  997     -- but we must proceed slowly, because it is NOT known if the
  998     -- instantiation is correct.
  999     let sig_mod = mkModule (VirtUnit uid) mod_name
 1000         isig_mod = fst (getModuleInstantiation sig_mod)
 1001     hsc_env <- getTopEnv
 1002     let nc        = hsc_NC hsc_env
 1003     let fc        = hsc_FC hsc_env
 1004     let home_unit = hsc_home_unit hsc_env
 1005     let units     = hsc_units hsc_env
 1006     let dflags    = hsc_dflags hsc_env
 1007     let logger    = hsc_logger hsc_env
 1008     let hooks     = hsc_hooks hsc_env
 1009     mb_isig_iface <- liftIO $ findAndReadIface logger nc fc hooks units home_unit dflags
 1010                                                (text "checkImplements 2")
 1011                                                isig_mod sig_mod NotBoot
 1012     isig_iface <- case mb_isig_iface of
 1013         Succeeded (iface, _) -> return iface
 1014         Failed err -> failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $
 1015             hang (text "Could not find hi interface for signature" <+>
 1016                   quotes (ppr isig_mod) <> colon) 4 err
 1017 
 1018     -- STEP 3: Check that the implementing interface exports everything
 1019     -- we need.  (Notice we IGNORE the Modules in the AvailInfos.)
 1020     forM_ (exportOccs (mi_exports isig_iface)) $ \occ ->
 1021         case lookupGlobalRdrEnv impl_gr occ of
 1022             [] -> addErr $ TcRnUnknownMessage $ mkPlainError noHints $
 1023                         quotes (ppr occ)
 1024                     <+> text "is exported by the hsig file, but not exported by the implementing module"
 1025                     <+> quotes (pprWithUnitState unit_state $ ppr impl_mod)
 1026             _ -> return ()
 1027     failIfErrsM
 1028 
 1029     -- STEP 4: Now that the export is complete, rename the interface...
 1030     sig_iface <- tcRnModIface insts (Just nsubst) isig_iface
 1031 
 1032     -- STEP 5: ...and typecheck it.  (Note that in both cases, the nsubst
 1033     -- lets us determine how top-level identifiers should be handled.)
 1034     sig_details <- initIfaceTcRn $ typecheckIfaceForInstantiate nsubst sig_iface
 1035 
 1036     -- STEP 6: Check that it's sufficient
 1037     tcg_env <- getGblEnv
 1038     checkHsigIface tcg_env impl_gr sig_iface sig_details
 1039 
 1040     -- STEP 7: Return the updated 'TcGblEnv' with the signature exports,
 1041     -- so we write them out.
 1042     return tcg_env {
 1043         tcg_exports = mi_exports sig_iface
 1044         }
 1045 
 1046 -- | Given 'tcg_mod', instantiate a 'ModIface' from the indefinite
 1047 -- library to use the actual implementations of the relevant entities,
 1048 -- checking that the implementation matches the signature.
 1049 instantiateSignature :: TcRn TcGblEnv
 1050 instantiateSignature = do
 1051     hsc_env <- getTopEnv
 1052     tcg_env <- getGblEnv
 1053     let outer_mod = tcg_mod tcg_env
 1054         inner_mod = tcg_semantic_mod tcg_env
 1055         home_unit = hsc_home_unit hsc_env
 1056     -- TODO: setup the local RdrEnv so the error messages look a little better.
 1057     -- But this information isn't stored anywhere. Should we RETYPECHECK
 1058     -- the local one just to get the information?  Hmm...
 1059     massert (isHomeModule home_unit outer_mod )
 1060     massert (isHomeUnitInstantiating home_unit)
 1061     let uid = homeUnitInstanceOf home_unit
 1062     inner_mod `checkImplements`
 1063         Module
 1064             (mkInstantiatedUnit uid (homeUnitInstantiations home_unit))
 1065             (moduleName outer_mod)