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.

3 files changed, 67 insertions, 21 deletions

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