Add hook to fam inst consistency check to GHCi/--make
[ghc.git] / compiler / typecheck / TcRnDriver.lhs
index a7e7335..9c9c71f 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,113 +26,75 @@ 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 )
-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 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 IfaceSyn                ( checkBootDecl, tyThingToIfaceDecl, 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 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 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 Outputable
+import Breakpoints
 
 #ifdef GHCI
-import HsSyn           ( HsStmtContext(..), Stmt(..), HsExpr(..), 
-                         HsLocalBinds(..), HsValBinds(..),
-                         LStmt, LHsExpr, LHsType, mkMatch, emptyLocalBinds,
-                         collectLStmtsBinders, collectLStmtBinders, nlVarPat,
-                         mkFunBind, placeHolderType, noSyntaxExpr )
-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 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            ( 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
+import Data.Maybe
 #endif
 
-import FastString      ( mkFastString )
-import Util            ( sortLe )
-import Bag             ( unionBags, snocBag, emptyBag, unitBag, unionManyBags )
+import FastString
+import Util
+import Bag
 
+import Control.Monad    ( unless )
 import Data.Maybe      ( isJust )
 \end{code}
 
@@ -152,7 +116,7 @@ tcRnModule :: HscEnv
 
 tcRnModule hsc_env hsc_src save_rn_syntax
         (L loc (HsModule maybe_mod export_ies 
-                         import_decls local_decls mod_deprec))
+                         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) ;
@@ -165,8 +129,7 @@ tcRnModule hsc_env hsc_src save_rn_syntax
    setSrcSpan loc $
    do {
                -- Deal with imports;
-       rn_imports <- rnImports import_decls ;
-        (rdr_env, imports) <- mkRdrEnvAndImports rn_imports ;
+       (rn_imports, rdr_env, imports) <- rnImports import_decls ;
 
        let { dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface)
            ; dep_mods = imp_dep_mods imports
@@ -205,11 +168,21 @@ tcRnModule hsc_env hsc_src save_rn_syntax
                -- 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 interfaces, so that
-               -- their rules and instance decls will be found
-       loadOrphanModules (imp_orphs imports) ;
+               -- 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  ;
+
+       traceRn (text "rn1: checking family instance consistency") ;
+       let { directlyImpMods =   map (\(mod, _, _) -> mod) 
+                               . moduleEnvElts 
+                               . imp_mods 
+                               $ imports } ;
+       checkFamInstConsistency (imp_finsts imports) directlyImpMods ;
 
        traceRn (text "rn1a") ;
                -- Rename and type check the declarations
@@ -219,6 +192,8 @@ tcRnModule hsc_env hsc_src save_rn_syntax
                        tcRnSrcDecls 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
@@ -229,9 +204,16 @@ tcRnModule hsc_env hsc_src save_rn_syntax
        reportDeprecations (hsc_dflags hsc_env) tcg_env ;
 
                -- Process the export list
-       rn_exports <- rnExports export_ies ;
-        let { liftM2' fn a b = do a' <- a; b' <- b; return (fn a' b') } ;
-        exports <- mkExportNameSet (isJust maybe_mod) (liftM2' (,) rn_exports export_ies) ;
+       (rn_exports, exports) <- rnExports (isJust maybe_mod) export_ies ;
+                 
+       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
@@ -242,9 +224,12 @@ tcRnModule hsc_env hsc_src save_rn_syntax
                                      tcg_rn_exports = if save_rn_syntax then
                                                          rn_exports
                                                       else Nothing,
-                                    tcg_dus = tcg_dus tcg_env `plusDU` usesOnly exports,
+                                    tcg_dus = tcg_dus tcg_env `plusDU` usesOnly (availsToNameSet exports),
                                     tcg_deprecs = tcg_deprecs tcg_env `plusDeprecs` 
-                                                  mod_deprecs }
+                                                  mod_deprecs,
+                                    tcg_doc = rn_module_doc, 
+                                    tcg_hmi = rn_module_info
+                                 }
                -- A module deprecation over-rides the earlier ones
             } ;
 
@@ -303,27 +288,30 @@ 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 ;
 
-       mod_guts = ModGuts {    mg_module   = this_mod,
-                               mg_boot     = False,
-                               mg_usages   = [],               -- ToDo: compute usage
-                               mg_dir_imps = [],               -- ??
-                               mg_deps     = noDependencies,   -- ??
-                               mg_exports  = my_exports,
-                               mg_types    = final_type_env,
-                               mg_insts    = tcg_insts tcg_env,
-                               mg_rules    = [],
-                               mg_binds    = core_binds,
+       mod_guts = ModGuts {    mg_module    = this_mod,
+                               mg_boot      = False,
+                               mg_usages    = [],              -- ToDo: compute usage
+                               mg_dir_imps  = [],              -- ??
+                               mg_deps      = noDependencies,  -- ??
+                               mg_exports   = my_exports,
+                               mg_types     = final_type_env,
+                               mg_insts     = tcg_insts tcg_env,
+                               mg_fam_insts = tcg_fam_insts tcg_env,
+                               mg_rules     = [],
+                               mg_binds     = core_binds,
 
                                -- Stubs
-                               mg_rdr_env  = emptyGlobalRdrEnv,
-                               mg_fix_env  = emptyFixityEnv,
-                               mg_deprecs  = NoDeprecs,
-                               mg_foreign  = NoStubs
+                               mg_rdr_env   = emptyGlobalRdrEnv,
+                               mg_fix_env   = emptyFixityEnv,
+                               mg_deprecs   = NoDeprecs,
+                               mg_foreign   = NoStubs,
+                               mg_hpc_info  = noHpcInfo,
+                                mg_dbg_sites = noDbgSites
                    } } ;
 
    tcCoreDump mod_guts ;
@@ -355,30 +343,34 @@ tcRnSrcDecls decls
        boot_iface <- tcHiBootIface mod ;
 
                -- Do all the declarations
-       (tc_envs, lie) <- getLIE (tc_rn_src_decls boot_iface decls) ;
+       (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 } ;
 
-       tcDump tcg_env ;
-       (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,
@@ -402,21 +394,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 ;
-
-       setEnvs tc_envs $
+       -- 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 ;
 
        -- If there is no splice, we're nearly done
+       setEnvs tc_envs $ 
        case group_tail of {
-          Nothing -> do {      -- Last thing: check for `main'
-                          tcg_env <- checkMain ;
-                          return (tcg_env, tcl_env) 
+          Nothing -> do { tcg_env <- checkMain ;       -- Check for `main'
+                          return (tcg_env, snd tc_envs) 
                      } ;
 
        -- If there's a splice, we must carry on
@@ -426,8 +414,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
@@ -437,7 +425,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}
 
 %************************************************************************
@@ -470,7 +458,8 @@ tcRnHsBootDecls decls
 
                -- Typecheck instance decls
        ; traceTc (text "Tc3")
-       ; (tcg_env, inst_infos, _binds) <- tcInstDecls1 tycl_decls (hs_instds rn_group)
+       ; (tcg_env, inst_infos, _binds) 
+            <- tcInstDecls1 tycl_decls (hs_instds rn_group) (hs_derivds rn_group)
        ; setGblEnv tcg_env     $ do {
 
                -- Typecheck value declarations
@@ -483,7 +472,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
@@ -510,19 +499,30 @@ checkHiBootIface :: TcGblEnv -> ModDetails -> TcM (LHsBinds Id)
 -- hs-boot file, such as       $fbEqT = $fEqT
 
 checkHiBootIface
-       (TcGblEnv { tcg_insts = local_insts, tcg_type_env = local_type_env })
-       (ModDetails { md_insts = boot_insts, md_types = boot_type_env })
+       (TcGblEnv { tcg_insts = local_insts, tcg_fam_insts = local_fam_insts,
+                   tcg_type_env = local_type_env })
+       (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
+       ; 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) }
   where
     check_one boot_thing
-      | no_check name
-      = return ()      
+      | 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)
       | 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 boot_thing
+                real_decl = tyThingToIfaceDecl real_thing
           ; checkTc (checkBootDecl boot_decl real_decl)
                     (bootMisMatch boot_thing boot_decl real_decl) }
                -- The easiest way to check compatibility is to convert to
@@ -532,15 +532,6 @@ checkHiBootIface
       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
-
     dfun_names = map getName boot_insts
 
     check_inst boot_inst
@@ -552,13 +543,15 @@ checkHiBootIface
        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")
 bootMisMatch thing boot_decl real_decl
-  = ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file")
+  = 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]
 instMisMatch inst
   = hang (ppr inst)
        2 (ptext SLIT("is defined in the hs-boot file, but not in the module"))
@@ -583,17 +576,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
@@ -625,6 +607,7 @@ tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
 tcTopSrcDecls boot_details
        (HsGroup { hs_tyclds = tycl_decls, 
                   hs_instds = inst_decls,
+                   hs_derivds = deriv_decls,
                   hs_fords  = foreign_decls,
                   hs_defds  = default_decls,
                   hs_ruleds = rule_decls,
@@ -645,7 +628,8 @@ tcTopSrcDecls boot_details
                -- Source-language instances, including derivings,
                -- and import the supporting declarations
         traceTc (text "Tc3") ;
-       (tcg_env, inst_infos, deriv_binds) <- tcInstDecls1 tycl_decls inst_decls ;
+       (tcg_env, inst_infos, deriv_binds) 
+            <- tcInstDecls1 tycl_decls inst_decls deriv_decls;
        setGblEnv tcg_env       $ do {
 
                -- Foreign import declarations next.  No zonking necessary
@@ -754,8 +738,8 @@ check_main ghc_mode tcg_env main_mod main_fn
 
        ; 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 
@@ -856,16 +840,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 }
     } ;
@@ -883,7 +881,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}
@@ -960,15 +958,20 @@ mkPlan stmt@(L loc (BindStmt {}))
   | [L _ v] <- collectLStmtBinders stmt                -- One binder, for a bind stmt 
   = do { let print_v  = L loc $ ExprStmt (nlHsApp (nlHsVar printName) (nlHsVar v))
                                           (HsVar thenIOName) placeHolderType
+
+       ; print_bind_result <- doptM Opt_PrintBindResult
+       ; let print_plan = do
+                 { stuff@([v_id], _) <- tcGhciStmts [stmt, print_v]
+                 ; v_ty <- zonkTcType (idType v_id)
+                 ; ifM (isUnitTy v_ty || not (isTauTy v_ty)) failM
+                 ; return stuff }
+
        -- The plans are:
        --      [stmt; print v]         but not if v::()
        --      [stmt]
-       ; runPlans [do { stuff@([v_id], _) <- tcGhciStmts [stmt, print_v]
-                      ; v_ty <- zonkTcType (idType v_id)
-                      ; ifM (isUnitTy v_ty || not (isTauTy v_ty)) failM
-                      ; return stuff },
-                   tcGhciStmts [stmt]
-         ]}
+       ; runPlans ((if print_bind_result then [print_plan] else []) ++
+                   [tcGhciStmts [stmt]])
+       }
 
 mkPlan stmt
   = tcGhciStmts [stmt]
@@ -982,6 +985,8 @@ tcGhciStmts stmts
            io_ty     = mkTyConApp ioTyCon [] ;
            ret_ty    = mkListTy unitTy ;
            io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
+           tc_io_stmts stmts = tcStmts DoExpr (tcDoStmt io_ty) stmts 
+                                       (emptyRefinement, io_ret_ty) ;
 
            names = map unLoc (collectLStmtsBinders stmts) ;
 
@@ -996,17 +1001,16 @@ tcGhciStmts stmts
                -- then the type checker would instantiate x..z, and we wouldn't
                -- get their *polymorphic* values.  (And we'd get ambiguity errs
                -- if they were overloaded, since they aren't applied to anything.)
-           mk_return ids = nlHsApp (noLoc $ TyApp (nlHsVar ret_id) [ret_ty]) 
+           mk_return ids = nlHsApp (nlHsTyApp ret_id [ret_ty]) 
                                    (noLoc $ ExplicitList unitTy (map mk_item ids)) ;
-           mk_item id = nlHsApp (noLoc $ TyApp (nlHsVar unsafeCoerceId) [idType id, unitTy])
+           mk_item id = nlHsApp (nlHsTyApp unsafeCoerceId [idType id, unitTy])
                                 (nlHsVar id) 
         } ;
 
        -- OK, we're ready to typecheck the stmts
        traceTc (text "tcs 2") ;
-       ((tc_stmts, ids), lie) <- getLIE $ 
-                                 tcStmts DoExpr (tcDoStmt io_ty) stmts io_ret_ty $ \ _ ->
-                                 mappM tcLookupId names ;
+       ((tc_stmts, ids), lie) <- getLIE $ tc_io_stmts stmts $ \ _ ->
+                                          mappM tcLookupId names ;
                                        -- Look up the names right in the middle,
                                        -- where they will all be in scope
 
@@ -1037,12 +1041,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
     }
@@ -1087,18 +1090,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 iNTERACTIVE (tcGetModuleExports mod checkMods)
 
-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)
+-- 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 
@@ -1135,6 +1154,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
@@ -1170,7 +1195,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!
@@ -1263,12 +1287,15 @@ tcCoreDump mod_guts
 
 -- It's unpleasant having both pprModGuts and pprModDetails here
 pprTcGblEnv :: TcGblEnv -> SDoc
-pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, 
-                       tcg_insts    = dfun_ids, 
-                       tcg_rules    = rules,
-                       tcg_imports  = imports })
-  = vcat [ ppr_types dfun_ids type_env
-        , ppr_insts dfun_ids
+pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env, 
+                       tcg_insts     = insts, 
+                       tcg_fam_insts = fam_insts, 
+                       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)
         , ppr_gen_tycons (typeEnvTyCons type_env)
         , ptext SLIT("Dependent modules:") <+> ppr (eltsUFM (imp_dep_mods imports))
@@ -1280,12 +1307,11 @@ pprModGuts (ModGuts { mg_types = type_env,
   = vcat [ ppr_types [] type_env,
           ppr_rules rules ]
 
-
 ppr_types :: [Instance] -> TypeEnv -> SDoc
-ppr_types ispecs type_env
+ppr_types insts type_env
   = text "TYPE SIGNATURES" $$ nest 4 (ppr_sigs ids)
   where
-    dfun_ids = map instanceDFunId ispecs
+    dfun_ids = map instanceDFunId insts
     ids = [id | id <- typeEnvIds type_env, want_sig id]
     want_sig id | opt_PprStyle_Debug = True
                | otherwise          = isLocalId id && 
@@ -1296,10 +1322,26 @@ ppr_types ispecs 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)
 
+ppr_fam_insts :: [FamInst] -> SDoc
+ppr_fam_insts []        = empty
+ppr_fam_insts fam_insts = 
+  text "FAMILY INSTANCES" $$ nest 2 (pprFamInsts fam_insts)
+
 ppr_sigs :: [Var] -> SDoc
 ppr_sigs ids
        -- Print type signatures; sort by OccName 
@@ -1308,6 +1350,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"),