X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FInteractiveUI.hs;h=0bf37dc4005e408893fc4663c9dc5d34b22a9528;hb=8d180b0dd5b3796c96b162464b93ab1cacc3b789;hp=174317e8a411693e52ec57f05157012c88424111;hpb=a1c063ae7150f7ca743bbbd81c2444c5fd6392d0;p=ghc-hetmet.git

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 174317e..0bf37dc 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -15,7 +15,8 @@ module InteractiveUI (
 
 -- The GHC interface
 import qualified GHC
-import GHC		( Session, verbosity, dopt, DynFlag(..),
+import GHC		( Session, verbosity, dopt, DynFlag(..), Target(..),
+			  TargetId(..),
 			  mkModule, pprModule, Type, Module, SuccessFlag(..),
 			  TyThing(..), Name, LoadHowMuch(..), Phase,
 			  GhcException(..), showGhcException,
@@ -30,6 +31,7 @@ import OccName( pprOccName )
 import SrcLoc( isGoodSrcLoc, srcLocFile, srcLocLine, srcLocCol )
 
 -- Other random utilities
+import Digraph		( flattenSCCs )
 import BasicTypes	( failed, successIf )
 import Panic 		( panic, installSignalHandlers )
 import Config
@@ -37,7 +39,6 @@ import StaticFlags	( opt_IgnoreDotGhci )
 import Linker		( showLinkerState )
 import Util		( removeSpaces, handle, global, toArgs,
 			  looksLikeModuleName, prefixMatch, sortLe )
-import ErrUtils		( printErrorsAndWarnings )
 
 #ifndef mingw32_HOST_OS
 import System.Posix
@@ -196,13 +197,6 @@ interactiveUI session srcs maybe_expr = do
    Readline.initialize
 #endif
 
-#if defined(mingw32_HOST_OS)
-    -- The win32 Console API mutates the first character of 
-    -- type-ahead when reading from it in a non-buffered manner. Work
-    -- around this by flushing the input buffer of type-ahead characters.
-    -- 
-   GHC.ConsoleHandler.flushConsole stdin
-#endif
    startGHCi (runGHCi srcs maybe_expr)
 	GHCiState{ progname = "<interactive>",
 		   args = [],
@@ -265,6 +259,18 @@ runGHCi paths maybe_expr = do
 
   case maybe_expr of
 	Nothing -> 
+#if defined(mingw32_HOST_OS)
+          do
+            -- The win32 Console API mutates the first character of 
+            -- type-ahead when reading from it in a non-buffered manner. Work
+            -- around this by flushing the input buffer of type-ahead characters,
+            -- but only if stdin is available.
+            flushed <- io (IO.try (GHC.ConsoleHandler.flushConsole stdin))
+            case flushed of 
+   	     Left err | isDoesNotExistError err -> return ()
+   		      | otherwise -> io (ioError err)
+   	     Right () -> return ()
+#endif
 	    -- enter the interactive loop
 	    interactiveLoop is_tty show_prompt
 	Just expr -> do
@@ -588,7 +594,7 @@ changeDirectory dir = do
 	io $ putStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n"
   io (GHC.setTargets session [])
   io (GHC.load session LoadAllTargets)
-  setContextAfterLoad []
+  setContextAfterLoad session []
   io (GHC.workingDirectoryChanged session)
   dir <- expandPath dir
   io (setCurrentDirectory dir)
@@ -670,7 +676,7 @@ checkModule :: String -> GHCi ()
 checkModule m = do
   let modl = mkModule m
   session <- getSession
-  result <- io (GHC.checkModule session modl printErrorsAndWarnings)
+  result <- io (GHC.checkModule session modl)
   case result of
     Nothing -> io $ putStrLn "Nothing"
     Just r  -> io $ putStrLn (showSDoc (
@@ -699,19 +705,39 @@ reloadModule m = do
 afterLoad ok session = do
   io (revertCAFs)  -- always revert CAFs on load.
   graph <- io (GHC.getModuleGraph session)
-  let mods = map GHC.ms_mod graph
-  mods' <- filterM (io . GHC.isLoaded session) mods
-  setContextAfterLoad mods'
-  modulesLoadedMsg ok mods'
+  graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod) graph
+  setContextAfterLoad session graph'
+  modulesLoadedMsg ok (map GHC.ms_mod graph')
 
-setContextAfterLoad [] = do
-  session <- getSession
+setContextAfterLoad session [] = do
   io (GHC.setContext session [] [prelude_mod])
-setContextAfterLoad (m:_) = do
-  session <- getSession
-  b <- io (GHC.moduleIsInterpreted session m)
-  if b then io (GHC.setContext session [m] []) 
-       else io (GHC.setContext session []  [prelude_mod,m])
+setContextAfterLoad session ms = do
+  -- load a target if one is available, otherwise load the topmost module.
+  targets <- io (GHC.getTargets session)
+  case [ m | Just m <- map (findTarget ms) targets ] of
+	[]    -> 
+	  let graph' = flattenSCCs (GHC.topSortModuleGraph True ms Nothing) in
+	  load_this (last graph')	  
+	(m:_) -> 
+	  load_this m
+ where
+   findTarget ms t
+    = case filter (`matches` t) ms of
+	[]    -> Nothing
+	(m:_) -> Just m
+
+   summary `matches` Target (TargetModule m) _
+	= GHC.ms_mod summary == m
+   summary `matches` Target (TargetFile f _) _ 
+	| Just f' <- GHC.ml_hs_file (GHC.ms_location summary)	= f == f'
+   summary `matches` target
+	= False
+
+   load_this summary | m <- GHC.ms_mod summary = do
+	b <- io (GHC.moduleIsInterpreted session m)
+	if b then io (GHC.setContext session [m] []) 
+       	     else io (GHC.setContext session []  [prelude_mod,m])
+
 
 modulesLoadedMsg :: SuccessFlag -> [Module] -> GHCi ()
 modulesLoadedMsg ok mods = do