remove old .NET related code
[ghc.git] / compiler / typecheck / TcRnDriver.lhs
index db4902b..b628591 100644 (file)
@@ -5,6 +5,8 @@
 \section[TcMovectle]{Typechecking a whole module}
 
 \begin{code}
+{-# LANGUAGE CPP, NondecreasingIndentation #-}
+
 module TcRnDriver (
 #ifdef GHCI
         tcRnStmt, tcRnExpr, tcRnType,
@@ -13,19 +15,19 @@ module TcRnDriver (
         getModuleInterface,
         tcRnDeclsi,
         isGHCiMonad,
+        runTcInteractive,    -- Used by GHC API clients (Trac #8878)
 #endif
         tcRnLookupName,
         tcRnGetInfo,
-        tcRnModule,
-        tcTopSrcDecls,
-        tcRnExtCore
+        tcRnModule, tcRnModuleTcRnM,
+        tcTopSrcDecls
     ) where
 
 #ifdef GHCI
-import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
+import {-# SOURCE #-} TcSplice ( runQuasi )
+import RnSplice ( rnTopSpliceDecls )
 #endif
 
-import TypeRep
 import DynFlags
 import StaticFlags
 import HsSyn
@@ -35,6 +37,7 @@ import TcHsSyn
 import TcExpr
 import TcRnMonad
 import TcEvidence
+import PprTyThing( pprTyThing )
 import Coercion( pprCoAxiom )
 import FamInst
 import InstEnv
@@ -50,17 +53,15 @@ import TcInstDcls
 import TcIface
 import TcMType
 import MkIface
-import IfaceSyn
 import TcSimplify
 import TcTyClsDecls
 import LoadIface
 import RnNames
 import RnEnv
 import RnSource
-import PprCore
-import CoreSyn
 import ErrUtils
 import Id
+import IdInfo( IdDetails( VanillaId ) )
 import VarEnv
 import Module
 import UniqFM
@@ -73,27 +74,27 @@ import SrcLoc
 import HscTypes
 import ListSetOps
 import Outputable
+import ConLike
 import DataCon
 import Type
 import Class
-import CoAxiom  ( CoAxBranch(..) )
-import TcType   ( orphNamesOfDFunHead )
+import CoAxiom
 import Inst     ( tcGetInstEnvs )
+import Annotations
 import Data.List ( sortBy )
-import Data.IORef ( readIORef )
 import Data.Ord
-
 #ifdef GHCI
+import BasicTypes hiding( SuccessFlag(..) )
 import TcType   ( isUnitTy, isTauTy )
 import TcHsType
 import TcMatches
 import RnTypes
 import RnExpr
 import MkId
-import BasicTypes
 import TidyPgm    ( globaliseAndTidyId )
 import TysWiredIn ( unitTy, mkListTy )
 #endif
+import TidyPgm    ( mkBootModDetailsTc )
 
 import FastString
 import Maybes
@@ -121,28 +122,162 @@ tcRnModule :: HscEnv
            -> IO (Messages, Maybe TcGblEnv)
 
 tcRnModule hsc_env hsc_src save_rn_syntax
-   HsParsedModule {
-      hpm_module =
-         (L loc (HsModule maybe_mod export_ies
-                          import_decls local_decls mod_deprec
-                          maybe_doc_hdr)),
-      hpm_src_files =
-         src_files
-   }
+   parsedModule@HsParsedModule {hpm_module=L loc this_module}
  = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
 
-   let { this_pkg = thisPackage (hsc_dflags hsc_env) ;
-         (this_mod, prel_imp_loc)
-            = case maybe_mod of
-                Nothing -- 'module M where' is omitted
-                    ->  (mAIN, srcLocSpan (srcSpanStart loc))
-
-                Just (L mod_loc mod)  -- The normal case
-                    -> (mkModule this_pkg mod, mod_loc) } ;
-
-   initTc hsc_env hsc_src save_rn_syntax this_mod $
-   setSrcSpan loc $
-   do {         -- Deal with imports; first add implicit prelude
+      ; let { this_pkg = thisPackage (hsc_dflags hsc_env)
+            ; pair@(this_mod,_)
+                = case hsmodName this_module of
+                    Nothing -- 'module M where' is omitted
+                        ->  (mAIN, srcLocSpan (srcSpanStart loc))
+
+                    Just (L mod_loc mod)  -- The normal case
+                        -> (mkModule this_pkg mod, mod_loc) } ;
+
+      ; initTc hsc_env hsc_src save_rn_syntax this_mod $
+        tcRnModuleTcRnM hsc_env hsc_src parsedModule pair }
+
+-- To be called at the beginning of renaming hsig files.
+-- If we're processing a signature, load up the RdrEnv
+-- specified by sig-of so that
+-- when we process top-level bindings, we pull in the right
+-- original names.  We also need to add in dependencies from
+-- the implementation (orphans, family instances, packages),
+-- similar to how rnImportDecl handles things.
+-- ToDo: Handle SafeHaskell
+tcRnSignature :: DynFlags -> HscSource -> TcRn TcGblEnv
+tcRnSignature dflags hsc_src
+ = do { tcg_env <- getGblEnv ;
+        case tcg_sig_of tcg_env of {
+          Just sof
+           | hsc_src /= HsigFile -> do
+                { addErr (ptext (sLit "Illegal -sig-of specified for non hsig"))
+                ; return tcg_env
+                }
+           | otherwise -> do
+            { sig_iface <- initIfaceTcRn $ loadSysInterface (text "sig-of") sof
+            ; let { gr = mkGlobalRdrEnv
+                              (gresFromAvails LocalDef (mi_exports sig_iface))
+                  ; avails = calculateAvails dflags
+                                    sig_iface False{- safe -} False{- boot -} }
+            ; return (tcg_env
+                { tcg_impl_rdr_env = Just gr
+                , tcg_imports = tcg_imports tcg_env `plusImportAvails` avails
+                })
+            } ;
+            Nothing
+             | HsigFile <- hsc_src
+             , HscNothing <- hscTarget dflags -> do
+                { return tcg_env
+                }
+             | HsigFile <- hsc_src -> do
+                { addErr (ptext (sLit "Missing -sig-of for hsig"))
+                ; failM }
+             | otherwise -> return tcg_env
+        }
+      }
+
+checkHsigIface :: HscEnv -> TcGblEnv -> TcRn ()
+checkHsigIface hsc_env tcg_env
+  = case tcg_impl_rdr_env tcg_env of
+      Just gr -> do { sig_details <- liftIO $ mkBootModDetailsTc hsc_env tcg_env
+                    ; checkHsigIface' gr sig_details
+                    }
+      Nothing -> return ()
+
+checkHsigIface' :: GlobalRdrEnv -> ModDetails -> TcRn ()
+checkHsigIface' gr
+  ModDetails { md_insts = sig_insts, md_fam_insts = sig_fam_insts,
+               md_types = sig_type_env, md_exports = sig_exports}
+  = do { traceTc "checkHsigIface" $ vcat
+           [ ppr sig_type_env, ppr sig_insts, ppr sig_exports ]
+       ; mapM_ check_export sig_exports
+       ; unless (null sig_fam_insts) $
+           panic ("TcRnDriver.checkHsigIface: Cannot handle family " ++
+                  "instances in hsig files yet...")
+       ; mapM_ check_inst sig_insts
+       ; failIfErrsM
+       }
+  where
+    check_export sig_avail
+      -- Skip instances, we'll check them later
+      | name `elem` dfun_names = return ()
+      | otherwise = do
+        { -- Lookup local environment only (don't want to accidentally pick
+          -- up the backing copy.)  We consult tcg_type_env because we want
+          -- to pick up wired in names too (which get dropped by the iface
+          -- creation process); it's OK for a signature file to mention
+          -- a wired in name.
+          env <- getGblEnv
+        ; case lookupNameEnv (tcg_type_env env) name of
+            Nothing
+                -- All this means is no local definition is available: but we
+                -- could have created the export this way:
+                --
+                -- module ASig(f) where
+                --      import B(f)
+                --
+                -- In this case, we have to just lookup the identifier in
+                -- the backing implementation and make sure it matches.
+                | [GRE { gre_name = name' }]
+                    <- lookupGlobalRdrEnv gr (nameOccName name)
+                , name == name' -> return ()
+                -- TODO: Possibly give a different error if the identifier
+                -- is exported, but it's a different original name
+                | otherwise -> addErrAt (nameSrcSpan name)
+                                (missingBootThing False name "exported by")
+            Just sig_thing -> do {
+          -- We use tcLookupImported_maybe because we want to EXCLUDE
+          -- tcg_env.
+        ; r <- tcLookupImported_maybe name
+        ; case r of
+            Failed err -> addErr err
+            Succeeded real_thing ->
+              when (not (checkBootDecl sig_thing real_thing))
+               $ addErrAt (nameSrcSpan (getName sig_thing))
+                          (bootMisMatch False real_thing sig_thing)
+        }}
+      where
+        name          = availName sig_avail
+
+    dfun_names = map getName sig_insts
+
+    -- In general, for hsig files we can't assume that the implementing
+    -- file actually implemented the instances (they may be reexported
+    -- from elsewhere.  Where should we look for the instances?  We do
+    -- the same as we would otherwise: consult the EPS.  This isn't
+    -- perfect (we might conclude the module exports an instance
+    -- when it doesn't, see #9422), but we will never refuse to compile
+    -- something
+    check_inst :: ClsInst -> TcM ()
+    check_inst sig_inst
+        = do eps <- getEps
+             when (not (memberInstEnv (eps_inst_env eps) sig_inst)) $
+               addErrTc (instMisMatch False sig_inst)
+
+tcRnModuleTcRnM :: HscEnv
+                -> HscSource
+                -> HsParsedModule
+                -> (Module, SrcSpan)
+                -> TcRn TcGblEnv
+-- Factored out separately so that a Core plugin can
+-- call the type checker directly
+tcRnModuleTcRnM hsc_env hsc_src
+                (HsParsedModule {
+                   hpm_module =
+                      (L loc (HsModule maybe_mod export_ies
+                                       import_decls local_decls mod_deprec
+                                       maybe_doc_hdr)),
+                   hpm_src_files = src_files
+                })
+                (this_mod, prel_imp_loc)
+ = setSrcSpan loc $
+   do { let { dflags = hsc_dflags hsc_env } ;
+
+        tcg_env <- tcRnSignature dflags hsc_src ;
+        setGblEnv tcg_env $ do {
+
+        -- Deal with imports; first add implicit prelude
         implicit_prelude <- xoptM Opt_ImplicitPrelude;
         let { prel_imports = mkPrelImports (moduleName this_mod) prel_imp_loc
                                          implicit_prelude import_decls } ;
@@ -151,7 +286,7 @@ tcRnModule hsc_env hsc_src save_rn_syntax
              when (notNull prel_imports) $ addWarn (implicitPreludeWarn) ;
 
         tcg_env <- {-# SCC "tcRnImports" #-}
-                   tcRnImports hsc_env this_mod (prel_imports ++ import_decls) ;
+                   tcRnImports hsc_env (prel_imports ++ import_decls) ;
 
           -- If the whole module is warned about or deprecated 
           -- (via mod_deprec) record that in tcg_warns. If we do thereby add
@@ -175,8 +310,8 @@ tcRnModule hsc_env hsc_src save_rn_syntax
 
                 -- Rename and type check the declarations
         traceRn (text "rn1a") ;
-        tcg_env <- if isHsBoot hsc_src then
-                        tcRnHsBootDecls local_decls
+        tcg_env <- if isHsBootOrSig hsc_src then
+                        tcRnHsBootDecls hsc_src local_decls
                    else
                         {-# SCC "tcRnSrcDecls" #-}
                         tcRnSrcDecls boot_iface local_decls ;
@@ -194,6 +329,21 @@ tcRnModule hsc_env hsc_src save_rn_syntax
         -- Must be done after processing the exports
         tcg_env <- checkHiBootIface tcg_env boot_iface ;
 
+        -- Compare the hsig tcg_env with the real thing
+        checkHsigIface hsc_env tcg_env ;
+
+        -- Nub out type class instances now that we've checked them,
+        -- if we're compiling an hsig with sig-of.
+        -- See Note [Signature files and type class instances]
+        tcg_env <- (case tcg_sig_of tcg_env of
+            Just _ -> return tcg_env {
+                        tcg_inst_env = emptyInstEnv,
+                        tcg_fam_inst_env = emptyFamInstEnv,
+                        tcg_insts = [],
+                        tcg_fam_insts = []
+                        }
+            Nothing -> return tcg_env) ;
+
         -- The new type env is already available to stuff slurped from
         -- interface files, via TcEnv.updateGlobalTypeEnv
         -- It's important that this includes the stuff in checkHiBootIface,
@@ -215,7 +365,6 @@ tcRnModule hsc_env hsc_src save_rn_syntax
         return tcg_env
     }}}}
 
-
 implicitPreludeWarn :: SDoc
 implicitPreludeWarn
   = ptext (sLit "Module `Prelude' implicitly imported")
@@ -229,26 +378,21 @@ implicitPreludeWarn
 %************************************************************************
 
 \begin{code}
-tcRnImports :: HscEnv -> Module
-            -> [LImportDecl RdrName] -> TcM TcGblEnv
-tcRnImports hsc_env this_mod import_decls
-  = do  { (rn_imports, rdr_env, imports,hpc_info) <- rnImports import_decls ;
+tcRnImports :: HscEnv -> [LImportDecl RdrName] -> TcM TcGblEnv
+tcRnImports hsc_env import_decls
+  = do  { (rn_imports, rdr_env, imports, hpc_info) <- rnImports import_decls ;
 
+        ; this_mod <- getModule
         ; let { dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface)
-                -- Make sure we record the dependencies from the DynFlags in the EPS or we
-                -- end up hitting the sanity check in LoadIface.loadInterface that
-                -- checks for unknown home-package modules being loaded. We put
-                -- these dependencies on the left so their (non-source) imports
-                -- take precedence over the (possibly-source) imports on the right.
-                -- We don't add them to any other field (e.g. the imp_dep_mods of
-                -- imports) because we don't want to load their instances etc.
-              ; dep_mods = listToUFM [(mod_nm, (mod_nm, False)) | mod_nm <- dynFlagDependencies (hsc_dflags hsc_env)]
-                                `plusUFM` imp_dep_mods imports
+              ; 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
+                -- get the instances from this module's hs-boot file.  This
+                -- filtering also ensures that we don't see instances from
+                -- modules batch (@--make@) compiled before this one, but
+                -- which are not below this one.
               ; want_instances :: ModuleName -> Bool
               ; want_instances mod = mod `elemUFM` dep_mods
                                    && mod /= moduleName this_mod
@@ -264,7 +408,7 @@ tcRnImports hsc_env this_mod import_decls
                 -- Update the gbl env
         ; updGblEnv ( \ gbl ->
             gbl {
-              tcg_rdr_env      = plusOccEnv (tcg_rdr_env gbl) rdr_env,
+              tcg_rdr_env      = tcg_rdr_env gbl `plusGlobalRdrEnv` rdr_env,
               tcg_imports      = tcg_imports gbl `plusImportAvails` imports,
               tcg_rn_imports   = rn_imports,
               tcg_inst_env     = extendInstEnvList (tcg_inst_env gbl) home_insts,
@@ -299,106 +443,6 @@ tcRnImports hsc_env this_mod import_decls
 
 %************************************************************************
 %*                                                                      *
-        Type-checking external-core modules
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
-tcRnExtCore :: HscEnv
-            -> HsExtCore RdrName
-            -> IO (Messages, Maybe ModGuts)
-        -- Nothing => some error occurred
-
-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 False this_mod $ do {
-
-   let { ldecls  = map noLoc decls } ;
-
-       -- Bring the type and class decls into scope
-       -- ToDo: check that this doesn't need to extract the val binds.
-       --       It seems that only the type and class decls need to be in scope below because
-       --          (a) tcTyAndClassDecls doesn't need the val binds, and
-       --          (b) tcExtCoreBindings doesn't need anything
-       --              (in fact, it might not even need to be in the scope of
-       --               this tcg_env at all)
-   (tc_envs, _bndrs) <- getLocalNonValBinders emptyFsEnv {- no fixity decls -}
-                                              (mkFakeGroup ldecls) ;
-   setEnvs tc_envs $ do {
-
-   (rn_decls, _fvs) <- checkNoErrs $ rnTyClDecls [] [ldecls] ;
-   -- The empty list is for extra dependencies coming from .hs-boot files
-   -- See Note [Extra dependencies from .hs-boot files] in RnSource
-
-        -- Dump trace of renaming part
-   rnDump (ppr rn_decls) ;
-
-        -- Typecheck them all together so that
-        -- any mutually recursive types are done right
-        -- Just discard the auxiliary bindings; they are generated
-        -- only for Haskell source code, and should already be in Core
-   tcg_env   <- tcTyAndClassDecls emptyModDetails rn_decls ;
-   safe_mode <- liftIO $ finalSafeMode (hsc_dflags hsc_env) tcg_env ;
-   dep_files <- liftIO $ readIORef (tcg_dependent_files tcg_env) ;
-
-   setGblEnv tcg_env $ do {
-        -- Make the new type env available to stuff slurped from interface files
-
-        -- Now the core bindings
-   core_binds <- initIfaceExtCore (tcExtCoreBindings src_binds) ;
-
-
-        -- Wrap up
-   let {
-        bndrs      = bindersOfBinds core_binds ;
-        my_exports = map (Avail . idName) bndrs ;
-                -- ToDo: export the data types also?
-
-        mod_guts = ModGuts {    mg_module    = this_mod,
-                                mg_boot      = False,
-                                mg_used_names = emptyNameSet, -- ToDo: compute usage
-                                mg_used_th   = False,
-                                mg_dir_imps  = emptyModuleEnv, -- ??
-                                mg_deps      = noDependencies,  -- ??
-                                mg_exports   = my_exports,
-                                mg_tcs       = tcg_tcs tcg_env,
-                                mg_insts     = tcg_insts tcg_env,
-                                mg_fam_insts = tcg_fam_insts tcg_env,
-                                mg_inst_env  = tcg_inst_env tcg_env,
-                                mg_fam_inst_env = tcg_fam_inst_env tcg_env,
-                                mg_rules        = [],
-                                mg_vect_decls   = [],
-                                mg_anns         = [],
-                                mg_binds        = core_binds,
-
-                                -- Stubs
-                                mg_rdr_env      = emptyGlobalRdrEnv,
-                                mg_fix_env      = emptyFixityEnv,
-                                mg_warns        = NoWarnings,
-                                mg_foreign      = NoStubs,
-                                mg_hpc_info     = emptyHpcInfo False,
-                                mg_modBreaks    = emptyModBreaks,
-                                mg_vect_info    = noVectInfo,
-                                mg_safe_haskell = safe_mode,
-                                mg_trust_pkg    = False,
-                                mg_dependent_files = dep_files
-                            } } ;
-
-   tcCoreDump mod_guts ;
-
-   return mod_guts
-   }}}}
-
-mkFakeGroup :: [LTyClDecl a] -> HsGroup a
-mkFakeGroup decls -- Rather clumsy; lots of unused fields
-  = emptyRdrGroup { hs_tyclds = [decls] }
-\end{code}
-
-
-%************************************************************************
-%*                                                                      *
         Type-checking the top level of a module
 %*                                                                      *
 %************************************************************************
@@ -462,58 +506,93 @@ tcRnSrcDecls boot_iface decls
                                    tcg_fords    = fords' } } ;
 
         setGlobalTypeEnv tcg_env' final_type_env
+       
    } }
 
 tc_rn_src_decls :: ModDetails
-                    -> [LHsDecl RdrName]
-                    -> TcM (TcGblEnv, TcLclEnv)
+                -> [LHsDecl RdrName]
+                -> TcM (TcGblEnv, TcLclEnv)
 -- Loops around dealing with each top level inter-splice group
 -- in turn, until it's dealt with the entire module
 tc_rn_src_decls boot_details ds
  = {-# SCC "tc_rn_src_decls" #-}
-   do { (first_group, group_tail) <- findSplice ds  ;
+   do { (first_group, group_tail) <- findSplice ds
                 -- If ds is [] we get ([], Nothing)
 
         -- The extra_deps are needed while renaming type and class declarations
         -- See Note [Extra dependencies from .hs-boot files] in RnSource
-        let { extra_deps = map tyConName (typeEnvTyCons (md_types boot_details)) } ;
+      ; let { extra_deps = map tyConName (typeEnvTyCons (md_types boot_details)) }
         -- Deal with decls up to, but not including, the first splice
-        (tcg_env, rn_decls) <- rnTopSrcDecls extra_deps first_group ;
+      ; (tcg_env, rn_decls) <- rnTopSrcDecls extra_deps first_group
                 -- rnTopSrcDecls fails if there are any errors
 
-        (tcg_env, tcl_env) <- setGblEnv tcg_env $
-                              tcTopSrcDecls boot_details rn_decls ;
+#ifdef GHCI
+        -- Get TH-generated top-level declarations and make sure they don't
+        -- contain any splices since we don't handle that at the moment
+      ; th_topdecls_var <- fmap tcg_th_topdecls getGblEnv
+      ; th_ds <- readTcRef th_topdecls_var
+      ; writeTcRef th_topdecls_var []
+
+      ; (tcg_env, rn_decls) <-
+            if null th_ds
+            then return (tcg_env, rn_decls)
+            else do { (th_group, th_group_tail) <- findSplice th_ds
+                    ; case th_group_tail of
+                        { Nothing -> return () ;
+                        ; Just (SpliceDecl (L loc _) _, _)
+                            -> setSrcSpan loc $
+                               addErr (ptext (sLit "Declaration splices are not permitted inside top-level declarations added with addTopDecls"))
+                        } ;
+                                         
+                    -- Rename TH-generated top-level declarations
+                    ; (tcg_env, th_rn_decls) <- setGblEnv tcg_env $
+                      rnTopSrcDecls extra_deps th_group
+
+                    -- Dump generated top-level declarations
+                    ; loc <- getSrcSpanM
+                    ; traceSplice (vcat [ppr loc <> colon <+> text "Splicing top-level declarations added with addTopDecls ",
+                                   nest 2 (nest 2 (ppr th_rn_decls))])
+
+                    ; return (tcg_env, appendGroups rn_decls th_rn_decls)
+                    }
+#endif /* GHCI */
+
+      -- Type check all declarations
+      ; (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 { tcg_env <- checkMain ;       -- Check for `main'
-                           traceTc "returning from tc_rn_src_decls: " $
-                             ppr $ nameEnvElts $ tcg_type_env tcg_env ; -- RAE
-                           return (tcg_env, tcl_env)
-                      } ;
+      ; setEnvs (tcg_env, tcl_env) $
+        case group_tail of
+          { Nothing -> do { tcg_env <- checkMain       -- Check for `main'
+#ifdef GHCI
+                            -- Run all module finalizers
+                          ; th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv
+                          ; modfinalizers <- readTcRef th_modfinalizers_var
+                          ; writeTcRef th_modfinalizers_var []
+                          ; mapM_ runQuasi modfinalizers
+#endif /* GHCI */
+                          ; return (tcg_env, tcl_env)
+                          }
 
 #ifndef GHCI
-        -- There shouldn't be a splice
-           Just (SpliceDecl {}, _) -> do {
-        failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
+            -- There shouldn't be a splice
+          ; Just (SpliceDecl {}, _) ->
+            failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
+          }
 #else
-        -- If there's a splice, we must carry on
-           Just (SpliceDecl splice_expr _, rest_ds) -> do {
-
-        -- Rename the splice expression, and get its supporting decls
-        (rn_splice_expr, splice_fvs) <- checkNoErrs (rnLExpr splice_expr) ;
-                -- checkNoErrs: don't typecheck if renaming failed
-        rnDump (ppr rn_splice_expr) ;
-
-        -- Execute the splice
-        spliced_decls <- tcSpliceDecls rn_splice_expr ;
-
-        -- Glue them on the front of the remaining decls and loop
-        setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
-        tc_rn_src_decls boot_details (spliced_decls ++ rest_ds)
+            -- If there's a splice, we must carry on
+          ; Just (SpliceDecl (L _ splice) _, rest_ds) ->
+            do { -- Rename the splice expression, and get its supporting decls
+                 (spliced_decls, splice_fvs) <- checkNoErrs (rnTopSpliceDecls splice)
+
+                 -- Glue them on the front of the remaining decls and loop
+               ; setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
+                 tc_rn_src_decls boot_details (spliced_decls ++ rest_ds)
+               }
+          }
 #endif /* GHCI */
-    } } }
+      }
 \end{code}
 
 %************************************************************************
@@ -524,8 +603,8 @@ tc_rn_src_decls boot_details ds
 %************************************************************************
 
 \begin{code}
-tcRnHsBootDecls :: [LHsDecl RdrName] -> TcM TcGblEnv
-tcRnHsBootDecls decls
+tcRnHsBootDecls :: HscSource -> [LHsDecl RdrName] -> TcM TcGblEnv
+tcRnHsBootDecls hsc_src decls
    = do { (first_group, group_tail) <- findSplice decls
 
                 -- Rename the declarations
@@ -546,12 +625,12 @@ tcRnHsBootDecls decls
 
                 -- Check for illegal declarations
         ; case group_tail of
-             Just (SpliceDecl d _, _) -> badBootDecl "splice" d
+             Just (SpliceDecl d _, _) -> badBootDecl hsc_src "splice" d
              Nothing                  -> return ()
-        ; mapM_ (badBootDecl "foreign") for_decls
-        ; mapM_ (badBootDecl "default") def_decls
-        ; mapM_ (badBootDecl "rule")    rule_decls
-        ; mapM_ (badBootDecl "vect")    vect_decls
+        ; mapM_ (badBootDecl hsc_src "foreign") for_decls
+        ; mapM_ (badBootDecl hsc_src "default") def_decls
+        ; mapM_ (badBootDecl hsc_src "rule")    rule_decls
+        ; mapM_ (badBootDecl hsc_src "vect")    vect_decls
 
                 -- Typecheck type/class/isntance decls
         ; traceTc "Tc2 (boot)" empty
@@ -573,7 +652,10 @@ tcRnHsBootDecls decls
                 -- are written into the interface file.
         ; let { type_env0 = tcg_type_env gbl_env
               ; type_env1 = extendTypeEnvWithIds type_env0 val_ids
-              ; type_env2 = extendTypeEnvWithIds type_env1 dfun_ids
+              -- Don't add the dictionaries for hsig, we don't actually want
+              -- to /define/ the instance
+              ; type_env2 | HsigFile <- hsc_src = type_env1
+                          | otherwise = extendTypeEnvWithIds type_env1 dfun_ids
               ; dfun_ids = map iDFunId inst_infos
               }
 
@@ -581,10 +663,15 @@ tcRnHsBootDecls decls
    }}
    ; traceTc "boot" (ppr lie); return gbl_env }
 
-badBootDecl :: String -> Located decl -> TcM ()
-badBootDecl what (L loc _)
+badBootDecl :: HscSource -> String -> Located decl -> TcM ()
+badBootDecl hsc_src what (L loc _)
   = addErrAt loc (char 'A' <+> text what
-      <+> ptext (sLit "declaration is not (currently) allowed in a hs-boot file"))
+      <+> ptext (sLit "declaration is not (currently) allowed in a")
+      <+> (case hsc_src of
+            HsBootFile -> ptext (sLit "hs-boot")
+            HsigFile -> ptext (sLit "hsig")
+            _ -> panic "badBootDecl: should be an hsig or hs-boot file")
+      <+> ptext (sLit "file"))
 \end{code}
 
 Once we've typechecked the body of the module, we want to compare what
@@ -604,12 +691,35 @@ checkHiBootIface
         tcg_env@(TcGblEnv { tcg_src = hs_src, tcg_binds = binds,
                             tcg_insts = local_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, md_exports = boot_exports })
-  | isHsBoot hs_src     -- Current module is already a hs-boot file!
+        boot_details
+  | HsBootFile <- hs_src     -- Current module is already a hs-boot file!
   = return tcg_env
 
   | otherwise
+  = do  { mb_dfun_prs <- checkHiBootIface' local_insts local_type_env
+                                           local_exports boot_details
+        ; let dfun_prs   = catMaybes mb_dfun_prs
+              boot_dfuns = map fst dfun_prs
+              dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun)
+                                     | (boot_dfun, dfun) <- dfun_prs ]
+              type_env'  = extendTypeEnvWithIds local_type_env boot_dfuns
+              tcg_env'   = tcg_env { tcg_binds = binds `unionBags` dfun_binds }
+
+        ; setGlobalTypeEnv tcg_env' type_env' }
+             -- Update the global type env *including* the knot-tied one
+             -- so that if the source module reads in an interface unfolding
+             -- mentioning one of the dfuns from the boot module, then it
+             -- can "see" that boot dfun.   See Trac #4003
+
+checkHiBootIface' :: [ClsInst] -> TypeEnv -> [AvailInfo]
+                  -> ModDetails -> TcM [Maybe (Id, Id)]
+-- Variant which doesn't require a full TcGblEnv; you could get the
+-- local components from another ModDetails.
+
+checkHiBootIface'
+        local_insts local_type_env local_exports
+        (ModDetails { md_insts = boot_insts, md_fam_insts = boot_fam_insts,
+                      md_types = boot_type_env, md_exports = boot_exports })
   = do  { traceTc "checkHiBootIface" $ vcat
              [ ppr boot_type_env, ppr boot_insts, ppr boot_exports]
 
@@ -626,19 +736,11 @@ checkHiBootIface
 
                 -- Check instance declarations
         ; mb_dfun_prs <- mapM check_inst boot_insts
-        ; let dfun_prs   = catMaybes mb_dfun_prs
-              boot_dfuns = map fst dfun_prs
-              dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun)
-                                     | (boot_dfun, dfun) <- dfun_prs ]
-              type_env'  = extendTypeEnvWithIds local_type_env boot_dfuns
-              tcg_env'   = tcg_env { tcg_binds = binds `unionBags` dfun_binds }
 
         ; failIfErrsM
-        ; setGlobalTypeEnv tcg_env' type_env' }
-             -- Update the global type env *including* the knot-tied one
-             -- so that if the source module reads in an interface unfolding
-             -- mentioning one of the dfuns from the boot module, then it
-             -- can "see" that boot dfun.   See Trac #4003
+
+        ; return mb_dfun_prs }
+
   where
     check_export boot_avail     -- boot_avail is exported by the boot iface
       | name `elem` dfun_names = return ()
@@ -649,7 +751,7 @@ checkHiBootIface
         -- Check that the actual module exports the same thing
       | not (null missing_names)
       = addErrAt (nameSrcSpan (head missing_names))
-                 (missingBootThing (head missing_names) "exported by")
+                 (missingBootThing True (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)
@@ -661,13 +763,10 @@ checkHiBootIface
         Just boot_thing <- mb_boot_thing
       = when (not (checkBootDecl boot_thing real_thing))
             $ addErrAt (nameSrcSpan (getName boot_thing))
-                       (let boot_decl = tyThingToIfaceDecl
-                                               (fromJust mb_boot_thing)
-                            real_decl = tyThingToIfaceDecl real_thing
-                        in bootMisMatch real_thing boot_decl real_decl)
+                       (bootMisMatch True real_thing boot_thing)
 
       | otherwise
-      = addErrTc (missingBootThing name "defined in")
+      = addErrTc (missingBootThing True name "defined in")
       where
         name          = availName boot_avail
         mb_boot_thing = lookupTypeEnv boot_type_env name
@@ -690,12 +789,12 @@ checkHiBootIface
                                                   , text "boot_inst"   <+> ppr boot_inst
                                                   , text "boot_inst_ty" <+> ppr boot_inst_ty
                                                   ])
-                     ; addErrTc (instMisMatch boot_inst); return Nothing }
+                     ; addErrTc (instMisMatch True 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
+          local_boot_dfun = Id.mkExportedLocalId VanillaId (idName boot_dfun) boot_inst_ty
 
 
 -- This has to compare the TyThing from the .hi-boot file to the TyThing
@@ -714,7 +813,7 @@ checkBootDecl (AnId id1) (AnId id2)
 checkBootDecl (ATyCon tc1) (ATyCon tc2)
   = checkBootTyCon tc1 tc2
 
-checkBootDecl (ADataCon dc1) (ADataCon _)
+checkBootDecl (AConLike (RealDataCon dc1)) (AConLike (RealDataCon _))
   = pprPanic "checkBootDecl" (ppr dc1)
 
 checkBootDecl _ _ = False -- probably shouldn't happen
@@ -743,22 +842,20 @@ checkBootTyCon tc1 tc2
           (_, rho_ty2) = splitForAllTys (idType id2)
           op_ty2 = funResultTy rho_ty2
 
-       eqAT (tc1, def_ats1) (tc2, def_ats2)
+       eqAT (ATI tc1 def_ats1) (ATI tc2 def_ats2)
          = checkBootTyCon tc1 tc2 &&
-           eqListBy eqATDef def_ats1 def_ats2
+           eqATDef def_ats1 def_ats2
 
        -- Ignore the location of the defaults
-       eqATDef (CoAxBranch { cab_tvs = tvs1, cab_lhs =  ty_pats1, cab_rhs = ty1 })
-               (CoAxBranch { cab_tvs = tvs2, cab_lhs =  ty_pats2, cab_rhs = ty2 })
-         | Just env <- eqTyVarBndrs emptyRnEnv2 tvs1 tvs2
-         = eqListBy (eqTypeX env) ty_pats1 ty_pats2 &&
-           eqTypeX env ty1 ty2
-         | otherwise = False
+       eqATDef Nothing    Nothing    = True
+       eqATDef (Just ty1) (Just ty2) = eqTypeX env ty1 ty2
+       eqATDef _ _ = False           
 
        eqFD (as1,bs1) (as2,bs2) =
          eqListBy (eqTypeX env) (mkTyVarTys as1) (mkTyVarTys as2) &&
          eqListBy (eqTypeX env) (mkTyVarTys bs1) (mkTyVarTys bs2)
     in
+       roles1 == roles2 &&
              -- Checks kind of class
        eqListBy eqFD clas_fds1 clas_fds2 &&
        (null sc_theta1 && null op_stuff1 && null ats1
@@ -771,26 +868,31 @@ checkBootTyCon tc1 tc2
   , Just syn_rhs2 <- synTyConRhs_maybe tc2
   , Just env <- eqTyVarBndrs emptyRnEnv2 (tyConTyVars tc1) (tyConTyVars tc2)
   = ASSERT(tc1 == tc2)
-    let eqSynRhs (SynFamilyTyCon o1 i1) (SynFamilyTyCon o2 i2)
-            = o1==o2 && i1==i2
+    let eqSynRhs OpenSynFamilyTyCon OpenSynFamilyTyCon = True
+        eqSynRhs AbstractClosedSynFamilyTyCon (ClosedSynFamilyTyCon {}) = True
+        eqSynRhs (ClosedSynFamilyTyCon {}) AbstractClosedSynFamilyTyCon = True
+        eqSynRhs (ClosedSynFamilyTyCon ax1) (ClosedSynFamilyTyCon ax2)
+            = eqClosedFamilyAx ax1 ax2
         eqSynRhs (SynonymTyCon t1) (SynonymTyCon t2)
             = eqTypeX env t1 t2
+        eqSynRhs (BuiltInSynFamTyCon _) (BuiltInSynFamTyCon _) = tc1 == tc2
         eqSynRhs _ _ = False
     in
+    roles1 == roles2 &&
     eqSynRhs syn_rhs1 syn_rhs2
 
   | isAlgTyCon tc1 && isAlgTyCon tc2
   , Just env <- eqTyVarBndrs emptyRnEnv2 (tyConTyVars tc1) (tyConTyVars tc2)
   = ASSERT(tc1 == tc2)
+    roles1 == roles2 &&
     eqListBy (eqPredX env) (tyConStupidTheta tc1) (tyConStupidTheta tc2) &&
     eqAlgRhs (algTyConRhs tc1) (algTyConRhs tc2)
 
-  | isForeignTyCon tc1 && isForeignTyCon tc2
-  = eqKind (tyConKind tc1) (tyConKind tc2) &&
-    tyConExtName tc1 == tyConExtName tc2
-
   | otherwise = False
   where
+    roles1 = tyConRoles tc1
+    roles2 = tyConRoles tc2
+
     eqAlgRhs (AbstractTyCon dis1) rhs2
       | dis1      = isDistinctAlgRhs rhs2   --Check compatibility
       | otherwise = True
@@ -808,25 +910,49 @@ checkBootTyCon tc1 tc2
       && dataConFieldLabels c1 == dataConFieldLabels c2
       && eqType (dataConUserType c1) (dataConUserType c2)
 
+    eqClosedFamilyAx (CoAxiom { co_ax_branches = branches1 })
+                     (CoAxiom { co_ax_branches = branches2 })
+      =  brListLength branches1 == brListLength branches2
+      && (and $ brListZipWith eqClosedFamilyBranch branches1 branches2)
+
+    eqClosedFamilyBranch (CoAxBranch { cab_tvs = tvs1, cab_lhs = lhs1, cab_rhs = rhs1 })
+                         (CoAxBranch { cab_tvs = tvs2, cab_lhs = lhs2, cab_rhs = rhs2 })
+      | Just env <- eqTyVarBndrs emptyRnEnv2 tvs1 tvs2
+      = eqListBy (eqTypeX env) lhs1 lhs2 &&
+        eqTypeX env rhs1 rhs2
+
+      | otherwise = False
+
 emptyRnEnv2 :: RnEnv2
 emptyRnEnv2 = mkRnEnv2 emptyInScopeSet
 
 ----------------
-missingBootThing :: Name -> String -> SDoc
-missingBootThing name what
-  = ppr name <+> ptext (sLit "is exported by the hs-boot file, but not")
+missingBootThing :: Bool -> Name -> String -> SDoc
+missingBootThing is_boot name what
+  = ppr name <+> ptext (sLit "is exported by the") <+>
+              (if is_boot then ptext (sLit "hs-boot") else ptext (sLit "hsig"))
+              <+> ptext (sLit "file, but not")
               <+> text what <+> ptext (sLit "the module")
 
-bootMisMatch :: TyThing -> IfaceDecl -> IfaceDecl -> SDoc
-bootMisMatch thing boot_decl real_decl
-  = vcat [ppr thing <+> ptext (sLit "has conflicting definitions in the module and its hs-boot file"),
-          ptext (sLit "Main module:") <+> ppr real_decl,
-          ptext (sLit "Boot file:  ") <+> ppr boot_decl]
-
-instMisMatch :: ClsInst -> SDoc
-instMisMatch inst
+bootMisMatch :: Bool -> TyThing -> TyThing -> SDoc
+bootMisMatch is_boot real_thing boot_thing
+  = vcat [ppr real_thing <+>
+          ptext (sLit "has conflicting definitions in the module"),
+          ptext (sLit "and its") <+>
+            (if is_boot then ptext (sLit "hs-boot file")
+                       else ptext (sLit "hsig file")),
+          ptext (sLit "Main module:") <+> PprTyThing.pprTyThing real_thing,
+          (if is_boot
+            then ptext (sLit "Boot file:  ")
+            else ptext (sLit "Hsig file: "))
+            <+> PprTyThing.pprTyThing boot_thing]
+
+instMisMatch :: Bool -> ClsInst -> SDoc
+instMisMatch is_boot inst
   = hang (ppr inst)
-       2 (ptext (sLit "is defined in the hs-boot file, but not in the module itself"))
+       2 (ptext (sLit "is defined in the") <+>
+        (if is_boot then ptext (sLit "hs-boot") else ptext (sLit "hsig"))
+       <+> ptext (sLit "file, but not in the module itself"))
 \end{code}
 
 
@@ -869,8 +995,17 @@ rnTopSrcDecls extra_deps group
 
         return (tcg_env', rn_decls)
    }
+\end{code}
 
-------------------------------------------------
+
+%************************************************************************
+%*                                                                      *
+                tcTopSrcDecls
+%*                                                                      *
+%************************************************************************
+
+
+\begin{code}
 tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
 tcTopSrcDecls boot_details
         (HsGroup { hs_tyclds = tycl_decls,
@@ -893,6 +1028,10 @@ tcTopSrcDecls boot_details
             <- tcTyClsInstDecls boot_details tycl_decls inst_decls deriv_decls ;
         setGblEnv tcg_env       $ do {
 
+
+                -- Generate Applicative/Monad proposal (AMP) warnings
+        traceTc "Tc3b" empty ;
+
                 -- Foreign import declarations next.
         traceTc "Tc4" empty ;
         (fi_ids, fi_decls, fi_gres) <- tcForeignImports foreign_decls ;
@@ -917,7 +1056,7 @@ tcTopSrcDecls boot_details
                 -- Second pass over class and instance declarations,
                 -- now using the kind-checked decls
         traceTc "Tc6" empty ;
-        inst_binds <- tcInstDecls2 (concat tycl_decls) inst_infos ;
+        inst_binds <- tcInstDecls2 (tyClGroupConcat tycl_decls) inst_infos ;
 
                 -- Foreign exports
         traceTc "Tc7" empty ;
@@ -948,17 +1087,17 @@ tcTopSrcDecls boot_details
 
                 -- Extend the GblEnv with the (as yet un-zonked)
                 -- bindings, rules, foreign decls
-            ; tcg_env' = tcg_env { tcg_binds = tcg_binds tcg_env `unionBags` all_binds
-                                 , tcg_sigs  = tcg_sigs tcg_env `unionNameSets` sig_names
-                                 , tcg_rules = tcg_rules tcg_env ++ rules
-                                 , tcg_vects = tcg_vects tcg_env ++ vects
-                                 , tcg_anns  = tcg_anns tcg_env ++ annotations
-                                 , tcg_fords = tcg_fords tcg_env ++ foe_decls ++ fi_decls
-                                 , tcg_dus   = tcg_dus tcg_env `plusDU` usesOnly fo_fvs } } ;
+            ; tcg_env' = tcg_env { tcg_binds   = tcg_binds tcg_env `unionBags` all_binds
+                                 , tcg_sigs    = tcg_sigs tcg_env `unionNameSets` sig_names
+                                 , tcg_rules   = tcg_rules tcg_env ++ rules
+                                 , tcg_vects   = tcg_vects tcg_env ++ vects
+                                 , tcg_anns    = tcg_anns tcg_env ++ annotations
+                                 , tcg_ann_env = extendAnnEnvList (tcg_ann_env tcg_env) annotations
+                                 , tcg_fords   = tcg_fords tcg_env ++ foe_decls ++ fi_decls
+                                 , tcg_dus     = tcg_dus tcg_env `plusDU` usesOnly fo_fvs } } ;
                                  -- tcg_dus: see Note [Newtype constructor usage in foreign declarations]
 
         addUsedRdrNames fo_rdr_names ;
-        traceTc "Tc8: type_env: " (ppr $ nameEnvElts $ tcg_type_env tcg_env') ; -- RAE
         return (tcg_env', tcl_env)
     }}}}}}
   where
@@ -986,12 +1125,12 @@ tcTyClsInstDecls :: ModDetails
                           HsValBinds Name)    -- Supporting bindings for derived instances
 
 tcTyClsInstDecls boot_details tycl_decls inst_decls deriv_decls
- = tcExtendTcTyThingEnv [(con, APromotionErr FamDataConPE) 
-                        | lid <- inst_decls, con <- get_cons lid ] $
+ = tcExtendKindEnv2 [ (con, APromotionErr FamDataConPE) 
+                    | lid <- inst_decls, con <- get_cons lid ] $
       -- Note [AFamDataCon: not promoting data family constructors]
    do { tcg_env <- tcTyAndClassDecls boot_details tycl_decls ;
       ; setGblEnv tcg_env $
-        tcInstDecls1 (concat tycl_decls) inst_decls deriv_decls }
+        tcInstDecls1 (tyClGroupConcat tycl_decls) inst_decls deriv_decls }
   where
     -- get_cons extracts the *constructor* bindings of the declaration
     get_cons :: LInstDecl Name -> [Name]
@@ -1070,7 +1209,7 @@ check_main dflags tcg_env
         ; let { root_main_name =  mkExternalName rootMainKey rOOT_MAIN
                                    (mkVarOccFS (fsLit "main"))
                                    (getSrcSpan main_name)
-              ; root_main_id = Id.mkExportedLocalId root_main_name
+              ; root_main_id = Id.mkExportedLocalId VanillaId root_main_name
                                                     (mkTyConApp ioTyCon [res_ty])
               ; co  = mkWpTyApps [res_ty]
               ; rhs = nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) main_expr
@@ -1101,32 +1240,36 @@ check_main dflags tcg_env
                 <+> ptext (sLit "is not defined in module") <+> quotes (ppr main_mod)
     pp_main_fn = ppMainFn main_fn
 
-ppMainFn :: RdrName -> SDoc
-ppMainFn main_fn
-  | main_fn == main_RDR_Unqual
-  = ptext (sLit "function") <+> quotes (ppr main_fn)
-  | otherwise
-  = ptext (sLit "main function") <+> quotes (ppr main_fn)
-
 -- | Get the unqualified name of the function to use as the \"main\" for the main module.
 -- Either returns the default name or the one configured on the command line with -main-is
 getMainFun :: DynFlags -> RdrName
-getMainFun dflags = case (mainFunIs dflags) of
-    Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn))
-    Nothing -> main_RDR_Unqual
+getMainFun dflags = case mainFunIs dflags of
+                      Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn))
+                      Nothing -> main_RDR_Unqual
 
 checkMainExported :: TcGblEnv -> TcM ()
-checkMainExported tcg_env = do
-  dflags    <- getDynFlags
-  case tcg_main tcg_env of
-    Nothing -> return () -- not the main module
-    Just main_name -> do
-      let main_mod = mainModIs dflags
-      checkTc (main_name `elem` concatMap availNames (tcg_exports tcg_env)) $
-              ptext (sLit "The") <+> ppMainFn (nameRdrName main_name) <+>
-              ptext (sLit "is not exported by module") <+> quotes (ppr main_mod)
+checkMainExported tcg_env
+  = case tcg_main tcg_env of
+      Nothing -> return () -- not the main module
+      Just main_name -> 
+         do { dflags <- getDynFlags
+            ; let main_mod = mainModIs dflags
+            ; checkTc (main_name `elem` concatMap availNames (tcg_exports tcg_env)) $
+                ptext (sLit "The") <+> ppMainFn (nameRdrName main_name) <+>
+                ptext (sLit "is not exported by module") <+> quotes (ppr main_mod) }
+
+ppMainFn :: RdrName -> SDoc
+ppMainFn main_fn
+  | rdrNameOcc main_fn == mainOcc
+  = ptext (sLit "IO action") <+> quotes (ppr main_fn)
+  | otherwise
+  = ptext (sLit "main IO action") <+> quotes (ppr main_fn)
+
+mainOcc :: OccName
+mainOcc = mkVarOccFS (fsLit "main")
 \end{code}
 
+
 Note [Root-main Id]
 ~~~~~~~~~~~~~~~~~~~
 The function that the RTS invokes is always :Main.main, which we call
@@ -1147,80 +1290,57 @@ get two defns for 'main' in the interface file!
 %*********************************************************
 
 \begin{code}
-setInteractiveContext :: HscEnv -> InteractiveContext -> TcRn a -> TcRn a
-setInteractiveContext hsc_env icxt thing_inside
-  = let -- Initialise the tcg_inst_env with instances from all home modules.
-        -- This mimics the more selective call to hptInstances in tcRnImports
-        (home_insts, home_fam_insts) = hptInstances hsc_env (\_ -> True)
-        (ic_insts, ic_finsts) = ic_instances icxt
-
-        -- Note [GHCi temporary Ids]
-        -- Ideally we would just make a type_env from ic_tythings
-        -- and ic_sys_vars, adding in implicit things.  However, Ids
-        -- bound interactively might have some free type variables
-        -- (RuntimeUnk things), and if we don't register these free
-        -- TyVars as global TyVars then the typechecker will try to
-        -- quantify over them and fall over in zonkQuantifiedTyVar.
-        --
-        -- So we must add any free TyVars to the typechecker's global
-        -- TyVar set.  This is what happens when the local environment
-        -- is extended, so we use tcExtendGhciEnv below which extends
-        -- the local environment with the Ids.
-        --
-        -- However, any Ids bound this way will shadow other Ids in
-        -- the GlobalRdrEnv, so we have to be careful to only add Ids
-        -- which are visible in the GlobalRdrEnv.
-        --
-        -- Perhaps it would be better to just extend the global TyVar
-        -- list from the free tyvars in the Ids here?  Anyway, at least
-        -- this hack is localised.
-        --
-        -- Note [delete shadowed tcg_rdr_env entries]
-        -- We also *delete* entries from tcg_rdr_env that we have
-        -- shadowed in the local env (see above).  This isn't strictly
-        -- necessary, but in an out-of-scope error when GHC suggests
-        -- names it can be confusing to see multiple identical
-        -- entries. (#5564)
-        --
-        (tmp_ids, types_n_classes) = partitionWith sel_id (ic_tythings icxt)
-          where sel_id (AnId id) = Left id
-                sel_id other     = Right other
+runTcInteractive :: HscEnv -> TcRn a -> IO (Messages, Maybe a)
+-- Initialise the tcg_inst_env with instances from all home modules.
+-- This mimics the more selective call to hptInstances in tcRnImports
+runTcInteractive hsc_env thing_inside
+  = initTcInteractive hsc_env $
+    do { traceTc "setInteractiveContext" $
+            vcat [ text "ic_tythings:" <+> vcat (map ppr (ic_tythings icxt))
+                 , text "ic_insts:" <+> vcat (map (pprBndr LetBind . instanceDFunId) ic_insts)
+                 , text "ic_rn_gbl_env (LocalDef)" <+>
+                      vcat (map ppr [ local_gres | gres <- occEnvElts (ic_rn_gbl_env icxt)
+                                                 , let local_gres = filter isLocalGRE gres
+                                                 , not (null local_gres) ]) ]
+       ; gbl_env <- getGblEnv
+       ; let gbl_env' = gbl_env {
+                           tcg_rdr_env      = ic_rn_gbl_env icxt
+                         , tcg_type_env     = type_env
+                         , tcg_insts        = ic_insts
+                         , tcg_fam_insts    = ic_finsts
+                         , tcg_inst_env     = extendInstEnvList
+                                               (extendInstEnvList (tcg_inst_env gbl_env) ic_insts)
+                                               home_insts
+                         , tcg_fam_inst_env = extendFamInstEnvList
+                                               (extendFamInstEnvList (tcg_fam_inst_env gbl_env)
+                                                                     ic_finsts)
+                                               home_fam_insts
+                         , tcg_field_env    = RecFields (mkNameEnv con_fields)
+                                                        (mkNameSet (concatMap snd con_fields))
+                              -- setting tcg_field_env is necessary
+                              -- to make RecordWildCards work (test: ghci049)
+                         , tcg_fix_env      = ic_fix_env icxt
+                         , tcg_default      = ic_default icxt }
+
+       ; setGblEnv gbl_env' $
+         tcExtendGhciIdEnv ty_things $   -- See Note [Initialising the type environment for GHCi]
+         thing_inside }                  -- in TcEnv
+  where
+    (home_insts, home_fam_insts) = hptInstances hsc_env (\_ -> True)
 
-        type_env = mkTypeEnvWithImplicits
-                       (map AnId (ic_sys_vars icxt) ++ types_n_classes)
+    icxt                  = hsc_IC hsc_env
+    (ic_insts, ic_finsts) = ic_instances icxt
+    ty_things             = ic_tythings icxt
 
-        visible_tmp_ids = filter visible tmp_ids
-          where visible id = not (null (lookupGRE_Name (ic_rn_gbl_env icxt)
-                                                       (idName id)))
+    type_env1 = mkTypeEnvWithImplicits ty_things
+    type_env  = extendTypeEnvWithIds type_env1 (map instanceDFunId ic_insts)
+                -- Putting the dfuns in the type_env
+                -- is just to keep Core Lint happy
+
+    con_fields = [ (dataConName c, dataConFieldLabels c)
+                 | ATyCon t <- ty_things
+                 , c <- tyConDataCons t ]
 
-        con_fields = [ (dataConName c, dataConFieldLabels c)
-                     | ATyCon t <- types_n_classes
-                     , c <- tyConDataCons t ]
-    in
-    updGblEnv (\env -> env {
-          tcg_rdr_env      = delListFromOccEnv (ic_rn_gbl_env icxt)
-                                               (map getOccName visible_tmp_ids)
-                                 -- Note [delete shadowed tcg_rdr_env entries]
-        , tcg_type_env     = type_env
-        , tcg_insts        = ic_insts
-        , tcg_inst_env     = extendInstEnvList
-                              (extendInstEnvList (tcg_inst_env env) ic_insts)
-                              home_insts
-        , tcg_fam_insts    = ic_finsts
-        , tcg_fam_inst_env = extendFamInstEnvList
-                              (extendFamInstEnvList (tcg_fam_inst_env env)
-                                                    ic_finsts)
-                              home_fam_insts
-        , tcg_field_env    = RecFields (mkNameEnv con_fields)
-                                       (mkNameSet (concatMap snd con_fields))
-             -- setting tcg_field_env is necessary to make RecordWildCards work
-             -- (test: ghci049)
-        , tcg_fix_env      = ic_fix_env icxt
-        , tcg_default      = ic_default icxt
-        }) $
-
-        tcExtendGhciEnv visible_tmp_ids $ -- Note [GHCi temporary Ids]
-          thing_inside
 
 #ifdef GHCI
 -- | The returned [Id] is the list of new Ids bound by this statement. It can
@@ -1228,11 +1348,10 @@ setInteractiveContext hsc_env icxt thing_inside
 --
 -- The returned TypecheckedHsExpr is of type IO [ () ], a list of the bound
 -- values, coerced to ().
-tcRnStmt :: HscEnv -> InteractiveContext -> GhciLStmt RdrName
+tcRnStmt :: HscEnv -> GhciLStmt RdrName
          -> IO (Messages, Maybe ([Id], LHsExpr Id, FixityEnv))
-tcRnStmt hsc_env ictxt rdr_stmt
-  = initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env ictxt $ do {
+tcRnStmt hsc_env rdr_stmt
+  = runTcInteractive hsc_env $ do {
 
     -- The real work is done here
     ((bound_ids, tc_expr), fix_env) <- tcUserStmt rdr_stmt ;
@@ -1245,7 +1364,7 @@ tcRnStmt hsc_env ictxt rdr_stmt
 
     traceTc "tcs 1" empty ;
     let { global_ids = map globaliseAndTidyId zonked_ids } ;
-        -- Note [Interactively-bound Ids in GHCi]
+        -- Note [Interactively-bound Ids in GHCi] in HscTypes
 
 {- ---------------------------------------------
    At one stage I removed any shadowed bindings from the type_env;
@@ -1277,24 +1396,6 @@ tcRnStmt hsc_env ictxt rdr_stmt
                                   nest 2 (ppr id <+> dcolon <+> ppr (idType id))])
 \end{code}
 
-Note [Interactively-bound Ids in GHCi]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The Ids bound by previous Stmts in GHCi are currently
-        a) GlobalIds
-        b) with an Internal Name (not External)
-        c) and a tidied type
-
- (a) They must be GlobalIds (not LocalIds) otherwise when we come to
-     compile an expression using these ids later, the byte code
-     generator will consider the occurrences to be free rather than
-     global.
-
- (b) They retain their Internal names becuase we don't have a suitable
-     Module to name them with. We could revisit this choice.
-
- (c) Their types are tidied. This is important, because :info may ask
-     to look at them, and :info expects the things it looks up to have
-     tidy types
 
 --------------------------------------------------------------------------
                 Typechecking Stmts in GHCi
@@ -1334,11 +1435,11 @@ runPlans (p:ps) = tryTcLIE_ (runPlans ps) p
 -- | Typecheck (and 'lift') a stmt entered by the user in GHCi into the
 -- GHCi 'environemnt'.
 --
--- By 'lift' and 'environment we mean that the code is changed to execute
--- properly in an IO monad. See Note [Interactively-bound Ids in GHCi] above
--- for more details. We do this lifting by trying different ways ('plans') of
--- lifting the code into the IO monad and type checking each plan until one
--- succeeds.
+-- By 'lift' and 'environment we mean that the code is changed to
+-- execute properly in an IO monad. See Note [Interactively-bound Ids
+-- in GHCi] in HscTypes for more details. We do this lifting by trying
+-- different ways ('plans') of lifting the code into the IO monad and
+-- type checking each plan until one succeeds.
 tcUserStmt :: GhciLStmt RdrName -> TcM (PlanResult, FixityEnv)
 
 -- An expression typed at the prompt is treated very specially
@@ -1351,7 +1452,7 @@ tcUserStmt (L loc (BodyStmt expr _ _ _))
         ; let fresh_it  = itName uniq loc
               matches   = [mkMatch [] rn_expr emptyLocalBinds]
               -- [it = expr]
-              the_bind  = L loc $ (mkTopFunBind (L loc fresh_it) matches) { bind_fvs = fvs }
+              the_bind  = L loc $ (mkTopFunBind FromSource (L loc fresh_it) matches) { bind_fvs = fvs }
                           -- Care here!  In GHCi the expression might have
                           -- free variables, and they in turn may have free type variables
                           -- (if we are at a breakpoint, say).  We must put those free vars
@@ -1435,7 +1536,8 @@ tcUserStmt rdr_stmt@(L loc _)
            ; return stuff }
       where
         print_v  = L loc $ BodyStmt (nlHsApp (nlHsVar printName) (nlHsVar v))
-                                    (HsVar thenIOName) noSyntaxExpr placeHolderType
+                                    (HsVar thenIOName) noSyntaxExpr
+                                    placeHolderType
 
 -- | Typecheck the statements given and then return the results of the
 -- statement in the form 'IO [()]'.
@@ -1476,7 +1578,7 @@ tcGhciStmts stmts
                 -- get their *polymorphic* values.  (And we'd get ambiguity errs
                 -- if they were overloaded, since they aren't applied to anything.)
             ret_expr = nlHsApp (nlHsTyApp ret_id [ret_ty])
-                       (noLoc $ ExplicitList unitTy (map mk_item ids)) ;
+                       (noLoc $ ExplicitList unitTy Nothing (map mk_item ids)) ;
             mk_item id = nlHsApp (nlHsTyApp unsafeCoerceId [idType id, unitTy])
                                  (nlHsVar id) ;
             stmts = tc_stmts ++ [noLoc (mkLastStmt ret_expr)]
@@ -1503,10 +1605,9 @@ getGhciStepIO = do
         step   = noLoc $ ExprWithTySig (nlHsVar ghciStepIoMName) stepTy
     return step
 
-isGHCiMonad :: HscEnv -> InteractiveContext -> String -> IO (Messages, Maybe Name)
-isGHCiMonad hsc_env ictxt ty
-  = initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env ictxt $ do
+isGHCiMonad :: HscEnv -> String -> IO (Messages, Maybe Name)
+isGHCiMonad hsc_env ty
+  = runTcInteractive hsc_env $ do
         rdrEnv <- getGlobalRdrEnv
         let occIO = lookupOccEnv rdrEnv (mkOccName tcName ty)
         case occIO of
@@ -1514,7 +1615,7 @@ isGHCiMonad hsc_env ictxt ty
                 let name = gre_name n
                 ghciClass <- tcLookupClass ghciIoClassName 
                 userTyCon <- tcLookupTyCon name
-                let userTy = TyConApp userTyCon []
+                let userTy = mkTyConApp userTyCon []
                 _ <- tcLookupInstance ghciClass [userTy]
                 return name
 
@@ -1527,13 +1628,11 @@ tcRnExpr just finds the type of an expression
 
 \begin{code}
 tcRnExpr :: HscEnv
-         -> InteractiveContext
          -> LHsExpr RdrName
          -> IO (Messages, Maybe Type)
 -- Type checks the expression and returns its most general type
-tcRnExpr hsc_env ictxt rdr_expr
-  = initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env ictxt $ do {
+tcRnExpr hsc_env rdr_expr
+  = runTcInteractive hsc_env $ do {
 
     (rn_expr, _fvs) <- rnLExpr rdr_expr ;
     failIfErrsM ;
@@ -1560,54 +1659,70 @@ tcRnExpr hsc_env ictxt rdr_expr
 tcRnImportDecls :: HscEnv
                 -> [LImportDecl RdrName]
                 -> IO (Messages, Maybe GlobalRdrEnv)
+-- Find the new chunk of GlobalRdrEnv created by this list of import
+-- decls.  In contract tcRnImports *extends* the TcGblEnv.
 tcRnImportDecls hsc_env import_decls
- =  initTcPrintErrors hsc_env iNTERACTIVE $
-    do { gbl_env <- tcRnImports hsc_env iNTERACTIVE import_decls
+ =  runTcInteractive hsc_env $
+    do { gbl_env <- updGblEnv zap_rdr_env $
+                    tcRnImports hsc_env import_decls
        ; return (tcg_rdr_env gbl_env) }
+  where
+    zap_rdr_env gbl_env = gbl_env { tcg_rdr_env = emptyGlobalRdrEnv }
 \end{code}
 
 tcRnType just finds the kind of a type
 
 \begin{code}
 tcRnType :: HscEnv
-         -> InteractiveContext
          -> Bool        -- Normalise the returned type
          -> LHsType RdrName
          -> IO (Messages, Maybe (Type, Kind))
-tcRnType hsc_env ictxt normalise rdr_type
-  = initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env ictxt $ do {
-
-    (rn_type, _fvs) <- rnLHsType GHCiCtx rdr_type ;
-    failIfErrsM ;
+tcRnType hsc_env normalise rdr_type
+  = runTcInteractive hsc_env $
+    setXOptM Opt_PolyKinds $   -- See Note [Kind-generalise in tcRnType]
+    do { (rn_type, _fvs) <- rnLHsType GHCiCtx rdr_type
+       ; failIfErrsM
 
         -- Now kind-check the type
         -- It can have any rank or kind
-    ty <- tcHsSigType GhciCtxt rn_type ;
-
-    ty' <- if normalise
-           then do { fam_envs <- tcGetFamInstEnvs
-                   ; return (snd (normaliseType fam_envs ty)) }
-                   -- normaliseType returns a coercion
-                   -- which we discard
-           else return ty ;
+       ; ty <- tcHsSigType GhciCtxt rn_type ;
 
-    return (ty', typeKind ty)
-    }
+       ; ty' <- if normalise
+                then do { fam_envs <- tcGetFamInstEnvs
+                        ; return (snd (normaliseType fam_envs Nominal ty)) }
+                        -- normaliseType returns a coercion
+                        -- which we discard, so the Role is irrelevant
+                else return ty ;
 
+       ; return (ty', typeKind ty) }
 \end{code}
 
+Note [Kind-generalise in tcRnType]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We switch on PolyKinds when kind-checking a user type, so that we will
+kind-generalise the type.  This gives the right default behaviour at
+the GHCi prompt, where if you say ":k T", and T has a polymorphic
+kind, you'd like to see that polymorphism. Of course.  If T isn't
+kind-polymorphic you won't get anything unexpected, but the apparent
+*loss* of polymorphism, for types that you know are polymorphic, is
+quite surprising.  See Trac #7688 for a discussion.
+
+
+%************************************************************************
+%*                                                                      *
+                 tcRnDeclsi
+%*                                                                      *
+%************************************************************************
+
 tcRnDeclsi exists to allow class, data, and other declarations in GHCi.
 
 \begin{code}
 tcRnDeclsi :: HscEnv
-           -> InteractiveContext
            -> [LHsDecl RdrName]
            -> IO (Messages, Maybe TcGblEnv)
 
-tcRnDeclsi hsc_env ictxt local_decls =
-    initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env ictxt $ do
+tcRnDeclsi hsc_env local_decls =
+  runTcInteractive hsc_env $ do
 
     ((tcg_env, tclcl_env), lie) <-
         captureConstraints $ tc_rn_src_decls emptyModDetails local_decls
@@ -1637,13 +1752,8 @@ tcRnDeclsi hsc_env ictxt local_decls =
                              tcg_vects     = vects',
                              tcg_fords     = fords' }
 
-    tcg_env'' <- setGlobalTypeEnv tcg_env' final_type_env
-
-    traceTc "returning from tcRnDeclsi: " $ ppr $ nameEnvElts $ tcg_type_env tcg_env'' -- RAE
-
-    return tcg_env''
-
-
+    setGlobalTypeEnv tcg_env' final_type_env
+    
 #endif /* GHCi */
 \end{code}
 
@@ -1662,13 +1772,12 @@ tcRnDeclsi hsc_env ictxt local_decls =
 -- could not be found.
 getModuleInterface :: HscEnv -> Module -> IO (Messages, Maybe ModIface)
 getModuleInterface hsc_env mod
-  = initTc hsc_env HsSrcFile False iNTERACTIVE $
+  = runTcInteractive hsc_env $
     loadModuleInterface (ptext (sLit "getModuleInterface")) mod
 
 tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Messages, Maybe [Name])
 tcRnLookupRdrName hsc_env rdr_name
-  = initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env (hsc_IC hsc_env) $
+  = runTcInteractive hsc_env $
     lookup_rdr_name rdr_name
 
 lookup_rdr_name :: RdrName -> TcM [Name]
@@ -1703,8 +1812,7 @@ lookup_rdr_name rdr_name = do
 
 tcRnLookupName :: HscEnv -> Name -> IO (Messages, Maybe TyThing)
 tcRnLookupName hsc_env name
-  = initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env (hsc_IC hsc_env) $
+  = runTcInteractive hsc_env $
     tcRnLookupName' name
 
 -- To look up a name we have to look in the local environment (tcl_lcl)
@@ -1721,7 +1829,7 @@ tcRnLookupName' name = do
 
 tcRnGetInfo :: HscEnv
             -> Name
-            -> IO (Messages, Maybe (TyThing, Fixity, [ClsInst]))
+            -> IO (Messages, Maybe (TyThing, Fixity, [ClsInst], [FamInst]))
 
 -- Used to implement :info in GHCi
 --
@@ -1731,41 +1839,41 @@ tcRnGetInfo :: HscEnv
 --  *and* as a type or class constructor;
 -- hence the call to dataTcOccs, and we return up to two results
 tcRnGetInfo hsc_env name
-  = let ictxt = hsc_IC hsc_env in
-    initTcPrintErrors hsc_env iNTERACTIVE $
-    setInteractiveContext hsc_env ictxt  $ do
-
-        -- Load the interface for all unqualified types and classes
-        -- That way we will find all the instance declarations
-        -- (Packages have not orphan modules, and we assume that
-        --  in the home package all relevant modules are loaded.)
-    loadUnqualIfaces hsc_env ictxt
-
-    thing  <- tcRnLookupName' name
-    fixity <- lookupFixityRn name
-    ispecs <- lookupInsts thing
-    return (thing, fixity, ispecs)
-
-lookupInsts :: TyThing -> TcM [ClsInst]
+  = runTcInteractive hsc_env $
+    do { loadUnqualIfaces hsc_env (hsc_IC hsc_env)
+           -- Load the interface for all unqualified types and classes
+           -- That way we will find all the instance declarations
+           -- (Packages have not orphan modules, and we assume that
+           --  in the home package all relevant modules are loaded.)
+
+       ; thing  <- tcRnLookupName' name
+       ; fixity <- lookupFixityRn name
+       ; (cls_insts, fam_insts) <- lookupInsts thing
+       ; return (thing, fixity, cls_insts, fam_insts) }
+
+lookupInsts :: TyThing -> TcM ([ClsInst],[FamInst])
 lookupInsts (ATyCon tc)
-  | Just cls <- tyConClass_maybe tc
-  = do  { inst_envs <- tcGetInstEnvs
-        ; return (classInstances inst_envs cls) }
-
-  | otherwise
   = do  { (pkg_ie, home_ie) <- tcGetInstEnvs
+        ; (pkg_fie, home_fie) <- tcGetFamInstEnvs
                 -- Load all instances for all classes that are
                 -- in the type environment (which are all the ones
                 -- we've seen in any interface file so far)
-        ; return [ ispec        -- Search all
+
+          -- Return only the instances relevant to the given thing, i.e.
+          -- the instances whose head contains the thing's name.
+        ; let cls_insts =
+                 [ ispec        -- Search all
                  | ispec <- instEnvElts home_ie ++ instEnvElts pkg_ie
-                 , let dfun = instanceDFunId ispec
-                 , relevant dfun ] }
+                 , tc_name `elemNameSet` orphNamesOfClsInst ispec ]
+        ; let fam_insts =
+                 [ fispec
+                 | fispec <- famInstEnvElts home_fie ++ famInstEnvElts pkg_fie
+                 , tc_name `elemNameSet` orphNamesOfFamInst fispec ]
+        ; return (cls_insts, fam_insts) }
   where
-    relevant df = tc_name `elemNameSet` orphNamesOfDFunHead (idType df)
     tc_name     = tyConName tc
 
-lookupInsts _ = return []
+lookupInsts _ = return ([],[])
 
 loadUnqualIfaces :: HscEnv -> InteractiveContext -> TcM ()
 -- Load the interface for everything that is in scope unqualified
@@ -1777,13 +1885,16 @@ loadUnqualIfaces hsc_env ictxt
   where
     this_pkg = thisPackage (hsc_dflags hsc_env)
 
-    unqual_mods = filter ((/= this_pkg) . modulePackageId)
-                  [ nameModule name
-                  | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt),
-                    let name = gre_name gre,
-                    not (isInternalName name),
-                    isTcOcc (nameOccName name),  -- Types and classes only
-                    unQualOK gre ]               -- In scope unqualified
+    unqual_mods = [ mod
+                  | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt)
+                  , let name = gre_name gre
+                  , not (isInternalName name)
+                  , let mod = nameModule name
+                  , not (modulePackageKey mod == this_pkg || isInteractiveModule mod)
+                      -- Don't attempt to load an interface for stuff
+                      -- from the command line, or from the home package
+                  , isTcOcc (nameOccName name)   -- Types and classes only
+                  , unQualOK gre ]               -- In scope unqualified
     doc = ptext (sLit "Need interface for module whose export(s) are in scope unqualified")
 \end{code}
 
@@ -1815,17 +1926,6 @@ tcDump env
         -- NB: foreign x-d's have undefined's in their types;
         --     hence can't show the tc_fords
 
-tcCoreDump :: ModGuts -> TcM ()
-tcCoreDump mod_guts
- = do { dflags <- getDynFlags ;
-        when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
-             (dumpTcRn (pprModGuts mod_guts)) ;
-
-        -- Dump bindings if -ddump-tc
-        dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump) }
-  where
-    full_dump = pprCoreBindings (mg_binds mod_guts)
-
 -- It's unpleasant having both pprModGuts and pprModDetails here
 pprTcGblEnv :: TcGblEnv -> SDoc
 pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
@@ -1843,7 +1943,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
          , ptext (sLit "Dependent modules:") <+>
                 ppr (sortBy cmp_mp $ eltsUFM (imp_dep_mods imports))
          , ptext (sLit "Dependent packages:") <+>
-                ppr (sortBy stablePackageIdCmp $ imp_dep_pkgs imports)]
+                ppr (sortBy stablePackageKeyCmp $ imp_dep_pkgs imports)]
   where         -- The two uses of sortBy are just to reduce unnecessary
                 -- wobbling in testsuite output
     cmp_mp (mod_name1, is_boot1) (mod_name2, is_boot2)
@@ -1851,12 +1951,6 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
                   `thenCmp`
           (is_boot1 `compare` is_boot2)
 
-pprModGuts :: ModGuts -> SDoc
-pprModGuts (ModGuts { mg_tcs = tcs
-                    , mg_rules = rules })
-  = vcat [ ppr_types [] (mkTypeEnv (map ATyCon tcs)),
-           ppr_rules rules ]
-
 ppr_types :: [ClsInst] -> TypeEnv -> SDoc
 ppr_types insts type_env
   = text "TYPE SIGNATURES" $$ nest 2 (ppr_sigs ids)
@@ -1872,7 +1966,7 @@ ppr_types insts type_env
         -- that the type checker has invented.  Top-level user-defined things
         -- have External names.
 
-ppr_tycons :: [FamInst br] -> TypeEnv -> SDoc
+ppr_tycons :: [FamInst] -> TypeEnv -> SDoc
 ppr_tycons fam_insts type_env
   = vcat [ text "TYPE CONSTRUCTORS"
          ,   nest 2 (ppr_tydecls tycons)
@@ -1890,7 +1984,7 @@ ppr_insts :: [ClsInst] -> SDoc
 ppr_insts []     = empty
 ppr_insts ispecs = text "INSTANCES" $$ nest 2 (pprInstances ispecs)
 
-ppr_fam_insts :: [FamInst br] -> SDoc
+ppr_fam_insts :: [FamInst] -> SDoc
 ppr_fam_insts []        = empty
 ppr_fam_insts fam_insts =
   text "FAMILY INSTANCES" $$ nest 2 (pprFamInsts fam_insts)
@@ -1907,13 +2001,5 @@ ppr_tydecls tycons
         -- Print type constructor info; sort by OccName
   = vcat (map ppr_tycon (sortBy (comparing getOccName) tycons))
   where
-    ppr_tycon tycon = vcat [ ppr (tyConName tycon) <+> dcolon <+> ppr (tyConKind tycon)
-                              -- Temporarily print the kind signature too
-                           , ppr (tyThingToIfaceDecl (ATyCon tycon)) ]
-
-ppr_rules :: [CoreRule] -> SDoc
-ppr_rules [] = empty
-ppr_rules rs = vcat [ptext (sLit "{-# RULES"),
-                      nest 2 (pprRules rs),
-                      ptext (sLit "#-}")]
+    ppr_tycon tycon = vcat [ ppr (tyThingToIfaceDecl (ATyCon tycon)) ]
 \end{code}