Rationalise GhcMode, HscTarget and GhcLink
[ghc.git] / compiler / typecheck / TcRnDriver.lhs
index 8f11232..e26c50b 100644 (file)
@@ -1,4 +1,5 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \section[TcModule]{Typechecking a whole module}
@@ -11,6 +12,7 @@ module TcRnDriver (
        tcRnLookupName,
        tcRnGetInfo,
        getModuleExports, 
+        tcRnRecoverDataCon,
 #endif
        tcRnModule, 
        tcTopSrcDecls,
@@ -24,120 +26,77 @@ import IO
 import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
 #endif
 
-import DynFlags                ( DynFlag(..), DynFlags(..), dopt, GhcMode(..) )
-import StaticFlags     ( opt_PprStyle_Debug )
-import HsSyn           ( HsModule(..), HsExtCore(..), HsGroup(..), LHsDecl,
-                         SpliceDecl(..), HsBind(..), LHsBinds,
-                         emptyRdrGroup, emptyRnGroup, appendGroups, plusHsValBinds,
-                         nlHsApp, nlHsVar, pprLHsBinds, HaddockModInfo(..) )
-import RdrHsSyn                ( findSplice )
-
-import PrelNames       ( runMainIOName, rootMainKey, rOOT_MAIN, mAIN,
-                         main_RDR_Unqual )
-import RdrName         ( RdrName, mkRdrUnqual, emptyGlobalRdrEnv )
-import TcHsSyn         ( zonkTopDecls )
-import TcExpr          ( tcInferRho )
+import DynFlags
+import StaticFlags
+import HsSyn
+import RdrHsSyn
+
+import PrelNames
+import RdrName
+import TcHsSyn
+import TcExpr
 import TcRnMonad
-import TcType          ( tidyTopType, tcEqType )
-import Inst            ( showLIE )
-import InstEnv         ( extendInstEnvList, Instance, pprInstances,
-                         instanceDFunId ) 
-import FamInstEnv       ( FamInst, pprFamInsts )
-import TcBinds         ( tcTopBinds, tcHsBootSigs )
-import TcDefaults      ( tcDefaults )
-import TcEnv           ( tcExtendGlobalValEnv, iDFunId )
-import TcRules         ( tcRules )
-import TcForeign       ( tcForeignImports, tcForeignExports )
-import TcInstDcls      ( tcInstDecls1, tcInstDecls2 )
-import TcIface         ( tcExtCoreBindings, tcHiBootIface )
-import MkIface         ( tyThingToIfaceDecl )
-import IfaceSyn                ( checkBootDecl, IfaceExtName(..) )
-import TcSimplify      ( tcSimplifyTop )
-import TcTyClsDecls    ( tcTyAndClassDecls )
-import LoadIface       ( loadOrphanModules )
-import RnNames         ( importsFromLocalDecls, rnImports, rnExports,
-                          mkRdrEnvAndImports, mkExportNameSet,
-                         reportUnusedNames, reportDeprecations )
-import RnEnv           ( lookupSrcOcc_maybe )
-import RnSource                ( rnSrcDecls, rnTyClDecls, checkModDeprec )
-import RnHsDoc          ( rnMbHsDoc )
-import PprCore         ( pprRules, pprCoreBindings )
-import CoreSyn         ( CoreRule, bindersOfBinds )
-import ErrUtils                ( Messages, mkDumpDoc, showPass )
-import Id              ( Id, mkExportedLocalId, isLocalId, idName, idType )
-import Var             ( Var )
+import TcType
+import Inst
+import FamInst
+import InstEnv
+import FamInstEnv
+import TcBinds
+import TcDefaults
+import TcEnv
+import TcRules
+import TcForeign
+import TcInstDcls
+import TcIface
+import MkIface
+import IfaceSyn
+import TcSimplify
+import TcTyClsDecls
+import LoadIface
+import RnNames
+import RnEnv
+import RnSource
+import RnHsDoc
+import PprCore
+import CoreSyn
+import ErrUtils
+import Id
+import Var
 import Module
-import UniqFM          ( elemUFM, eltsUFM )
-import OccName         ( mkVarOccFS, plusOccEnv )
-import Name            ( Name, NamedThing(..), isExternalName, getSrcLoc, isWiredInName,
-                         nameModule, nameOccName, isImplicitName, mkExternalName )
+import UniqFM
+import Name
+import NameEnv
 import NameSet
-import TyCon           ( tyConHasGenerics )
-import SrcLoc          ( srcLocSpan, Located(..), noLoc )
-import DriverPhases    ( HscSource(..), isHsBoot )
-import HscTypes                ( ModGuts(..), ModDetails(..), emptyModDetails,
-                         HscEnv(..), ExternalPackageState(..),
-                         IsBootInterface, noDependencies, 
-                         Deprecs( NoDeprecs ), plusDeprecs,
-                         ForeignStubs(NoStubs), 
-                         TypeEnv, lookupTypeEnv, hptInstances, 
-                         extendTypeEnvWithIds, typeEnvIds, typeEnvTyCons, typeEnvElts,
-                         emptyFixityEnv
-                       )
+import TyCon
+import SrcLoc
+import HscTypes
+import ListSetOps
 import Outputable
+import Breakpoints
 
 #ifdef GHCI
-import HsSyn           ( HsStmtContext(..), Stmt(..), HsExpr(..), 
-                         HsLocalBinds(..), HsValBinds(..),
-                         LStmt, LHsExpr, LHsType, mkMatch, emptyLocalBinds,
-                         collectLStmtsBinders, collectLStmtBinders, nlVarPat,
-                         mkFunBind, placeHolderType, noSyntaxExpr, nlHsTyApp )
-import RdrName         ( GlobalRdrElt(..), globalRdrEnvElts,
-                         unQualOK, lookupLocalRdrEnv, extendLocalRdrEnv )
-import RnSource                ( addTcgDUs )
-import TcHsSyn         ( mkHsDictLet, zonkTopLExpr, zonkTopBndrs )
-import TcHsType                ( kcHsType )
-import TcMType         ( zonkTcType, zonkQuantifiedTyVar )
-import TcMatches       ( tcStmts, tcDoStmt )
-import TcSimplify      ( tcSimplifyInteractive, tcSimplifyInfer )
-import TcGadt          ( emptyRefinement )
-import TcType          ( Type, mkForAllTys, mkFunTys, mkTyConApp, tyVarsOfType, isTauTy,
-                         isUnLiftedType, tyClsNamesOfDFunHead, tyClsNamesOfType, isUnitTy )
-import TcEnv           ( tcLookupTyCon, tcLookupId, tcLookupGlobal )
-import TypeRep         ( TyThing(..) )
-import RnTypes         ( rnLHsType )
-import Inst            ( tcGetInstEnvs )
-import InstEnv         ( classInstances, instEnvElts )
-import RnExpr          ( rnStmts, rnLExpr )
-import LoadIface       ( loadSysInterface )
-import IfaceEnv                ( ifaceExportNames )
-import RnEnv           ( lookupOccRn, dataTcOccs, lookupFixityRn )
-import Id              ( setIdType )
-import MkId            ( unsafeCoerceId )
-import TyCon           ( tyConName )
-import TysWiredIn      ( mkListTy, unitTy )
-import IdInfo          ( GlobalIdDetails(..) )
-import {- Kind parts of -} Type                ( Kind )
-import Var             ( globaliseId )
-import Name            ( isBuiltInSyntax, isInternalName )
-import OccName         ( isTcOcc )
-import NameEnv         ( delListFromNameEnv )
-import PrelNames       ( iNTERACTIVE, ioTyConName, printName, itName, 
-                         bindIOName, thenIOName, returnIOName )
-import HscTypes                ( InteractiveContext(..),
-                         ModIface(..), icPrintUnqual,
-                         Dependencies(..) )
-import BasicTypes      ( Fixity, RecFlag(..) )
-import SrcLoc          ( unLoc )
-import Data.Maybe      ( isNothing )
+import Linker
+import DataCon
+import TcHsType
+import TcMType
+import TcMatches
+import TcGadt
+import RnTypes
+import RnExpr
+import IfaceEnv
+import MkId
+import TysWiredIn
+import IdInfo
+import {- Kind parts of -} Type
+import BasicTypes
 #endif
 
-import FastString      ( mkFastString )
-import Util            ( sortLe )
-import Bag             ( unionBags, snocBag, emptyBag, unitBag, unionManyBags )
+import FastString
+import Maybes
+import Util
+import Bag
 
 import Control.Monad    ( unless )
-import Data.Maybe      ( isJust )
 \end{code}
 
 
@@ -158,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) ;
@@ -167,117 +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 <- rnImports import_decls ;
-        (rdr_env, imports) <- mkRdrEnvAndImports rn_imports ;
-
-       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
-       failIfErrsM ;
+   do {                -- Deal with imports;
+       tcg_env <- tcRnImports hsc_env this_mod import_decls ;
+       setGblEnv tcg_env               $ do {
 
-               -- Load any orphan-module interfaces, so that
-               -- their rules and instance decls will be found
-       loadOrphanModules (imp_orphs imports) ;
+               -- 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 {
 
-       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 <- rnExports export_ies ;
-                 
-               -- 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 } } ;
-
-        let { liftM2' fn a b = do a' <- a; b' <- b; return (fn a' b') } ;
-        exports <- mkExportNameSet (isJust maybe_mod) 
-                                  (liftM2' (,) rn_exports export_ies) ;
-
-               -- 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 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
-            } ;
+       tcg_env <- rnExports (isJust maybe_mod) export_ies tcg_env ;
+       traceRn (text "rn4") ;
+
+       -- 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
 %*                                                                     *
 %************************************************************************
@@ -292,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 } ;
 
@@ -321,7 +294,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
        -- Wrap up
    let {
        bndrs      = bindersOfBinds core_binds ;
-       my_exports = mkNameSet (map idName bndrs) ;
+       my_exports = map (Avail . idName) bndrs ;
                -- ToDo: export the data types also?
 
        final_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
@@ -335,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,
 
@@ -342,7 +316,9 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
                                mg_rdr_env   = emptyGlobalRdrEnv,
                                mg_fix_env   = emptyFixityEnv,
                                mg_deprecs   = NoDeprecs,
-                               mg_foreign   = NoStubs
+                               mg_foreign   = NoStubs,
+                               mg_hpc_info  = noHpcInfo,
+                                mg_dbg_sites = noDbgSites
                    } } ;
 
    tcCoreDump mod_guts ;
@@ -362,41 +338,39 @@ 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
-       (tc_envs, lie) <- getLIE (tc_rn_src_decls boot_iface decls) ;
+tcRnSrcDecls boot_iface decls
+ = do {        -- Do all the declarations
+       (tc_envs, lie) <- getLIE $ tc_rn_src_decls boot_iface decls ;
 
+            --         Finish simplifying class constraints
+            -- 
             -- tcSimplifyTop deals with constant or ambiguous InstIds.  
             -- How could there be ambiguous ones?  They can only arise if a
-            -- top-level decl falls under the monomorphism
-            -- restriction, and no subsequent decl instantiates its
-            -- type.  (Usually, ambiguous type variables are resolved
-            -- during the generalisation step.)
+            -- top-level decl falls under the monomorphism restriction
+            -- and no subsequent decl instantiates its type.
+            --
+            -- We do this after checkMain, so that we use the type info 
+            -- thaat checkMain adds
+            -- 
+            -- We do it with both global and local env in scope:
+            --  * the global env exposes the instances to tcSimplifyTop
+            --  * the local env exposes the local Ids to tcSimplifyTop, 
+            --    so that we get better error messages (monomorphism restriction)
         traceTc (text "Tc8") ;
        inst_binds <- setEnvs tc_envs (tcSimplifyTop lie) ;
-               -- Setting the global env exposes the instances to tcSimplifyTop
-               -- Setting the local env exposes the local Ids to tcSimplifyTop, 
-               -- so that we get better error messages (monomorphism restriction)
 
            -- Backsubstitution.  This must be done last.
            -- Even tcSimplifyTop may do some unification.
         traceTc (text "Tc9") ;
-       let { (tcg_env, _) = tc_envs ;
-             TcGblEnv { tcg_type_env = type_env, tcg_binds = binds, 
-                        tcg_rules = rules, tcg_fords = fords } = tcg_env } ;
+       let { (tcg_env, _) = tc_envs
+           ; TcGblEnv { tcg_type_env = type_env, tcg_binds = binds, 
+                        tcg_rules = rules, tcg_fords = fords } = tcg_env
+           ; all_binds = binds `unionBags` inst_binds } ;
 
-       (bind_ids, binds', fords', rules') <- zonkTopDecls (binds `unionBags` inst_binds)
-                                                          rules fords ;
+       (bind_ids, binds', fords', rules') <- zonkTopDecls all_binds rules fords ;
 
        let { final_type_env = extendTypeEnvWithIds type_env bind_ids
            ; tcg_env' = tcg_env { tcg_type_env = final_type_env,
@@ -404,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)
@@ -420,20 +388,17 @@ tc_rn_src_decls boot_details ds
  = do { let { (first_group, group_tail) = findSplice ds } ;
                -- If ds is [] we get ([], Nothing)
 
-       -- Type check the decls up to, but not including, the first splice
-       tc_envs@(tcg_env,tcl_env) <- tcRnGroup boot_details first_group ;
-
-       -- Bale out if errors; for example, error recovery when checking
-       -- the RHS of 'main' can mean that 'main' is not in the envt for 
-       -- the subsequent checkMain test
-       failIfErrsM ;
+       -- Deal with decls up to, but not including, the first splice
+       (tcg_env, rn_decls) <- checkNoErrs $ rnTopSrcDecls first_group ;
+               -- checkNoErrs: stop if renaming fails
 
-       setEnvs tc_envs $
+       (tcg_env, tcl_env) <- setGblEnv tcg_env $ 
+                             tcTopSrcDecls boot_details rn_decls ;
 
        -- If there is no splice, we're nearly done
+       setEnvs (tcg_env, tcl_env) $ 
        case group_tail of {
-          Nothing -> do {      -- Last thing: check for `main'
-                          tcg_env <- checkMain ;
+          Nothing -> do { tcg_env <- checkMain ;       -- Check for `main'
                           return (tcg_env, tcl_env) 
                      } ;
 
@@ -444,8 +409,8 @@ tc_rn_src_decls boot_details ds
 #else
 
        -- Rename the splice expression, and get its supporting decls
-       (rn_splice_expr, splice_fvs) <- rnLExpr splice_expr ;
-       failIfErrsM ;   -- Don't typecheck if renaming failed
+       (rn_splice_expr, splice_fvs) <- checkNoErrs (rnLExpr splice_expr) ;
+               -- checkNoErrs: don't typecheck if renaming failed
        rnDump (ppr rn_splice_expr) ;
 
        -- Execute the splice
@@ -455,7 +420,7 @@ tc_rn_src_decls boot_details ds
        setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
        tc_rn_src_decls boot_details (spliced_decls ++ rest_ds)
 #endif /* GHCI */
-    }}}
+    } } }
 \end{code}
 
 %************************************************************************
@@ -488,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 {
 
@@ -502,7 +467,7 @@ tcRnHsBootDecls decls
        ; gbl_env <- getGblEnv 
        
                -- Make the final type-env
-               -- Include the dfun_ids so that their type sigs get
+               -- Include the dfun_ids so that their type sigs
                -- are written into the interface file
        ; let { type_env0 = tcg_type_env gbl_env
              ; type_env1 = extendTypeEnvWithIds type_env0 val_ids
@@ -519,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
@@ -529,68 +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
-      | no_check name
-      = return ()      
+    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 ext_nm boot_thing
-                real_decl = tyThingToIfaceDecl ext_nm real_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
-
-    ext_nm name = ExtPkg (nameModule name) (nameOccName name)
-       -- Just enough to compare; no versions etc needed
-
-    no_check name = isWiredInName name -- No checking for wired-in names.  In particular,
-                                       -- 'error' is handled by a rather gross hack
-                                       -- (see comments in GHC.Err.hs-boot)
-                 || name `elem` dfun_names
-                 || isImplicitName name        -- Has a parent, which we'll check
-
+       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 = mkExportedLocalId (idName boot_dfun) boot_inst_ty
+         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}
 
 
@@ -612,17 +614,6 @@ declarations.  It expects there to be an incoming TcGblEnv in the
 monad; it augments it and returns the new TcGblEnv.
 
 \begin{code}
-tcRnGroup :: ModDetails -> HsGroup RdrName -> TcM (TcGblEnv, TcLclEnv)
-       -- Returns the variables free in the decls, for unused-binding reporting
-tcRnGroup boot_details decls
- = do {                -- Rename the declarations
-       (tcg_env, rn_decls) <- rnTopSrcDecls decls ;
-       setGblEnv tcg_env $ do {
-
-               -- Typecheck the declarations
-       tcTopSrcDecls boot_details rn_decls 
-  }}
-
 ------------------------------------------------
 rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name)
 rnTopSrcDecls group
@@ -737,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
@@ -771,22 +761,11 @@ 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")) 
-                                  (Just main_name) (getSrcLoc main_name)
-             ; root_main_id = mkExportedLocalId root_main_name ty
+                                  (getSrcLoc main_name)
+             ; root_main_id = Id.mkExportedLocalId root_main_name ty
              ; main_bind    = noLoc (VarBind root_main_id main_expr) }
 
        ; return (tcg_env { tcg_binds = tcg_binds tcg_env 
@@ -800,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.
@@ -811,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
@@ -887,16 +879,30 @@ tcRnStmt hsc_env ictxt rdr_stmt
        bound_names = map idName global_ids ;
        new_rn_env  = extendLocalRdrEnv rn_env bound_names ;
 
-               -- Remove any shadowed bindings from the type_env;
-               -- they are inaccessible but might, I suppose, cause 
-               -- a space leak if we leave them there
+{- ---------------------------------------------
+   At one stage I removed any shadowed bindings from the type_env;
+   they are inaccessible but might, I suppose, cause a space leak if we leave them there.
+   However, with Template Haskell they aren't necessarily inaccessible.  Consider this
+   GHCi session
+        Prelude> let f n = n * 2 :: Int
+        Prelude> fName <- runQ [| f |]
+        Prelude> $(return $ AppE fName (LitE (IntegerL 7)))
+        14
+        Prelude> let f n = n * 3 :: Int
+        Prelude> $(return $ AppE fName (LitE (IntegerL 7)))
+   In the last line we use 'fName', which resolves to the *first* 'f'
+   in scope. If we delete it from the type env, GHCi crashes because
+   it doesn't expect that.
+   Hence this code is commented out
+
        shadowed = [ n | name <- bound_names,
                         let rdr_name = mkRdrUnqual (nameOccName name),
                         Just n <- [lookupLocalRdrEnv rn_env rdr_name] ] ;
-
        filtered_type_env = delListFromNameEnv type_env shadowed ;
-       new_type_env = extendTypeEnvWithIds filtered_type_env global_ids ;
+-------------------------------------------------- -}
 
+       new_type_env = extendTypeEnvWithIds type_env global_ids ;
        new_ic = ictxt { ic_rn_local_env = new_rn_env, 
                         ic_type_env     = new_type_env }
     } ;
@@ -914,7 +920,7 @@ tcRnStmt hsc_env ictxt rdr_stmt
 globaliseAndTidy :: Id -> Id
 globaliseAndTidy id
 -- Give the Id a Global Name, and tidy its type
-  = setIdType (globaliseId VanillaGlobal id) tidy_type
+  = Id.setIdType (globaliseId VanillaGlobal id) tidy_type
   where
     tidy_type = tidyTopType (idType id)
 \end{code}
@@ -1074,12 +1080,11 @@ tcRnExpr hsc_env ictxt rdr_expr
        -- Now typecheck the expression; 
        -- it might have a rank-2 type (e.g. :t runST)
     ((tc_expr, res_ty), lie)      <- getLIE (tcInferRho rn_expr) ;
-    ((qtvs, _, dict_ids), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie)  ;
+    ((qtvs, dict_insts, _), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie)  ;
     tcSimplifyInteractive lie_top ;
-    qtvs' <- mappM zonkQuantifiedTyVar qtvs ;
 
-    let { all_expr_ty = mkForAllTys qtvs' $
-                       mkFunTys (map idType dict_ids)  $
+    let { all_expr_ty = mkForAllTys qtvs $
+                       mkFunTys (map (idType . instToId) dict_insts)   $
                        res_ty } ;
     zonkTcType all_expr_ty
     }
@@ -1124,18 +1129,34 @@ tcRnType hsc_env ictxt rdr_type
 -- a package module with an interface on disk.  If neither of these is
 -- true, then the result will be an error indicating the interface
 -- could not be found.
-getModuleExports :: HscEnv -> Module -> IO (Messages, Maybe NameSet)
+getModuleExports :: HscEnv -> Module -> IO (Messages, Maybe [AvailInfo])
 getModuleExports hsc_env mod
-  = initTc hsc_env HsSrcFile iNTERACTIVE (tcGetModuleExports mod)
+  = 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
 
-tcGetModuleExports :: Module -> TcM NameSet
-tcGetModuleExports mod = do
-  let doc = ptext SLIT("context for compiling statements")
-  iface <- initIfaceTcRn $ loadSysInterface doc mod
-  loadOrphanModules (dep_orphs (mi_deps iface))
-               -- Load any orphan-module interfaces,
-               -- so their instances are visible
-  ifaceExportNames (mi_exports iface)
+               -- 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 
@@ -1172,6 +1193,12 @@ lookup_rdr_name rdr_name = do {
     return good_names
  }
 
+tcRnRecoverDataCon :: HscEnv -> a -> IO (Maybe DataCon) 
+tcRnRecoverDataCon hsc_env a
+  = initTcPrintErrors hsc_env iNTERACTIVE $ 
+    setInteractiveContext hsc_env (hsc_IC hsc_env) $
+     do name    <- recoverDataCon a
+        tcLookupDataCon name
 
 tcRnLookupName :: HscEnv -> Name -> IO (Maybe TyThing)
 tcRnLookupName hsc_env name
@@ -1207,7 +1234,6 @@ tcRnGetInfo hsc_env name
     ispecs <- lookupInsts (icPrintUnqual ictxt) thing
     return (thing, fixity, ispecs)
 
-
 lookupInsts :: PrintUnqualified -> TyThing -> TcM [Instance]
 -- Filter the instances by the ones whose tycons (or clases resp) 
 -- are in scope unqualified.  Otherwise we list a whole lot too many!
@@ -1306,6 +1332,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
                        tcg_rules     = rules,
                        tcg_imports   = imports })
   = vcat [ ppr_types insts type_env
+        , ppr_tycons fam_insts type_env
         , ppr_insts insts
         , ppr_fam_insts fam_insts
         , vcat (map ppr rules)
@@ -1334,6 +1361,17 @@ ppr_types insts type_env
        -- that the type checker has invented.  Top-level user-defined things 
        -- have External names.
 
+ppr_tycons :: [FamInst] -> TypeEnv -> SDoc
+ppr_tycons fam_insts type_env
+  = text "TYPE CONSTRUCTORS" $$ nest 4 (ppr_tydecls tycons)
+  where
+    fi_tycons = map famInstTyCon fam_insts
+    tycons = [tycon | tycon <- typeEnvTyCons type_env, want_tycon tycon]
+    want_tycon tycon | opt_PprStyle_Debug = True
+                    | otherwise          = not (isImplicitTyCon tycon) &&
+                                           isExternalName (tyConName tycon) &&
+                                           not (tycon `elem` fi_tycons)
+
 ppr_insts :: [Instance] -> SDoc
 ppr_insts []     = empty
 ppr_insts ispecs = text "INSTANCES" $$ nest 2 (pprInstances ispecs)
@@ -1351,6 +1389,16 @@ ppr_sigs ids
     le_sig id1 id2 = getOccName id1 <= getOccName id2
     ppr_sig id = ppr id <+> dcolon <+> ppr (tidyTopType (idType id))
 
+ppr_tydecls :: [TyCon] -> SDoc
+ppr_tydecls tycons
+       -- Print type constructor info; sort by OccName 
+  = vcat (map ppr_tycon (sortLe le_sig tycons))
+  where
+    le_sig tycon1 tycon2 = getOccName tycon1 <= getOccName tycon2
+    ppr_tycon tycon 
+      | isCoercionTyCon tycon = ptext SLIT("coercion") <+> ppr tycon
+      | otherwise             = ppr (tyThingToIfaceDecl (ATyCon tycon))
+
 ppr_rules :: [CoreRule] -> SDoc
 ppr_rules [] = empty
 ppr_rules rs = vcat [ptext SLIT("{-# RULES"),