X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FInteractiveUI.hs;h=89fdfeb70d8389e2bfb5b02e3655773738c318e9;hb=a304af4524cd40079a05b84abf16af2fd063265c;hp=3b505550e0014176938db2ee028ae4b6f859edd4;hpb=4bf4b39021016fcc681da736b72768b402d0e5af;p=ghc-hetmet.git

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 3b50555..89fdfeb 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -#include "Linker.h" #-}
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.182 2005/01/12 12:44:25 ross Exp $
+-- $Id: InteractiveUI.hs,v 1.187 2005/02/04 13:32:28 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -12,12 +12,10 @@ module InteractiveUI (
 	ghciWelcomeMsg
    ) where
 
-#include "../includes/ghcconfig.h"
 #include "HsVersions.h"
 
 import CompManager
-import HscTypes		( HomeModInfo(hm_linkable), HomePackageTable,
-			  isObjectLinkable, GhciMode(..) )
+import HscTypes		( GhciMode(..) )
 import IfaceSyn		( IfaceDecl(..), IfaceClassOp(..), IfaceConDecls(..), IfaceConDecl(..), 
 		   	  IfaceInst(..), pprIfaceDeclHead, pprParendIfaceType, pprIfaceForAllPart )
 import FunDeps		( pprFundeps )
@@ -26,12 +24,11 @@ import DriverState
 import DriverUtil	( remove_spaces )
 import Linker		( showLinkerState, linkPackages )
 import Util
-import Module		( showModMsg, lookupModuleEnv )
 import Name		( Name, NamedThing(..) )
 import OccName		( OccName, isSymOcc, occNameUserString )
 import BasicTypes	( StrictnessMark(..), defaultFixity, SuccessFlag(..) )
 import Outputable
-import CmdLineOpts	( DynFlag(..), DynFlags(..), dopt_unset )
+import CmdLineOpts	( DynFlags(..) )
 import Panic 		hiding ( showException )
 import Config
 import SrcLoc		( SrcLoc, isGoodSrcLoc )
@@ -53,7 +50,7 @@ import System.Console.Readline as Readline
 
 import Control.Exception as Exception
 import Data.Dynamic
-import Control.Concurrent
+-- import Control.Concurrent
 
 import Numeric
 import Data.List
@@ -69,6 +66,7 @@ import Control.Monad as Monad
 import Foreign.StablePtr	( newStablePtr )
 
 import GHC.Exts		( unsafeCoerce# )
+import GHC.IOBase	( IOErrorType(InvalidArgument) )
 
 import Data.IORef	( IORef, newIORef, readIORef, writeIORef )
 
@@ -309,8 +307,14 @@ fileLoop hdl prompt = do
    when prompt (io (putStr (mkPrompt mod imports)))
    l <- io (IO.try (hGetLine hdl))
    case l of
-	Left e | isEOFError e -> return ()
-	       | otherwise    -> io (ioError e)
+	Left e | isEOFError e		   -> return ()
+	       | InvalidArgument <- etype  -> return ()
+	       | otherwise		   -> io (ioError e)
+		where etype = ioeGetErrorType e
+		-- treat InvalidArgument in the same way as EOF:
+		-- this can happen if the user closed stdin, or
+		-- perhaps did getContents which closes stdin at
+		-- EOF.
 	Right l -> 
 	  case remove_spaces l of
 	    "" -> fileLoop hdl prompt
@@ -441,9 +445,9 @@ noArgs c = throwDyn (CmdLineError ("command '" ++ c ++ "' takes no arguments"))
 GLOBAL_VAR(flush_interp,       error "no flush_interp", IO ())
 GLOBAL_VAR(turn_off_buffering, error "no flush_stdout", IO ())
 
-no_buf_cmd = "IO.hSetBuffering IO.stdout IO.NoBuffering" ++
-	     " Prelude.>> IO.hSetBuffering IO.stderr IO.NoBuffering"
-flush_cmd  = "IO.hFlush IO.stdout Prelude.>> IO.hFlush IO.stderr"
+no_buf_cmd = "System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering" ++
+	     " Prelude.>> System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering"
+flush_cmd  = "System.IO.hFlush System.IO.stdout Prelude.>> System.IO.hFlush IO.stderr"
 
 initInterpBuffering :: CmState -> IO ()
 initInterpBuffering cmstate
@@ -492,9 +496,8 @@ info s  = do { let names = words s
 
 showThing :: GetInfoResult -> SDoc
 showThing  (wanted_str, (thing, fixity, src_loc, insts)) 
-    = vcat [ showDecl want_name thing, 
+    = vcat [ showWithLoc src_loc (showDecl want_name thing),
 	     show_fixity fixity,
-	     show_loc src_loc,
 	     vcat (map show_inst insts)]
   where
     want_name occ = wanted_str == occNameUserString occ
@@ -503,15 +506,19 @@ showThing  (wanted_str, (thing, fixity, src_loc, insts))
 	| fix == defaultFixity = empty
 	| otherwise            = ppr fix <+> text wanted_str
 
+    show_inst (iface_inst, loc)
+	= showWithLoc loc (ptext SLIT("instance") <+> ppr (ifInstHead iface_inst))
+
+showWithLoc :: SrcLoc -> SDoc -> SDoc
+showWithLoc loc doc 
+    = hang doc 2 (char '\t' <> show_loc loc)
+		-- The tab tries to make them line up a bit
+  where
     show_loc loc	-- The ppr function for SrcLocs is a bit wonky
 	| isGoodSrcLoc loc = comment <+> ptext SLIT("Defined at") <+> ppr loc
 	| otherwise	   = comment <+> ppr loc
     comment = ptext SLIT("--")
 
-    show_inst (iface_inst, loc)
-	= hang (ptext SLIT("instance") <+> ppr (ifInstHead iface_inst))
-	     2 (char '\t' <> show_loc loc)
-		-- The tab tries to make them line up a bit
 
 -- Now there is rather a lot of goop just to print declarations in a
 -- civilised way with "..." for the parts we are less interested in.
@@ -972,22 +979,10 @@ showCmd str =
 	["linker"]   -> io showLinkerState
 	_ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings]")
 
-showModules = do
-  cms <- getCmState
-  let (mg, hpt) = cmGetModInfo cms
-  mapM_ (showModule hpt) mg
-
-
-showModule :: HomePackageTable -> ModSummary -> GHCi ()
-showModule hpt mod_summary
-  = case lookupModuleEnv hpt mod of
-	Nothing	      -> panic "missing linkable"
-	Just mod_info -> io (putStrLn (showModMsg obj_linkable mod locn))
-		      where
-			 obj_linkable = isObjectLinkable (hm_linkable mod_info)
-  where
-    mod = ms_mod mod_summary
-    locn = ms_location mod_summary
+showModules
+  = do	{ cms <- getCmState
+	; let show_one ms = io (putStrLn (cmShowModule cms ms))
+	; mapM_ show_one (cmGetModuleGraph cms) }
 
 showBindings = do
   cms <- getCmState