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.

2 files changed, 15 insertions, 25 deletions

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 };
        } ;