Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

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.
  • Loading branch information...
commit 3db757241ce7fb99c096c30481aefa86bb9855a1 1 parent 9de6f19
Simon Marlow authored September 16, 2011

Showing 35 changed files with 1,255 additions and 642 deletions. Show diff stats Hide diff stats

  1. 2  compiler/basicTypes/DataCon.lhs-boot
  2. 18  compiler/basicTypes/Name.lhs
  3. 4  compiler/basicTypes/Name.lhs-boot
  4. 5  compiler/basicTypes/RdrName.lhs
  5. 66  compiler/deSugar/Desugar.lhs
  6. 2  compiler/ghci/ByteCodeLink.lhs
  7. 25  compiler/ghci/Debugger.hs
  8. 61  compiler/ghci/Linker.lhs
  9. 76  compiler/iface/IfaceEnv.lhs
  10. 32  compiler/main/GHC.hs
  11. 120  compiler/main/HscMain.lhs
  12. 287  compiler/main/HscTypes.lhs
  13. 76  compiler/main/InteractiveEval.hs
  14. 142  compiler/main/TidyPgm.lhs
  15. 12  compiler/prelude/PrelNames.lhs
  16. 37  compiler/rename/RnNames.lhs
  17. 3  compiler/rename/RnSource.lhs
  18. 32  compiler/typecheck/FamInst.lhs
  19. 110  compiler/typecheck/Inst.lhs
  20. 22  compiler/typecheck/TcEnv.lhs
  21. 7  compiler/typecheck/TcInstDcls.lhs
  22. 284  compiler/typecheck/TcRnDriver.lhs
  23. 19  compiler/typecheck/TcRnMonad.lhs
  24. 3  compiler/typecheck/TcRnTypes.lhs
  25. 19  compiler/typecheck/TcTyClsDecls.lhs
  26. 122  compiler/types/FamInstEnv.lhs
  27. 139  compiler/types/InstEnv.lhs
  28. 2  compiler/types/TypeRep.lhs
  29. 12  compiler/utils/Outputable.lhs
  30. 18  compiler/vectorise/Vectorise.hs
  31. 11  compiler/vectorise/Vectorise/Env.hs
  32. 8  compiler/vectorise/Vectorise/Monad.hs
  33. 24  compiler/vectorise/Vectorise/Type/Env.hs
  34. 19  ghc/GhciMonad.hs
  35. 78  ghc/InteractiveUI.hs
2  compiler/basicTypes/DataCon.lhs-boot
@@ -5,4 +5,6 @@ import Name( Name )
5 5
 data DataCon
6 6
 dataConName      :: DataCon -> Name
7 7
 isVanillaDataCon :: DataCon -> Bool
  8
+instance Eq DataCon
  9
+instance Ord DataCon
8 10
 \end{code}
18  compiler/basicTypes/Name.lhs
@@ -435,17 +435,17 @@ instance OutputableBndr Name where
435 435
     pprBndr _ name = pprName name
436 436
 
437 437
 pprName :: Name -> SDoc
438  
-pprName (Name {n_sort = sort, n_uniq = u, n_occ = occ})
  438
+pprName n@(Name {n_sort = sort, n_uniq = u, n_occ = occ})
439 439
   = getPprStyle $ \ sty ->
440 440
     case sort of
441  
-      WiredIn mod _ builtin   -> pprExternal sty uniq mod occ True  builtin
442  
-      External mod  	      -> pprExternal sty uniq mod occ False UserSyntax
  441
+      WiredIn mod _ builtin   -> pprExternal sty uniq mod occ n True  builtin
  442
+      External mod            -> pprExternal sty uniq mod occ n False UserSyntax
443 443
       System   		      -> pprSystem sty uniq occ
444 444
       Internal    	      -> pprInternal sty uniq occ
445 445
   where uniq = mkUniqueGrimily (iBox u)
446 446
 
447  
-pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
448  
-pprExternal sty uniq mod occ is_wired is_builtin
  447
+pprExternal :: PprStyle -> Unique -> Module -> OccName -> Name -> Bool -> BuiltInSyntax -> SDoc
  448
+pprExternal sty uniq mod occ name is_wired is_builtin
449 449
   | codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ
450 450
 	-- In code style, always qualify
451 451
 	-- ToDo: maybe we could print all wired-in things unqualified
@@ -455,7 +455,7 @@ pprExternal sty uniq mod occ is_wired is_builtin
455 455
 				      pprNameSpaceBrief (occNameSpace occ), 
456 456
 		 		      pprUnique uniq])
457 457
   | BuiltInSyntax <- is_builtin = ppr_occ_name occ  -- Never qualify builtin syntax
458  
-  | otherwise		        = pprModulePrefix sty mod occ <> ppr_occ_name occ
  458
+  | otherwise                   = pprModulePrefix sty mod name <> ppr_occ_name occ
459 459
   where
460 460
     pp_mod | opt_SuppressModulePrefixes = empty
461 461
            | otherwise                  = ppr mod <> dot 
@@ -482,14 +482,14 @@ pprSystem sty uniq occ
482 482
 				-- so print the unique
483 483
 
484 484
 
485  
-pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
  485
+pprModulePrefix :: PprStyle -> Module -> Name -> SDoc
486 486
 -- Print the "M." part of a name, based on whether it's in scope or not
487 487
 -- See Note [Printing original names] in HscTypes
488  
-pprModulePrefix sty mod occ
  488
+pprModulePrefix sty mod name
489 489
   | opt_SuppressModulePrefixes = empty
490 490
   
491 491
   | otherwise
492  
-  = case qualName sty mod occ of	           -- See Outputable.QualifyName:
  492
+  = case qualName sty name of              -- See Outputable.QualifyName:
493 493
       NameQual modname -> ppr modname <> dot       -- Name is in scope       
494 494
       NameNotInScope1  -> ppr mod <> dot           -- Not in scope
495 495
       NameNotInScope2  -> ppr (modulePackageId mod) <> colon     -- Module not in
4  compiler/basicTypes/Name.lhs-boot
... ...
@@ -1,5 +1,9 @@
1 1
 \begin{code}
2 2
 module Name where
3 3
 
  4
+import {-# SOURCE #-} Module
  5
+
4 6
 data Name
  7
+
  8
+nameModule :: Name -> Module
5 9
 \end{code}
5  compiler/basicTypes/RdrName.lhs
@@ -66,6 +66,7 @@ import Maybes
66 66
 import SrcLoc
67 67
 import FastString
68 68
 import Outputable
  69
+import Unique
69 70
 import Util
70 71
 import StaticFlags( opt_PprStyle_Debug )
71 72
 
@@ -247,7 +248,9 @@ instance Outputable RdrName where
247 248
     ppr (Exact name)   = ppr name
248 249
     ppr (Unqual occ)   = ppr occ
249 250
     ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
250  
-    ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)
  251
+    ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod name <> ppr occ)
  252
+       where name = mkExternalName (mkUniqueGrimily 0) mod occ noSrcSpan
  253
+         -- Note [Outputable Orig RdrName] in HscTypes
251 254
 
252 255
 instance OutputableBndr RdrName where
253 256
     pprBndr _ n 
66  compiler/deSugar/Desugar.lhs
@@ -56,24 +56,26 @@ deSugar :: HscEnv -> ModLocation -> TcGblEnv -> IO (Messages, Maybe ModGuts)
56 56
 deSugar hsc_env 
57 57
         mod_loc
58 58
         tcg_env@(TcGblEnv { tcg_mod          = mod,
59  
-			    tcg_src	     = hsc_src,
60  
-		    	    tcg_type_env     = type_env,
61  
-		    	    tcg_imports      = imports,
62  
-		    	    tcg_exports      = exports,
63  
-			    tcg_keep	     = keep_var,
  59
+                            tcg_src          = hsc_src,
  60
+                            tcg_type_env     = type_env,
  61
+                            tcg_imports      = imports,
  62
+                            tcg_exports      = exports,
  63
+                            tcg_keep	     = keep_var,
64 64
                             tcg_th_splice_used = tc_splice_used,
65 65
                             tcg_rdr_env      = rdr_env,
66  
-		    	    tcg_fix_env      = fix_env,
67  
-		    	    tcg_inst_env     = inst_env,
68  
-		    	    tcg_fam_inst_env = fam_inst_env,
69  
-	    	    	    tcg_warns        = warns,
70  
-	    	    	    tcg_anns         = anns,
71  
-			    tcg_binds        = binds,
72  
-		    	    tcg_imp_specs    = imp_specs,
  66
+                            tcg_fix_env      = fix_env,
  67
+                            tcg_inst_env     = inst_env,
  68
+                            tcg_fam_inst_env = fam_inst_env,
  69
+                            tcg_warns        = warns,
  70
+                            tcg_anns         = anns,
  71
+                            tcg_binds        = binds,
  72
+                            tcg_imp_specs    = imp_specs,
73 73
                             tcg_ev_binds     = ev_binds,
74 74
                             tcg_fords        = fords,
75 75
                             tcg_rules        = rules,
76 76
                             tcg_vects        = vects,
  77
+                            tcg_tcs          = tcs,
  78
+                            tcg_clss         = clss,
77 79
                             tcg_insts        = insts,
78 80
                             tcg_fam_insts    = fam_insts,
79 81
                             tcg_hpc          = other_hpc_info })
@@ -96,8 +98,7 @@ deSugar hsc_env
96 98
 			 <- if (opt_Hpc
97 99
 				  || target == HscInterpreted)
98 100
 			       && (not (isHsBoot hsc_src))
99  
-                              then addCoverageTicksToBinds dflags mod mod_loc
100  
-                                                           (typeEnvTyCons type_env) binds 
  101
+                              then addCoverageTicksToBinds dflags mod mod_loc tcs binds 
101 102
                               else return (binds, hpcInfo, emptyModBreaks)
102 103
                      initDs hsc_env mod rdr_env type_env $ do
103 104
                        do { ds_ev_binds <- dsEvBinds ev_binds
@@ -151,26 +152,27 @@ deSugar hsc_env
151 152
         ; used_th <- readIORef tc_splice_used
152 153
 
153 154
         ; let mod_guts = ModGuts {
154  
-		mg_module    	= mod,
155  
-		mg_boot	     	= isHsBoot hsc_src,
156  
-		mg_exports   	= exports,
157  
-		mg_deps	     	= deps,
158  
-		mg_used_names   = used_names,
  155
+                mg_module       = mod,
  156
+                mg_boot	        = isHsBoot hsc_src,
  157
+                mg_exports      = exports,
  158
+                mg_deps	        = deps,
  159
+                mg_used_names   = used_names,
159 160
                 mg_used_th      = used_th,
160 161
                 mg_dir_imps     = imp_mods imports,
161  
-	        mg_rdr_env   	= rdr_env,
162  
-		mg_fix_env   	= fix_env,
163  
-		mg_warns   	= warns,
164  
-		mg_anns      	= anns,
165  
-		mg_types     	= type_env,
166  
-		mg_insts     	= insts,
167  
-		mg_fam_insts 	= fam_insts,
168  
-		mg_inst_env     = inst_env,
169  
-		mg_fam_inst_env = fam_inst_env,
170  
-	        mg_rules     	= ds_rules_for_imps,
171  
-		mg_binds     	= ds_binds,
172  
-		mg_foreign   	= ds_fords,
173  
-		mg_hpc_info  	= ds_hpc_info,
  162
+                mg_rdr_env      = rdr_env,
  163
+                mg_fix_env      = fix_env,
  164
+                mg_warns        = warns,
  165
+                mg_anns         = anns,
  166
+                mg_tcs          = tcs,
  167
+                mg_clss         = clss,
  168
+                mg_insts        = insts,
  169
+                mg_fam_insts    = fam_insts,
  170
+                mg_inst_env     = inst_env,
  171
+                mg_fam_inst_env = fam_inst_env,
  172
+                mg_rules        = ds_rules_for_imps,
  173
+                mg_binds        = ds_binds,
  174
+                mg_foreign      = ds_fords,
  175
+                mg_hpc_info     = ds_hpc_info,
174 176
                 mg_modBreaks    = modBreaks,
175 177
                 mg_vect_decls   = ds_vects,
176 178
                 mg_vect_info    = noVectInfo,
2  compiler/ghci/ByteCodeLink.lhs
@@ -254,7 +254,7 @@ lookupIE ie con_nm
25  compiler/ghci/Debugger.hs
@@ -87,7 +87,7 @@ pprintClosureCommand bindThings force str = do
87 87
    tidyTermTyVars :: GhcMonad m => Term -> m Term
88 88
    tidyTermTyVars t =
89 89
      withSession $ \hsc_env -> do
90  
-     let env_tvs      = tyVarsOfTypes (map idType (ic_tmp_ids (hsc_IC hsc_env)))
  90
+     let env_tvs      = tyThingsTyVars $ ic_tythings $ hsc_IC hsc_env
91 91
          my_tvs       = termTyVars t
92 92
          tvs          = env_tvs `minusVarSet` my_tvs
93 93
          tyvarOccName = nameOccName . tyVarName
@@ -110,7 +110,7 @@ bindSuspensions t = do
110 110
       let (names, tys, hvals) = unzip3 stuff
111 111
       let ids = [ mkVanillaGlobal name ty 
112 112
                 | (name,ty) <- zip names tys]
113  
-          new_ic = extendInteractiveContext ictxt ids
  113
+          new_ic = extendInteractiveContext ictxt (map AnId ids)
114 114
       liftIO $ extendLinkEnv (zip names hvals)
115 115
       modifySession $ \_ -> hsc_env {hsc_IC = new_ic }
116 116
       return t'
@@ -187,10 +187,8 @@ showTerm term = do
187 187
 
188 188
   bindToFreshName hsc_env ty userName = do
189 189
     name <- newGrimName userName
190  
-    let ictxt    = hsc_IC hsc_env
191  
-        tmp_ids  = ic_tmp_ids ictxt
192  
-        id       = mkVanillaGlobal name ty 
193  
-        new_ic   = ictxt { ic_tmp_ids = id : tmp_ids }
  190
+    let id       = AnId $ mkVanillaGlobal name ty 
  191
+        new_ic   = extendInteractiveContext (hsc_IC hsc_env) [id]
194 192
     return (hsc_env {hsc_IC = new_ic }, name)
195 193
 
196 194
 --    Create new uniques and give them sequentially numbered names
@@ -202,20 +200,19 @@ newGrimName userName  = do
202 200
         name    = mkInternalName unique occname noSrcSpan
203 201
     return name
204 202
 
205  
-pprTypeAndContents :: GhcMonad m => [Id] -> m SDoc
206  
-pprTypeAndContents ids = do
  203
+pprTypeAndContents :: GhcMonad m => Id -> m SDoc
  204
+pprTypeAndContents id = do
207 205
   dflags  <- GHC.getSessionDynFlags
208 206
   let pefas     = dopt Opt_PrintExplicitForalls dflags
209 207
       pcontents = dopt Opt_PrintBindContents dflags
  208
+      pprdId    = (pprTyThing pefas . AnId) id
210 209
   if pcontents 
211 210
     then do
212 211
       let depthBound = 100
213  
-      terms      <- mapM (GHC.obtainTermFromId depthBound False) ids
214  
-      docs_terms <- mapM showTerm terms
215  
-      return $ vcat $ zipWith (\ty cts -> ty <+> equals <+> cts)
216  
-                             (map (pprTyThing pefas . AnId) ids)
217  
-                             docs_terms
218  
-    else return $  vcat $ map (pprTyThing pefas . AnId) ids
  212
+      term      <- GHC.obtainTermFromId depthBound False id
  213
+      docs_term <- showTerm term
  214
+      return $ pprdId <+> equals <+> docs_term
  215
+    else return pprdId
219 216
 
220 217
 --------------------------------------------------------------
221 218
 -- Utils 
61  compiler/ghci/Linker.lhs
@@ -12,7 +12,7 @@
12 12
 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
13 13
 
14 14
 module Linker ( HValue, getHValue, showLinkerState,
15  
-		linkExpr, unload, withExtendedLinkEnv,
  15
+		linkExpr, linkDecls, unload, withExtendedLinkEnv,
16 16
                 extendLinkEnv, deleteFromLinkEnv,
17 17
                 extendLoadedPkgs, 
18 18
 		linkPackages,initDynLinker,linkModule,
@@ -52,6 +52,7 @@ import UniqSet
52 52
 import FastString
53 53
 import Config
54 54
 import SysTools
  55
+import PrelNames
55 56
 
56 57
 -- Standard libraries
57 58
 import Control.Monad
@@ -427,9 +428,9 @@ linkExpr hsc_env span root_ul_bco
427 428
 
428 429
      needed_mods :: [Module]
429 430
      needed_mods = [ nameModule n | n <- free_names, 
430  
-				    isExternalName n,	 	-- Names from other modules
431  
-				    not (isWiredInName n)	-- Exclude wired-in names
432  
-		   ]						-- (see note below)
  431
+                     isExternalName n,      -- Names from other modules
  432
+                     not (isWiredInName n)  -- Exclude wired-in names
  433
+                   ]                        -- (see note below)
433 434
 	-- Exclude wired-in names because we may not have read
434 435
 	-- their interface files, so getLinkDeps will fail
435 436
 	-- 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
476 477
 -- Find all the packages and linkables that a set of modules depends on
477 478
  = do {
478 479
 	-- 1.  Find the dependent home-pkg-modules/packages from each iface
479  
-        (mods_s, pkgs_s) <- follow_deps mods emptyUniqSet emptyUniqSet;
  480
+        -- (omitting iINTERACTIVE, which is already linked)
  481
+        (mods_s, pkgs_s) <- follow_deps (filter ((/=) iNTERACTIVE) mods)
  482
+                                        emptyUniqSet emptyUniqSet;
480 483
 
481 484
 	let {
482 485
 	-- 2.  Exclude ones already linked
@@ -488,7 +491,6 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods
488 491
                                 (objs_loaded pls ++ bcos_loaded pls)
489 492
 	} ;
490 493
 	
491  
---        putStrLn (showSDoc (ppr mods_s)) ;
492 494
 	-- 3.  For each dependent module, find its linkable
493 495
 	--     This will either be in the HPT or (in the case of one-shot
494 496
 	--     compilation) we may need to use maybe_getFileLinkable
@@ -594,6 +596,53 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods
594 596
 	    adjust_ul _ _ = panic "adjust_ul"
595 597
 \end{code}
596 598
 
  599
+
  600
+%************************************************************************
  601
+%*									*
  602
+              Loading a Decls statement
  603
+%*									*
  604
+%************************************************************************
  605
+\begin{code}
  606
+linkDecls :: HscEnv -> SrcSpan -> CompiledByteCode -> IO () --[HValue]
  607
+linkDecls hsc_env span (ByteCode unlinkedBCOs itblEnv) = do
  608
+    -- Initialise the linker (if it's not been done already)
  609
+    let dflags = hsc_dflags hsc_env
  610
+    initDynLinker dflags
  611
+
  612
+    -- Take lock for the actual work.
  613
+    modifyPLS $ \pls0 -> do
  614
+
  615
+    -- Link the packages and modules required
  616
+    (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods
  617
+    if failed ok
  618
+      then ghcError (ProgramError "")
  619
+      else do
  620
+
  621
+    -- Link the expression itself
  622
+    let ie = plusNameEnv (itbl_env pls) itblEnv
  623
+        ce = closure_env pls
  624
+
  625
+    -- Link the necessary packages and linkables
  626
+    (final_gce, _) <- linkSomeBCOs False ie ce unlinkedBCOs
  627
+    let pls2 = pls { closure_env = final_gce,
  628
+                     itbl_env    = ie }
  629
+    return (pls2, ()) --hvals)
  630
+  where
  631
+    free_names =  concatMap (nameSetToList . bcoFreeNames) unlinkedBCOs
  632
+
  633
+    needed_mods :: [Module]
  634
+    needed_mods = [ nameModule n | n <- free_names, 
  635
+                    isExternalName n,       -- Names from other modules
  636
+                    not (isWiredInName n)   -- Exclude wired-in names
  637
+                  ]                         -- (see note below)
  638
+    -- Exclude wired-in names because we may not have read
  639
+    -- their interface files, so getLinkDeps will fail
  640
+    -- All wired-in names are in the base package, which we link
  641
+    -- by default, so we can safely ignore them here.
  642
+\end{code}
  643
+
  644
+
  645
+
597 646
 %************************************************************************
598 647
 %*									*
599 648
               Loading a single module
76  compiler/iface/IfaceEnv.lhs
@@ -71,39 +71,49 @@ allocateGlobalBinder
71 71
   -> (NameCache, Name)
72 72
 allocateGlobalBinder name_supply mod occ loc
73 73
   = case lookupOrigNameCache (nsNames name_supply) mod occ of
74  
-	-- A hit in the cache!  We are at the binding site of the name.
75  
-	-- This is the moment when we know the SrcLoc
76  
-	-- of the Name, so we set this field in the Name we return.
77  
-	--
78  
-	-- Then (bogus) multiple bindings of the same Name
79  
-	-- get different SrcLocs can can be reported as such.
80  
-	--
81  
-	-- Possible other reason: it might be in the cache because we
82  
-	-- 	encountered an occurrence before the binding site for an
83  
-	--	implicitly-imported Name.  Perhaps the current SrcLoc is
84  
-	--	better... but not really: it'll still just say 'imported'
85  
-	--
86  
-	-- IMPORTANT: Don't mess with wired-in names.  
87  
-	-- 	      Their wired-in-ness is in their NameSort
88  
-	--	      and their Module is correct.
89  
-
90  
-	Just name | isWiredInName name -> (name_supply, name)
91  
-		  | otherwise -> (new_name_supply, name')
92  
-		  where
93  
-		    uniq      = nameUnique name
94  
-		    name'     = mkExternalName uniq mod occ loc
95  
-		    new_cache = extendNameCache (nsNames name_supply) mod occ name'
96  
-		    new_name_supply = name_supply {nsNames = new_cache}		     
97  
-
98  
-	-- Miss in the cache!
99  
-	-- Build a completely new Name, and put it in the cache
100  
-	Nothing -> (new_name_supply, name)
101  
-		where
102  
-		  (uniq, us')     = takeUniqFromSupply (nsUniqs name_supply)
103  
-		  name            = mkExternalName uniq mod occ loc
104  
-		  new_cache       = extendNameCache (nsNames name_supply) mod occ name
105  
-		  new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
106  
-
  74
+        -- A hit in the cache!  We are at the binding site of the name.
  75
+        -- This is the moment when we know the SrcLoc
  76
+        -- of the Name, so we set this field in the Name we return.
  77
+        --
  78
+        -- Then (bogus) multiple bindings of the same Name
  79
+        -- get different SrcLocs can can be reported as such.
  80
+        --
  81
+        -- Possible other reason: it might be in the cache because we
  82
+        -- 	encountered an occurrence before the binding site for an
  83
+        --	implicitly-imported Name.  Perhaps the current SrcLoc is
  84
+        --	better... but not really: it'll still just say 'imported'
  85
+        --
  86
+        -- IMPORTANT: Don't mess with wired-in names.
  87
+        -- 	      Their wired-in-ness is in their NameSort
  88
+        --	      and their Module is correct.
  89
+
  90
+        Just name | isWiredInName name -> (name_supply, name)
  91
+                  | mod /= iNTERACTIVE -> (new_name_supply, name')
  92
+                     -- Note [interactive name cache]
  93
+                  where
  94
+                    uniq            = nameUnique name
  95
+                    name'           = mkExternalName uniq mod occ loc
  96
+                    new_cache       = extendNameCache (nsNames name_supply) mod occ name'
  97
+                    new_name_supply = name_supply {nsNames = new_cache}
  98
+
  99
+        -- Miss in the cache!
  100
+        -- Build a completely new Name, and put it in the cache
  101
+        _ -> (new_name_supply, name)
  102
+                  where
  103
+                    (uniq, us')     = takeUniqFromSupply (nsUniqs name_supply)
  104
+                    name            = mkExternalName uniq mod occ loc
  105
+                    new_cache       = extendNameCache (nsNames name_supply) mod occ name
  106
+                    new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
  107
+
  108
+{- Note [interactive name cache]
  109
+
  110
+In GHCi we always create Names with the same Module, ":Interactive".
  111
+However, we want to be able to shadow older declarations with newer
  112
+ones, and we don't want the Name cache giving us back the same Unique
  113
+for the new Name as for the old, hence this special case.
  114
+
  115
+See also Note [Outputable Orig RdrName] in HscTypes.
  116
+-}
107 117
 
108 118
 newImplicitBinder :: Name			-- Base name
109 119
 	          -> (OccName -> OccName) 	-- Occurrence name modifier
32  compiler/main/GHC.hs
@@ -80,7 +80,7 @@ module GHC (
80 80
 	PrintUnqualified, alwaysQualify,
81 81
 
82 82
 	-- * Interactive evaluation
83  
-	getBindings, getPrintUnqual,
  83
+	getBindings, getInsts, getPrintUnqual,
84 84
         findModule,
85 85
         lookupModule,
86 86
 #ifdef GHCI
@@ -94,7 +94,7 @@ module GHC (
94 94
 	typeKind,
95 95
 	parseName,
96 96
 	RunResult(..),  
97  
-	runStmt, runStmtWithLocation,
  97
+	runStmt, runStmtWithLocation, runDecls, runDeclsWithLocation,
98 98
         parseImportDecl, SingleStep(..),
99 99
         resume,
100 100
         Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
@@ -166,7 +166,9 @@ module GHC (
166 166
 
167 167
 	-- ** Instances
168 168
 	Instance, 
169  
-	instanceDFunId, pprInstance, pprInstanceHdr,
  169
+	instanceDFunId, 
  170
+        pprInstance, pprInstanceHdr,
  171
+        pprFamInst, pprFamInstHdr,
170 172
 
171 173
 	-- ** Types and Kinds
172 174
 	Type, splitForAllTys, funResultTy, 
@@ -264,8 +266,9 @@ import Class
264 266
 import DataCon
265 267
 import Name             hiding ( varName )
266 268
 import InstEnv
  269
+import FamInstEnv
267 270
 import SrcLoc
268  
-import CoreSyn          ( CoreBind )
  271
+import CoreSyn
269 272
 import TidyPgm
270 273
 import DriverPhases     ( Phase(..), isHaskellSrcFilename )
271 274
 import Finder
@@ -864,11 +867,15 @@ compileCore simplify fn = do
864 867
         -- we just have a ModGuts.
865 868
         gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
866 869
         gutsToCoreModule (Left (cg, md))  = CoreModule {
867  
-          cm_module = cg_module cg,    cm_types = md_types md,
  870
+          cm_module = cg_module cg,
  871
+          cm_types = md_types md,
868 872
           cm_binds = cg_binds cg
869 873
         }
870 874
         gutsToCoreModule (Right mg) = CoreModule {
871  
-          cm_module  = mg_module mg,                   cm_types   = mg_types mg,
  875
+          cm_module  = mg_module mg,
  876
+          cm_types   = typeEnvFromEntities (bindersOfBinds (mg_binds mg))
  877
+                                           (mg_tcs mg) (mg_clss mg)
  878
+                                           (mg_fam_insts mg),
872 879
           cm_binds   = mg_binds mg
873 880
          }
874 881
 
@@ -899,13 +906,12 @@ isLoaded m = withSession $ \hsc_env ->
899 906
 -- | Return the bindings for the current interactive session.
900 907
 getBindings :: GhcMonad m => m [TyThing]
901 908
 getBindings = withSession $ \hsc_env ->
902  
-   -- we have to implement the shadowing behaviour of ic_tmp_ids here
903  
-   -- (see InteractiveContext) and the quickest way is to use an OccEnv.
904  
-   let 
905  
-       occ_env = mkOccEnv [ (nameOccName (idName id), AnId id) 
906  
-                          | id <- ic_tmp_ids (hsc_IC hsc_env) ]
907  
-   in
908  
-   return (occEnvElts occ_env)
  909
+    return $ icInScopeTTs $ hsc_IC hsc_env
  910
+
  911
+-- | Return the instances for the current interactive session.
  912
+getInsts :: GhcMonad m => m ([Instance], [FamInst])
  913
+getInsts = withSession $ \hsc_env ->
  914
+    return $ ic_instances (hsc_IC hsc_env)
909 915
 
910 916
 getPrintUnqual :: GhcMonad m => m PrintUnqualified
911 917
 getPrintUnqual = withSession $ \hsc_env ->
120  compiler/main/HscMain.lhs
@@ -63,6 +63,7 @@ module HscMain
63 63
     , hscRnImportDecls
64 64
     , hscTcRnLookupRdrName
65 65
     , hscStmt, hscStmtWithLocation
  66
+    , hscDecls, hscDeclsWithLocation
66 67
     , hscTcExpr, hscImport, hscKcType
67 68
     , hscCompileCoreExpr
68 69
 #endif
@@ -71,13 +72,11 @@ module HscMain
71 72
 
72 73
 #ifdef GHCI
73 74
 import ByteCodeGen	( byteCodeGen, coreExprToBCOs )
74  
-import Linker		( HValue, linkExpr )
  75
+import Linker
75 76
 import CoreTidy		( tidyExpr )
76 77
 import Type		( Type )
77  
-import TcType           ( tyVarsOfTypes )
78  
-import PrelNames	( iNTERACTIVE )
  78
+import PrelNames
79 79
 import {- Kind parts of -} Type		( Kind )
80  
-import Id      	     	( idType )
81 80
 import CoreLint		( lintUnfolding )
82 81
 import DsMeta		( templateHaskellNames )
83 82
 import VarSet
@@ -85,7 +84,7 @@ import VarEnv		( emptyTidyEnv )
85 84
 import Panic
86 85
 #endif
87 86
 
88  
-import Id		( Id )
  87
+import Id
89 88
 import Module
90 89
 import Packages
91 90
 import RdrName
@@ -100,7 +99,7 @@ import TcIface		( typecheckIface )
100 99
 import TcRnMonad
101 100
 import IfaceEnv		( initNameCache )
102 101
 import LoadIface	( ifaceStats, initExternalPackageState )
103  
-import PrelInfo		( wiredInThings, basicKnownKeyNames )
  102
+import PrelInfo
104 103
 import MkIface
105 104
 import Desugar
106 105
 import SimplCore
@@ -111,8 +110,9 @@ import qualified StgCmm	( codeGen )
111 110
 import StgSyn
112 111
 import CostCentre
113 112
 import ProfInit
114  
-import TyCon            ( TyCon, isDataTyCon )
115  
-import Name		( Name, NamedThing(..) )
  113
+import TyCon
  114
+import Class
  115
+import Name
116 116
 import SimplStg		( stg2stg )
117 117
 import CodeGen		( codeGen )
118 118
 import OldCmm as Old    ( CmmGroup )
@@ -127,7 +127,7 @@ import CodeOutput
127 127
 import NameEnv          ( emptyNameEnv )
128 128
 import NameSet          ( emptyNameSet )
129 129
 import InstEnv
130  
-import FamInstEnv       ( emptyFamInstEnv )
  130
+import FamInstEnv
131 131
 import Fingerprint      ( Fingerprint )
132 132
 
133 133
 import DynFlags
@@ -1287,8 +1287,8 @@ hscStmtWithLocation hsc_env stmt source linenumber = runHsc hsc_env $ do
1287 1287
                             tcRnStmt hsc_env icontext parsed_stmt
1288 1288
 	    -- Desugar it
1289 1289
 	let rdr_env  = ic_rn_gbl_env icontext
1290  
-	    type_env = mkTypeEnv (map AnId (ic_tmp_ids icontext))
1291  
-	ds_expr <- ioMsgMaybe $
  1290
+            type_env = mkTypeEnvWithImplicits (ic_tythings icontext)
  1291
+        ds_expr <- ioMsgMaybe $
1292 1292
                      deSugarExpr hsc_env iNTERACTIVE rdr_env type_env tc_expr
1293 1293
         handleWarnings
1294 1294
 
@@ -1297,7 +1297,90 @@ hscStmtWithLocation hsc_env stmt source linenumber = runHsc hsc_env $ do
1297 1297
         hsc_env <- getHscEnv
1298 1298
 	hval <- liftIO $ hscCompileCoreExpr hsc_env src_span ds_expr
1299 1299
 
1300  
-	return $ Just (ids, hval)
  1300
+        return $ Just (ids, hval)
  1301
+
  1302
+hscDecls                -- Compile a decls
  1303
+  :: HscEnv
  1304
+  -> String             -- The statement
  1305
+  -> IO ([TyThing], InteractiveContext)
  1306
+hscDecls hsc_env str = hscDeclsWithLocation hsc_env str "<interactive>" 1
  1307
+
  1308
+hscDeclsWithLocation    -- Compile a decls
  1309
+  :: HscEnv
  1310
+  -> String             -- The statement
  1311
+  -> String             -- the source
  1312
+  -> Int                -- ^ starting line
  1313
+  -> IO ([TyThing], InteractiveContext)
  1314
+hscDeclsWithLocation hsc_env str source linenumber = runHsc hsc_env $ do 
  1315
+    L _ (HsModule{hsmodDecls=decls}) <-
  1316
+        hscParseThingWithLocation source linenumber parseModule str
  1317
+    
  1318
+    -- Rename and typecheck it
  1319
+    let icontext = hsc_IC hsc_env
  1320
+    tc_gblenv <- ioMsgMaybe $ tcRnDeclsi hsc_env icontext decls
  1321
+
  1322
+    -- Grab the new instances
  1323
+    -- We grab the whole environment because of the overlapping that may have 
  1324
+    -- been done.  See the notes at the definition of InteractiveContext
  1325
+    -- (ic_instances) for more details.
  1326
+    let finsts  = famInstEnvElts $ tcg_fam_inst_env tc_gblenv
  1327
+        insts   = instEnvElts $ tcg_inst_env tc_gblenv
  1328
+
  1329
+	-- Desugar it
  1330
+    -- We use a basically null location for iNTERACTIVE
  1331
+    let iNTERACTIVELoc = ModLocation{ ml_hs_file   = Nothing,
  1332
+                                      ml_hi_file   = undefined,
  1333
+                                      ml_obj_file  = undefined}
  1334
+    ds_result <- ioMsgMaybe $ deSugar hsc_env iNTERACTIVELoc tc_gblenv
  1335
+    handleWarnings
  1336
+
  1337
+        -- Simplify
  1338
+    simpl_mg <- liftIO $ hscSimplify hsc_env ds_result
  1339
+
  1340
+        -- Tidy
  1341
+    (tidy_cg, _mod_details) <- liftIO $ tidyProgram hsc_env simpl_mg
  1342
+
  1343
+    let dflags = hsc_dflags hsc_env
  1344
+        CgGuts{ cg_binds     = core_binds,
  1345
+                cg_tycons    = tycons,
  1346
+                cg_modBreaks = mod_breaks } = tidy_cg
  1347
+        data_tycons = filter isDataTyCon tycons
  1348
+
  1349
+	-------------------
  1350
+	-- PREPARE FOR CODE GENERATION
  1351
+	-- Do saturation and convert to A-normal form
  1352
+    prepd_binds <- {-# SCC "CorePrep" #-}
  1353
+                    liftIO $ corePrepPgm dflags core_binds data_tycons
  1354
+
  1355
+    -----------------  Generate byte code ------------------
  1356
+    cbc <- liftIO $ byteCodeGen dflags prepd_binds data_tycons mod_breaks
  1357
+
  1358
+    let src_span = srcLocSpan interactiveSrcLoc
  1359
+    hsc_env <- getHscEnv
  1360
+    liftIO $ linkDecls hsc_env src_span cbc
  1361
+
  1362
+    -- pprTrace "te" (ppr te) $ return ()
  1363
+
  1364
+    let
  1365
+        tcs     = filter (not . isImplicitTyCon) $ mg_tcs simpl_mg
  1366
+        clss    = mg_clss simpl_mg
  1367
+        tythings = map ATyCon tcs ++ map (ATyCon . classTyCon) clss
  1368
+        sys_vars = filter (isExternalName . idName) $
  1369
+                      bindersOfBinds (cg_binds tidy_cg)
  1370
+                   -- we only need to keep around the external bindings
  1371
+                   -- (as decided by TidyPgm), since those are the only ones
  1372
+                   -- that might be referenced elsewhere.
  1373
+
  1374
+    -- pprTrace "new tycons"  (ppr tcs) $ return ()
  1375
+    -- pprTrace "new classes" (ppr clss) $ return ()
  1376
+    -- pprTrace "new sys Ids" (ppr sys_vars) $ return ()
  1377
+
  1378
+    let ictxt1 = extendInteractiveContext icontext tythings
  1379
+        ictxt = ictxt1 {
  1380
+            ic_sys_vars   = sys_vars ++ ic_sys_vars ictxt1,
  1381
+            ic_instances  = (insts, finsts) }
  1382
+    
  1383
+    return $ (tythings, ictxt)
1301 1384
 
1302 1385
 hscImport :: HscEnv -> String -> IO (ImportDecl RdrName)
1303 1386
 hscImport hsc_env str = runHsc hsc_env $ do
@@ -1311,7 +1394,7 @@ hscImport hsc_env str = runHsc hsc_env $ do
1311 1394
 
1312 1395
 hscTcExpr	-- Typecheck an expression (but don't run it)
1313 1396
   :: HscEnv
1314  
-  -> String			-- The expression
  1397
+  -> String                     -- The expression
1315 1398
   -> IO Type
1316 1399
 
1317 1400
 hscTcExpr hsc_env expr = runHsc hsc_env $ do
@@ -1326,7 +1409,7 @@ hscTcExpr hsc_env expr = runHsc hsc_env $ do
1326 1409
 -- | Find the kind of a type
1327 1410
 hscKcType
1328 1411
   :: HscEnv
1329  
-  -> String			-- ^ The type
  1412
+  -> String                     -- ^ The type
1330 1413
   -> IO Kind
1331 1414
 
1332 1415
 hscKcType hsc_env str = runHsc hsc_env $ do
@@ -1414,7 +1497,8 @@ mkModGuts mod binds = ModGuts {
1414 1497
   mg_used_th = False,
1415 1498
   mg_rdr_env = emptyGlobalRdrEnv,
1416 1499
   mg_fix_env = emptyFixityEnv,
1417  
-  mg_types = emptyTypeEnv,
  1500
+  mg_tcs   = [],
  1501
+  mg_clss  = [],
1418 1502
   mg_insts = [],
1419 1503
   mg_fam_insts = [],
1420 1504
   mg_rules = [],
@@ -1463,9 +1547,11 @@ hscCompileCoreExpr hsc_env srcspan ds_expr
1463 1547
   	-- ToDo: improve SrcLoc
1464 1548
     when lint_on $
1465 1549
        let ictxt = hsc_IC hsc_env
1466  
-           tyvars = varSetElems (tyVarsOfTypes (map idType (ic_tmp_ids ictxt)))
  1550
+           te     = mkTypeEnvWithImplicits (ic_tythings ictxt ++ map AnId (ic_sys_vars ictxt))
  1551
+           tyvars = varSetElems $ tyThingsTyVars $ typeEnvElts $ te
  1552
+           vars   = typeEnvIds te
1467 1553
        in
1468  
-           case lintUnfolding noSrcLoc tyvars prepd_expr of
  1554
+           case lintUnfolding noSrcLoc (tyvars ++ vars) prepd_expr of
1469 1555
   	      Just err -> pprPanic "hscCompileCoreExpr" err
1470 1556
   	      Nothing  -> return ()
1471 1557
 
287  compiler/main/HscTypes.lhs
@@ -41,10 +41,10 @@ module HscTypes (
41 41
         prepareAnnotations,
42 42
 
43 43
         -- * Interactive context
44  
-	InteractiveContext(..), emptyInteractiveContext, 
45  
-        InteractiveImport(..),
46  
-	icPrintUnqual, extendInteractiveContext,
47  
-        substInteractiveContext,
  44
+        InteractiveContext(..), emptyInteractiveContext, 
  45
+        icPrintUnqual, icInScopeTTs, icPlusGblRdrEnv,
  46
+        extendInteractiveContext, substInteractiveContext,
  47
+        InteractiveImport(..), 
48 48
         mkPrintUnqualified, pprModulePrefix,
49 49
 
50 50
 	-- * Interfaces
@@ -55,15 +55,17 @@ module HscTypes (
55 55
 	FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
56 56
 
57 57
         -- * TyThings and type environments
58  
-	TyThing(..),
  58
+        TyThing(..),  tyThingAvailInfo,
59 59
 	tyThingTyCon, tyThingDataCon,
60  
-        tyThingId, tyThingCoAxiom, tyThingParent_maybe,
61  
-	implicitTyThings, implicitTyConThings, implicitClassThings, isImplicitTyThing,
  60
+        tyThingId, tyThingCoAxiom, tyThingParent_maybe, tyThingsTyVars,
  61
+        implicitTyThings, implicitTyConThings, implicitClassThings,
  62
+        isImplicitTyThing,
62 63
 	
63 64
 	TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
  65
+        typeEnvFromEntities, mkTypeEnvWithImplicits,
64 66
 	extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
65 67
 	typeEnvElts, typeEnvTyCons, typeEnvIds,
66  
-	typeEnvDataCons, typeEnvCoAxioms,
  68
+        typeEnvDataCons, typeEnvCoAxioms, typeEnvClasses,
67 69
 
68 70
         -- * MonadThings
69 71
         MonadThings(..),
@@ -73,8 +75,8 @@ module HscTypes (
73 75
 	Dependencies(..), noDependencies,
74 76
 	NameCache(..), OrigNameCache, OrigIParamCache,
75 77
 	Avails, availsToNameSet, availsToNameEnv, availName, availNames,
76  
-	AvailInfo(..),
77  
-	IfaceExport, stableAvailCmp, 
  78
+        AvailInfo(..), gresFromAvails, gresFromAvail,
  79
+        IfaceExport, stableAvailCmp,
78 80
 
79 81
 	-- * Warnings
80 82
 	Warnings(..), WarningTxt(..), plusWarns,
@@ -118,7 +120,7 @@ import NameEnv
118 120
 import NameSet  
119 121
 import Module
120 122
 import InstEnv          ( InstEnv, Instance )
121  
-import FamInstEnv       ( FamInstEnv, FamInst )
  123
+import FamInstEnv
122 124
 import Rules            ( RuleBase )
123 125
 import CoreSyn          ( CoreBind )
124 126
 import VarEnv
@@ -129,23 +131,24 @@ import IdInfo		( IdDetails(..) )
129 131
 import Type             
130 132
 
131 133
 import Annotations
132  
-import Class		( Class, classAllSelIds, classATs, classTyCon )
  134
+import Class
133 135
 import TyCon
134  
-import DataCon		( DataCon, dataConImplicitIds, dataConWrapId, dataConTyCon )
  136
+import DataCon
135 137
 import PrelNames	( gHC_PRIM )
136 138
 import Packages hiding ( Version(..) )
137 139
 import DynFlags
138  
-import DriverPhases	( HscSource(..), isHsBoot, hscSourceString, Phase )
139  
-import BasicTypes	( IPName, defaultFixity, WarningTxt(..) )
  140
+import DriverPhases
  141
+import BasicTypes
140 142
 import OptimizationFuel	( OptFuelState )
141 143
 import IfaceSyn
142 144
 import CoreSyn		( CoreRule, CoreVect )
143  
-import Maybes		( orElse, expectJust, catMaybes )
  145
+import Maybes
144 146
 import Outputable
145 147
 import BreakArray
146 148
 import SrcLoc
147  
-import UniqFM		( lookupUFM, eltsUFM, emptyUFM )
148  
-import UniqSupply	( UniqSupply )
  149
+import Unique
  150
+import UniqFM
  151
+import UniqSupply
149 152
 import FastString
150 153
 import StringBuffer	( StringBuffer )
151 154
 import Fingerprint
@@ -159,7 +162,6 @@ import System.Time	( ClockTime )
159 162
 import Data.IORef
160 163
 import Data.Array       ( Array, array )
161 164
 import Data.Map         ( Map )
162  
-import Data.List
163 165
 import Data.Word
164 166
 import Control.Monad    ( mplus, guard, liftM, when )
165 167
 import Exception
@@ -747,7 +749,8 @@ data ModGuts
747 749
 	-- These fields all describe the things **declared in this module**
748 750
 	mg_fix_env   :: !FixityEnv,	 -- ^ Fixities declared in this module
749 751
 	                                 -- TODO: I'm unconvinced this is actually used anywhere
750  
-	mg_types     :: !TypeEnv,        -- ^ Types declared in this module
  752
+        mg_tcs       :: ![TyCon],        -- ^ TyCons declared in this module
  753
+        mg_clss      :: ![Class],        -- ^ Classes declared in this module
751 754
 	mg_insts     :: ![Instance],	 -- ^ Class instances declared in this module
752 755
 	mg_fam_insts :: ![FamInst],	 -- ^ Family instances declared in this module
753 756
         mg_rules     :: ![CoreRule],	 -- ^ Before the core pipeline starts, contains 
@@ -895,70 +898,130 @@ data InteractiveContext
895 898
              -- ^ The GHCi context is extended with these imports
896 899
 
897 900
          ic_rn_gbl_env :: GlobalRdrEnv,
898  
-             -- ^ The contexts' cached 'GlobalRdrEnv', built by
899  
-             -- 'InteractiveEval.setContext'
  901
+             -- ^ The cached 'GlobalRdrEnv', built by
  902
+             -- 'InteractiveEval.setContext' and updated regularly
900 903
 
901  
-         ic_tmp_ids :: [Id],
902  
-             -- ^ Names bound during interaction with the user.  Later
903  
-             -- Ids shadow earlier ones with the same OccName
904  
-             -- Expressions are typed with these Ids in the envt For
905  
-             -- runtime-debugging, these Ids may have free TcTyVars of
906  
-             -- RuntimUnkSkol flavour, but no free TyVars (because the
907  
-             -- typechecker doesn't expect that)
  904
+         ic_tythings :: [TyThing],
  905
+             -- ^ TyThings defined by the user, in reverse order of
  906
+             -- definition.
  907
+
  908
+         ic_sys_vars  :: [Id],
  909
+             -- ^ Variables defined automatically by the system (e.g.
  910
+             -- record field selectors).  See Notes [ic_sys_vars]
  911
+
  912
+         ic_instances :: ([Instance], [FamInst]),
  913
+             -- ^ All instances and family instances created during
  914
+             -- this session.  These are grabbed en masse after each
  915
+             -- update to be sure that proper overlapping is retained.
  916
+             -- That is, rather than re-check the overlapping each
  917
+             -- time we update the context, we just take the results
  918
+             -- from the instance code that already does that.
908 919
 
909 920
 #ifdef GHCI
910  
-         ic_resume :: [Resume],
  921
+          ic_resume :: [Resume],
911 922
              -- ^ The stack of breakpoint contexts
912 923
 #endif
913 924
 
914  
-         ic_cwd :: Maybe FilePath
  925
+          ic_cwd :: Maybe FilePath
915 926
              -- virtual CWD of the program
916 927
     }
917 928
 
918  
-data InteractiveImport 
919  
-  = IIDecl (ImportDecl RdrName)	-- Bring the exports of a particular module
920  
-    	   	       		-- (filtered by an import decl) into scope
  929
+{-
  930
+Note [ic_sys_vars]
921 931
 
922  
-  | IIModule Module	-- Bring into scope the entire top-level envt of
923  
-    	     		-- of this module, including the things imported
924  
-			-- into it.
925  
- 
  932
+This list constains any Ids that arise from TyCons, Classes or
  933
+instances defined interactively, but that are not given by
  934
+'implicitTyThings'.  This includes record selectors, default methods,
  935
+and dfuns.
  936
+
  937
+We *could* get rid of this list and generate these Ids from
  938
+ic_tythings:
  939
+
  940
+   - dfuns come from Instances
  941
+   - record selectors from TyCons
  942
+   - default methods from Classes
  943
+
  944
+For record selectors the TyCon gives the Name, but in order to make an
  945
+Id we would have to construct the type ourselves.  Similarly for
  946
+default methods.  So for now we collect the Ids after tidying (see
  947
+hscDeclsWithLocation) and save them in ic_sys_vars.
  948
+-}
  949
+
  950
+-- | Constructs an empty InteractiveContext.
926 951
 emptyInteractiveContext :: InteractiveContext
927  
-emptyInteractiveContext
928  
-  = InteractiveContext { ic_imports = [],
929  
-			 ic_rn_gbl_env = emptyGlobalRdrEnv,
930  
-			 ic_tmp_ids = []
  952
+emptyInteractiveContext = InteractiveContext {
  953
+    ic_imports      = [],
  954
+    ic_rn_gbl_env   = emptyGlobalRdrEnv,
  955
+    ic_tythings     = [],
  956
+    ic_sys_vars     = [],
  957
+    ic_instances    = ([],[]),
931 958
 #ifdef GHCI
932  
-                         , ic_resume = []
  959
+    ic_resume       = [],
933 960
 #endif
934  
-                         , ic_cwd = Nothing
935  
-                       }
936  
-
937  
-icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
938  
-icPrintUnqual dflags ictxt = mkPrintUnqualified dflags (ic_rn_gbl_env ictxt)
  961
+    ic_cwd          = Nothing }
939 962
 
  963
+-- | This function returns the list of visible TyThings (useful for
  964
+-- e.g. showBindings)
  965
+icInScopeTTs :: InteractiveContext -> [TyThing]
  966
+icInScopeTTs = ic_tythings
940 967
 
  968
+-- | Get the PrintUnqualified function based on the flags and this InteractiveContext
  969
+icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
  970
+icPrintUnqual dflags InteractiveContext{ ic_rn_gbl_env = grenv } = 
  971
+    mkPrintUnqualified dflags grenv
  972
+
  973
+-- | This function is called with new TyThings recently defined to update the 
  974
+-- InteractiveContext to include them.  Ids are easily removed when shadowed,
  975
+-- but Classes and TyCons are not.  Some work could be done to determine 
  976
+-- whether they are entirely shadowed, but as you could still have references 
  977
+-- to them (e.g. instances for classes or values of the type for TyCons), it's
  978
+-- not clear whether removing them is even the appropriate behavior.
941 979
 extendInteractiveContext
942 980
         :: InteractiveContext
943  
-        -> [Id]
  981
+        -> [TyThing]
944 982
         -> InteractiveContext
945  
-extendInteractiveContext ictxt ids
946  
-  = ictxt { ic_tmp_ids =  snub ((ic_tmp_ids ictxt \\ ids) ++ ids)
947  
-                          -- NB. must be this way around, because we want
948  
-                          -- new ids to shadow existing bindings.
  983
+extendInteractiveContext ictxt new_tythings
  984
+  = ictxt { ic_tythings = new_tythings ++ old_tythings
  985
+          , ic_rn_gbl_env = new_tythings `icPlusGblRdrEnv` ic_rn_gbl_env ictxt
949 986
           }
950  
-    where snub = map head . group . sort
  987
+  where
  988
+    old_tythings = filter (not . shadowed) (ic_tythings ictxt)
  989
+
  990
+    shadowed (AnId id) = ((`elem` new_names) . nameOccName . idName) id
  991
+    shadowed _ = False
  992
+
  993
+    new_names = [ nameOccName (getName id) | AnId id <- new_tythings ]
  994
+
  995
+    -- XXX should not add Ids to the gbl env here
  996
+
  997
+-- | Add TyThings to the GlobalRdrEnv, earlier ones in the list
  998
+-- shadowing later ones, and shadowing existing entries in the
  999
+-- GlobalRdrEnv.
  1000
+icPlusGblRdrEnv :: [TyThing] -> GlobalRdrEnv -> GlobalRdrEnv
  1001
+icPlusGblRdrEnv tythings env = extendOccEnvList env list
  1002
+  where new_gres = gresFromAvails LocalDef (map tyThingAvailInfo tythings)
  1003
+        list = [ (nameOccName (gre_name gre), [gre]) | gre <- new_gres ]
951 1004
 
952 1005
 substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext
953 1006
 substInteractiveContext ictxt subst | isEmptyTvSubst subst = ictxt
954  
-substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst 
955  
-  = ictxt { ic_tmp_ids = map subst_ty ids }
  1007
+substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst 
  1008
+  = ictxt { ic_tythings = map subst_ty tts }
956 1009
   where
957  
-   subst_ty id = id `setIdType` substTy subst (idType id)
  1010
+   subst_ty (AnId id) = AnId $ id `setIdType` substTy subst (idType id)
  1011
+   subst_ty tt = tt
  1012
+
  1013
+data InteractiveImport
  1014
+  = IIDecl (ImportDecl RdrName)	-- Bring the exports of a particular module
  1015
+                                -- (filtered by an import decl) into scope
  1016
+
  1017
+  | IIModule Module	-- Bring into scope the entire top-level envt of
  1018
+                    -- of this module, including the things imported
  1019
+                    -- into it.
958 1020
 
959 1021
 instance Outputable InteractiveImport where
960 1022
   ppr (IIModule m) = char '*' <> ppr m
961 1023
   ppr (IIDecl d)   = ppr d
  1024
+
962 1025
 \end{code}
963 1026
 
964 1027
 %************************************************************************
@@ -1003,7 +1066,7 @@ the (ppr mod) of case (3), in Name.pprModulePrefix
1003 1066
 mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified
1004 1067
 mkPrintUnqualified dflags env = (qual_name, qual_mod)
1005 1068
   where
1006  
-  qual_name mod occ	-- The (mod,occ) pair is the original name of the thing
  1069
+  qual_name name
1007 1070
         | [gre] <- unqual_gres, right_name gre = NameUnqual
1008 1071
 		-- If there's a unique entity that's in scope unqualified with 'occ'
1009 1072
 		-- 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)
1017 1080
 
1018 1081
 	| otherwise = panic "mkPrintUnqualified"
1019 1082
       where
1020  
-	right_name gre = nameModule_maybe (gre_name gre) == Just mod
  1083
+        mod = nameModule name
  1084
+        occ = nameOccName name
  1085
+
  1086
+        is_rdr_orig = nameUnique name == mkUniqueGrimily 0
  1087
+         -- Note [Outputable Orig RdrName]
  1088
+
  1089
+        right_name gre
  1090
+          | is_rdr_orig = nameModule_maybe (gre_name gre) == Just mod
  1091
+          | otherwise   = gre_name gre == name
1021 1092
 
1022 1093
         unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
1023 1094
         qual_gres   = filter right_name (lookupGlobalRdrEnv env occ)
@@ -1041,6 +1112,25 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
1041 1112
 
1042 1113
      | otherwise = True
1043 1114
      where lookup = lookupModuleInAllPackages dflags (moduleName mod)
  1115
+
  1116
+-- Note [Outputable Orig RdrName]
  1117
+--
  1118
+-- This is a Grotesque Hack.  The Outputable instance for RdrEnv wants
  1119
+-- to print Orig names, which are just pairs of (Module,OccName).  But
  1120
+-- we want to use full Names here, because in GHCi we might have Ids
  1121
+-- that have the same (Module,OccName) pair but a different Unique
  1122
+-- (this happens when you shadow a TyCon or Class in GHCi).
  1123
+--
  1124
+-- So in Outputable RdrName we just use a dummy Unique (0), and check
  1125
+-- for it here.
  1126
+--
  1127
+-- Arguably GHCi is invalidating the assumption that (Module,OccName)
  1128
+-- uniquely identifies an entity.  But we do want to be able to shadow
  1129
+-- old declarations with new ones in GHCi, and it would be hard to
  1130
+-- delete all references to the old declaration when that happened.
  1131
+-- See also Note [interactive name cache] in IfaceEnv for somewhere
  1132
+-- else that this broken assumption bites.
  1133
+--
1044 1134
 \end{code}
1045 1135
 
1046 1136
 
@@ -1090,6 +1180,8 @@ implicitTyConThings tc
1090 1180
       -- for each data constructor in order,
1091 1181
       --   the contructor, worker, and (possibly) wrapper
1092 1182
     concatMap (extras_plus . ADataCon) (tyConDataCons tc)
  1183
+      -- NB. record selectors are *not* implicit, they have fully-fledged
  1184
+      -- bindings that pass through the compilation pipeline as normal.
1093 1185
   where
1094 1186
     class_stuff = case tyConClass_maybe tc of
1095 1187
         Nothing -> []
@@ -1121,26 +1213,49 @@ isImplicitTyThing (AnId id)     = isImplicitId id
1121 1213
 isImplicitTyThing (ATyCon tc)   = isImplicitTyCon tc
1122 1214
 isImplicitTyThing (ACoAxiom {}) = True
1123 1215
 
1124  
-extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
1125  
-extendTypeEnvWithIds env ids
1126  
-  = extendNameEnvList env [(getName id, AnId id) | id <- ids]
1127  
-
1128 1216
 tyThingParent_maybe :: TyThing -> Maybe TyThing
1129 1217
 -- (tyThingParent_maybe x) returns (Just p)
1130 1218
 -- when pprTyThingInContext sould print a declaration for p
1131 1219
 -- (albeit with some "..." in it) when asked to show x
1132 1220
 -- It returns the *immediate* parent.  So a datacon returns its tycon
1133  
--- but the tycon could be the assocated type of a class, so it in turn
  1221
+-- but the tycon could be the associated type of a class, so it in turn
1134 1222
 -- might have a parent.
1135 1223
 tyThingParent_maybe (ADataCon dc) = Just (ATyCon (dataConTyCon dc))
1136 1224
 tyThingParent_maybe (ATyCon tc)   = case tyConAssoc_maybe tc of
1137 1225
                                       Just cls -> Just (ATyCon (classTyCon cls))
1138 1226
                                       Nothing  -> Nothing
1139 1227
 tyThingParent_maybe (AnId id)     = case idDetails id of
1140  
-      				      	 RecSelId { sel_tycon = tc } -> Just (ATyCon tc)
  1228
+                                         RecSelId { sel_tycon = tc } -> Just (ATyCon tc)
1141 1229
       				      	 ClassOpId cls               -> Just (ATyCon (classTyCon cls))
1142 1230
                                       	 _other                      -> Nothing
1143 1231
 tyThingParent_maybe _other = Nothing
  1232
+
  1233
+tyThingsTyVars :: [TyThing] -> TyVarSet
  1234
+tyThingsTyVars tts =
  1235
+    unionVarSets $ map ttToVarSet tts
  1236
+    where
  1237
+        ttToVarSet (AnId id)     = tyVarsOfType $ idType id
  1238
+        ttToVarSet (ADataCon dc) = tyVarsOfType $ dataConRepType dc
  1239
+        ttToVarSet (ATyCon tc)
  1240
+          = case tyConClass_maybe tc of
  1241
+              Just cls -> (mkVarSet . fst . classTvsFds) cls
  1242
+              Nothing  -> tyVarsOfType $ tyConKind tc
  1243
+        ttToVarSet _             = emptyVarSet
  1244
+
  1245
+-- | The Names that a TyThing should bring into scope.  Used to build
  1246
+-- the GlobalRdrEnv for the InteractiveContext.
  1247
+tyThingAvailInfo :: TyThing -> AvailInfo
  1248
+tyThingAvailInfo (ATyCon t)
  1249
+   = case tyConClass_maybe t of
  1250
+        Just c  -> AvailTC n (n : map getName (classMethods c)
  1251
+                  ++ map getName (classATs c))
  1252
+             where n = getName c
  1253
+        Nothing -> AvailTC n (n : map getName dcs ++
  1254
+                                   concatMap dataConFieldLabels dcs)
  1255
+             where n = getName t
  1256
+                   dcs = tyConDataCons t
  1257
+tyThingAvailInfo t
  1258
+   = Avail (getName t)
1144 1259
 \end{code}
1145 1260
 
1146 1261
 %************************************************************************
@@ -1160,6 +1275,7 @@ typeEnvTyCons   :: TypeEnv -> [TyCon]
1160 1275
 typeEnvCoAxioms :: TypeEnv -> [CoAxiom]
1161 1276
 typeEnvIds      :: TypeEnv -> [Id]
1162 1277
 typeEnvDataCons :: TypeEnv -> [DataCon]
  1278
+typeEnvClasses  :: TypeEnv -> [Class]
1163 1279
 lookupTypeEnv   :: TypeEnv -> Name -> Maybe TyThing
1164 1280
 
1165