Rationalise GhcMode, HscTarget and GhcLink
[ghc-hetmet.git] / compiler / typecheck / TcRnDriver.lhs
index a93133d..e26c50b 100644 (file)
@@ -65,11 +65,14 @@ import Var
 import Module
 import UniqFM
 import Name
+import NameEnv
 import NameSet
 import TyCon
 import SrcLoc
 import HscTypes
+import ListSetOps
 import Outputable
+import Breakpoints
 
 #ifdef GHCI
 import Linker
@@ -86,15 +89,14 @@ import TysWiredIn
 import IdInfo
 import {- Kind parts of -} Type
 import BasicTypes
-import Data.Maybe
 #endif
 
 import FastString
+import Maybes
 import Util
 import Bag
 
 import Control.Monad    ( unless )
-import Data.Maybe      ( isJust )
 \end{code}
 
 
@@ -115,7 +117,8 @@ tcRnModule :: HscEnv
 
 tcRnModule hsc_env hsc_src save_rn_syntax
         (L loc (HsModule maybe_mod export_ies 
-                         import_decls local_decls mod_deprec _ module_info maybe_doc))
+                         import_decls local_decls mod_deprec _ 
+                         module_info maybe_doc))
  = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
 
    let { this_pkg = thisPackage (hsc_dflags hsc_env) ;
@@ -124,126 +127,130 @@ tcRnModule hsc_env hsc_src save_rn_syntax
                        Just (L _ mod) -> mkModule this_pkg mod } ;
                                                -- The normal case
                
-   initTc hsc_env hsc_src this_mod $ 
+   initTc hsc_env hsc_src save_rn_syntax this_mod $ 
    setSrcSpan loc $
-   do {
-               -- Deal with imports;
-       (rn_imports, rdr_env, imports) <- rnImports import_decls ;
-
-       let { dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface)
-           ; dep_mods = imp_dep_mods imports
-
-               -- We want instance declarations from all home-package
-               -- modules below this one, including boot modules, except
-               -- ourselves.  The 'except ourselves' is so that we don't
-               -- get the instances from this module's hs-boot file
-           ; want_instances :: ModuleName -> Bool
-           ; want_instances mod = mod `elemUFM` dep_mods
-                                  && mod /= moduleName this_mod
-           ; home_insts = hptInstances hsc_env want_instances
-           } ;
-
-               -- Record boot-file info in the EPS, so that it's 
-               -- visible to loadHiBootInterface in tcRnSrcDecls,
-               -- and any other incrementally-performed imports
-       updateEps_ (\eps -> eps { eps_is_boot = dep_mods }) ;
-
-               -- Update the gbl env
-       updGblEnv ( \ gbl -> 
-               gbl { tcg_rdr_env  = plusOccEnv (tcg_rdr_env gbl) rdr_env,
-                     tcg_inst_env = extendInstEnvList (tcg_inst_env gbl) home_insts,
-                     tcg_imports  = tcg_imports gbl `plusImportAvails` imports,
-                      tcg_rn_imports = if save_rn_syntax then
-                                         Just rn_imports
-                                       else
-                                         Nothing,
-                     tcg_rn_decls = if save_rn_syntax then
-                                       Just emptyRnGroup
-                                    else
-                                       Nothing })
-               $ do {
-
-       traceRn (text "rn1" <+> ppr (imp_dep_mods imports)) ;
-               -- Fail if there are any errors so far
-               -- The error printing (if needed) takes advantage 
-               -- of the tcg_env we have now set
-        traceIf (text "rdr_env: " <+> ppr rdr_env) ;
-       failIfErrsM ;
-
-               -- Load any orphan-module and family instance-module
-               -- interfaces, so that their rules and instance decls will be
-               -- found.
-       loadOrphanModules (imp_orphs  imports) False ;
-       loadOrphanModules (imp_finsts imports) True  ;
+   do {                -- Deal with imports;
+       tcg_env <- tcRnImports hsc_env this_mod import_decls ;
+       setGblEnv tcg_env               $ do {
 
-       traceRn (text "rn1: checking family instance consistency") ;
-       let { directlyImpMods =   map (\(mod, _, _) -> mod) 
-                               . moduleEnvElts 
-                               . imp_mods 
-                               $ imports } ;
-       checkFamInstConsistency (imp_finsts imports) directlyImpMods ;
+               -- Load the hi-boot interface for this module, if any
+               -- We do this now so that the boot_names can be passed
+               -- to tcTyAndClassDecls, because the boot_names are 
+               -- automatically considered to be loop breakers
+               --
+               -- Do this *after* tcRnImports, so that we know whether
+               -- a module that we import imports us; and hence whether to
+               -- look for a hi-boot file
+       boot_iface <- tcHiBootIface hsc_src this_mod ;
 
-       traceRn (text "rn1a") ;
                -- Rename and type check the declarations
+       traceRn (text "rn1a") ;
        tcg_env <- if isHsBoot hsc_src then
                        tcRnHsBootDecls local_decls
                   else 
-                       tcRnSrcDecls local_decls ;
+                       tcRnSrcDecls boot_iface local_decls ;
        setGblEnv tcg_env               $ do {
 
-       failIfErrsM ;   -- reportDeprecations crashes sometimes 
-                       -- as a result of typechecker repairs (e.g. unboundNames)
-       traceRn (text "rn3") ;
-
                -- Report the use of any deprecated things
-               -- We do this before processsing the export list so
+               -- We do this *before* processsing the export list so
                -- that we don't bleat about re-exporting a deprecated
                -- thing (especially via 'module Foo' export item)
-               -- Only uses in the body of the module are complained about
-       reportDeprecations (hsc_dflags hsc_env) tcg_env ;
+               -- That is, only uses in the *body* of the module are complained about
+       traceRn (text "rn3") ;
+       failIfErrsM ;   -- finishDeprecations crashes sometimes 
+                       -- as a result of typechecker repairs (e.g. unboundNames)
+       tcg_env <- finishDeprecations (hsc_dflags hsc_env) mod_deprec tcg_env ;
 
                -- Process the export list
-       (rn_exports, exports) <- rnExports (isJust maybe_mod) export_ies ;
-                 
+       tcg_env <- rnExports (isJust maybe_mod) export_ies tcg_env ;
        traceRn (text "rn4") ;
 
-               -- Rename the Haddock documentation header 
-       rn_module_doc <- rnMbHsDoc maybe_doc ;
-
-               -- Rename the Haddock module info 
-       rn_description <- rnMbHsDoc (hmi_description module_info) ;
-       let { rn_module_info = module_info { hmi_description = rn_description } } ;
-
-               -- Check whether the entire module is deprecated
-               -- This happens only once per module
-       let { mod_deprecs = checkModDeprec mod_deprec } ;
-
-               -- Add exports and deprecations to envt
-       let { final_env  = tcg_env { tcg_exports = exports,
-                                     tcg_rn_exports = if save_rn_syntax then
-                                                         rn_exports
-                                                      else Nothing,
-                                    tcg_dus = tcg_dus tcg_env `plusDU` usesOnly (availsToNameSet exports),
-                                    tcg_deprecs = tcg_deprecs tcg_env `plusDeprecs` 
-                                                  mod_deprecs,
-                                    tcg_doc = rn_module_doc, 
-                                    tcg_hmi = rn_module_info
-                                 }
-               -- A module deprecation over-rides the earlier ones
-            } ;
+       -- Compare the hi-boot iface (if any) with the real thing
+       -- Must be done after processing the exports
+       tcg_env <- checkHiBootIface tcg_env boot_iface ;
+
+       -- Make the new type env available to stuff slurped from interface files
+       -- Must do this after checkHiBootIface, because the latter might add new
+       -- bindings for boot_dfuns, which may be mentioned in imported unfoldings
+       writeMutVar (tcg_type_env_var tcg_env) (tcg_type_env tcg_env) ;
+
+               -- Rename the Haddock documentation 
+       tcg_env <- rnHaddock module_info maybe_doc tcg_env ;
 
                -- Report unused names
-       reportUnusedNames export_ies final_env ;
+       reportUnusedNames export_ies tcg_env ;
 
                -- Dump output and return
-       tcDump final_env ;
-       return final_env
+       tcDump tcg_env ;
+       return tcg_env
     }}}}
 \end{code}
 
 
 %************************************************************************
 %*                                                                     *
+               Import declarations
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+tcRnImports :: HscEnv -> Module -> [LImportDecl RdrName] -> TcM TcGblEnv
+tcRnImports hsc_env this_mod import_decls
+  = do { (rn_imports, rdr_env, imports) <- rnImports import_decls ;
+
+       ; let { dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface)
+             ; dep_mods = imp_dep_mods imports
+
+               -- We want instance declarations from all home-package
+               -- modules below this one, including boot modules, except
+               -- ourselves.  The 'except ourselves' is so that we don't
+               -- get the instances from this module's hs-boot file
+             ; want_instances :: ModuleName -> Bool
+             ; want_instances mod = mod `elemUFM` dep_mods
+                                  && mod /= moduleName this_mod
+             ; home_insts = hptInstances hsc_env want_instances
+             } ;
+
+               -- Record boot-file info in the EPS, so that it's 
+               -- visible to loadHiBootInterface in tcRnSrcDecls,
+               -- and any other incrementally-performed imports
+       ; updateEps_ (\eps -> eps { eps_is_boot = dep_mods }) ;
+
+               -- Update the gbl env
+       ; updGblEnv ( \ gbl -> 
+               gbl { tcg_rdr_env    = plusOccEnv (tcg_rdr_env gbl) rdr_env,
+                     tcg_imports    = tcg_imports gbl `plusImportAvails` imports,
+                      tcg_rn_imports = fmap (const rn_imports) (tcg_rn_imports gbl),
+                     tcg_inst_env   = extendInstEnvList (tcg_inst_env gbl) home_insts
+               }) $ do {
+
+       ; traceRn (text "rn1" <+> ppr (imp_dep_mods imports))
+               -- Fail if there are any errors so far
+               -- The error printing (if needed) takes advantage 
+               -- of the tcg_env we have now set
+--     ; traceIf (text "rdr_env: " <+> ppr rdr_env)
+       ; failIfErrsM
+
+               -- Load any orphan-module and family instance-module
+               -- interfaces, so that their rules and instance decls will be
+               -- found.
+       ; loadOrphanModules (imp_orphs  imports) False
+       ; loadOrphanModules (imp_finsts imports) True 
+
+               -- Check type-familily consistency
+       ; traceRn (text "rn1: checking family instance consistency")
+       ; let { dir_imp_mods = map (\ (mod, _, _) -> mod) 
+                            . moduleEnvElts 
+                            . imp_mods 
+                            $ imports }
+       ; checkFamInstConsistency (imp_finsts imports) dir_imp_mods ;
+
+       ; getGblEnv } }
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
        Type-checking external-core modules
 %*                                                                     *
 %************************************************************************
@@ -258,7 +265,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
        -- The decls are IfaceDecls; all names are original names
  = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
 
-   initTc hsc_env ExtCoreFile this_mod $ do {
+   initTc hsc_env ExtCoreFile False this_mod $ do {
 
    let { ldecls  = map noLoc decls } ;
 
@@ -301,6 +308,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
                                mg_types     = final_type_env,
                                mg_insts     = tcg_insts tcg_env,
                                mg_fam_insts = tcg_fam_insts tcg_env,
+                               mg_fam_inst_env = tcg_fam_inst_env tcg_env,
                                mg_rules     = [],
                                mg_binds     = core_binds,
 
@@ -309,7 +317,8 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
                                mg_fix_env   = emptyFixityEnv,
                                mg_deprecs   = NoDeprecs,
                                mg_foreign   = NoStubs,
-                               mg_hpc_info  = noHpcInfo
+                               mg_hpc_info  = noHpcInfo,
+                                mg_dbg_sites = noDbgSites
                    } } ;
 
    tcCoreDump mod_guts ;
@@ -329,18 +338,11 @@ mkFakeGroup decls -- Rather clumsy; lots of unused fields
 %************************************************************************
 
 \begin{code}
-tcRnSrcDecls :: [LHsDecl RdrName] -> TcM TcGblEnv
+tcRnSrcDecls :: ModDetails -> [LHsDecl RdrName] -> TcM TcGblEnv
        -- Returns the variables free in the decls
        -- Reason: solely to report unused imports and bindings
-tcRnSrcDecls decls
- = do {        -- Load the hi-boot interface for this module, if any
-               -- We do this now so that the boot_names can be passed
-               -- to tcTyAndClassDecls, because the boot_names are 
-               -- automatically considered to be loop breakers
-       mod <- getModule ;
-       boot_iface <- tcHiBootIface mod ;
-
-               -- Do all the declarations
+tcRnSrcDecls boot_iface decls
+ = do {        -- Do all the declarations
        (tc_envs, lie) <- getLIE $ tc_rn_src_decls boot_iface decls ;
 
             --         Finish simplifying class constraints
@@ -376,13 +378,7 @@ tcRnSrcDecls decls
                                   tcg_rules = rules', 
                                   tcg_fords = fords' } } ;
 
-       -- Make the new type env available to stuff slurped from interface files
-       writeMutVar (tcg_type_env_var tcg_env) final_type_env ;
-
-       -- Compare the hi-boot iface (if any) with the real thing
-       dfun_binds <- checkHiBootIface tcg_env' boot_iface ;
-
-       return (tcg_env' { tcg_binds = tcg_binds tcg_env' `unionBags` dfun_binds }) 
+       return (tcg_env' { tcg_binds = tcg_binds tcg_env' }) 
    }
 
 tc_rn_src_decls :: ModDetails -> [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv)
@@ -394,15 +390,16 @@ tc_rn_src_decls boot_details ds
 
        -- Deal with decls up to, but not including, the first splice
        (tcg_env, rn_decls) <- checkNoErrs $ rnTopSrcDecls first_group ;
-               -- checkNoErrs: don't typecheck if renaming failed
-       tc_envs <- setGblEnv tcg_env $ 
-                  tcTopSrcDecls boot_details rn_decls ;
+               -- checkNoErrs: stop if renaming fails
+
+       (tcg_env, tcl_env) <- setGblEnv tcg_env $ 
+                             tcTopSrcDecls boot_details rn_decls ;
 
        -- If there is no splice, we're nearly done
-       setEnvs tc_envs $ 
+       setEnvs (tcg_env, tcl_env) $ 
        case group_tail of {
           Nothing -> do { tcg_env <- checkMain ;       -- Check for `main'
-                          return (tcg_env, snd tc_envs) 
+                          return (tcg_env, tcl_env) 
                      } ;
 
        -- If there's a splice, we must carry on
@@ -456,7 +453,7 @@ tcRnHsBootDecls decls
 
                -- Typecheck instance decls
        ; traceTc (text "Tc3")
-       ; (tcg_env, inst_infos, _binds) 
+       ; (tcg_env, inst_infos, _deriv_binds) 
             <- tcInstDecls1 tycl_decls (hs_instds rn_group) (hs_derivds rn_group)
        ; setGblEnv tcg_env     $ do {
 
@@ -487,7 +484,7 @@ Once we've typechecked the body of the module, we want to compare what
 we've found (gathered in a TypeEnv) with the hi-boot details (if any).
 
 \begin{code}
-checkHiBootIface :: TcGblEnv -> ModDetails -> TcM (LHsBinds Id)
+checkHiBootIface :: TcGblEnv -> ModDetails -> TcM TcGblEnv
 -- Compare the hi-boot file for this module (if there is one)
 -- with the type environment we've just come up with
 -- In the common case where there is no hi-boot file, the list
@@ -497,62 +494,105 @@ checkHiBootIface :: TcGblEnv -> ModDetails -> TcM (LHsBinds Id)
 -- hs-boot file, such as       $fbEqT = $fEqT
 
 checkHiBootIface
-       (TcGblEnv { tcg_insts = local_insts, tcg_fam_insts = local_fam_insts,
-                   tcg_type_env = local_type_env })
+       tcg_env@(TcGblEnv { tcg_src = hs_src, tcg_binds = binds,
+                           tcg_insts = local_insts, tcg_fam_insts = local_fam_insts,
+                           tcg_type_env = local_type_env, tcg_exports = local_exports })
        (ModDetails { md_insts = boot_insts, md_fam_insts = boot_fam_insts,
-                     md_types = boot_type_env })
-  = do { traceTc (text "checkHiBootIface" <+> (ppr boot_type_env $$ ppr boot_insts)) ;
-       ; mapM_ check_one (typeEnvElts boot_type_env)
-       ; dfun_binds <- mapM check_inst boot_insts
+                     md_types = boot_type_env, md_exports = boot_exports })
+  | isHsBoot hs_src    -- Current module is already a hs-boot file!
+  = return tcg_env     
+
+  | otherwise
+  = do { traceTc (text "checkHiBootIface" <+> (ppr boot_type_env $$ ppr boot_insts $$ 
+                               ppr boot_exports)) ;
+
+               -- Check the exports of the boot module, one by one
+       ; mapM_ check_export boot_exports
+
+               -- Check instance declarations
+       ; mb_dfun_prs <- mapM check_inst boot_insts
+       ; let tcg_env' = tcg_env { tcg_binds    = binds `unionBags` dfun_binds,
+                                  tcg_type_env = extendTypeEnvWithIds local_type_env boot_dfuns }
+             dfun_prs   = catMaybes mb_dfun_prs
+             boot_dfuns = map fst dfun_prs
+             dfun_binds = listToBag [ noLoc $ VarBind boot_dfun (nlHsVar dfun)
+                                    | (boot_dfun, dfun) <- dfun_prs ]
+
+               -- Check for no family instances
        ; unless (null boot_fam_insts) $
            panic ("TcRnDriver.checkHiBootIface: Cannot handle family " ++
                   "instances in boot files yet...")
             -- FIXME: Why?  The actual comparison is not hard, but what would
             --       be the equivalent to the dfun bindings returned for class
             --       instances?  We can't easily equate tycons...
-       ; return (unionManyBags dfun_binds) }
+
+       ; return tcg_env' }
   where
-    check_one boot_thing
-      | isImplicitTyThing boot_thing = return ()
-      | name `elem` dfun_names       = return ()       
-      | isWiredInName name          = return ()        -- No checking for wired-in names.  In particular,
-                                                       -- 'error' is handled by a rather gross hack
-                                                       -- (see comments in GHC.Err.hs-boot)
+    check_export boot_avail    -- boot_avail is exported by the boot iface
+      | name `elem` dfun_names = return ()     
+      | isWiredInName name     = return ()     -- No checking for wired-in names.  In particular,
+                                               -- 'error' is handled by a rather gross hack
+                                               -- (see comments in GHC.Err.hs-boot)
+
+       -- Check that the actual module exports the same thing
+      | not (null missing_names)
+      = addErrTc (missingBootThing (head missing_names) "exported by")
+
+       -- If the boot module does not *define* the thing, we are done
+       -- (it simply re-exports it, and names match, so nothing further to do)
+      | isNothing mb_boot_thing = return ()
+
+       -- Check that the actual module also defines the thing, and 
+       -- then compare the definitions
       | Just real_thing <- lookupTypeEnv local_type_env name
-      = do { let boot_decl = tyThingToIfaceDecl boot_thing
+      = do { let boot_decl = tyThingToIfaceDecl (fromJust mb_boot_thing)
                 real_decl = tyThingToIfaceDecl real_thing
           ; checkTc (checkBootDecl boot_decl real_decl)
-                    (bootMisMatch boot_thing boot_decl real_decl) }
+                    (bootMisMatch real_thing boot_decl real_decl) }
                -- The easiest way to check compatibility is to convert to
                -- iface syntax, where we already have good comparison functions
+
       | otherwise
-      = addErrTc (missingBootThing boot_thing)
+      = addErrTc (missingBootThing name "defined in")
       where
-       name = getName boot_thing
-
+       name          = availName boot_avail
+       mb_boot_thing = lookupTypeEnv boot_type_env name
+       missing_names = case lookupNameEnv local_export_env name of
+                         Nothing    -> [name]
+                         Just avail -> availNames boot_avail `minusList` availNames avail
+                
     dfun_names = map getName boot_insts
 
+    local_export_env :: NameEnv AvailInfo
+    local_export_env = availsToNameEnv local_exports
+
+    check_inst :: Instance -> TcM (Maybe (Id, Id))
+       -- Returns a pair of the boot dfun in terms of the equivalent real dfun
     check_inst boot_inst
        = case [dfun | inst <- local_insts, 
                       let dfun = instanceDFunId inst,
                       idType dfun `tcEqType` boot_inst_ty ] of
-           [] -> do { addErrTc (instMisMatch boot_inst); return emptyBag }
-           (dfun:_) -> return (unitBag $ noLoc $ VarBind local_boot_dfun (nlHsVar dfun))
+           [] -> do { addErrTc (instMisMatch boot_inst); return Nothing }
+           (dfun:_) -> return (Just (local_boot_dfun, dfun))
        where
          boot_dfun = instanceDFunId boot_inst
          boot_inst_ty = idType boot_dfun
          local_boot_dfun = Id.mkExportedLocalId (idName boot_dfun) boot_inst_ty
 
+
 ----------------
-missingBootThing thing
-  = ppr thing <+> ptext SLIT("is defined in the hs-boot file, but not in the module")
+missingBootThing thing what
+  = ppr thing <+> ptext SLIT("is exported by the hs-boot file, but not") 
+             <+> text what <+> ptext SLIT("the module")
+
 bootMisMatch thing boot_decl real_decl
   = vcat [ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file"),
-         ptext SLIT("Decl") <+> ppr real_decl,
-         ptext SLIT("Boot file:") <+> ppr boot_decl]
+         ptext SLIT("Main module:") <+> ppr real_decl,
+         ptext SLIT("Boot file:  ") <+> ppr boot_decl]
+
 instMisMatch inst
   = hang (ppr inst)
-       2 (ptext SLIT("is defined in the hs-boot file, but not in the module"))
+       2 (ptext SLIT("is defined in the hs-boot file, but not in the module itself"))
 \end{code}
 
 
@@ -688,19 +728,18 @@ tcTopSrcDecls boot_details
 checkMain :: TcM TcGblEnv
 -- If we are in module Main, check that 'main' is defined.
 checkMain 
-  = do { ghc_mode <- getGhcMode ;
-        tcg_env   <- getGblEnv ;
+  = do { tcg_env   <- getGblEnv ;
         dflags    <- getDOpts ;
         let { main_mod = mainModIs dflags ;
               main_fn  = case mainFunIs dflags of {
                                Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn)) ;
                                Nothing -> main_RDR_Unqual } } ;
        
-        check_main ghc_mode tcg_env main_mod main_fn
+        check_main dflags tcg_env main_mod main_fn
     }
 
 
-check_main ghc_mode tcg_env main_mod main_fn
+check_main dflags tcg_env main_mod main_fn
  | mod /= main_mod
  = traceTc (text "checkMain not" <+> ppr main_mod <+> ppr mod) >>
    return tcg_env
@@ -722,18 +761,7 @@ check_main ghc_mode tcg_env main_mod main_fn
        ; (main_expr, ty) <- setSrcSpan (srcLocSpan (getSrcLoc main_name)) $
                             tcInferRho rhs
 
-       -- The function that the RTS invokes is always :Main.main,
-       -- which we call root_main_id.  
-       -- (Because GHC allows the user to have a module not called 
-       -- Main as the main module, we can't rely on the main function
-       -- being called "Main.main".  That's why root_main_id has a fixed
-       -- module ":Main".)
-       -- We also make root_main_id an implicit Id, by making main_name
-       -- its parent (hence (Just main_name)).  That has the effect
-       -- of preventing its type and unfolding from getting out into
-       -- the interface file. Otherwise we can end up with two defns
-       -- for 'main' in the interface file!
-
+               -- See Note [Root-main Id]
        ; let { root_main_name =  mkExternalName rootMainKey rOOT_MAIN 
                                   (mkVarOccFS FSLIT("main")) 
                                   (getSrcLoc main_name)
@@ -751,8 +779,8 @@ check_main ghc_mode tcg_env main_mod main_fn
   where
     mod = tcg_mod tcg_env
  
-    complain_no_main | ghc_mode == Interactive = return ()
-                    | otherwise                = failWithTc noMainMsg
+    complain_no_main | ghcLink dflags == LinkInMemory = return ()
+                    | otherwise = failWithTc noMainMsg
        -- In interactive mode, don't worry about the absence of 'main'
        -- In other modes, fail altogether, so that we don't go on
        -- and complain a second time when processing the export list.
@@ -762,6 +790,19 @@ check_main ghc_mode tcg_env main_mod main_fn
                <+> ptext SLIT("is not defined in module") <+> quotes (ppr main_mod)
 \end{code}
 
+Note [Root-main Id]
+~~~~~~~~~~~~~~~~~~~
+The function that the RTS invokes is always :Main.main, which we call
+root_main_id.  (Because GHC allows the user to have a module not
+called Main as the main module, we can't rely on the main function
+being called "Main.main".  That's why root_main_id has a fixed module
+":Main".)  
+
+This is unusual: it's a LocalId whose Name has a Module from another
+module.  Tiresomely, we must filter it out again in MkIface, les we
+get two defns for 'main' in the interface file!
+
+
 %*********************************************************
 %*                                                      *
                GHCi stuff
@@ -1090,19 +1131,32 @@ tcRnType hsc_env ictxt rdr_type
 -- could not be found.
 getModuleExports :: HscEnv -> Module -> IO (Messages, Maybe [AvailInfo])
 getModuleExports hsc_env mod
-  = initTc hsc_env HsSrcFile iNTERACTIVE (tcGetModuleExports mod)
-
-tcGetModuleExports :: Module -> TcM [AvailInfo]
-tcGetModuleExports mod = do
-  let doc = ptext SLIT("context for compiling statements")
-  iface <- initIfaceTcRn $ loadSysInterface doc mod
-  loadOrphanModules (dep_orphs (mi_deps iface)) False 
-               -- Load any orphan-module interfaces,
-               -- so their instances are visible
-  loadOrphanModules (dep_finsts (mi_deps iface)) True
-               -- Load any family instance-module interfaces,
-               -- so all family instances are visible
-  ifaceExportNames (mi_exports iface)
+  = let
+      ic        = hsc_IC hsc_env
+      checkMods = ic_toplev_scope ic ++ ic_exports ic
+    in
+    initTc hsc_env HsSrcFile False iNTERACTIVE (tcGetModuleExports mod checkMods)
+
+-- Get the export avail info and also load all orphan and family-instance
+-- modules.  Finally, check that the family instances of all modules in the
+-- interactive context are consistent (these modules are in the second
+-- argument).
+tcGetModuleExports :: Module -> [Module] -> TcM [AvailInfo]
+tcGetModuleExports mod directlyImpMods
+  = do { let doc = ptext SLIT("context for compiling statements")
+       ; iface <- initIfaceTcRn $ loadSysInterface doc mod
+
+               -- Load any orphan-module and family instance-module
+               -- interfaces, so their instances are visible.
+       ; loadOrphanModules (dep_orphs (mi_deps iface)) False 
+       ; loadOrphanModules (dep_finsts (mi_deps iface)) True
+
+                -- Check that the family instances of all directly loaded
+                -- modules are consistent.
+       ; checkFamInstConsistency (dep_finsts (mi_deps iface)) directlyImpMods
+
+       ; ifaceExportNames (mi_exports iface)
+       }
 
 tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Maybe [Name])
 tcRnLookupRdrName hsc_env rdr_name