Add support for all top-level declarations to GHCi

  This is work mostly done by Daniel Winograd-Cort during his
  internship at MSR Cambridge, with some further refactoring by me.

This commit adds support to GHCi for most top-level declarations that
can be used in Haskell source files.  Class, data, newtype, type,
instance are all supported, as are Type Family-related declarations.

The current set of declarations are shown by :show bindings.  As with
variable bindings, entities bound by newer declarations shadow earlier
ones.

Tests are in testsuite/tests/ghci/scripts/ghci039--ghci054.
Documentation to follow.

35 files changed, 1255 insertions, 642 deletions

diff --git a/compiler/basicTypes/DataCon.lhs-boot b/compiler/basicTypes/DataCon.lhs-boot
index c5e05c9ecd..3477a4b2e4 100644
--- a/compiler/basicTypes/DataCon.lhs-boot
+++ b/compiler/basicTypes/DataCon.lhs-boot
@@ -5,4 +5,6 @@ import Name( Name )
 data DataCon
 dataConName      :: DataCon -> Name
 isVanillaDataCon :: DataCon -> Bool
+instance Eq DataCon
+instance Ord DataCon
 \end{code}
diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs
index db24f7508b..754f6292b2 100644
--- a/compiler/basicTypes/Name.lhs
+++ b/compiler/basicTypes/Name.lhs
@@ -435,17 +435,17 @@ instance OutputableBndr Name where
     pprBndr _ name = pprName name
 
 pprName :: Name -> SDoc
-pprName (Name {n_sort = sort, n_uniq = u, n_occ = occ})
+pprName n@(Name {n_sort = sort, n_uniq = u, n_occ = occ})
   = getPprStyle $ \ sty ->
     case sort of
-      WiredIn mod _ builtin   -> pprExternal sty uniq mod occ True  builtin
-      External mod  	      -> pprExternal sty uniq mod occ False UserSyntax
+      WiredIn mod _ builtin   -> pprExternal sty uniq mod occ n True  builtin
+      External mod            -> pprExternal sty uniq mod occ n False UserSyntax
       System   		      -> pprSystem sty uniq occ
       Internal    	      -> pprInternal sty uniq occ
   where uniq = mkUniqueGrimily (iBox u)
 
-pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
-pprExternal sty uniq mod occ is_wired is_builtin
+pprExternal :: PprStyle -> Unique -> Module -> OccName -> Name -> Bool -> BuiltInSyntax -> SDoc
+pprExternal sty uniq mod occ name is_wired is_builtin
   | codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ
 	-- In code style, always qualify
 	-- ToDo: maybe we could print all wired-in things unqualified
@@ -455,7 +455,7 @@ pprExternal sty uniq mod occ is_wired is_builtin
 				      pprNameSpaceBrief (occNameSpace occ), 
 		 		      pprUnique uniq])
   | BuiltInSyntax <- is_builtin = ppr_occ_name occ  -- Never qualify builtin syntax
-  | otherwise		        = pprModulePrefix sty mod occ <> ppr_occ_name occ
+  | otherwise                   = pprModulePrefix sty mod name <> ppr_occ_name occ
   where
     pp_mod | opt_SuppressModulePrefixes = empty
            | otherwise                  = ppr mod <> dot 
@@ -482,14 +482,14 @@ pprSystem sty uniq occ
 				-- so print the unique
 
 
-pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
+pprModulePrefix :: PprStyle -> Module -> Name -> SDoc
 -- Print the "M." part of a name, based on whether it's in scope or not
 -- See Note [Printing original names] in HscTypes
-pprModulePrefix sty mod occ
+pprModulePrefix sty mod name
   | opt_SuppressModulePrefixes = empty
   
   | otherwise
-  = case qualName sty mod occ of	           -- See Outputable.QualifyName:
+  = case qualName sty name of              -- See Outputable.QualifyName:
       NameQual modname -> ppr modname <> dot       -- Name is in scope       
       NameNotInScope1  -> ppr mod <> dot           -- Not in scope
       NameNotInScope2  -> ppr (modulePackageId mod) <> colon     -- Module not in
diff --git a/compiler/basicTypes/Name.lhs-boot b/compiler/basicTypes/Name.lhs-boot
index 167ce4242d..27b71d944f 100644
--- a/compiler/basicTypes/Name.lhs-boot
+++ b/compiler/basicTypes/Name.lhs-boot
@@ -1,5 +1,9 @@
 \begin{code}
 module Name where
 
+import {-# SOURCE #-} Module
+
 data Name
+
+nameModule :: Name -> Module
 \end{code}
diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs
index 7f7d04802e..b410d5914c 100644
--- a/compiler/basicTypes/RdrName.lhs
+++ b/compiler/basicTypes/RdrName.lhs
@@ -66,6 +66,7 @@ import Maybes
 import SrcLoc
 import FastString
 import Outputable
+import Unique
 import Util
 import StaticFlags( opt_PprStyle_Debug )
 
@@ -247,7 +248,9 @@ instance Outputable RdrName where
     ppr (Exact name)   = ppr name
     ppr (Unqual occ)   = ppr occ
     ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
-    ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)
+    ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod name <> ppr occ)
+       where name = mkExternalName (mkUniqueGrimily 0) mod occ noSrcSpan
+         -- Note [Outputable Orig RdrName] in HscTypes
 
 instance OutputableBndr RdrName where
     pprBndr _ n 
diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index 6cbda9e09e..9001ec7cf5 100644
--- a/compiler/deSugar/Desugar.lhs
+++ b/compiler/deSugar/Desugar.lhs
@@ -56,24 +56,26 @@ deSugar :: HscEnv -> ModLocation -> TcGblEnv -> IO (Messages, Maybe ModGuts)
 deSugar hsc_env 
         mod_loc
         tcg_env@(TcGblEnv { tcg_mod          = mod,
-			    tcg_src	     = hsc_src,
-		    	    tcg_type_env     = type_env,
-		    	    tcg_imports      = imports,
-		    	    tcg_exports      = exports,
-			    tcg_keep	     = keep_var,
+                            tcg_src          = hsc_src,
+                            tcg_type_env     = type_env,
+                            tcg_imports      = imports,
+                            tcg_exports      = exports,
+                            tcg_keep	     = keep_var,
                             tcg_th_splice_used = tc_splice_used,
                             tcg_rdr_env      = rdr_env,
-		    	    tcg_fix_env      = fix_env,
-		    	    tcg_inst_env     = inst_env,
-		    	    tcg_fam_inst_env = fam_inst_env,
-	    	    	    tcg_warns        = warns,
-	    	    	    tcg_anns         = anns,
-			    tcg_binds        = binds,
-		    	    tcg_imp_specs    = imp_specs,
+                            tcg_fix_env      = fix_env,
+                            tcg_inst_env     = inst_env,
+                            tcg_fam_inst_env = fam_inst_env,
+                            tcg_warns        = warns,
+                            tcg_anns         = anns,
+                            tcg_binds        = binds,
+                            tcg_imp_specs    = imp_specs,
                             tcg_ev_binds     = ev_binds,
                             tcg_fords        = fords,
                             tcg_rules        = rules,
                             tcg_vects        = vects,
+                            tcg_tcs          = tcs,
+                            tcg_clss         = clss,
                             tcg_insts        = insts,
                             tcg_fam_insts    = fam_insts,
                             tcg_hpc          = other_hpc_info })
@@ -96,8 +98,7 @@ deSugar hsc_env
 			 <- if (opt_Hpc
 				  || target == HscInterpreted)
 			       && (not (isHsBoot hsc_src))
-                              then addCoverageTicksToBinds dflags mod mod_loc
-                                                           (typeEnvTyCons type_env) binds 
+                              then addCoverageTicksToBinds dflags mod mod_loc tcs binds 
                               else return (binds, hpcInfo, emptyModBreaks)
                      initDs hsc_env mod rdr_env type_env $ do
                        do { ds_ev_binds <- dsEvBinds ev_binds
@@ -151,26 +152,27 @@ deSugar hsc_env
         ; used_th <- readIORef tc_splice_used
 
         ; let mod_guts = ModGuts {
-		mg_module    	= mod,
-		mg_boot	     	= isHsBoot hsc_src,
-		mg_exports   	= exports,
-		mg_deps	     	= deps,
-		mg_used_names   = used_names,
+                mg_module       = mod,
+                mg_boot	        = isHsBoot hsc_src,
+                mg_exports      = exports,
+                mg_deps	        = deps,
+                mg_used_names   = used_names,
                 mg_used_th      = used_th,
                 mg_dir_imps     = imp_mods imports,
-	        mg_rdr_env   	= rdr_env,
-		mg_fix_env   	= fix_env,
-		mg_warns   	= warns,
-		mg_anns      	= anns,
-		mg_types     	= type_env,
-		mg_insts     	= insts,
-		mg_fam_insts 	= fam_insts,
-		mg_inst_env     = inst_env,
-		mg_fam_inst_env = fam_inst_env,
-	        mg_rules     	= ds_rules_for_imps,
-		mg_binds     	= ds_binds,
-		mg_foreign   	= ds_fords,
-		mg_hpc_info  	= ds_hpc_info,
+                mg_rdr_env      = rdr_env,
+                mg_fix_env      = fix_env,
+                mg_warns        = warns,
+                mg_anns         = anns,
+                mg_tcs          = tcs,
+                mg_clss         = clss,
+                mg_insts        = insts,
+                mg_fam_insts    = fam_insts,
+                mg_inst_env     = inst_env,
+                mg_fam_inst_env = fam_inst_env,
+                mg_rules        = ds_rules_for_imps,
+                mg_binds        = ds_binds,
+                mg_foreign      = ds_fords,
+                mg_hpc_info     = ds_hpc_info,
                 mg_modBreaks    = modBreaks,
                 mg_vect_decls   = ds_vects,
                 mg_vect_info    = noVectInfo,
diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs
index d4ddcc4ba2..4cd7729608 100644
--- a/compiler/ghci/ByteCodeLink.lhs
+++ b/compiler/ghci/ByteCodeLink.lhs
@@ -254,7 +254,7 @@ lookupIE ie con_nm
 linkFail :: String -> String -> IO a
 linkFail who what
    = ghcError (ProgramError $
-        unlines [ ""
+        unlines [ "",who
 	        , "During interactive linking, GHCi couldn't find the following symbol:"
 		, ' ' : ' ' : what 
 		, "This may be due to you not asking GHCi to load extra object files,"
diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index d27aedb960..e859609527 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -87,7 +87,7 @@ pprintClosureCommand bindThings force str = do
    tidyTermTyVars :: GhcMonad m => Term -> m Term
    tidyTermTyVars t =
      withSession $ \hsc_env -> do
-     let env_tvs      = tyVarsOfTypes (map idType (ic_tmp_ids (hsc_IC hsc_env)))
+     let env_tvs      = tyThingsTyVars $ ic_tythings $ hsc_IC hsc_env
          my_tvs       = termTyVars t
          tvs          = env_tvs `minusVarSet` my_tvs
          tyvarOccName = nameOccName . tyVarName
@@ -110,7 +110,7 @@ bindSuspensions t = do
       let (names, tys, hvals) = unzip3 stuff
       let ids = [ mkVanillaGlobal name ty 
                 | (name,ty) <- zip names tys]
-          new_ic = extendInteractiveContext ictxt ids
+          new_ic = extendInteractiveContext ictxt (map AnId ids)
       liftIO $ extendLinkEnv (zip names hvals)
       modifySession $ \_ -> hsc_env {hsc_IC = new_ic }
       return t'
@@ -187,10 +187,8 @@ showTerm term = do
 
   bindToFreshName hsc_env ty userName = do
     name <- newGrimName userName
-    let ictxt    = hsc_IC hsc_env
-        tmp_ids  = ic_tmp_ids ictxt
-        id       = mkVanillaGlobal name ty 
-        new_ic   = ictxt { ic_tmp_ids = id : tmp_ids }
+    let id       = AnId $ mkVanillaGlobal name ty 
+        new_ic   = extendInteractiveContext (hsc_IC hsc_env) [id]
     return (hsc_env {hsc_IC = new_ic }, name)
 
 --    Create new uniques and give them sequentially numbered names
@@ -202,20 +200,19 @@ newGrimName userName  = do
         name    = mkInternalName unique occname noSrcSpan
     return name
 
-pprTypeAndContents :: GhcMonad m => [Id] -> m SDoc
-pprTypeAndContents ids = do
+pprTypeAndContents :: GhcMonad m => Id -> m SDoc
+pprTypeAndContents id = do
   dflags  <- GHC.getSessionDynFlags
   let pefas     = dopt Opt_PrintExplicitForalls dflags
       pcontents = dopt Opt_PrintBindContents dflags
+      pprdId    = (pprTyThing pefas . AnId) id
   if pcontents 
     then do
       let depthBound = 100
-      terms      <- mapM (GHC.obtainTermFromId depthBound False) ids
-      docs_terms <- mapM showTerm terms
-      return $ vcat $ zipWith (\ty cts -> ty <+> equals <+> cts)
-                             (map (pprTyThing pefas . AnId) ids)
-                             docs_terms
-    else return $  vcat $ map (pprTyThing pefas . AnId) ids
+      term      <- GHC.obtainTermFromId depthBound False id
+      docs_term <- showTerm term
+      return $ pprdId <+> equals <+> docs_term
+    else return pprdId
 
 --------------------------------------------------------------
 -- Utils 
diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 747edde140..2f8943ef24 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -12,7 +12,7 @@
 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
 
 module Linker ( HValue, getHValue, showLinkerState,
-		linkExpr, unload, withExtendedLinkEnv,
+		linkExpr, linkDecls, unload, withExtendedLinkEnv,
                 extendLinkEnv, deleteFromLinkEnv,
                 extendLoadedPkgs, 
 		linkPackages,initDynLinker,linkModule,
@@ -52,6 +52,7 @@ import UniqSet
 import FastString
 import Config
 import SysTools
+import PrelNames
 
 -- Standard libraries
 import Control.Monad
@@ -427,9 +428,9 @@ linkExpr hsc_env span root_ul_bco
 
      needed_mods :: [Module]
      needed_mods = [ nameModule n | n <- free_names, 
-				    isExternalName n,	 	-- Names from other modules
-				    not (isWiredInName n)	-- Exclude wired-in names
-		   ]						-- (see note below)
+                     isExternalName n,      -- Names from other modules
+                     not (isWiredInName n)  -- Exclude wired-in names
+                   ]                        -- (see note below)
 	-- Exclude wired-in names because we may not have read
 	-- their interface files, so getLinkDeps will fail
 	-- All wired-in names are in the base package, which we link
@@ -476,7 +477,9 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods
 -- Find all the packages and linkables that a set of modules depends on
  = do {
 	-- 1.  Find the dependent home-pkg-modules/packages from each iface
-        (mods_s, pkgs_s) <- follow_deps mods emptyUniqSet emptyUniqSet;
+        -- (omitting iINTERACTIVE, which is already linked)
+        (mods_s, pkgs_s) <- follow_deps (filter ((/=) iNTERACTIVE) mods)
+                                        emptyUniqSet emptyUniqSet;
 
 	let {
 	-- 2.  Exclude ones already linked
@@ -488,7 +491,6 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods
                                 (objs_loaded pls ++ bcos_loaded pls)
 	} ;
 	
---        putStrLn (showSDoc (ppr mods_s)) ;
 	-- 3.  For each dependent module, find its linkable
 	--     This will either be in the HPT or (in the case of one-shot
 	--     compilation) we may need to use maybe_getFileLinkable
@@ -594,6 +596,53 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods
 	    adjust_ul _ _ = panic "adjust_ul"
 \end{code}
 
+
+%************************************************************************
+%*									*
+              Loading a Decls statement
+%*									*
+%************************************************************************
+\begin{code}
+linkDecls :: HscEnv -> SrcSpan -> CompiledByteCode -> IO () --[HValue]
+linkDecls hsc_env span (ByteCode unlinkedBCOs itblEnv) = do
+    -- Initialise the linker (if it's not been done already)
+    let dflags = hsc_dflags hsc_env
+    initDynLinker dflags
+
+    -- Take lock for the actual work.
+    modifyPLS $ \pls0 -> do
+
+    -- Link the packages and modules required
+    (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods
+    if failed ok
+      then ghcError (ProgramError "")
+      else do
+
+    -- Link the expression itself
+    let ie = plusNameEnv (itbl_env pls) itblEnv
+        ce = closure_env pls
+
+    -- Link the necessary packages and linkables
+    (final_gce, _) <- linkSomeBCOs False ie ce unlinkedBCOs
+    let pls2 = pls { closure_env = final_gce,
+                     itbl_env    = ie }
+    return (pls2, ()) --hvals)
+  where
+    free_names =  concatMap (nameSetToList . bcoFreeNames) unlinkedBCOs
+
+    needed_mods :: [Module]
+    needed_mods = [ nameModule n | n <- free_names, 
+                    isExternalName n,       -- Names from other modules
+                    not (isWiredInName n)   -- Exclude wired-in names
+                  ]                         -- (see note below)
+    -- Exclude wired-in names because we may not have read
+    -- their interface files, so getLinkDeps will fail
+    -- All wired-in names are in the base package, which we link
+    -- by default, so we can safely ignore them here.
+\end{code}
+
+
+
 %************************************************************************
 %*									*
               Loading a single module
diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs
index 0b28525148..798164c448 100644
--- a/compiler/iface/IfaceEnv.lhs
+++ b/compiler/iface/IfaceEnv.lhs
@@ -71,39 +71,49 @@ allocateGlobalBinder
   -> (NameCache, Name)
 allocateGlobalBinder name_supply mod occ loc
   = case lookupOrigNameCache (nsNames name_supply) mod occ of
-	-- A hit in the cache!  We are at the binding site of the name.
-	-- This is the moment when we know the SrcLoc
-	-- of the Name, so we set this field in the Name we return.
-	--
-	-- Then (bogus) multiple bindings of the same Name
-	-- get different SrcLocs can can be reported as such.
-	--
-	-- Possible other reason: it might be in the cache because we
-	-- 	encountered an occurrence before the binding site for an
-	--	implicitly-imported Name.  Perhaps the current SrcLoc is
-	--	better... but not really: it'll still just say 'imported'
-	--
-	-- IMPORTANT: Don't mess with wired-in names.  
-	-- 	      Their wired-in-ness is in their NameSort
-	--	      and their Module is correct.
-
-	Just name | isWiredInName name -> (name_supply, name)
-		  | otherwise -> (new_name_supply, name')
-		  where
-		    uniq      = nameUnique name
-		    name'     = mkExternalName uniq mod occ loc
-		    new_cache = extendNameCache (nsNames name_supply) mod occ name'
-		    new_name_supply = name_supply {nsNames = new_cache}		     
-
-	-- Miss in the cache!
-	-- Build a completely new Name, and put it in the cache
-	Nothing -> (new_name_supply, name)
-		where
-		  (uniq, us')     = takeUniqFromSupply (nsUniqs name_supply)
-		  name            = mkExternalName uniq mod occ loc
-		  new_cache       = extendNameCache (nsNames name_supply) mod occ name
-		  new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
-
+        -- A hit in the cache!  We are at the binding site of the name.
+        -- This is the moment when we know the SrcLoc
+        -- of the Name, so we set this field in the Name we return.
+        --
+        -- Then (bogus) multiple bindings of the same Name
+        -- get different SrcLocs can can be reported as such.
+        --
+        -- Possible other reason: it might be in the cache because we
+        -- 	encountered an occurrence before the binding site for an
+        --	implicitly-imported Name.  Perhaps the current SrcLoc is
+        --	better... but not really: it'll still just say 'imported'
+        --
+        -- IMPORTANT: Don't mess with wired-in names.
+        -- 	      Their wired-in-ness is in their NameSort
+        --	      and their Module is correct.
+
+        Just name | isWiredInName name -> (name_supply, name)
+                  | mod /= iNTERACTIVE -> (new_name_supply, name')
+                     -- Note [interactive name cache]
+                  where
+                    uniq            = nameUnique name
+                    name'           = mkExternalName uniq mod occ loc
+                    new_cache       = extendNameCache (nsNames name_supply) mod occ name'
+                    new_name_supply = name_supply {nsNames = new_cache}
+
+        -- Miss in the cache!
+        -- Build a completely new Name, and put it in the cache
+        _ -> (new_name_supply, name)
+                  where
+                    (uniq, us')     = takeUniqFromSupply (nsUniqs name_supply)
+                    name            = mkExternalName uniq mod occ loc
+                    new_cache       = extendNameCache (nsNames name_supply) mod occ name
+                    new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
+
+{- Note [interactive name cache]
+
+In GHCi we always create Names with the same Module, ":Interactive".
+However, we want to be able to shadow older declarations with newer
+ones, and we don't want the Name cache giving us back the same Unique
+for the new Name as for the old, hence this special case.
+
+See also Note [Outputable Orig RdrName] in HscTypes.
+-}
 
 newImplicitBinder :: Name			-- Base name
 	          -> (OccName -> OccName) 	-- Occurrence name modifier
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 7489ea3115..d803ea85fb 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -80,7 +80,7 @@ module GHC (
 	PrintUnqualified, alwaysQualify,
 
 	-- * Interactive evaluation
-	getBindings, getPrintUnqual,
+	getBindings, getInsts, getPrintUnqual,
         findModule,
         lookupModule,
 #ifdef GHCI
@@ -94,7 +94,7 @@ module GHC (
 	typeKind,
 	parseName,
 	RunResult(..),  
-	runStmt, runStmtWithLocation,
+	runStmt, runStmtWithLocation, runDecls, runDeclsWithLocation,
         parseImportDecl, SingleStep(..),
         resume,
         Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
@@ -166,7 +166,9 @@ module GHC (
 
 	-- ** Instances
 	Instance, 
-	instanceDFunId, pprInstance, pprInstanceHdr,
+	instanceDFunId, 
+        pprInstance, pprInstanceHdr,
+        pprFamInst, pprFamInstHdr,
 
 	-- ** Types and Kinds
 	Type, splitForAllTys, funResultTy, 
@@ -264,8 +266,9 @@ import Class
 import DataCon
 import Name             hiding ( varName )
 import InstEnv
+import FamInstEnv
 import SrcLoc
-import CoreSyn          ( CoreBind )
+import CoreSyn
 import TidyPgm
 import DriverPhases     ( Phase(..), isHaskellSrcFilename )
 import Finder
@@ -864,11 +867,15 @@ compileCore simplify fn = do
         -- we just have a ModGuts.
         gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
         gutsToCoreModule (Left (cg, md))  = CoreModule {
-          cm_module = cg_module cg,    cm_types = md_types md,
+          cm_module = cg_module cg,
+          cm_types = md_types md,
           cm_binds = cg_binds cg
         }
         gutsToCoreModule (Right mg) = CoreModule {
-          cm_module  = mg_module mg,                   cm_types   = mg_types mg,
+          cm_module  = mg_module mg,
+          cm_types   = typeEnvFromEntities (bindersOfBinds (mg_binds mg))
+                                           (mg_tcs mg) (mg_clss mg)
+                                           (mg_fam_insts mg),
           cm_binds   = mg_binds mg
          }
 
@@ -899,13 +906,12 @@ isLoaded m = withSession $ \hsc_env ->
 -- | Return the bindings for the current interactive session.
 getBindings :: GhcMonad m => m [TyThing]
 getBindings = withSession $ \hsc_env ->
-   -- we have to implement the shadowing behaviour of ic_tmp_ids here
-   -- (see InteractiveContext) and the quickest way is to use an OccEnv.
-   let 
-       occ_env = mkOccEnv [ (nameOccName (idName id), AnId id) 
-                          | id <- ic_tmp_ids (hsc_IC hsc_env) ]
-   in
-   return (occEnvElts occ_env)
+    return $ icInScopeTTs $ hsc_IC hsc_env
+
+-- | Return the instances for the current interactive session.
+getInsts :: GhcMonad m => m ([Instance], [FamInst])
+getInsts = withSession $ \hsc_env ->
+    return $ ic_instances (hsc_IC hsc_env)
 
 getPrintUnqual :: GhcMonad m => m PrintUnqualified
 getPrintUnqual = withSession $ \hsc_env ->
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 30a0c651b2..b688d4cf6a 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -63,6 +63,7 @@ module HscMain
     , hscRnImportDecls
     , hscTcRnLookupRdrName
     , hscStmt, hscStmtWithLocation
+    , hscDecls, hscDeclsWithLocation
     , hscTcExpr, hscImport, hscKcType
     , hscCompileCoreExpr
 #endif
@@ -71,13 +72,11 @@ module HscMain
 
 #ifdef GHCI
 import ByteCodeGen	( byteCodeGen, coreExprToBCOs )
-import Linker		( HValue, linkExpr )
+import Linker
 import CoreTidy		( tidyExpr )
 import Type		( Type )
-import TcType           ( tyVarsOfTypes )
-import PrelNames	( iNTERACTIVE )
+import PrelNames
 import {- Kind parts of -} Type		( Kind )
-import Id      	     	( idType )
 import CoreLint		( lintUnfolding )
 import DsMeta		( templateHaskellNames )
 import VarSet
@@ -85,7 +84,7 @@ import VarEnv		( emptyTidyEnv )
 import Panic
 #endif
 
-import Id		( Id )
+import Id
 import Module
 import Packages
 import RdrName
@@ -100,7 +99,7 @@ import TcIface		( typecheckIface )
 import TcRnMonad
 import IfaceEnv		( initNameCache )
 import LoadIface	( ifaceStats, initExternalPackageState )
-import PrelInfo		( wiredInThings, basicKnownKeyNames )
+import PrelInfo
 import MkIface
 import Desugar
 import SimplCore
@@ -111,8 +110,9 @@ import qualified StgCmm	( codeGen )
 import StgSyn
 import CostCentre
 import ProfInit
-import TyCon            ( TyCon, isDataTyCon )
-import Name		( Name, NamedThing(..) )
+import TyCon
+import Class
+import Name
 import SimplStg		( stg2stg )
 import CodeGen		( codeGen )
 import OldCmm as Old    ( CmmGroup )
@@ -127,7 +127,7 @@ import CodeOutput
 import NameEnv          ( emptyNameEnv )
 import NameSet          ( emptyNameSet )
 import InstEnv
-import FamInstEnv       ( emptyFamInstEnv )
+import FamInstEnv
 import Fingerprint      ( Fingerprint )
 
 import DynFlags
@@ -1287,8 +1287,8 @@ hscStmtWithLocation hsc_env stmt source linenumber = runHsc hsc_env $ do
                             tcRnStmt hsc_env icontext parsed_stmt
 	    -- Desugar it
 	let rdr_env  = ic_rn_gbl_env icontext
-	    type_env = mkTypeEnv (map AnId (ic_tmp_ids icontext))
-	ds_expr <- ioMsgMaybe $
+            type_env = mkTypeEnvWithImplicits (ic_tythings icontext)
+        ds_expr <- ioMsgMaybe $
                      deSugarExpr hsc_env iNTERACTIVE rdr_env type_env tc_expr
         handleWarnings
 
@@ -1297,7 +1297,90 @@ hscStmtWithLocation hsc_env stmt source linenumber = runHsc hsc_env $ do
         hsc_env <- getHscEnv
 	hval <- liftIO $ hscCompileCoreExpr hsc_env src_span ds_expr
 
-	return $ Just (ids, hval)
+        return $ Just (ids, hval)
+
+hscDecls                -- Compile a decls
+  :: HscEnv
+  -> String             -- The statement
+  -> IO ([TyThing], InteractiveContext)
+hscDecls hsc_env str = hscDeclsWithLocation hsc_env str "<interactive>" 1
+
+hscDeclsWithLocation    -- Compile a decls
+  :: HscEnv
+  -> String             -- The statement
+  -> String             -- the source
+  -> Int                -- ^ starting line
+  -> IO ([TyThing], InteractiveContext)
+hscDeclsWithLocation hsc_env str source linenumber = runHsc hsc_env $ do 
+    L _ (HsModule{hsmodDecls=decls}) <-
+        hscParseThingWithLocation source linenumber parseModule str
+    
+    -- Rename and typecheck it
+    let icontext = hsc_IC hsc_env
+    tc_gblenv <- ioMsgMaybe $ tcRnDeclsi hsc_env icontext decls
+
+    -- Grab the new instances
+    -- We grab the whole environment because of the overlapping that may have 
+    -- been done.  See the notes at the definition of InteractiveContext
+    -- (ic_instances) for more details.
+    let finsts  = famInstEnvElts $ tcg_fam_inst_env tc_gblenv
+        insts   = instEnvElts $ tcg_inst_env tc_gblenv
+
+	-- Desugar it
+    -- We use a basically null location for iNTERACTIVE
+    let iNTERACTIVELoc = ModLocation{ ml_hs_file   = Nothing,
+                                      ml_hi_file   = undefined,
+                                      ml_obj_file  = undefined}
+    ds_result <- ioMsgMaybe $ deSugar hsc_env iNTERACTIVELoc tc_gblenv
+    handleWarnings
+
+        -- Simplify
+    simpl_mg <- liftIO $ hscSimplify hsc_env ds_result
+
+        -- Tidy
+    (tidy_cg, _mod_details) <- liftIO $ tidyProgram hsc_env simpl_mg
+
+    let dflags = hsc_dflags hsc_env
+        CgGuts{ cg_binds     = core_binds,
+                cg_tycons    = tycons,
+                cg_modBreaks = mod_breaks } = tidy_cg
+        data_tycons = filter isDataTyCon tycons
+
+	-------------------
+	-- PREPARE FOR CODE GENERATION
+	-- Do saturation and convert to A-normal form
+    prepd_binds <- {-# SCC "CorePrep" #-}
+                    liftIO $ corePrepPgm dflags core_binds data_tycons
+
+    -----------------  Generate byte code ------------------
+    cbc <- liftIO $ byteCodeGen dflags prepd_binds data_tycons mod_breaks
+
+    let src_span = srcLocSpan interactiveSrcLoc
+    hsc_env <- getHscEnv
+    liftIO $ linkDecls hsc_env src_span cbc
+
+    -- pprTrace "te" (ppr te) $ return ()
+
+    let
+        tcs     = filter (not . isImplicitTyCon) $ mg_tcs simpl_mg
+        clss    = mg_clss simpl_mg
+        tythings = map ATyCon tcs ++ map (ATyCon . classTyCon) clss
+        sys_vars = filter (isExternalName . idName) $
+                      bindersOfBinds (cg_binds tidy_cg)
+                   -- we only need to keep around the external bindings
+                   -- (as decided by TidyPgm), since those are the only ones
+                   -- that might be referenced elsewhere.
+
+    -- pprTrace "new tycons"  (ppr tcs) $ return ()
+    -- pprTrace "new classes" (ppr clss) $ return ()
+    -- pprTrace "new sys Ids" (ppr sys_vars) $ return ()
+
+    let ictxt1 = extendInteractiveContext icontext tythings
+        ictxt = ictxt1 {
+            ic_sys_vars   = sys_vars ++ ic_sys_vars ictxt1,
+            ic_instances  = (insts, finsts) }
+    
+    return $ (tythings, ictxt)
 
 hscImport :: HscEnv -> String -> IO (ImportDecl RdrName)
 hscImport hsc_env str = runHsc hsc_env $ do
@@ -1311,7 +1394,7 @@ hscImport hsc_env str = runHsc hsc_env $ do
 
 hscTcExpr	-- Typecheck an expression (but don't run it)
   :: HscEnv
-  -> String			-- The expression
+  -> String                     -- The expression
   -> IO Type
 
 hscTcExpr hsc_env expr = runHsc hsc_env $ do
@@ -1326,7 +1409,7 @@ hscTcExpr hsc_env expr = runHsc hsc_env $ do
 -- | Find the kind of a type
 hscKcType
   :: HscEnv
-  -> String			-- ^ The type
+  -> String                     -- ^ The type
   -> IO Kind
 
 hscKcType hsc_env str = runHsc hsc_env $ do
@@ -1414,7 +1497,8 @@ mkModGuts mod binds = ModGuts {
   mg_used_th = False,
   mg_rdr_env = emptyGlobalRdrEnv,
   mg_fix_env = emptyFixityEnv,
-  mg_types = emptyTypeEnv,
+  mg_tcs   = [],
+  mg_clss  = [],
   mg_insts = [],
   mg_fam_insts = [],
   mg_rules = [],
@@ -1463,9 +1547,11 @@ hscCompileCoreExpr hsc_env srcspan ds_expr
   	-- ToDo: improve SrcLoc
     when lint_on $
        let ictxt = hsc_IC hsc_env
-           tyvars = varSetElems (tyVarsOfTypes (map idType (ic_tmp_ids ictxt)))
+           te     = mkTypeEnvWithImplicits (ic_tythings ictxt ++ map AnId (ic_sys_vars ictxt))
+           tyvars = varSetElems $ tyThingsTyVars $ typeEnvElts $ te
+           vars   = typeEnvIds te
        in
-           case lintUnfolding noSrcLoc tyvars prepd_expr of
+           case lintUnfolding noSrcLoc (tyvars ++ vars) prepd_expr of
   	      Just err -> pprPanic "hscCompileCoreExpr" err
   	      Nothing  -> return ()
 
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 7fab8d0ff7..0b90fd9668 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -41,10 +41,10 @@ module HscTypes (
         prepareAnnotations,
 
         -- * Interactive context
-	InteractiveContext(..), emptyInteractiveContext, 
-        InteractiveImport(..),
-	icPrintUnqual, extendInteractiveContext,
-        substInteractiveContext,
+        InteractiveContext(..), emptyInteractiveContext, 
+        icPrintUnqual, icInScopeTTs, icPlusGblRdrEnv,
+        extendInteractiveContext, substInteractiveContext,
+        InteractiveImport(..), 
         mkPrintUnqualified, pprModulePrefix,
 
 	-- * Interfaces
@@ -55,15 +55,17 @@ module HscTypes (
 	FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
 
         -- * TyThings and type environments
-	TyThing(..),
+        TyThing(..),  tyThingAvailInfo,
 	tyThingTyCon, tyThingDataCon,
-        tyThingId, tyThingCoAxiom, tyThingParent_maybe,
-	implicitTyThings, implicitTyConThings, implicitClassThings, isImplicitTyThing,
+        tyThingId, tyThingCoAxiom, tyThingParent_maybe, tyThingsTyVars,
+        implicitTyThings, implicitTyConThings, implicitClassThings,
+        isImplicitTyThing,
 	
 	TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
+        typeEnvFromEntities, mkTypeEnvWithImplicits,
 	extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
 	typeEnvElts, typeEnvTyCons, typeEnvIds,
-	typeEnvDataCons, typeEnvCoAxioms,
+        typeEnvDataCons, typeEnvCoAxioms, typeEnvClasses,
 
         -- * MonadThings
         MonadThings(..),
@@ -73,8 +75,8 @@ module HscTypes (
 	Dependencies(..), noDependencies,
 	NameCache(..), OrigNameCache, OrigIParamCache,
 	Avails, availsToNameSet, availsToNameEnv, availName, availNames,
-	AvailInfo(..),
-	IfaceExport, stableAvailCmp, 
+        AvailInfo(..), gresFromAvails, gresFromAvail,
+        IfaceExport, stableAvailCmp,
 
 	-- * Warnings
 	Warnings(..), WarningTxt(..), plusWarns,
@@ -118,7 +120,7 @@ import NameEnv
 import NameSet  
 import Module
 import InstEnv          ( InstEnv, Instance )
-import FamInstEnv       ( FamInstEnv, FamInst )
+import FamInstEnv
 import Rules            ( RuleBase )
 import CoreSyn          ( CoreBind )
 import VarEnv
@@ -129,23 +131,24 @@ import IdInfo		( IdDetails(..) )
 import Type             
 
 import Annotations
-import Class		( Class, classAllSelIds, classATs, classTyCon )
+import Class
 import TyCon
-import DataCon		( DataCon, dataConImplicitIds, dataConWrapId, dataConTyCon )
+import DataCon
 import PrelNames	( gHC_PRIM )
 import Packages hiding ( Version(..) )
 import DynFlags
-import DriverPhases	( HscSource(..), isHsBoot, hscSourceString, Phase )
-import BasicTypes	( IPName, defaultFixity, WarningTxt(..) )
+import DriverPhases
+import BasicTypes
 import OptimizationFuel	( OptFuelState )
 import IfaceSyn
 import CoreSyn		( CoreRule, CoreVect )
-import Maybes		( orElse, expectJust, catMaybes )
+import Maybes
 import Outputable
 import BreakArray
 import SrcLoc
-import UniqFM		( lookupUFM, eltsUFM, emptyUFM )
-import UniqSupply	( UniqSupply )
+import Unique
+import UniqFM
+import UniqSupply
 import FastString
 import StringBuffer	( StringBuffer )
 import Fingerprint
@@ -159,7 +162,6 @@ import System.Time	( ClockTime )
 import Data.IORef
 import Data.Array       ( Array, array )
 import Data.Map         ( Map )
-import Data.List
 import Data.Word
 import Control.Monad    ( mplus, guard, liftM, when )
 import Exception
@@ -747,7 +749,8 @@ data ModGuts
 	-- These fields all describe the things **declared in this module**
 	mg_fix_env   :: !FixityEnv,	 -- ^ Fixities declared in this module
 	                                 -- TODO: I'm unconvinced this is actually used anywhere
-	mg_types     :: !TypeEnv,        -- ^ Types declared in this module
+        mg_tcs       :: ![TyCon],        -- ^ TyCons declared in this module
+        mg_clss      :: ![Class],        -- ^ Classes declared in this module
 	mg_insts     :: ![Instance],	 -- ^ Class instances declared in this module
 	mg_fam_insts :: ![FamInst],	 -- ^ Family instances declared in this module
         mg_rules     :: ![CoreRule],	 -- ^ Before the core pipeline starts, contains 
@@ -895,70 +898,130 @@ data InteractiveContext
              -- ^ The GHCi context is extended with these imports
 
          ic_rn_gbl_env :: GlobalRdrEnv,
-             -- ^ The contexts' cached 'GlobalRdrEnv', built by
-             -- 'InteractiveEval.setContext'
+             -- ^ The cached 'GlobalRdrEnv', built by
+             -- 'InteractiveEval.setContext' and updated regularly
 
-         ic_tmp_ids :: [Id],
-             -- ^ Names bound during interaction with the user.  Later
-             -- Ids shadow earlier ones with the same OccName
-             -- Expressions are typed with these Ids in the envt For
-             -- runtime-debugging, these Ids may have free TcTyVars of
-             -- RuntimUnkSkol flavour, but no free TyVars (because the
-             -- typechecker doesn't expect that)
+         ic_tythings :: [TyThing],
+             -- ^ TyThings defined by the user, in reverse order of
+             -- definition.
+
+         ic_sys_vars  :: [Id],
+             -- ^ Variables defined automatically by the system (e.g.
+             -- record field selectors).  See Notes [ic_sys_vars]
+
+         ic_instances :: ([Instance], [FamInst]),
+             -- ^ All instances and family instances created during
+             -- this session.  These are grabbed en masse after each
+             -- update to be sure that proper overlapping is retained.
+             -- That is, rather than re-check the overlapping each
+             -- time we update the context, we just take the results
+             -- from the instance code that already does that.
 
 #ifdef GHCI
-         ic_resume :: [Resume],
+          ic_resume :: [Resume],
              -- ^ The stack of breakpoint contexts
 #endif
 
-         ic_cwd :: Maybe FilePath
+          ic_cwd :: Maybe FilePath
              -- virtual CWD of the program
     }
 
-data InteractiveImport 
-  = IIDecl (ImportDecl RdrName)	-- Bring the exports of a particular module
-    	   	       		-- (filtered by an import decl) into scope
+{-
+Note [ic_sys_vars]
 
-  | IIModule Module	-- Bring into scope the entire top-level envt of
-    	     		-- of this module, including the things imported
-			-- into it.
- 
+This list constains any Ids that arise from TyCons, Classes or
+instances defined interactively, but that are not given by
+'implicitTyThings'.  This includes record selectors, default methods,
+and dfuns.
+
+We *could* get rid of this list and generate these Ids from
+ic_tythings:
+
+   - dfuns come from Instances
+   - record selectors from TyCons
+   - default methods from Classes
+
+For record selectors the TyCon gives the Name, but in order to make an
+Id we would have to construct the type ourselves.  Similarly for
+default methods.  So for now we collect the Ids after tidying (see
+hscDeclsWithLocation) and save them in ic_sys_vars.
+-}
+
+-- | Constructs an empty InteractiveContext.
 emptyInteractiveContext :: InteractiveContext
-emptyInteractiveContext
-  = InteractiveContext { ic_imports = [],
-			 ic_rn_gbl_env = emptyGlobalRdrEnv,
-			 ic_tmp_ids = []
+emptyInteractiveContext = InteractiveContext {
+    ic_imports      = [],
+    ic_rn_gbl_env   = emptyGlobalRdrEnv,
+    ic_tythings     = [],
+    ic_sys_vars     = [],
+    ic_instances    = ([],[]),
 #ifdef GHCI
-                         , ic_resume = []
+    ic_resume       = [],
 #endif
-                         , ic_cwd = Nothing
-                       }
-
-icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
-icPrintUnqual dflags ictxt = mkPrintUnqualified dflags (ic_rn_gbl_env ictxt)
+    ic_cwd          = Nothing }
 
+-- | This function returns the list of visible TyThings (useful for
+-- e.g. showBindings)
+icInScopeTTs :: InteractiveContext -> [TyThing]
+icInScopeTTs = ic_tythings
 
+-- | Get the PrintUnqualified function based on the flags and this InteractiveContext
+icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
+icPrintUnqual dflags InteractiveContext{ ic_rn_gbl_env = grenv } = 
+    mkPrintUnqualified dflags grenv
+
+-- | This function is called with new TyThings recently defined to update the 
+-- InteractiveContext to include them.  Ids are easily removed when shadowed,
+-- but Classes and TyCons are not.  Some work could be done to determine 
+-- whether they are entirely shadowed, but as you could still have references 
+-- to them (e.g. instances for classes or values of the type for TyCons), it's
+-- not clear whether removing them is even the appropriate behavior.
 extendInteractiveContext
         :: InteractiveContext
-        -> [Id]
+        -> [TyThing]
         -> InteractiveContext
-extendInteractiveContext ictxt ids
-  = ictxt { ic_tmp_ids =  snub ((ic_tmp_ids ictxt \\ ids) ++ ids)
-                          -- NB. must be this way around, because we want
-                          -- new ids to shadow existing bindings.
+extendInteractiveContext ictxt new_tythings
+  = ictxt { ic_tythings = new_tythings ++ old_tythings
+          , ic_rn_gbl_env = new_tythings `icPlusGblRdrEnv` ic_rn_gbl_env ictxt
           }
-    where snub = map head . group . sort
+  where
+    old_tythings = filter (not . shadowed) (ic_tythings ictxt)
+
+    shadowed (AnId id) = ((`elem` new_names) . nameOccName . idName) id
+    shadowed _ = False
+
+    new_names = [ nameOccName (getName id) | AnId id <- new_tythings ]
+
+    -- XXX should not add Ids to the gbl env here
+
+-- | Add TyThings to the GlobalRdrEnv, earlier ones in the list
+-- shadowing later ones, and shadowing existing entries in the
+-- GlobalRdrEnv.
+icPlusGblRdrEnv :: [TyThing] -> GlobalRdrEnv -> GlobalRdrEnv
+icPlusGblRdrEnv tythings env = extendOccEnvList env list
+  where new_gres = gresFromAvails LocalDef (map tyThingAvailInfo tythings)
+        list = [ (nameOccName (gre_name gre), [gre]) | gre <- new_gres ]
 
 substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext
 substInteractiveContext ictxt subst | isEmptyTvSubst subst = ictxt
-substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst 
-  = ictxt { ic_tmp_ids = map subst_ty ids }
+substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst 
+  = ictxt { ic_tythings = map subst_ty tts }
   where
-   subst_ty id = id `setIdType` substTy subst (idType id)
+   subst_ty (AnId id) = AnId $ id `setIdType` substTy subst (idType id)
+   subst_ty tt = tt
+
+data InteractiveImport
+  = IIDecl (ImportDecl RdrName)	-- Bring the exports of a particular module
+                                -- (filtered by an import decl) into scope
+
+  | IIModule Module	-- Bring into scope the entire top-level envt of
+                    -- of this module, including the things imported
+                    -- into it.
 
 instance Outputable InteractiveImport where
   ppr (IIModule m) = char '*' <> ppr m
   ppr (IIDecl d)   = ppr d
+
 \end{code}
 
 %************************************************************************
@@ -1003,7 +1066,7 @@ the (ppr mod) of case (3), in Name.pprModulePrefix
 mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified
 mkPrintUnqualified dflags env = (qual_name, qual_mod)
   where
-  qual_name mod occ	-- The (mod,occ) pair is the original name of the thing
+  qual_name name
         | [gre] <- unqual_gres, right_name gre = NameUnqual
 		-- If there's a unique entity that's in scope unqualified with 'occ'
 		-- AND that entity is the right one, then we can use the unqualified name
@@ -1017,7 +1080,15 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
 
 	| otherwise = panic "mkPrintUnqualified"
       where
-	right_name gre = nameModule_maybe (gre_name gre) == Just mod
+        mod = nameModule name
+        occ = nameOccName name
+
+        is_rdr_orig = nameUnique name == mkUniqueGrimily 0
+         -- Note [Outputable Orig RdrName]
+
+        right_name gre
+          | is_rdr_orig = nameModule_maybe (gre_name gre) == Just mod
+          | otherwise   = gre_name gre == name
 
         unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
         qual_gres   = filter right_name (lookupGlobalRdrEnv env occ)
@@ -1041,6 +1112,25 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
 
      | otherwise = True
      where lookup = lookupModuleInAllPackages dflags (moduleName mod)
+
+-- Note [Outputable Orig RdrName]
+--
+-- This is a Grotesque Hack.  The Outputable instance for RdrEnv wants
+-- to print Orig names, which are just pairs of (Module,OccName).  But
+-- we want to use full Names here, because in GHCi we might have Ids
+-- that have the same (Module,OccName) pair but a different Unique
+-- (this happens when you shadow a TyCon or Class in GHCi).
+--
+-- So in Outputable RdrName we just use a dummy Unique (0), and check
+-- for it here.
+--
+-- Arguably GHCi is invalidating the assumption that (Module,OccName)
+-- uniquely identifies an entity.  But we do want to be able to shadow
+-- old declarations with new ones in GHCi, and it would be hard to
+-- delete all references to the old declaration when that happened.
+-- See also Note [interactive name cache] in IfaceEnv for somewhere
+-- else that this broken assumption bites.
+--
 \end{code}
 
 
@@ -1090,6 +1180,8 @@ implicitTyConThings tc
       -- for each data constructor in order,
       --   the contructor, worker, and (possibly) wrapper
     concatMap (extras_plus . ADataCon) (tyConDataCons tc)
+      -- NB. record selectors are *not* implicit, they have fully-fledged
+      -- bindings that pass through the compilation pipeline as normal.
   where
     class_stuff = case tyConClass_maybe tc of
         Nothing -> []
@@ -1121,26 +1213,49 @@ isImplicitTyThing (AnId id)     = isImplicitId id
 isImplicitTyThing (ATyCon tc)   = isImplicitTyCon tc
 isImplicitTyThing (ACoAxiom {}) = True
 
-extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
-extendTypeEnvWithIds env ids
-  = extendNameEnvList env [(getName id, AnId id) | id <- ids]
-
 tyThingParent_maybe :: TyThing -> Maybe TyThing
 -- (tyThingParent_maybe x) returns (Just p)
 -- when pprTyThingInContext sould print a declaration for p
 -- (albeit with some "..." in it) when asked to show x
 -- It returns the *immediate* parent.  So a datacon returns its tycon
--- but the tycon could be the assocated type of a class, so it in turn
+-- but the tycon could be the associated type of a class, so it in turn
 -- might have a parent.
 tyThingParent_maybe (ADataCon dc) = Just (ATyCon (dataConTyCon dc))
 tyThingParent_maybe (ATyCon tc)   = case tyConAssoc_maybe tc of
                                       Just cls -> Just (ATyCon (classTyCon cls))
                                       Nothing  -> Nothing
 tyThingParent_maybe (AnId id)     = case idDetails id of
-      				      	 RecSelId { sel_tycon = tc } -> Just (ATyCon tc)
+                                         RecSelId { sel_tycon = tc } -> Just (ATyCon tc)
       				      	 ClassOpId cls               -> Just (ATyCon (classTyCon cls))
                                       	 _other                      -> Nothing
 tyThingParent_maybe _other = Nothing
+
+tyThingsTyVars :: [TyThing] -> TyVarSet
+tyThingsTyVars tts =
+    unionVarSets $ map ttToVarSet tts
+    where
+        ttToVarSet (AnId id)     = tyVarsOfType $ idType id
+        ttToVarSet (ADataCon dc) = tyVarsOfType $ dataConRepType dc
+        ttToVarSet (ATyCon tc)
+          = case tyConClass_maybe tc of
+              Just cls -> (mkVarSet . fst . classTvsFds) cls
+              Nothing  -> tyVarsOfType $ tyConKind tc
+        ttToVarSet _             = emptyVarSet
+
+-- | The Names that a TyThing should bring into scope.  Used to build
+-- the GlobalRdrEnv for the InteractiveContext.
+tyThingAvailInfo :: TyThing -> AvailInfo
+tyThingAvailInfo (ATyCon t)
+   = case tyConClass_maybe t of
+        Just c  -> AvailTC n (n : map getName (classMethods c)
+                  ++ map getName (classATs c))
+             where n = getName c
+        Nothing -> AvailTC n (n : map getName dcs ++
+                                   concatMap dataConFieldLabels dcs)
+             where n = getName t
+                   dcs = tyConDataCons t
+tyThingAvailInfo t
+   = Avail (getName t)
 \end{code}
 
 %************************************************************************
@@ -1160,6 +1275,7 @@ typeEnvTyCons   :: TypeEnv -> [TyCon]
 typeEnvCoAxioms :: TypeEnv -> [CoAxiom]
 typeEnvIds      :: TypeEnv -> [Id]
 typeEnvDataCons :: TypeEnv -> [DataCon]
+typeEnvClasses  :: TypeEnv -> [Class]
 lookupTypeEnv   :: TypeEnv -> Name -> Maybe TyThing
 
 emptyTypeEnv 	    = emptyNameEnv
@@ -1168,10 +1284,27 @@ typeEnvTyCons   env = [tc | ATyCon tc   <- typeEnvElts env]
 typeEnvCoAxioms env = [ax | ACoAxiom ax <- typeEnvElts env] 
 typeEnvIds      env = [id | AnId id     <- typeEnvElts env] 
 typeEnvDataCons env = [dc | ADataCon dc <- typeEnvElts env] 
+typeEnvClasses  env = [cl | tc <- typeEnvTyCons env,
+                            Just cl <- [tyConClass_maybe tc]]
 
 mkTypeEnv :: [TyThing] -> TypeEnv
 mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
 		
+mkTypeEnvWithImplicits :: [TyThing] -> TypeEnv
+mkTypeEnvWithImplicits things = 
+  mkTypeEnv things
+    `plusNameEnv`
+  mkTypeEnv (concatMap implicitTyThings things)
+
+typeEnvFromEntities :: [Id] -> [TyCon] -> [Class] -> [FamInst] -> TypeEnv
+typeEnvFromEntities ids tcs clss faminsts =
+  mkTypeEnv (   map AnId ids
+             ++ map ATyCon all_tcs
+             ++ concatMap implicitTyConThings all_tcs
+            )
+ where
+  all_tcs = tcs ++ map classTyCon clss ++ map famInstTyCon faminsts
+
 lookupTypeEnv = lookupNameEnv
 
 -- Extend the type environment
@@ -1180,6 +1313,11 @@ extendTypeEnv env thing = extendNameEnv env (getName thing) thing
 
 extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
 extendTypeEnvList env things = foldl extendTypeEnv env things
+
+extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
+extendTypeEnvWithIds env ids
+  = extendNameEnvList env [(getName id, AnId id) | id <- ids]
+
 \end{code}
 
 \begin{code}
@@ -1377,6 +1515,25 @@ availNames :: AvailInfo -> [Name]
 availNames (Avail n)      = [n]
 availNames (AvailTC _ ns) = ns
 
+-- | make a 'GlobalRdrEnv' where all the elements point to the same
+-- import declaration (useful for "hiding" imports, or imports with
+-- no details).
+gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
+gresFromAvails prov avails
+  = concatMap (gresFromAvail (const prov)) avails
+
+gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
+gresFromAvail prov_fn avail
+  = [ GRE {gre_name = n,
+           gre_par = parent n avail,
+           gre_prov = prov_fn n}
+    | n <- availNames avail ]
+  where
+    parent _ (Avail _)                 = NoParent
+    parent n (AvailTC m _) | n == m    = NoParent
+                           | otherwise = ParentIs m
+
+
 instance Outputable AvailInfo where
    ppr = pprAvail
 
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index d94e514ab8..3e763d55eb 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -9,7 +9,7 @@
 module InteractiveEval (
 #ifdef GHCI
         RunResult(..), Status(..), Resume(..), History(..),
-	runStmt, runStmtWithLocation,
+	runStmt, runStmtWithLocation, runDecls, runDeclsWithLocation,
         parseImportDecl, SingleStep(..),
         resume,
         abandon, abandonAll,
@@ -42,7 +42,6 @@ import GhcMonad
 import HscMain
 import HsSyn
 import HscTypes
-import RnNames          (gresFromAvails)
 import InstEnv
 import Type     hiding( typeKind )
 import TcType		hiding( typeKind )
@@ -93,8 +92,7 @@ import System.IO.Unsafe
 
 data RunResult
   = RunOk [Name] 		-- ^ names bound by this evaluation
-  | RunFailed	 		-- ^ statement failed compilation
-  | RunException SomeException	-- ^ statement raised an exception
+  | RunException SomeException  -- ^ statement raised an exception
   | RunBreak ThreadId [Name] (Maybe BreakInfo)
 
 data Status
@@ -109,7 +107,7 @@ data Resume
        resumeThreadId  :: ThreadId,     -- thread running the computation
        resumeBreakMVar :: MVar (),   
        resumeStatMVar  :: MVar Status,
-       resumeBindings  :: [Id],
+       resumeBindings  :: ([TyThing], GlobalRdrEnv),
        resumeFinalIds  :: [Id],         -- [Id] to bind on completion
        resumeApStack   :: HValue,       -- The object from which we can get
                                         -- value of the free variables.
@@ -203,9 +201,9 @@ runStmtWithLocation source linenumber expr step =
     r <- liftIO $ hscStmtWithLocation hsc_env' expr source linenumber
 
     case r of
-      Nothing -> return RunFailed -- empty statement / comment
+      Nothing -> return (RunOk []) -- empty statement / comment
 
-      Just (ids, hval) -> do
+      Just (tyThings, hval) -> do
         status <-
           withVirtualCWD $
             withBreakAction (isStep step) dflags' breakMVar statusMVar $ do
@@ -213,16 +211,38 @@ runStmtWithLocation source linenumber expr step =
                 liftIO $ sandboxIO dflags' statusMVar thing_to_run
               
         let ic = hsc_IC hsc_env
-            bindings = ic_tmp_ids ic
+            bindings = (ic_tythings ic, ic_rn_gbl_env ic)
 
         case step of
           RunAndLogSteps ->
-              traceRunStatus expr bindings ids
+              traceRunStatus expr bindings tyThings
                              breakMVar statusMVar status emptyHistory
           _other ->
-              handleRunStatus expr bindings ids
+              handleRunStatus expr bindings tyThings
                                breakMVar statusMVar status emptyHistory
 
+runDecls :: GhcMonad m => String -> m [Name]
+runDecls = runDeclsWithLocation "<interactive>" 1
+
+runDeclsWithLocation :: GhcMonad m => String -> Int -> String -> m [Name]
+runDeclsWithLocation source linenumber expr =
+  do
+    hsc_env <- getSession
+
+    -- Turn off -fwarn-unused-bindings when running a statement, to hide
+    -- warnings about the implicit bindings we introduce.
+    let dflags'  = wopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
+        hsc_env' = hsc_env{ hsc_dflags = dflags' }
+
+    (tyThings, ic) <- liftIO $ hscDeclsWithLocation hsc_env' expr source linenumber
+    
+    setSession $ hsc_env { hsc_IC = ic }
+    hsc_env <- getSession
+    hsc_env' <- liftIO $ rttiEnvironment hsc_env
+    modifySession (\_ -> hsc_env')
+    return (map getName tyThings)
+
+
 withVirtualCWD :: GhcMonad m => m a -> m a
 withVirtualCWD m = do
   hsc_env <- getSession
@@ -251,7 +271,7 @@ emptyHistory :: BoundedList History
 emptyHistory = nilBL 50 -- keep a log of length 50
 
 handleRunStatus :: GhcMonad m =>
-                   String-> [Id] -> [Id]
+                   String-> ([TyThing],GlobalRdrEnv) -> [Id]
                 -> MVar () -> MVar Status -> Status -> BoundedList History
                 -> m RunResult
 handleRunStatus expr bindings final_ids breakMVar statusMVar status
@@ -280,15 +300,16 @@ handleRunStatus expr bindings final_ids breakMVar statusMVar status
 	    Left e -> return (RunException e)
 	    Right hvals -> do
                 hsc_env <- getSession
-                let final_ic = extendInteractiveContext (hsc_IC hsc_env) final_ids 
-                    final_names = map idName final_ids
+                let final_ic = extendInteractiveContext (hsc_IC hsc_env)
+                                                        (map AnId final_ids)
+                    final_names = map getName final_ids
                 liftIO $ Linker.extendLinkEnv (zip final_names hvals)
                 hsc_env' <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic}
                 modifySession (\_ -> hsc_env')
                 return (RunOk final_names)
 
 traceRunStatus :: GhcMonad m =>
-                  String -> [Id] -> [Id]
+                  String -> ([TyThing], GlobalRdrEnv) -> [Id]
                -> MVar () -> MVar Status -> Status -> BoundedList History
                -> m RunResult
 traceRunStatus expr bindings final_ids
@@ -448,15 +469,16 @@ resume canLogSpan step
         -- unbind the temporary locals by restoring the TypeEnv from
         -- before the breakpoint, and drop this Resume from the
         -- InteractiveContext.
-        let resume_tmp_ids = resumeBindings r
-            ic' = ic { ic_tmp_ids  = resume_tmp_ids,
+        let (resume_tmp_te,resume_rdr_env) = resumeBindings r
+            ic' = ic { ic_tythings = resume_tmp_te,
+                       ic_rn_gbl_env = resume_rdr_env,
                        ic_resume   = rs }
         modifySession (\_ -> hsc_env{ hsc_IC = ic' })
         
         -- remove any bindings created since the breakpoint from the 
         -- linker's environment
-        let new_names = map idName (filter (`notElem` resume_tmp_ids)
-                                           (ic_tmp_ids ic))
+        let new_names = map getName (filter (`notElem` resume_tmp_te)
+                                           (ic_tythings ic))
         liftIO $ Linker.deleteFromLinkEnv new_names
         
         when (isStep step) $ liftIO setStepFlag
@@ -555,7 +577,7 @@ bindLocalsAtBreakpoint hsc_env apStack Nothing = do
        e_fs      = fsLit "e"
        e_name    = mkInternalName (getUnique e_fs) (mkTyVarOccFS e_fs) span
        e_tyvar   = mkRuntimeUnkTyVar e_name liftedTypeKind
-       exn_id    = Id.mkVanillaGlobal exn_name (mkTyVarTy e_tyvar)
+       exn_id    = AnId $ Id.mkVanillaGlobal exn_name (mkTyVarTy e_tyvar)
 
        ictxt0 = hsc_IC hsc_env
        ictxt1 = extendInteractiveContext ictxt0 [exn_id]
@@ -627,7 +649,7 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
        (_,tidy_tys) = tidyOpenTypes emptyTidyEnv id_tys
        final_ids = zipWith setIdType all_ids tidy_tys
        ictxt0 = hsc_IC hsc_env
-       ictxt1 = extendInteractiveContext ictxt0 final_ids
+       ictxt1 = extendInteractiveContext ictxt0 (map AnId final_ids)
 
    Linker.extendLinkEnv [ (name,hval) | (name, Just hval) <- zip names mb_hValues ]
    when result_ok $ Linker.extendLinkEnv [(result_name, unsafeCoerce# apStack)]
@@ -656,7 +678,7 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
 
 rttiEnvironment :: HscEnv -> IO HscEnv 
 rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
-   let InteractiveContext{ic_tmp_ids=tmp_ids} = ic
+   let tmp_ids = [id | AnId id <- ic_tythings ic]
        incompletelyTypedIds = 
            [id | id <- tmp_ids
                , not $ noSkolems id
@@ -666,7 +688,7 @@ rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
     where
      noSkolems = isEmptyVarSet . tyVarsOfType . idType
      improveTypes hsc_env@HscEnv{hsc_IC=ic} name = do
-      let InteractiveContext{ic_tmp_ids=tmp_ids} = ic
+      let tmp_ids = [id | AnId id <- ic_tythings ic]
           Just id = find (\i -> idName i == name) tmp_ids
       if noSkolems id
          then return hsc_env
@@ -783,9 +805,10 @@ setContext imports
   = do { hsc_env <- getSession
        ; let old_ic = hsc_IC hsc_env
        ; all_env <- liftIO $ findGlobalRdrEnv hsc_env imports
+       ; let final_rdr_env = ic_tythings old_ic `icPlusGblRdrEnv` all_env
        ; modifySession $ \_ ->
          hsc_env{ hsc_IC = old_ic { ic_imports      = imports
-                                  , ic_rn_gbl_env   = all_env }}}
+                                  , ic_rn_gbl_env   = final_rdr_env }}}
 
 findGlobalRdrEnv :: HscEnv -> [InteractiveImport] -> IO GlobalRdrEnv
 -- Compute the GlobalRdrEnv for the interactive context
@@ -880,11 +903,8 @@ getRdrNamesInScope = withSession $ \hsc_env -> do
   let 
       ic = hsc_IC hsc_env
       gbl_rdrenv = ic_rn_gbl_env ic
-      ids = ic_tmp_ids ic
-      gbl_names = concat (map greToRdrNames (globalRdrEnvElts gbl_rdrenv))
-      lcl_names = map (mkRdrUnqual.nameOccName.idName) ids
-  --
-  return (gbl_names ++ lcl_names)
+      gbl_names = concatMap greToRdrNames $ globalRdrEnvElts gbl_rdrenv
+  return gbl_names
 
 
 -- ToDo: move to RdrName
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index e1e4d87f63..050931c813 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -4,13 +4,13 @@
 \section{Tidying up Core}
 
 \begin{code}
-module TidyPgm( mkBootModDetailsDs, mkBootModDetailsTc, 
-       		tidyProgram, globaliseAndTidyId ) where
+module TidyPgm (
+       mkBootModDetailsTc, tidyProgram, globaliseAndTidyId
+   ) where
 
 #include "HsVersions.h"
 
 import TcRnTypes
-import FamInstEnv
 import DynFlags
 import CoreSyn
 import CoreUnfold
@@ -20,13 +20,13 @@ import CoreMonad
 import CoreUtils
 import Rules
 import CoreArity	( exprArity, exprBotStrictness_maybe )
-import Class		( classAllSelIds )
 import VarEnv
 import VarSet
 import Var
 import Id
 import IdInfo
 import InstEnv
+import FamInstEnv
 import Demand
 import BasicTypes
 import Name hiding (varName)
@@ -36,6 +36,7 @@ import NameEnv
 import TcType
 import DataCon
 import TyCon
+import Class
 import Module
 import Packages( isDllName )
 import HscTypes
@@ -117,30 +118,19 @@ Plan A: mkBootModDetails: omit pragmas, make interfaces small
 mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails
 mkBootModDetailsTc hsc_env 
         TcGblEnv{ tcg_exports   = exports,
-                  tcg_type_env  = type_env,
+                  tcg_type_env  = type_env, -- just for the Ids
+                  tcg_tcs       = tcs,
+                  tcg_clss      = clss,
                   tcg_insts     = insts,
                   tcg_fam_insts = fam_insts
                 }
-  = mkBootModDetails hsc_env exports type_env insts fam_insts
-
-mkBootModDetailsDs :: HscEnv -> ModGuts -> IO ModDetails
-mkBootModDetailsDs hsc_env 
-        ModGuts{ mg_exports   = exports,
-                 mg_types     = type_env,
-                 mg_insts     = insts,
-                 mg_fam_insts = fam_insts
-                }
-  = mkBootModDetails hsc_env exports type_env insts fam_insts
-  
-mkBootModDetails :: HscEnv -> [AvailInfo] -> NameEnv TyThing
-                 -> [Instance] -> [FamInstEnv.FamInst] -> IO ModDetails
-mkBootModDetails hsc_env exports type_env insts fam_insts
-  = do	{ let dflags = hsc_dflags hsc_env 
+  = do  { let dflags = hsc_dflags hsc_env
 	; showPass dflags CoreTidy
 
 	; let { insts'     = tidyInstances globaliseAndTidyId insts
 	      ; dfun_ids   = map instanceDFunId insts'
-	      ; type_env1  = tidyBootTypeEnv (availsToNameSet exports) type_env
+              ; type_env1  = mkBootTypeEnv (availsToNameSet exports)
+                                (typeEnvIds type_env) tcs clss fam_insts
 	      ; type_env'  = extendTypeEnvWithIds type_env1 dfun_ids
 	      }
 	; return (ModDetails { md_types     = type_env'
@@ -154,21 +144,26 @@ mkBootModDetails hsc_env exports type_env insts fam_insts
 	}
   where
 
-tidyBootTypeEnv :: NameSet -> TypeEnv -> TypeEnv
-tidyBootTypeEnv exports type_env 
-  = tidyTypeEnv True False exports type_env final_ids
+mkBootTypeEnv :: NameSet -> [Id] -> [TyCon] -> [Class] -> [FamInst] -> TypeEnv
+mkBootTypeEnv exports ids tcs clss fam_insts
+  = tidyTypeEnv True False exports $
+       typeEnvFromEntities final_ids tcs clss fam_insts
   where
-	-- Find the LocalIds in the type env that are exported
+        -- Find the LocalIds in the type env that are exported
 	-- Make them into GlobalIds, and tidy their types
 	--
 	-- It's very important to remove the non-exported ones
 	-- because we don't tidy the OccNames, and if we don't remove
 	-- the non-exported ones we'll get many things with the
 	-- same name in the interface file, giving chaos.
-    final_ids = [ globaliseAndTidyId id
-		| id <- typeEnvIds type_env
-		, isLocalId id
-		, keep_it id ]
+        --
+        -- Do make sure that we keep Ids that are already Global.
+        -- When typechecking an .hs-boot file, the Ids come through as
+        -- GlobalIds.
+    final_ids = [ if isLocalId id then globaliseAndTidyId id
+                                  else id
+                | id <- ids
+                , keep_it id ]
 
         -- default methods have their export flag set, but everything
         -- else doesn't (yet), because this is pre-desugaring, so we
@@ -289,7 +284,8 @@ RHSs, so that they print nicely in interfaces.
 tidyProgram :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails)
 tidyProgram hsc_env  (ModGuts { mg_module    = mod
                               , mg_exports   = exports
-                              , mg_types     = type_env
+                              , mg_tcs       = tcs
+                              , mg_clss      = clss
                               , mg_insts     = insts
                               , mg_fam_insts = fam_insts
                               , mg_binds     = binds
@@ -309,12 +305,16 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
               }
         ; showPass dflags CoreTidy
 
-        ; let { implicit_binds = getImplicitBinds type_env }
+        ; let { type_env = typeEnvFromEntities [] tcs clss fam_insts
+
+              ; implicit_binds
+                  = concatMap getClassImplicitBinds (typeEnvClasses type_env) ++
+                    concatMap getTyConImplicitBinds (typeEnvTyCons type_env)
+              }
 
         ; (unfold_env, tidy_occ_env)
               <- chooseExternalIds hsc_env mod omit_prags expose_all 
                                    binds implicit_binds imp_rules (vectInfoVar vect_info)
-
         ; let { ext_rules = findExternalRules omit_prags binds imp_rules unfold_env }
                 -- Glom together imp_rules and rules currently attached to binders
                 -- Then pick just the ones we need to expose
@@ -326,9 +326,11 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
 	; let { export_set = availsToNameSet exports
 	      ; final_ids  = [ id | id <- bindersOfBinds tidy_binds, 
 				    isExternalName (idName id)]
+
               ; tidy_type_env = tidyTypeEnv omit_prags th export_set
-					    type_env final_ids
-	      ; tidy_insts    = tidyInstances (lookup_dfun tidy_type_env) insts
+                                      (extendTypeEnvWithIds type_env final_ids)
+
+              ; tidy_insts    = tidyInstances (lookup_dfun tidy_type_env) insts
 		-- A DFunId will have a binding in tidy_binds, and so
 		-- will now be in final_env, replete with IdInfo
 		-- Its name will be unchanged since it was born, but
@@ -345,12 +347,21 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
               -- See Note [Injecting implicit bindings]
               ; all_tidy_binds = implicit_binds ++ tidy_binds
 
+              -- get the TyCons to generate code for.  Careful!  We must use
+              -- the untidied TypeEnv here, because we need
+              --  (a) implicit TyCons arising from types and classes defined
+              --      in this module
+              --  (b) wired-in TyCons, which are normally removed from the
+              --      TypeEnv we put in the ModDetails
+              --  (c) Constructors even if they are not exported (the
+              --      tidied TypeEnv has trimmed these away)
               ; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env)
               }
 
         ; endPass dflags CoreTidy all_tidy_binds tidy_rules
 
-	  -- If the endPass didn't print the rules, but ddump-rules is on, print now
+          -- If the endPass didn't print the rules, but ddump-rules is
+          -- on, print now
 	; dumpIfSet (dopt Opt_D_dump_rules dflags 
                      && (not (dopt Opt_D_dump_simpl dflags))) 
 		    CoreTidy
@@ -374,7 +385,7 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
                            cg_hpc_info = hpc_info,
                            cg_modBreaks = modBreaks }, 
 
-		   ModDetails { md_types     = tidy_type_env,
+                   ModDetails { md_types     = tidy_type_env,
 				md_rules     = tidy_rules,
 				md_insts     = tidy_insts,
                                 md_vect_info = tidy_vect_info,
@@ -391,40 +402,29 @@ lookup_dfun type_env dfun_id
 	_other -> pprPanic "lookup_dfun" (ppr dfun_id)
 
 --------------------------
-tidyTypeEnv :: Bool 	-- Compiling without -O, so omit prags
-	    -> Bool	-- Template Haskell is on
-	    -> NameSet -> TypeEnv -> [Id] -> TypeEnv
+tidyTypeEnv :: Bool       -- Compiling without -O, so omit prags
+            -> Bool       -- Template Haskell is on
+            -> NameSet -> TypeEnv -> TypeEnv
 
 -- The competed type environment is gotten from
---	Dropping any wired-in things, and then
--- 	a) keeping the types and classes
---	b) removing all Ids, 
---	c) adding Ids with correct IdInfo, including unfoldings,
+--      a) the types and classes defined here (plus implicit things)
+--      b) adding Ids with correct IdInfo, including unfoldings,
 --		gotten from the bindings
--- From (c) we keep only those Ids with External names;
+-- From (b) we keep only those Ids with External names;
 --	    the CoreTidy pass makes sure these are all and only
 --	    the externally-accessible ones
 -- This truncates the type environment to include only the 
 -- exported Ids and things needed from them, which saves space
 
-tidyTypeEnv omit_prags th exports type_env final_ids
- = let  type_env1 = filterNameEnv keep_it type_env
-	type_env2 = extendTypeEnvWithIds type_env1 final_ids
-	type_env3 | omit_prags = mapNameEnv (trimThing th exports) type_env2
-		  | otherwise  = type_env2
-    in 
-    type_env3
-  where
-   	-- We keep GlobalIds, because they won't appear 
-	-- in the bindings from which final_ids are derived!
-	-- (The bindings bind LocalIds.)
-    keep_it thing | isWiredInThing thing = False
-    keep_it (AnId id) = isGlobalId id	-- Keep GlobalIds (e.g. class ops)
-    keep_it _other    = True		-- Keep all TyCons, DataCons, and Classes
-
---------------------------
-isWiredInThing :: TyThing -> Bool
-isWiredInThing thing = isWiredInName (getName thing)
+tidyTypeEnv omit_prags th exports type_env
+ = let
+        type_env1 = filterNameEnv (not . isWiredInName . getName) type_env
+          -- (1) remove wired-in things
+        type_env2 | omit_prags = mapNameEnv (trimThing th exports) type_env1
+                  | otherwise  = type_env1
+          -- (2) trimmed if necessary
+    in
+    type_env2
 
 --------------------------
 trimThing :: Bool -> NameSet -> TyThing -> TyThing
@@ -576,16 +576,14 @@ really just a code generation trick.... binding itself makes no sense.
 See CorePrep Note [Data constructor workers].
 
 \begin{code}
-getImplicitBinds :: TypeEnv -> [CoreBind]
-getImplicitBinds type_env
-  = map get_defn (concatMap implicit_ids (typeEnvElts type_env))
-  where
-    implicit_ids (ATyCon tc)  = class_ids ++ mapCatMaybes dataConWrapId_maybe (tyConDataCons tc)
-      where class_ids = maybe [] classAllSelIds (tyConClass_maybe tc)
-    implicit_ids _            = []
-    
-    get_defn :: Id -> CoreBind
-    get_defn id = NonRec id (unfoldingTemplate (realIdUnfolding id))
+getTyConImplicitBinds :: TyCon -> [CoreBind]
+getTyConImplicitBinds tc = map get_defn (mapCatMaybes dataConWrapId_maybe (tyConDataCons tc))
+
+getClassImplicitBinds :: Class -> [CoreBind]
+getClassImplicitBinds cls = map get_defn (classAllSelIds cls)
+
+get_defn :: Id -> CoreBind
+get_defn id = NonRec id (unfoldingTemplate (realIdUnfolding id))
 \end{code}
 
 
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 0606c59673..77c5499265 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -51,14 +51,10 @@ module PrelNames (
 
 import Module
 import OccName
-import RdrName    ( RdrName, nameRdrName, mkOrig, rdrNameOcc, mkUnqual )
-import Unique     ( Unique, Uniquable(..), hasKey,
-                    mkPreludeMiscIdUnique, mkPreludeDataConUnique,
-                    mkPreludeTyConUnique, mkPreludeClassUnique,
-                    mkTupleTyConUnique
-                  )
-import BasicTypes ( TupleSort(..), Arity )
-import Name       ( Name, mkInternalName, mkExternalName, mkSystemVarName )
+import RdrName
+import Unique
+import BasicTypes
+import Name
 import SrcLoc
 import FastString
 \end{code}
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index ef842f261e..574550f1ff 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -397,6 +397,7 @@ extendGlobalRdrEnvRn :: [AvailInfo]
 extendGlobalRdrEnvRn avails new_fixities
   = do  { (gbl_env, lcl_env) <- getEnvs
         ; stage <- getStage
+        ; isGHCi <- getIsGHCi
         ; let rdr_env = tcg_rdr_env gbl_env
               fix_env = tcg_fix_env gbl_env
 
@@ -406,10 +407,12 @@ extendGlobalRdrEnvRn avails new_fixities
               -- See Note [Top-level Names in Template Haskell decl quotes]
               shadowP  = isBrackStage stage
               new_occs = map (nameOccName . gre_name) gres
-              rdr_env1 = transformGREs qual_gre new_occs rdr_env
+              rdr_env_TH = transformGREs qual_gre new_occs rdr_env
+              rdr_env_GHCi = delListFromOccEnv rdr_env new_occs
               lcl_env1 = lcl_env { tcl_rdr = delListFromOccEnv (tcl_rdr lcl_env) new_occs }
-              (rdr_env2, lcl_env2) | shadowP   = (rdr_env1, lcl_env1)
-                                   | otherwise = (rdr_env,  lcl_env)
+              (rdr_env2, lcl_env2) | shadowP   = (rdr_env_TH,   lcl_env1)
+                                   | isGHCi    = (rdr_env_GHCi, lcl_env1)
+                                   | otherwise = (rdr_env,      lcl_env)
 
               rdr_env3 = foldl extendGlobalRdrEnv rdr_env2 gres
               fix_env' = foldl extend_fix_env     fix_env  gres
@@ -802,20 +805,6 @@ catMaybeErr ms =  [ a | Succeeded a <- ms ]
 %************************************************************************
 
 \begin{code}
--- | make a 'GlobalRdrEnv' where all the elements point to the same
--- import declaration (useful for "hiding" imports, or imports with
--- no details).
-gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
-gresFromAvails prov avails
-  = concatMap (gresFromAvail (const prov)) avails
-
-gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
-gresFromAvail prov_fn avail
-  = [ GRE {gre_name = n,
-           gre_par = availParent n avail,
-           gre_prov = prov_fn n}
-    | n <- availNames avail ]
-
 greExportAvail :: GlobalRdrElt -> AvailInfo
 greExportAvail gre 
   = case gre_par gre of
@@ -840,11 +829,6 @@ plusAvail (AvailTC n1 (s1:ss1)) (AvailTC n2 (s2:ss2))
        (False,False) -> AvailTC n1 ((s1:ss1) `unionLists` (s2:ss2))
 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
 
-availParent :: Name -> AvailInfo -> Parent
-availParent _ (Avail _)                 = NoParent
-availParent n (AvailTC m _) | n == m    = NoParent
-                            | otherwise = ParentIs m
-
 trimAvail :: AvailInfo -> Name -> AvailInfo
 trimAvail (Avail n)      _ = Avail n
 trimAvail (AvailTC n ns) m = ASSERT( m `elem` ns) AvailTC n [m]
@@ -1734,8 +1718,13 @@ addDupDeclErr []
 addDupDeclErr names@(name : _)
   = addErrAt (getSrcSpan (last sorted_names)) $
     -- Report the error at the later location
-    vcat [ptext (sLit "Multiple declarations of") <+> quotes (ppr name),
-          ptext (sLit "Declared at:") <+> vcat (map (ppr . nameSrcLoc) sorted_names)]
+    vcat [ptext (sLit "Multiple declarations of") <+>
+             quotes (ppr (nameOccName name)),
+             -- NB. print the OccName, not the Name, because the
+             -- latter might not be in scope in the RdrEnv and so will
+             -- be printed qualified.
+          ptext (sLit "Declared at:") <+>
+                   vcat (map (ppr . nameSrcLoc) sorted_names)]
   where
     sorted_names = sortWith nameSrcLoc names
 
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index d30769d0fa..0a3d3ffc25 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -163,6 +163,7 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
       -- Haddock docs; no free vars
    rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
 
+    last_tcg_env <- getGblEnv ;
    -- (I) Compute the results and return
    let {rn_group = HsGroup { hs_valds  	= rn_val_decls,
 			     hs_tyclds 	= rn_tycl_decls,
@@ -189,7 +190,7 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
 		-- Instance decls may have occurrences of things bound in bind_dus
 		-- so we must put other_fvs last
 
-        final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
+        final_tcg_env = let tcg_env' = (last_tcg_env `addTcgDUs` src_dus)
                         in -- we return the deprecs in the env, not in the HsGroup above
                         tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
        } ;
diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs
index ccdbf579dc..e2d1206380 100644
--- a/compiler/typecheck/FamInst.lhs
+++ b/compiler/typecheck/FamInst.lhs
@@ -147,18 +147,25 @@ tcExtendLocalFamInstEnv fam_insts thing_inside
 -- Check that the proposed new instance is OK, 
 -- and then add it to the home inst env
 addLocalFamInst :: FamInstEnv -> FamInst -> TcM FamInstEnv
-addLocalFamInst home_fie famInst
-  = do {       -- Load imported instances, so that we report
-	       -- overlaps correctly
-       ; eps <- getEps
-       ; let inst_envs = (eps_fam_inst_env eps, home_fie)
-
-	       -- Check for conflicting instance decls
-       ; checkForConflicts inst_envs famInst
-
-	       -- OK, now extend the envt
-       ; return (extendFamInstEnv home_fie famInst) 
-       }
+addLocalFamInst home_fie famInst = do
+        -- Load imported instances, so that we report
+        -- overlaps correctly
+    eps <- getEps
+    let inst_envs = (eps_fam_inst_env eps, home_fie)
+
+        -- Check for conflicting instance decls
+    skol_tvs <- tcInstSkolTyVars (tyConTyVars (famInstTyCon famInst))
+    let conflicts = lookupFamInstEnvConflicts inst_envs famInst skol_tvs
+    -- If there are any conflicts, we should probably error
+    -- But, if we're allowed to overwrite and the conflict is in the home FIE,
+    -- then overwrite instead of error.
+    isGHCi <- getIsGHCi
+    case conflicts of
+        dup : _ ->  case (isGHCi, home_conflicts) of
+                        (True, _ : _) -> return (overwriteFamInstEnv home_fie famInst)
+                        (_, _)        -> conflictInstErr famInst (fst dup) >> return (extendFamInstEnv home_fie famInst)
+                    where home_conflicts = lookupFamInstEnvConflicts' home_fie famInst skol_tvs
+        []      ->  return (extendFamInstEnv home_fie famInst)
 \end{code}
 
 %************************************************************************
@@ -186,7 +193,6 @@ checkForConflicts inst_envs famInst
        ; unless (null conflicts) $
 	   conflictInstErr famInst (fst (head conflicts))
        }
-  where
 
 conflictInstErr :: FamInst -> FamInst -> TcRn ()
 conflictInstErr famInst conflictingFamInst
diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index 1690079bba..64acaf367a 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -399,52 +399,65 @@ tcExtendLocalInstEnv dfuns thing_inside
 addLocalInst :: InstEnv -> Instance -> TcM InstEnv
 -- Check that the proposed new instance is OK, 
 -- and then add it to the home inst env
-addLocalInst home_ie ispec
-  = do	{ 	-- Instantiate the dfun type so that we extend the instance
-		-- envt with completely fresh template variables
-		-- This is important because the template variables must
-		-- not overlap with anything in the things being looked up
-		-- (since we do unification).  
-                --
-                -- We use tcInstSkolType because we don't want to allocate fresh
-                --  *meta* type variables.
-                --
-                -- We use UnkSkol --- and *not* InstSkol or PatSkol --- because
-                -- these variables must be bindable by tcUnifyTys.  See
-                -- the call to tcUnifyTys in InstEnv, and the special
-                -- treatment that instanceBindFun gives to isOverlappableTyVar
-                -- This is absurdly delicate.
-
-	  let dfun = instanceDFunId ispec
-        ; (tvs', theta', tau') <- tcInstSkolType (idType dfun)
-	; let	(cls, tys') = tcSplitDFunHead tau'
-		dfun' 	    = setIdType dfun (mkSigmaTy tvs' theta' tau')	    
-	  	ispec'      = setInstanceDFunId ispec dfun'
-
-		-- Load imported instances, so that we report
-		-- duplicates correctly
-	; eps <- getEps
-	; let inst_envs = (eps_inst_env eps, home_ie)
-
-		-- Check functional dependencies
-	; case checkFunDeps inst_envs ispec' of
-		Just specs -> funDepErr ispec' specs
-		Nothing    -> return ()
-
-		-- Check for duplicate instance decls
-	; let { (matches, _, _) = lookupInstEnv inst_envs cls tys'
-	      ;	dup_ispecs = [ dup_ispec 
-			     | (dup_ispec, _) <- matches
-			     , let (_,_,_,dup_tys) = instanceHead dup_ispec
-			     , isJust (tcMatchTys (mkVarSet tvs') tys' dup_tys)] }
-		-- Find memebers of the match list which ispec itself matches.
-		-- If the match is 2-way, it's a duplicate
-	; case dup_ispecs of
-	    dup_ispec : _ -> dupInstErr ispec' dup_ispec
-	    []            -> return ()
-
-		-- OK, now extend the envt
-	; return (extendInstEnv home_ie ispec') }
+-- If overwrite_inst, then we can overwrite a direct match
+addLocalInst home_ie ispec = do
+    -- Instantiate the dfun type so that we extend the instance
+    -- envt with completely fresh template variables
+    -- This is important because the template variables must
+    -- not overlap with anything in the things being looked up
+    -- (since we do unification).  
+        --
+        -- We use tcInstSkolType because we don't want to allocate fresh
+        --  *meta* type variables.
+        --
+        -- We use UnkSkol --- and *not* InstSkol or PatSkol --- because
+        -- these variables must be bindable by tcUnifyTys.  See
+        -- the call to tcUnifyTys in InstEnv, and the special
+        -- treatment that instanceBindFun gives to isOverlappableTyVar
+        -- This is absurdly delicate.
+
+    let dfun = instanceDFunId ispec
+    (tvs', theta', tau') <- tcInstSkolType (idType dfun)
+    let (cls, tys') = tcSplitDFunHead tau'
+        dfun' 	    = setIdType dfun (mkSigmaTy tvs' theta' tau')	    
+        ispec'      = setInstanceDFunId ispec dfun'
+
+        -- Load imported instances, so that we report
+        -- duplicates correctly
+    eps <- getEps
+    let inst_envs = (eps_inst_env eps, home_ie)
+
+        -- Check functional dependencies
+    case checkFunDeps inst_envs ispec' of
+        Just specs -> funDepErr ispec' specs
+        Nothing    -> return ()
+
+        -- Check for duplicate instance decls
+    let (matches, unifs, _) = lookupInstEnv inst_envs cls tys'
+        dup_ispecs = [ dup_ispec 
+                        | (dup_ispec, _) <- matches
+                        , let (_,_,_,dup_tys) = instanceHead dup_ispec
+                        , isJust (tcMatchTys (mkVarSet tvs') tys' dup_tys)]
+                        
+        -- Find memebers of the match list which ispec itself matches.
+        -- If the match is 2-way, it's a duplicate
+        -- If it's a duplicate, but we can overwrite home package dups, then overwrite
+    isGHCi <- getIsGHCi
+    overlapFlag <- getOverlapFlag
+    case isGHCi of
+        False -> case dup_ispecs of
+            dup : _ -> dupInstErr ispec' dup >> return (extendInstEnv home_ie ispec')
+            []      -> return (extendInstEnv home_ie ispec')
+        True  -> case (dup_ispecs, home_ie_matches, unifs, overlapFlag) of
+            (_, _:_, _, _)      -> return (overwriteInstEnv home_ie ispec')
+            (dup:_, [], _, _)   -> dupInstErr ispec' dup >> return (extendInstEnv home_ie ispec')
+            ([], _, u:_, NoOverlap _)    -> overlappingInstErr ispec' u >> return (extendInstEnv home_ie ispec')
+            _                   -> return (extendInstEnv home_ie ispec')
+          where (homematches, _) = lookupInstEnv' home_ie cls tys'
+                home_ie_matches = [ dup_ispec 
+                    | (dup_ispec, _) <- homematches
+                    , let (_,_,_,dup_tys) = instanceHead dup_ispec
+                    , isJust (tcMatchTys (mkVarSet tvs') tys' dup_tys)]
 
 traceDFuns :: [Instance] -> TcRn ()
 traceDFuns ispecs
@@ -463,6 +476,11 @@ dupInstErr ispec dup_ispec
   = addDictLoc ispec $
     addErr (hang (ptext (sLit "Duplicate instance declarations:"))
 	       2 (pprInstances [ispec, dup_ispec]))
+overlappingInstErr :: Instance -> Instance -> TcRn ()
+overlappingInstErr ispec dup_ispec
+  = addDictLoc ispec $
+    addErr (hang (ptext (sLit "Overlapping instance declarations:"))
+	       2 (pprInstances [ispec, dup_ispec]))
 
 addDictLoc :: Instance -> TcRn a -> TcRn a
 addDictLoc ispec thing_inside
diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index 5cec582b8f..678731bf76 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -12,7 +12,7 @@ module TcEnv(
 	InstBindings(..),
 
 	-- Global environment
-	tcExtendGlobalEnv, setGlobalTypeEnv,
+        tcExtendGlobalEnv, tcExtendGlobalEnvImplicit, setGlobalTypeEnv,
 	tcExtendGlobalValEnv,
 	tcLookupLocatedGlobal,	tcLookupGlobal, 
 	tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
@@ -274,10 +274,28 @@ setGlobalTypeEnv tcg_env new_type_env
     	   writeMutVar (tcg_type_env_var tcg_env) new_type_env
 	 ; return (tcg_env { tcg_type_env = new_type_env }) }
 
+
 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
-  -- Given a mixture of Ids, TyCons, Classes, all from the
+  -- Given a mixture of Ids, TyCons, Classes, all defined in the
   -- module being compiled, extend the global environment
 tcExtendGlobalEnv things thing_inside
+  = do { env <- getGblEnv
+       ; let env' = env { tcg_tcs  = [ tc | ATyCon tc <- things,
+                                            not (isClassTyCon tc)]
+                                      ++ tcg_tcs env
+                        , tcg_clss = [ cl | ATyCon tc <- things,
+                                            Just cl <- [tyConClass_maybe tc]]
+                                      ++ tcg_clss env }
+       ; setGblEnv env' $
+            tcExtendGlobalEnvImplicit things thing_inside
+       }
+
+tcExtendGlobalEnvImplicit :: [TyThing] -> TcM r -> TcM r
+  -- Extend the global environment with some TyThings that can be obtained
+  -- via implicitTyThings from other entities in the environment.  Examples
+  -- are dfuns, famInstTyCons, data cons, etc.
+  -- These TyThings are not added to tcg_tcs or tcg_clss.
+tcExtendGlobalEnvImplicit things thing_inside
    = do	{ tcg_env <- getGblEnv
 	; let ge'  = extendTypeEnvList (tcg_type_env tcg_env) things
 	; tcg_env' <- setGlobalTypeEnv tcg_env ge'
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 5026b563de..dbca41c533 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -361,7 +361,7 @@ tcInstDecls1    -- Deal with both source-code and imported instance decls
                                 -- contains all dfuns for this module
            HsValBinds Name)     -- Supporting bindings for derived instances
 
-tcInstDecls1 tycl_decls inst_decls deriv_decls
+tcInstDecls1 tycl_decls inst_decls deriv_decls 
   = checkNoErrs $
     do {        -- Stop if addInstInfos etc discovers any errors
                 -- (they recover, so that we get more than one error each
@@ -380,7 +380,8 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
 
                 -- (2) Add the tycons of indexed types and their implicit
                 --     tythings to the global environment
-       ; tcExtendGlobalEnv (map ATyCon at_idx_tycons ++ implicit_things) $ do {
+       ; tcExtendGlobalEnvImplicit
+             (map ATyCon at_idx_tycons ++ implicit_things) $ do {
 
 
                 -- Next, construct the instance environment so far, consisting
@@ -405,7 +406,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
        -- the generic representation
        ; let all_tycons = map ATyCon (deriv_tys ++ deriv_ty_insts)
        ; gbl_env <- tcExtendGlobalEnv all_tycons $
-                    tcExtendGlobalEnv (concatMap implicitTyThings all_tycons) $
+                    tcExtendGlobalEnvImplicit (concatMap implicitTyThings all_tycons) $
                     addFamInsts deriv_ty_insts $
                     addInsts deriv_inst_info getGblEnv
 
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index a19a68fdbe..21b71b2c6a 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -10,6 +10,7 @@ module TcRnDriver (
 	tcRnStmt, tcRnExpr, tcRnType,
 	tcRnLookupRdrName,
 	getModuleInterface,
+	tcRnDeclsi,
 #endif
 	tcRnImports,
 	tcRnLookupName,
@@ -336,36 +337,34 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 	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_used_names = emptyNameSet, -- ToDo: compute usage
+                                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_types     = final_type_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_deps      = noDependencies,	-- ??
+                                mg_exports   = my_exports,
+                                mg_tcs       = tcg_tcs tcg_env,
+                                mg_clss      = tcg_clss 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_trust_pkg = False
-		    } } ;
+                            } } ;
 
    tcCoreDump mod_guts ;
 
@@ -390,9 +389,9 @@ tcRnSrcDecls :: ModDetails -> [LHsDecl RdrName] -> TcM TcGblEnv
 	-- Reason: solely to report unused imports and bindings
 tcRnSrcDecls boot_iface decls
  = do {   	-- Do all the declarations
-	(tc_envs, lie) <- captureConstraints $ tc_rn_src_decls boot_iface decls ;
+	((tcg_env, tcl_env), lie) <- captureConstraints $ tc_rn_src_decls boot_iface decls ;
       ; traceTc "Tc8" empty ;
-      ; setEnvs tc_envs $ 
+      ; setEnvs (tcg_env, tcl_env) $ 
    do { 
 
 	     -- 	Finish simplifying class constraints
@@ -403,7 +402,7 @@ tcRnSrcDecls boot_iface decls
 	     -- and no subsequent decl instantiates its type.
 	     --
 	     -- We do this after checkMain, so that we use the type info 
-	     -- thaat checkMain adds
+	     -- that checkMain adds
 	     -- 
 	     -- We do it with both global and local env in scope:
 	     --	 * the global env exposes the instances to simplifyTop
@@ -419,8 +418,7 @@ tcRnSrcDecls boot_iface decls
         -- Zonk the final code.  This must be done last.
         -- Even simplifyTop may do some unification.
         -- This pass also warns about missing type signatures
-        let { (tcg_env, _) = tc_envs
-            ; TcGblEnv { tcg_type_env  = type_env,
+        let { TcGblEnv { tcg_type_env  = type_env,
                          tcg_binds     = binds,
                          tcg_sigs      = sig_ns,
                          tcg_ev_binds  = cur_ev_binds,
@@ -441,20 +439,22 @@ tcRnSrcDecls boot_iface decls
                                    tcg_vects    = vects', 
                                    tcg_fords    = fords' } } ;
 
-        setGlobalTypeEnv tcg_env' final_type_env                                   
+        setGlobalTypeEnv tcg_env' final_type_env
    } }
 
-tc_rn_src_decls :: ModDetails -> [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv)
+tc_rn_src_decls :: ModDetails 
+                    -> [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
  = do { (first_group, group_tail) <- findSplice ds  ;
 		-- If ds is [] we get ([], Nothing)
-
+        
 	-- Deal with decls up to, but not including, the first splice
 	(tcg_env, rn_decls) <- rnTopSrcDecls first_group ;
 		-- rnTopSrcDecls fails if there are any errors
-
+        
 	(tcg_env, tcl_env) <- setGblEnv tcg_env $ 
 			      tcTopSrcDecls boot_details rn_decls ;
 
@@ -860,7 +860,7 @@ rnTopSrcDecls group
 
 ------------------------------------------------
 tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
-tcTopSrcDecls boot_details
+tcTopSrcDecls boot_details 
 	(HsGroup { hs_tyclds = tycl_decls, 
 		   hs_instds = inst_decls,
                    hs_derivds = deriv_decls,
@@ -1082,28 +1082,63 @@ 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 tcRnModule.
-	(home_insts, home_fam_insts) = hptInstances hsc_env (\_ -> True)
-    in
-    updGblEnv (\env -> env { 
-	tcg_rdr_env      = ic_rn_gbl_env icxt,
-	tcg_inst_env     = extendInstEnvList    (tcg_inst_env env) home_insts,
-	tcg_fam_inst_env = extendFamInstEnvList (tcg_fam_inst_env env) 
-                                                home_fam_insts 
-      }) $
-
-    tcExtendGhciEnv (ic_tmp_ids icxt) $
-        -- tcExtendGhciEnv does lots: 
-        --   - it extends the local type env (tcl_env) with the given Ids,
-        --   - it extends the local rdr env (tcl_rdr) with the Names from 
-        --     the given Ids
-        --   - it adds the free tyvars of the Ids to the tcl_tyvars
-        --     set.
+        (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.
         --
-        -- later ids in ic_tmp_ids must shadow earlier ones with the same
-        -- OccName, and tcExtendIdEnv implements this behaviour.
+        -- 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.
+
+        (tmp_ids, types_n_classes) = partitionWith sel_id (ic_tythings icxt)
+          where sel_id (AnId id) = Left id
+                sel_id other     = Right other
+
+        type_env = mkTypeEnvWithImplicits
+                       (map AnId (ic_sys_vars icxt) ++ types_n_classes)
 
-    do	{ traceTc "setIC" (ppr (ic_tmp_ids icxt))
- 	; thing_inside }
+        visible_tmp_ids = filter visible tmp_ids
+          where visible id = not (null (lookupGRE_Name (ic_rn_gbl_env icxt)
+                                                       (idName id)))
+
+        con_fields = [ (dataConName c, dataConFieldLabels c)
+                     | ATyCon t <- types_n_classes
+                     , c <- tyConDataCons t ]
+    in
+    updGblEnv (\env -> env {
+          tcg_rdr_env      = ic_rn_gbl_env icxt
+        , tcg_type_env     = type_env
+        , tcg_inst_env     = extendInstEnvList
+                              (extendInstEnvList (tcg_inst_env env) ic_insts)
+                              home_insts
+        , 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)
+        }) $
+
+        tcExtendGhciEnv visible_tmp_ids $ -- Note [GHCi temporary Ids]
+          thing_inside
 \end{code}
 
 
@@ -1176,9 +1211,9 @@ tcRnStmt hsc_env ictxt rdr_stmt
 
 Note [Interactively-bound Ids in GHCi]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The Ids bound by previous Stmts in Template Haskell are currently
+The Ids bound by previous Stmts in GHCi are currently
 	a) GlobalIds
-	b) with an Internal Name (not External)
+        b) with an Internal Name (not External)
 	c) and a tidied type
 
  (a) They must be GlobalIds (not LocalIds) otherwise when we come to
@@ -1341,11 +1376,11 @@ tcRnExpr just finds the type of an expression
 
 \begin{code}
 tcRnExpr :: HscEnv
-	 -> InteractiveContext
+         -> InteractiveContext
 	 -> LHsExpr RdrName
 	 -> IO (Messages, Maybe Type)
 tcRnExpr hsc_env ictxt rdr_expr
-  = initTcPrintErrors hsc_env iNTERACTIVE $ 
+  = initTcPrintErrors hsc_env iNTERACTIVE $
     setInteractiveContext hsc_env ictxt $ do {
 
     (rn_expr, _fvs) <- rnLExpr rdr_expr ;
@@ -1372,11 +1407,11 @@ tcRnType just finds the kind of a type
 
 \begin{code}
 tcRnType :: HscEnv
-	 -> InteractiveContext
+         -> InteractiveContext
 	 -> LHsType RdrName
 	 -> IO (Messages, Maybe Kind)
 tcRnType hsc_env ictxt rdr_type
-  = initTcPrintErrors hsc_env iNTERACTIVE $ 
+  = initTcPrintErrors hsc_env iNTERACTIVE $
     setInteractiveContext hsc_env ictxt $ do {
 
     rn_type <- rnLHsType doc rdr_type ;
@@ -1389,6 +1424,53 @@ tcRnType hsc_env ictxt rdr_type
   where
     doc = ptext (sLit "In GHCi input")
 
+\end{code}
+
+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
+    
+    ((tcg_env, tclcl_env), lie) <- 
+        captureConstraints $ tc_rn_src_decls emptyModDetails local_decls
+    setEnvs (tcg_env, tclcl_env) $ do
+
+    new_ev_binds <- simplifyTop lie
+    failIfErrsM
+    let TcGblEnv { tcg_type_env  = type_env,
+                   tcg_binds     = binds,
+                   tcg_sigs      = sig_ns,
+                   tcg_ev_binds  = cur_ev_binds,
+                   tcg_imp_specs = imp_specs,
+                   tcg_rules     = rules,
+                   tcg_vects     = vects,
+                   tcg_fords     = fords } = tcg_env
+        all_ev_binds = cur_ev_binds `unionBags` new_ev_binds
+
+    (bind_ids, ev_binds', binds', fords', imp_specs', rules', vects') 
+        <- zonkTopDecls all_ev_binds binds sig_ns rules vects imp_specs fords
+    
+    let --global_ids = map globaliseAndTidyId bind_ids
+        final_type_env = extendTypeEnvWithIds type_env bind_ids --global_ids
+        tcg_env' = tcg_env { tcg_binds     = binds',
+                             tcg_ev_binds  = ev_binds',
+                             tcg_imp_specs = imp_specs',
+                             tcg_rules     = rules', 
+                             tcg_vects     = vects', 
+                             tcg_fords     = fords' }
+
+    tcg_env'' <- setGlobalTypeEnv tcg_env' final_type_env
+
+    return tcg_env''
+
+
 #endif /* GHCi */
 \end{code}
 
@@ -1411,45 +1493,44 @@ getModuleInterface hsc_env mod
     loadModuleInterface (ptext (sLit "getModuleInterface")) mod
 
 tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Messages, Maybe [Name])
-tcRnLookupRdrName hsc_env rdr_name 
-  = initTcPrintErrors hsc_env iNTERACTIVE $ 
+tcRnLookupRdrName hsc_env rdr_name
+  = initTcPrintErrors hsc_env iNTERACTIVE $
     setInteractiveContext hsc_env (hsc_IC hsc_env) $ 
     lookup_rdr_name rdr_name
 
 lookup_rdr_name :: RdrName -> TcM [Name]
-lookup_rdr_name rdr_name = do {
-	-- If the identifier is a constructor (begins with an
-	-- upper-case letter), then we need to consider both
-	-- constructor and type class identifiers.
-    let { rdr_names = dataTcOccs rdr_name } ;
-
-	-- results :: [Either Messages Name]
-    results <- mapM (tryTcErrs . lookupOccRn) rdr_names ;
-
-    traceRn (text "xx" <+> vcat [ppr rdr_names, ppr (map snd results)]);
-	-- The successful lookups will be (Just name)
-    let { (warns_s, good_names) = unzip [ (msgs, name) 
-					| (msgs, Just name) <- results] ;
-	  errs_s = [msgs | (msgs, Nothing) <- results] } ;
-
-	-- Fail if nothing good happened, else add warnings
-    if null good_names then
-		-- No lookup succeeded, so
-		-- pick the first error message and report it
-		-- ToDo: If one of the errors is "could be Foo.X or Baz.X",
-		--	 while the other is "X is not in scope", 
-		--	 we definitely want the former; but we might pick the latter
-	do { addMessages (head errs_s) ; failM }
-      else 			-- Add deprecation warnings
-	mapM_ addMessages warns_s ;
-    
+lookup_rdr_name rdr_name = do
+        -- If the identifier is a constructor (begins with an
+        -- upper-case letter), then we need to consider both
+        -- constructor and type class identifiers.
+    let rdr_names = dataTcOccs rdr_name
+
+        -- results :: [Either Messages Name]
+    results <- mapM (tryTcErrs . lookupOccRn) rdr_names
+
+    traceRn (text "xx" <+> vcat [ppr rdr_names, ppr (map snd results)])
+        -- The successful lookups will be (Just name)
+    let (warns_s, good_names) = unzip [ (msgs, name) 
+                                      | (msgs, Just name) <- results]
+        errs_s = [msgs | (msgs, Nothing) <- results]
+
+        -- Fail if nothing good happened, else add warnings
+    if null good_names
+      then  addMessages (head errs_s) >> failM
+                -- No lookup succeeded, so
+                -- pick the first error message and report it
+                -- ToDo: If one of the errors is "could be Foo.X or Baz.X",
+                --	 while the other is "X is not in scope", 
+                --	 we definitely want the former; but we might pick the latter
+      else 	mapM_ addMessages warns_s
+                -- Add deprecation warnings
     return good_names
- }
+
 #endif
 
 tcRnLookupName :: HscEnv -> Name -> IO (Messages, Maybe TyThing)
 tcRnLookupName hsc_env name
-  = initTcPrintErrors hsc_env iNTERACTIVE $ 
+  = initTcPrintErrors hsc_env iNTERACTIVE $
     setInteractiveContext hsc_env (hsc_IC hsc_env) $
     tcRnLookupName' name
 
@@ -1491,7 +1572,7 @@ tcRnGetInfo' hsc_env name
 	-- 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 ictxt
+    loadUnqualIfaces hsc_env ictxt
 
     thing  <- tcRnLookupName' name
     fixity <- lookupFixityRn name
@@ -1519,15 +1600,18 @@ lookupInsts (ATyCon tc)
 
 lookupInsts _ = return []
 
-loadUnqualIfaces :: InteractiveContext -> TcM ()
--- Load the home module for everything that is in scope unqualified
+loadUnqualIfaces :: HscEnv -> InteractiveContext -> TcM ()
+-- Load the interface for everything that is in scope unqualified
 -- This is so that we can accurately report the instances for 
 -- something
-loadUnqualIfaces ictxt
-  = initIfaceTcRn $
+loadUnqualIfaces hsc_env ictxt
+  = initIfaceTcRn $ do
     mapM_ (loadSysInterface doc) (moduleSetElts (mkModuleSet unqual_mods))
   where
-    unqual_mods = [ nameModule name
+    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),
@@ -1601,9 +1685,11 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
 	  (is_boot1 `compare` is_boot2)
 
 pprModGuts :: ModGuts -> SDoc
-pprModGuts (ModGuts { mg_types = type_env,
-		      mg_rules = rules })
-  = vcat [ ppr_types [] type_env,
+pprModGuts (ModGuts { mg_tcs = tcs
+                    , mg_clss = clss
+                    , mg_rules = rules })
+  = vcat [ ppr_types [] (mkTypeEnv (map ATyCon tcs
+                                    ++ map (ATyCon . classTyCon) clss)),
 	   ppr_rules rules ]
 
 ppr_types :: [Instance] -> TypeEnv -> SDoc
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 6a45bb8e1f..6fcc8a9fb8 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -14,6 +14,7 @@ module TcRnMonad(
 import TcRnTypes	-- Re-export all
 import IOEnv		-- Re-export all
 
+import Coercion
 import HsSyn hiding (LIE)
 import HscTypes
 import Module
@@ -23,8 +24,7 @@ import Type
 import TcType
 import InstEnv
 import FamInstEnv
-import PrelNames        ( iNTERACTIVE )
-import Coercion
+import PrelNames
 
 import Var
 import Id
@@ -117,6 +117,8 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
 		tcg_ev_binds  = emptyBag,
 		tcg_warns     = NoWarnings,
 		tcg_anns      = [],
+                tcg_tcs       = [],
+                tcg_clss      = [],
 		tcg_insts     = [],
                 tcg_fam_insts = [],
                 tcg_rules     = [],
@@ -1145,19 +1147,6 @@ initIfaceTc iface do_this
     mod = mi_module iface
     doc = ptext (sLit "The interface for") <+> quotes (ppr mod)
 
-initIfaceRules :: HscEnv -> ModGuts -> IfG a -> IO a
--- Used when sucking in new Rules in SimplCore
--- We have available the type envt of the module being compiled, and we must use it
-initIfaceRules hsc_env guts do_this
- = do	{ let {
-	     type_info = (mg_module guts, return (mg_types guts))
-	   ; gbl_env = IfGblEnv { if_rec_types = Just type_info } ;
-	   }
-
-	-- Run the thing; any exceptions just bubble out from here
-	; initTcRnIf 'i' hsc_env gbl_env () do_this
-    }
-
 initIfaceLcl :: Module -> SDoc -> IfL a -> IfM lcl a
 initIfaceLcl mod loc_doc thing_inside 
   = setLclEnv (mkIfLclEnv mod loc_doc) thing_inside
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index ba022cf8b0..58c3aa6a43 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -65,6 +65,7 @@ import HsSyn
 import HscTypes
 import Type
 import Class    ( Class )
+import TyCon    ( TyCon )
 import DataCon  ( DataCon, dataConUserType )
 import TcType
 import Annotations
@@ -266,6 +267,8 @@ data TcGblEnv
         tcg_imp_specs :: [LTcSpecPrag],     -- ...SPECIALISE prags for imported Ids
 	tcg_warns     :: Warnings,	    -- ...Warnings and deprecations
 	tcg_anns      :: [Annotation],      -- ...Annotations
+        tcg_tcs       :: [TyCon],           -- ...TyCons
+        tcg_clss      :: [Class],           -- ...Classes
 	tcg_insts     :: [Instance],	    -- ...Instances
         tcg_fam_insts :: [FamInst],         -- ...Family instances
         tcg_rules     :: [LRuleDecl Id],    -- ...Rules
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index c938001da6..d99e19116b 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -69,10 +69,10 @@ import Data.List
 \begin{code}
 
 tcTyAndClassDecls :: ModDetails 
-                   -> [[LTyClDecl Name]]     -- Mutually-recursive groups in dependency order
-   	           -> TcM (TcGblEnv,   	     -- Input env extended by types and classes 
-					     -- and their implicit Ids,DataCons
-		           HsValBinds Name)  -- Renamed bindings for record selectors
+                   -> [[LTyClDecl Name]]    -- Mutually-recursive groups in dependency order
+                   -> TcM (TcGblEnv,   	    -- Input env extended by types and classes 
+                                            -- and their implicit Ids,DataCons
+                           HsValBinds Name) -- Renamed bindings for record selectors
 -- Fails if there are any errors
 
 tcTyAndClassDecls boot_details decls_s
@@ -114,12 +114,13 @@ tcTyAndClassDecls boot_details decls_s
 	--     the same.
 	; let {	implicit_things = concatMap implicitTyThings tyclss
 	      ; rec_sel_binds   = mkRecSelBinds [tc | ATyCon tc <- tyclss]
-              ; dm_ids          = mkDefaultMethodIds tyclss }
+          ; dm_ids          = mkDefaultMethodIds tyclss }
 
-  	; env <- tcExtendGlobalEnv implicit_things $
-                 tcExtendGlobalValEnv dm_ids $
-                 getGblEnv
-        ; return (env, rec_sel_binds) } }
+        ; tcg_env <- tcExtendGlobalEnvImplicit implicit_things $
+                     tcExtendGlobalValEnv dm_ids $
+                     getGblEnv
+
+        ; return (tcg_env, rec_sel_binds) } }
                     
 zipRecTyClss :: [[LTyClDecl Name]]
              -> [TyThing]           -- Knot-tied
diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs
index da6f26f449..c429a9b179 100644
--- a/compiler/types/FamInstEnv.lhs
+++ b/compiler/types/FamInstEnv.lhs
@@ -11,10 +11,10 @@ module FamInstEnv (
 	famInstHead, mkLocalFamInst, mkImportedFamInst,
 
 	FamInstEnvs, FamInstEnv, emptyFamInstEnv, emptyFamInstEnvs, 
-	extendFamInstEnv, extendFamInstEnvList, 
+	extendFamInstEnv, overwriteFamInstEnv, extendFamInstEnvList, 
 	famInstEnvElts, familyInstances,
 
-	lookupFamInstEnv, lookupFamInstEnvConflicts,
+	lookupFamInstEnv, lookupFamInstEnvConflicts, lookupFamInstEnvConflicts',
 	
 	-- Normalisation
 	topNormaliseType
@@ -225,6 +225,43 @@ extendFamInstEnv inst_env ins_item@(FamInst {fi_fam = cls_nm, fi_tcs = mb_tcs})
     add (FamIE items tyvar) _ = FamIE (ins_item:items)
 				      (ins_tyvar || tyvar)
     ins_tyvar = not (any isJust mb_tcs)
+
+overwriteFamInstEnv :: FamInstEnv -> FamInst -> FamInstEnv
+overwriteFamInstEnv inst_env ins_item@(FamInst {fi_fam = cls_nm, fi_tcs = mb_tcs})
+  = addToUFM_C add inst_env cls_nm (FamIE [ins_item] ins_tyvar)
+  where
+    add (FamIE items tyvar) _ = FamIE (replaceFInst items)
+				      (ins_tyvar || tyvar)
+    ins_tyvar = not (any isJust mb_tcs)
+    match _ tpl_tvs tpl_tys tys = tcMatchTys tpl_tvs tpl_tys tys
+    
+    inst_tycon = famInstTyCon ins_item
+    (fam, tys) = expectJust "FamInstEnv.lookuFamInstEnvConflicts"
+    	       	            (tyConFamInst_maybe inst_tycon)
+    arity = tyConArity fam
+    n_tys = length tys
+    match_tys 
+        | arity > n_tys = take arity tys
+        | otherwise     = tys
+    rough_tcs = roughMatchTcs match_tys
+    
+    replaceFInst [] = [ins_item]
+    replaceFInst (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs, 
+                                  fi_tys = tpl_tys }) : rest)
+	-- Fast check for no match, uses the "rough match" fields
+      | instanceCantMatch rough_tcs mb_tcs
+      = item : replaceFInst rest
+
+        -- Proper check
+      | Just _ <- match item tpl_tvs tpl_tys match_tys
+      = ins_item : rest
+
+        -- No match => try next
+      | otherwise
+      = item : replaceFInst rest
+
+
+
 \end{code}
 
 %************************************************************************
@@ -265,6 +302,58 @@ lookupFamInstEnv
    where
      match _ tpl_tvs tpl_tys tys = tcMatchTys tpl_tvs tpl_tys tys
 
+lookupFamInstEnvConflicts'
+    :: FamInstEnv
+    -> FamInst		-- Putative new instance
+    -> [TyVar]		-- Unique tyvars, matching arity of FamInst
+    -> [FamInstMatch] 	-- Conflicting matches
+-- E.g. when we are about to add
+--    f : type instance F [a] = a->a
+-- we do (lookupFamInstConflicts f [b])
+-- to find conflicting matches
+-- The skolem tyvars are needed because we don't have a 
+-- unique supply to hand
+--
+-- Precondition: the tycon is saturated (or over-saturated)
+
+lookupFamInstEnvConflicts' env fam_inst skol_tvs
+  = lookup_fam_inst_env' my_unify False env fam tys'
+  where
+    inst_tycon = famInstTyCon fam_inst
+    (fam, tys) = expectJust "FamInstEnv.lookuFamInstEnvConflicts"
+    	       	            (tyConFamInst_maybe inst_tycon)
+    skol_tys = mkTyVarTys skol_tvs
+    tys'     = substTys (zipTopTvSubst (tyConTyVars inst_tycon) skol_tys) tys
+        -- In example above,   fam tys' = F [b]   
+
+    my_unify old_fam_inst tpl_tvs tpl_tys match_tys
+       = ASSERT2( tyVarsOfTypes tys `disjointVarSet` tpl_tvs,
+		  (ppr fam <+> ppr tys) $$
+		  (ppr tpl_tvs <+> ppr tpl_tys) )
+		-- Unification will break badly if the variables overlap
+		-- They shouldn't because we allocate separate uniques for them
+         case tcUnifyTys instanceBindFun tpl_tys match_tys of
+	      Just subst | conflicting old_fam_inst subst -> Just subst
+	      _other	   	              	          -> Nothing
+
+      -- - In the case of data family instances, any overlap is fundamentally a
+      --   conflict (as these instances imply injective type mappings).
+      -- - In the case of type family instances, overlap is admitted as long as
+      --   the right-hand sides of the overlapping rules coincide under the
+      --   overlap substitution.  We require that they are syntactically equal;
+      --   anything else would be difficult to test for at this stage.
+    conflicting old_fam_inst subst 
+      | isAlgTyCon fam = True
+      | otherwise      = not (old_rhs `eqType` new_rhs)
+      where
+        old_tycon = famInstTyCon old_fam_inst
+        old_tvs   = tyConTyVars old_tycon
+        old_rhs   = mkTyConApp old_tycon  (substTyVars subst old_tvs)
+        new_rhs   = mkTyConApp inst_tycon (substTyVars subst skol_tvs)
+
+
+
+
 lookupFamInstEnvConflicts
     :: FamInstEnvs
     -> FamInst		-- Putative new instance
@@ -336,25 +425,19 @@ type MatchFun =  FamInst		-- The FamInst template
 type OneSidedMatch = Bool     -- Are optimisations that are only valid for
                               -- one sided matches allowed?
 
-lookup_fam_inst_env 	      -- The worker, local to this module
+lookup_fam_inst_env' 	      -- The worker, local to this module
     :: MatchFun
     -> OneSidedMatch
-    -> FamInstEnvs
+    -> FamInstEnv
     -> TyCon -> [Type]		-- What we are looking for
     -> [FamInstMatch] 	        -- Successful matches
-
--- Precondition: the tycon is saturated (or over-saturated)
-
-lookup_fam_inst_env match_fun one_sided (pkg_ie, home_ie) fam tys
+lookup_fam_inst_env' match_fun one_sided ie fam tys
   | not (isFamilyTyCon fam) 
   = []
   | otherwise
   = ASSERT2( n_tys >= arity, ppr fam <+> ppr tys )	-- Family type applications must be saturated
-    home_matches ++ pkg_matches
+    lookup ie
   where
-    home_matches = lookup home_ie 
-    pkg_matches  = lookup pkg_ie  
-
     -- See Note [Over-saturated matches]
     arity = tyConArity fam
     n_tys = length tys
@@ -394,6 +477,21 @@ lookup_fam_inst_env match_fun one_sided (pkg_ie, home_ie) fam tys
         -- No match => try next
       | otherwise
       = find rest
+-- Precondition: the tycon is saturated (or over-saturated)
+
+lookup_fam_inst_env 	      -- The worker, local to this module
+    :: MatchFun
+    -> OneSidedMatch
+    -> FamInstEnvs
+    -> TyCon -> [Type]		-- What we are looking for
+    -> [FamInstMatch] 	        -- Successful matches
+
+-- Precondition: the tycon is saturated (or over-saturated)
+
+lookup_fam_inst_env match_fun one_sided (pkg_ie, home_ie) fam tys = 
+    lookup_fam_inst_env' match_fun one_sided home_ie fam tys ++
+    lookup_fam_inst_env' match_fun one_sided pkg_ie  fam tys
+
 \end{code}
 
 Note [Over-saturated matches]
diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs
index dd70be8748..ab90be248a 100644
--- a/compiler/types/InstEnv.lhs
+++ b/compiler/types/InstEnv.lhs
@@ -13,8 +13,8 @@ module InstEnv (
 	instanceHead, mkLocalInstance, mkImportedInstance,
 	instanceDFunId, setInstanceDFunId, instanceRoughTcs,
 
-	InstEnv, emptyInstEnv, extendInstEnv, 
-	extendInstEnvList, lookupInstEnv, instEnvElts,
+	InstEnv, emptyInstEnv, extendInstEnv, overwriteInstEnv, 
+	extendInstEnvList, lookupInstEnv', lookupInstEnv, instEnvElts,
 	classInstances, instanceBindFun,
 	instanceCantMatch, roughMatchTcs
     ) where
@@ -387,6 +387,29 @@ extendInstEnv inst_env ins_item@(Instance { is_cls = cls_nm })
   = addToUFM_C add inst_env cls_nm (ClsIE [ins_item])
   where
     add (ClsIE cur_insts) _ = ClsIE (ins_item : cur_insts)
+
+overwriteInstEnv :: InstEnv -> Instance -> InstEnv
+overwriteInstEnv inst_env ins_item@(Instance { is_cls = cls_nm, is_tys = tys })
+  = addToUFM_C add inst_env cls_nm (ClsIE [ins_item])
+  where
+    add (ClsIE cur_insts) _ = ClsIE (replaceInst cur_insts)
+    
+    rough_tcs  = roughMatchTcs tys
+    replaceInst [] = [ins_item]
+    replaceInst (item@(Instance { is_tcs = mb_tcs,  is_tvs = tpl_tvs, 
+                                  is_tys = tpl_tys,
+                                  is_dfun = dfun }) : rest)
+    -- Fast check for no match, uses the "rough match" fields
+      | instanceCantMatch rough_tcs mb_tcs
+      = item : replaceInst rest
+
+      | Just _ <- tcMatchTys tpl_tvs tpl_tys tys
+      = let (dfun_tvs, _) = tcSplitForAllTys (idType dfun)
+        in ASSERT( all (`elemVarSet` tpl_tvs) dfun_tvs )	-- Check invariant
+           ins_item : rest
+
+      | otherwise
+      = item : replaceInst rest
 \end{code}
 
 
@@ -418,17 +441,15 @@ might have some tyvars that *only* appear in arguments
 When we match this against D [ty], we return the instantiating types
 	[Right ty, Left b]
 where the Nothing indicates that 'b' can be freely instantiated.  
-(The caller instantiates it to a flexi type variable, which will presumably
+(The caller instantiates it to a flexi type variable, which will 
  presumably later become fixed via functional dependencies.)
 
 \begin{code}
-lookupInstEnv :: (InstEnv, InstEnv) 	-- External and home package inst-env
-	      -> Class -> [Type]	-- What we are looking for
-	      -> ([InstMatch], 		-- Successful matches
-		  [Instance],		-- These don't match but do unify
-                  Bool)                 -- True if error condition caused by
-                                        -- Safe Haskell condition.
 
+lookupInstEnv' :: InstEnv    -- InstEnv to look in
+                    -> Class -> [Type]  -- What we are looking for
+                    -> ([InstMatch],    -- Successful matches
+                        [Instance])     -- These don't match but do unify
 -- The second component of the result pair happens when we look up
 --	Foo [a]
 -- in an InstEnv that has entries for
@@ -439,53 +460,11 @@ lookupInstEnv :: (InstEnv, InstEnv) 	-- External and home package inst-env
 -- but Foo [Int] is a unifier.  This gives the caller a better chance of
 -- giving a suitable error message
 
-lookupInstEnv (pkg_ie, home_ie) cls tys
-  = (safe_matches, all_unifs, safe_fail)
+lookupInstEnv' ie cls tys
+  = lookup ie
   where
     rough_tcs  = roughMatchTcs tys
     all_tvs    = all isNothing rough_tcs
-    (home_matches, home_unifs) = lookup home_ie 
-    (pkg_matches,  pkg_unifs)  = lookup pkg_ie  
-    all_matches = home_matches ++ pkg_matches
-    all_unifs   = home_unifs   ++ pkg_unifs
-    pruned_matches = foldr insert_overlapping [] all_matches
-    (safe_matches, safe_fail) = if length pruned_matches == 1 
-                        then check_safe (head pruned_matches) all_matches
-                        else (pruned_matches, False)
-	-- Even if the unifs is non-empty (an error situation)
-	-- we still prune the matches, so that the error message isn't
-	-- misleading (complaining of multiple matches when some should be
-	-- overlapped away)
-
-    -- Safe Haskell: We restrict code compiled in 'Safe' mode from 
-    -- overriding code compiled in any other mode. The rational is
-    -- that code compiled in 'Safe' mode is code that is untrusted
-    -- by the ghc user. So we shouldn't let that code change the
-    -- behaviour of code the user didn't compile in 'Safe' mode
-    -- since thats the code they trust. So 'Safe' instances can only
-    -- overlap instances from the same module. A same instance origin
-    -- policy for safe compiled instances.
-    check_safe match@(inst,_) others
-        = case isSafeOverlap (is_flag inst) of
-                -- most specific isn't from a Safe module so OK
-                False -> ([match], False)
-                -- otherwise we make sure it only overlaps instances from
-                -- the same module
-                True -> (go [] others, True)
-        where
-            go bad [] = match:bad
-            go bad (i@(x,_):unchecked) =
-                if inSameMod x
-                    then go bad unchecked
-                    else go (i:bad) unchecked
-            
-            inSameMod b =
-                let na = getName $ getName inst
-                    la = isInternalName na
-                    nb = getName $ getName b
-                    lb = isInternalName nb
-                in (la && lb) || (nameModule na == nameModule nb)
-
     --------------
     lookup env = case lookupUFM env cls of
 		   Nothing -> ([],[])	-- No instances for this class
@@ -531,6 +510,60 @@ lookupInstEnv (pkg_ie, home_ie) cls tys
 				Nothing -> Left tv
 
 ---------------
+-- This is the common way to call this function.
+lookupInstEnv :: (InstEnv, InstEnv)     -- External and home package inst-env
+                   -> Class -> [Type]   -- What we are looking for
+                   -> ([InstMatch],     -- Successful matches
+                       [Instance],      -- These don't match but do unify
+                       Bool)            -- True if error condition caused by
+                                        -- SafeHaskell condition.
+
+lookupInstEnv (pkg_ie, home_ie) cls tys
+  = (safe_matches, all_unifs, safe_fail)
+  where
+    (home_matches, home_unifs) = lookupInstEnv' home_ie cls tys
+    (pkg_matches,  pkg_unifs)  = lookupInstEnv' pkg_ie  cls tys
+    all_matches = home_matches ++ pkg_matches
+    all_unifs   = home_unifs   ++ pkg_unifs
+    pruned_matches = foldr insert_overlapping [] all_matches
+    (safe_matches, safe_fail) = if length pruned_matches == 1 
+                        then check_safe (head pruned_matches) all_matches
+                        else (pruned_matches, False)
+	-- Even if the unifs is non-empty (an error situation)
+	-- we still prune the matches, so that the error message isn't
+	-- misleading (complaining of multiple matches when some should be
+	-- overlapped away)
+
+    -- Safe Haskell: We restrict code compiled in 'Safe' mode from 
+    -- overriding code compiled in any other mode. The rational is
+    -- that code compiled in 'Safe' mode is code that is untrusted
+    -- by the ghc user. So we shouldn't let that code change the
+    -- behaviour of code the user didn't compile in 'Safe' mode
+    -- since that's the code they trust. So 'Safe' instances can only
+    -- overlap instances from the same module. A same instance origin
+    -- policy for safe compiled instances.
+    check_safe match@(inst,_) others
+        = case isSafeOverlap (is_flag inst) of
+                -- most specific isn't from a Safe module so OK
+                False -> ([match], False)
+                -- otherwise we make sure it only overlaps instances from
+                -- the same module
+                True -> (go [] others, True)
+        where
+            go bad [] = match:bad
+            go bad (i@(x,_):unchecked) =
+                if inSameMod x
+                    then go bad unchecked
+                    else go (i:bad) unchecked
+            
+            inSameMod b =
+                let na = getName $ getName inst
+                    la = isInternalName na
+                    nb = getName $ getName b
+                    lb = isInternalName nb
+                in (la && lb) || (nameModule na == nameModule nb)
+
+---------------
 ---------------
 insert_overlapping :: InstMatch -> [InstMatch] -> [InstMatch]
 -- Add a new solution, knocking out strictly less specific ones
diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 178ffdc00e..2908047ad3 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -288,6 +288,7 @@ data TyThing = AnId     Id
 	     | ADataCon DataCon
 	     | ATyCon   TyCon
              | ACoAxiom CoAxiom
+        deriving (Eq, Ord)
 
 instance Outputable TyThing where 
   ppr = pprTyThing
@@ -303,6 +304,7 @@ pprTyThingCategory (ACoAxiom _) = ptext (sLit "Coercion axiom")
 pprTyThingCategory (AnId   _)   = ptext (sLit "Identifier")
 pprTyThingCategory (ADataCon _) = ptext (sLit "Data constructor")
 
+
 instance NamedThing TyThing where	-- Can't put this with the type
   getName (AnId id)     = getName id	-- decl, because the DataCon instance
   getName (ATyCon tc)   = getName tc	-- isn't visible there
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 8cfb8e2919..833309e6aa 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -70,7 +70,7 @@ module Outputable (
     ) where
 
 import {-# SOURCE #-} 	Module( Module, ModuleName, moduleName )
-import {-# SOURCE #-} 	OccName( OccName )
+import {-# SOURCE #-}   Name( Name, nameModule )
 
 import StaticFlags
 import FastString 
@@ -145,7 +145,7 @@ data Depth = AllTheWay
 -- as @Exception.catch@, this fuction will return @Just "Exception"@.
 -- Note that the return value is a ModuleName, not a Module, because
 -- in source code, names are qualified by ModuleNames.
-type QueryQualifyName = Module -> OccName -> QualifyName
+type QueryQualifyName = Name -> QualifyName
 
 -- See Note [Printing original names] in HscTypes
 data QualifyName                        -- given P:M.T
@@ -166,10 +166,10 @@ type QueryQualifyModule = Module -> Bool
 type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
 
 alwaysQualifyNames :: QueryQualifyName
-alwaysQualifyNames m _ = NameQual (moduleName m)
+alwaysQualifyNames n = NameQual (moduleName (nameModule n))
 
 neverQualifyNames :: QueryQualifyName
-neverQualifyNames _ _ = NameUnqual
+neverQualifyNames _ = NameUnqual
 
 alwaysQualifyModules :: QueryQualifyModule
 alwaysQualifyModules _ = True
@@ -278,8 +278,8 @@ getPprStyle df = SDoc $ \ctx -> runSDoc (df (sdocStyle ctx)) ctx
 
 \begin{code}
 qualName :: PprStyle -> QueryQualifyName
-qualName (PprUser (qual_name,_) _) m  n = qual_name m n
-qualName _other		           m _n = NameQual (moduleName m)
+qualName (PprUser (qual_name,_) _)  n = qual_name n
+qualName _other                     n = NameQual (moduleName (nameModule n))
 
 qualModule :: PprStyle -> QueryQualifyModule
 qualModule (PprUser (_,qual_mod) _)  m = qual_mod m
diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
index 649f33f2db..083b2b05a5 100644
--- a/compiler/vectorise/Vectorise.hs
+++ b/compiler/vectorise/Vectorise.hs
@@ -61,7 +61,7 @@ vectoriseIO hsc_env guts
 -- Vectorise a single module, in the VM monad.
 --
 vectModule :: ModGuts -> VM ModGuts
-vectModule guts@(ModGuts { mg_types      = types
+vectModule guts@(ModGuts { mg_tcs        = tycons
                          , mg_binds      = binds
                          , mg_fam_insts  = fam_insts
                          , mg_vect_decls = vect_decls
@@ -69,12 +69,14 @@ vectModule guts@(ModGuts { mg_types      = types
  = do { dumpOptVt Opt_D_dump_vt_trace "Before vectorisation" $ 
           pprCoreBindings binds
  
-          -- Vectorise the type environment.  This will add vectorised type constructors, their
-          -- representaions, and the conrresponding data constructors.  Moreover, we produce
-          -- bindings for dfuns and family instances of the classes and type families used in the
-          -- DPH library to represent array types.
-      ; (types', new_fam_insts, tc_binds) <- vectTypeEnv types [vd 
-                                                               | vd@(VectType _ _) <- vect_decls]
+          -- Vectorise the type environment.  This will add vectorised
+          -- type constructors, their representaions, and the
+          -- conrresponding data constructors.  Moreover, we produce
+          -- bindings for dfuns and family instances of the classes
+          -- and type families used in the DPH library to represent
+          -- array types.
+      ; (tycons', new_fam_insts, tc_binds) <- vectTypeEnv tycons [vd
+                                                                | vd@(VectType _ _) <- vect_decls]
 
       ; (_, fam_inst_env) <- readGEnv global_fam_inst_env
 
@@ -82,7 +84,7 @@ vectModule guts@(ModGuts { mg_types      = types
       ; binds_top <- mapM vectTopBind binds
       ; binds_imp <- mapM vectImpBind [imp_id | Vect imp_id _ <- vect_decls, isGlobalId imp_id]
 
-      ; return $ guts { mg_types        = types'
+      ; return $ guts { mg_tcs          = tycons'
                       , mg_binds        = Rec tc_binds : (binds_top ++ binds_imp)
                       , mg_fam_inst_env = fam_inst_env
                       , mg_fam_insts    = fam_insts ++ new_fam_insts
diff --git a/compiler/vectorise/Vectorise/Env.hs b/compiler/vectorise/Vectorise/Env.hs
index 5220d5a0fe..99c1e230de 100644
--- a/compiler/vectorise/Vectorise/Env.hs
+++ b/compiler/vectorise/Vectorise/Env.hs
@@ -202,8 +202,8 @@ setPRFunsEnv ps genv
 -- data constructors referenced in VECTORISE pragmas, even if they are defined in an imported
 -- module.
 --
-modVectInfo :: GlobalEnv -> TypeEnv -> [CoreVect]-> VectInfo -> VectInfo
-modVectInfo env tyenv vectDecls info
+modVectInfo :: GlobalEnv -> [TyCon] -> [CoreVect]-> VectInfo -> VectInfo
+modVectInfo env tycons vectDecls info
   = info 
     { vectInfoVar          = mk_env ids      (global_vars     env)
     , vectInfoTyCon        = mk_env tyCons   (global_tycons   env)
@@ -216,9 +216,10 @@ modVectInfo env tyenv vectDecls info
     vectIds        = [id    | Vect     id    _ <- vectDecls]
     vectTypeTyCons = [tycon | VectType tycon _ <- vectDecls]
     vectDataCons   = concatMap tyConDataCons vectTypeTyCons
-    ids            = typeEnvIds      tyenv ++ vectIds
-    tyCons         = typeEnvTyCons   tyenv ++ vectTypeTyCons
-    dataCons       = typeEnvDataCons tyenv ++ vectDataCons
+    ids            = {- typeEnvIds      tyenv ++ -} vectIds
+                     -- XXX: what Ids do you want here?
+    tyCons         = tycons ++ vectTypeTyCons
+    dataCons       = concatMap tyConDataCons tycons ++ vectDataCons
     
     -- Produce an entry for every declaration that is mentioned in the domain of the 'inspectedEnv'
     mk_env decls inspectedEnv
diff --git a/compiler/vectorise/Vectorise/Monad.hs b/compiler/vectorise/Vectorise/Monad.hs
index 9a61c6d013..0c9766e33e 100644
--- a/compiler/vectorise/Vectorise/Monad.hs
+++ b/compiler/vectorise/Vectorise/Monad.hs
@@ -55,7 +55,11 @@ initV :: HscEnv
       -> VM a
       -> IO (Maybe (VectInfo, a))
 initV hsc_env guts info thing_inside
-  = do { (_, Just res) <- initDs hsc_env (mg_module guts) (mg_rdr_env guts) (mg_types guts) go
+  = do {
+         let type_env = typeEnvFromEntities [] (mg_tcs guts) (mg_clss guts) (mg_fam_insts guts)
+                        -- XXX should we try to get the Ids here?
+       ; (_, Just res) <- initDs hsc_env (mg_module guts)
+                                         (mg_rdr_env guts) type_env go
 
        ; dumpIfVtTrace "Incoming VectInfo" (ppr info)
        ; case res of
@@ -110,7 +114,7 @@ initV hsc_env guts info thing_inside
                                   }
            } }
 
-    new_info genv = modVectInfo genv (mg_types guts) (mg_vect_decls guts) info
+    new_info genv = modVectInfo genv (mg_tcs guts) (mg_vect_decls guts) info
 
     selectBackendErr = sLit "To use -fvectorise select a DPH backend with -fdph-par or -fdph-seq"
 
diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs
index 063e04dd5e..35dbcb92e6 100644
--- a/compiler/vectorise/Vectorise/Type/Env.hs
+++ b/compiler/vectorise/Vectorise/Type/Env.hs
@@ -22,7 +22,6 @@ import Vectorise.Type.PRepr
 import Vectorise.Type.Repr
 import Vectorise.Utils
 
-import HscTypes
 import CoreSyn
 import CoreUtils
 import CoreUnfold
@@ -90,13 +89,13 @@ import Data.List
 
 -- |Vectorise a type environment.
 --
-vectTypeEnv :: TypeEnv                  -- Original type environment
+vectTypeEnv :: [TyCon]                  -- TyCons defined in this module
             -> [CoreVect]               -- All 'VECTORISE [SCALAR] type' declarations in this module
-            -> VM ( TypeEnv             -- Vectorised type environment.
+            -> VM ( [TyCon]             -- old TyCons ++ new TyCons
                   , [FamInst]           -- New type family instances.
                   , [(Var, CoreExpr)])  -- New top level bindings.
-vectTypeEnv env vectTypeDecls
-  = do { traceVt "** vectTypeEnv" $ ppr env
+vectTypeEnv tycons vectTypeDecls
+  = do { traceVt "** vectTypeEnv" $ ppr tycons
 
          -- Build a map containing all vectorised type constructor.  If they are scalar, they are
          -- mapped to 'False' (vectorised type constructor == original type constructor).
@@ -115,7 +114,7 @@ vectTypeEnv env vectTypeDecls
              localScalarTyConNames  = mkNameSet (map tyConName localScalarTyCons)
              notLocalScalarTyCon tc = not $ (tyConName tc) `elemNameSet` localScalarTyConNames
 
-             maybeVectoriseTyCons   = filter notLocalScalarTyCon (typeEnvTyCons env)
+             maybeVectoriseTyCons   = filter notLocalScalarTyCon tycons
              (conv_tcs, keep_tcs)   = classifyTyCons vectTyConFlavour maybeVectoriseTyCons
              orig_tcs               = keep_tcs ++ conv_tcs
              keep_dcs               = concatMap tyConDataCons keep_tcs
@@ -166,16 +165,11 @@ vectTypeEnv env vectTypeDecls
               ; return (dfuns, binds)
               }
 
-           -- We add to the type environment: (1) the vectorised type constructors, (2) their
-           -- 'PRepr' & 'PData' instance constructors, and (3) the data constructors of the fomer
-           -- two.
-       ; let all_new_tcs = new_tcs ++ inst_tcs
-             new_env     = extendTypeEnvList env
-                         $ map ATyCon all_new_tcs ++
-                           [ADataCon dc | tc <- all_new_tcs
-                                        , dc <- tyConDataCons tc]
+           -- We return: (1) the vectorised type constructors, (2)
+           -- their 'PRepr' & 'PData' instance constructors two.
+       ; let new_tycons = tycons ++ new_tcs ++ inst_tcs
 
-       ; return (new_env, fam_insts, binds)
+       ; return (new_tycons, fam_insts, binds)
        }
 
 
diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
index ba58d8c21f..d7d5b447be 100644
--- a/ghc/GhciMonad.hs
+++ b/ghc/GhciMonad.hs
@@ -247,16 +247,27 @@ printForUserPartWay doc = do
   unqual <- GHC.getPrintUnqual
   liftIO $ Outputable.printForUserPartWay stdout opt_PprUserLength unqual doc
 
-runStmt :: String -> GHC.SingleStep -> GHCi GHC.RunResult
+runStmt :: String -> GHC.SingleStep -> GHCi (Maybe GHC.RunResult)
 runStmt expr step = do
   st <- getGHCiState
   reifyGHCi $ \x ->
     withProgName (progname st) $
     withArgs (args st) $
       reflectGHCi x $ do
-        GHC.handleSourceError (\e -> do GHC.printException e
-                                        return GHC.RunFailed) $ do
-          GHC.runStmtWithLocation (progname st) (line_number st) expr step 
+        GHC.handleSourceError (\e -> do GHC.printException e; 
+                                        return Nothing) $ do
+          r <- GHC.runStmtWithLocation (progname st) (line_number st) expr step
+          return (Just r)
+
+runDecls :: String -> GHCi [GHC.Name]
+runDecls decls = do
+  st <- getGHCiState
+  reifyGHCi $ \x ->
+    withProgName (progname st) $
+    withArgs (args st) $
+      reflectGHCi x $ do
+        GHC.handleSourceError (\e -> do GHC.printException e; return []) $ do
+          GHC.runDeclsWithLocation (progname st) (line_number st) decls
 
 resume :: (SrcSpan -> Bool) -> GHC.SingleStep -> GHCi GHC.RunResult
 resume canLogSpan step = do
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 8b9e8192fc..e72533a8f7 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -449,7 +449,7 @@ runGHCi paths maybe_exprs = do
         Nothing ->
           do
             -- enter the interactive loop
-            runGHCiInput $ runCommands True $ nextInputLine show_prompt is_tty
+            runGHCiInput $ runCommands False $ nextInputLine show_prompt is_tty
         Just exprs -> do
             -- just evaluate the expression we were given
             enqueueCommands exprs
@@ -463,7 +463,7 @@ runGHCi paths maybe_exprs = do
                                    -- this used to be topHandlerFastExit, see #2228
                                      $ topHandler e
             runInputTWithPrefs defaultPrefs defaultSettings $ do
-                runCommands' handle True (return Nothing)
+                runCommands' handle False (return Nothing)
 
   -- and finally, exit
   liftIO $ when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
@@ -723,6 +723,10 @@ enqueueCommands cmds = do
   st <- getGHCiState
   setGHCiState st{ cmdqueue = cmds ++ cmdqueue st }
 
+-- | If we one of these strings prefixes a command, then we treat it as a decl
+-- rather than a stmt.
+declPrefixes :: [String]
+declPrefixes = ["class ","data ","newtype ","type ","instance ", "deriving "]
 
 runStmt :: String -> SingleStep -> GHCi Bool
 runStmt stmt step
@@ -730,6 +734,10 @@ runStmt stmt step
  = return False
  | "import " `isPrefixOf` stmt
  = do addImportToContext stmt; return False
+ | any (flip isPrefixOf stmt) declPrefixes
+ = do _ <- liftIO $ tryIO $ hFlushAll stdin
+      result <- GhciMonad.runDecls stmt
+      afterRunStmt (const True) (GHC.RunOk result)
  | otherwise
  = do -- In the new IO library, read handles buffer data even if the Handle
       -- is set to NoBuffering.  This causes problems for GHCi where there
@@ -737,8 +745,10 @@ runStmt stmt step
       -- GHCi's stdin Handle here (only relevant if stdin is attached to
       -- a file, otherwise the read buffer can't be flushed).
       _ <- liftIO $ tryIO $ hFlushAll stdin
-      result <- GhciMonad.runStmt stmt step
-      afterRunStmt (const True) result
+      m_result <- GhciMonad.runStmt stmt step
+      case m_result of
+        Nothing     -> return False
+        Just result -> afterRunStmt (const True) result
 
 --afterRunStmt :: GHC.RunResult -> GHCi Bool
                                  -- False <=> the statement failed to compile
@@ -791,8 +801,8 @@ printStoppedAtBreakInfo resume names = do
   --  printTypeOfNames session names
   let namesSorted = sortBy compareNames names
   tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
-  docs <- pprTypeAndContents [id | AnId id <- tythings]
-  printForUserPartWay docs
+  docs <- mapM pprTypeAndContents [id | AnId id <- tythings]
+  printForUserPartWay $ vcat docs
 
 printTypeOfNames :: [Name] -> GHCi ()
 printTypeOfNames names
@@ -918,20 +928,19 @@ help _ = liftIO (putStr helpText)
 
 info :: String -> InputT GHCi ()
 info "" = ghcError (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
-info s  = handleSourceError GHC.printException $
-          do { let names = words s
-             ; dflags <- getDynFlags
-             ; let pefas = dopt Opt_PrintExplicitForalls dflags
-             ; mapM_ (infoThing pefas) names }
-  where
-    infoThing pefas str = do
-        names     <- GHC.parseName str
-        mb_stuffs <- mapM GHC.getInfo names
-        let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
-        unqual <- GHC.getPrintUnqual
-        liftIO $ putStrLn $ showSDocForUser unqual $
-                     vcat (intersperse (text "") $
-                           map (pprInfo pefas) filtered)
+info s  = handleSourceError GHC.printException $ do
+    unqual <- GHC.getPrintUnqual
+    sdocs  <- mapM infoThing (words s)
+    mapM_ (liftIO . putStrLn . showSDocForUser unqual) sdocs
+
+infoThing :: GHC.GhcMonad m => String -> m SDoc
+infoThing str = do
+    dflags    <- getDynFlags
+    let pefas = dopt Opt_PrintExplicitForalls dflags
+    names     <- GHC.parseName str
+    mb_stuffs <- mapM GHC.getInfo names
+    let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
+    return $ vcat (intersperse (text "") $ map (pprInfo pefas) filtered)
 
   -- Filter out names whose parent is also there Good
   -- example is '[]', which is both a type and data
@@ -1947,13 +1956,30 @@ getLoadedModules = do
 
 showBindings :: GHCi ()
 showBindings = do
-  bindings <- GHC.getBindings
-  docs     <- pprTypeAndContents
-                  [ id | AnId id <- sortBy compareTyThings bindings]
-  printForUserPartWay docs
+    bindings <- GHC.getBindings
+    (insts, finsts) <- GHC.getInsts
+    docs     <- mapM makeDoc ({- sortBy compareTyThings -} bindings)
+--    docs     <- mapM pprTypeAndContents
+--                  [ id | AnId id <- sortBy compareTyThings bindings]
+    let idocs  = map GHC.pprInstanceHdr insts
+        fidocs = map GHC.pprFamInstHdr finsts
+    mapM_ printForUserPartWay (docs ++ idocs ++ fidocs)
+  where
+    makeDoc (AnId id) = pprTypeAndContents id
+    makeDoc tt = do
+        dflags    <- getDynFlags
+        let pefas = dopt Opt_PrintExplicitForalls dflags
+        mb_stuff <- GHC.getInfo (getName tt)
+        return $ maybe (text "") (pprTT pefas) mb_stuff
+    pprTT :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc
+    pprTT pefas (thing, fixity, _insts) = 
+        pprTyThing pefas thing
+        $$ show_fixity fixity
+      where
+        show_fixity fix 
+            | fix == GHC.defaultFixity  = empty
+            | otherwise                 = ppr fix <+> ppr (GHC.getName thing)
 
-compareTyThings :: TyThing -> TyThing -> Ordering
-t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2
 
 printTyThing :: TyThing -> GHCi ()
 printTyThing tyth = do dflags <- getDynFlags