X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FInteractiveUI.hs;h=257c219adf5120f127014b9712c9ab41e8520204;hb=8a45d6bb5426552fc6993fc4a1f391d0f3c77b8d;hp=ab52f347a0db510be5db92df55b2af5bce383891;hpb=b7e6411240c960d296934c6ca4d7c223cbe59470;p=ghc-hetmet.git

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index ab52f34..257c219 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.147 2003/02/20 13:12:40 simonpj Exp $
+-- $Id: InteractiveUI.hs,v 1.158 2003/08/27 12:29:21 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -8,7 +8,7 @@
 --
 -----------------------------------------------------------------------------
 module InteractiveUI ( 
-	interactiveUI,  -- :: CmState -> [FilePath] -> [LibrarySpec] -> IO ()
+	interactiveUI,  -- :: CmState -> [FilePath] -> IO ()
 	ghciWelcomeMsg
    ) where
 
@@ -17,14 +17,13 @@ module InteractiveUI (
 
 import CompManager
 import HscTypes		( TyThing(..), HomeModInfo(hm_linkable), HomePackageTable,
-			  isObjectLinkable )
+			  isObjectLinkable, GhciMode(..) )
 import HsSyn		( TyClDecl(..), ConDecl(..), Sig(..) )
 import MkIface		( ifaceTyThing )
 import DriverFlags
 import DriverState
-import DriverUtil	( remove_spaces, handle )
-import Linker		( initLinker, showLinkerState, linkLibraries, 
-			  linkPackages )
+import DriverUtil	( remove_spaces )
+import Linker		( showLinkerState, linkPackages )
 import Util
 import IdInfo		( GlobalIdDetails(..) )
 import Id		( isImplicitId, idName, globalIdDetails )
@@ -45,8 +44,12 @@ import CmdLineOpts	( DynFlag(..), DynFlags(..), getDynFlags, saveDynFlags,
 import Panic 		hiding ( showException )
 import Config
 
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
+import DriverUtil( handle )
 import System.Posix
+#if __GLASGOW_HASKELL__ > 504
+	hiding (getEnv)
+#endif
 #endif
 
 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
@@ -74,7 +77,7 @@ import GHC.Exts		( unsafeCoerce# )
 
 import Data.IORef	( IORef, newIORef, readIORef, writeIORef )
 
-import GHC.Posix	( setNonBlockingFD )
+import System.Posix.Internals ( setNonBlockingFD )
 
 -----------------------------------------------------------------------------
 
@@ -152,21 +155,14 @@ helpText = "\
 \                         (eg. -v2, -fglasgow-exts, etc.)\n\ 
 \"
 
-interactiveUI :: CmState -> [FilePath] -> [FilePath] -> IO ()
-interactiveUI cmstate paths cmdline_objs = do
-   hFlush stdout
-   hSetBuffering stdout NoBuffering
-
+interactiveUI :: [FilePath] -> IO ()
+interactiveUI srcs = do
    dflags <- getDynFlags
 
-   initLinker
-
-	-- link packages requested explicitly on the command-line
-   expl <- readIORef v_ExplicitPackages
-   linkPackages dflags expl
+   cmstate <- cmInit Interactive;
 
-	-- link libraries from the command-line
-   linkLibraries dflags cmdline_objs
+   hFlush stdout
+   hSetBuffering stdout NoBuffering
 
 	-- Initialise buffering for the *interpreted* I/O system
    cmstate <- initInterpBuffering cmstate dflags
@@ -182,10 +178,10 @@ interactiveUI cmstate paths cmdline_objs = do
    Readline.initialize
 #endif
 
-   startGHCi (runGHCi paths dflags) 
+   startGHCi (runGHCi srcs dflags) 
 	GHCiState{ progname = "<interactive>",
 		   args = [],
-		   targets = paths,
+		   targets = srcs,
 		   cmstate = cmstate,
 		   options = [] }
 
@@ -228,38 +224,36 @@ runGHCi paths dflags = do
   		  Left e    -> return ()
   		  Right hdl -> fileLoop hdl False
 
-  -- perform a :load for files given on the GHCi command line
+  -- Perform a :load for files given on the GHCi command line
   when (not (null paths)) $
      ghciHandle showException $
 	loadModule paths
 
-  -- enter the interactive loop
-#if defined(mingw32_TARGET_OS)
-   -- always show prompt, since hIsTerminalDevice returns True for Consoles
-   -- only, which we may or may not be running under (cf. Emacs sub-shells.)
-  interactiveLoop True
-#else
+  -- if verbosity is greater than 0, or we are connected to a
+  -- terminal, display the prompt in the interactive loop.
   is_tty <- io (hIsTerminalDevice stdin)
-  interactiveLoop is_tty
-#endif
+  let show_prompt = verbosity dflags > 0 || is_tty
+
+  -- enter the interactive loop
+  interactiveLoop is_tty show_prompt
 
   -- and finally, exit
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 
 
-interactiveLoop is_tty = do
-  -- ignore ^C exceptions caught here
+interactiveLoop is_tty show_prompt = do
+  -- Ignore ^C exceptions caught here
   ghciHandleDyn (\e -> case e of 
-			Interrupted -> ghciUnblock (interactiveLoop is_tty)
+			Interrupted -> ghciUnblock (interactiveLoop is_tty show_prompt)
 			_other      -> return ()) $ do
 
   -- read commands from stdin
 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
   if (is_tty) 
 	then readlineLoop
-	else fileLoop stdin False  -- turn off prompt for non-TTY input
+	else fileLoop stdin show_prompt
 #else
-  fileLoop stdin is_tty
+  fileLoop stdin show_prompt
 #endif
 
 
@@ -274,7 +268,7 @@ interactiveLoop is_tty = do
 
 checkPerms :: String -> IO Bool
 checkPerms name =
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
   return True
 #else
   DriverUtil.handle (\_ -> return False) $ do
@@ -498,8 +492,8 @@ info s = do
 	| fix == defaultFixity = empty
 	| otherwise            = ppr fix <+> 
 				 (if isSymOcc (nameOccName name)
-					then ppr name
-					else char '`' <> ppr name <> char '`')
+				  then ppr name
+				  else char '`' <> ppr name <> char '`')
 
     showTyThing (AClass cl)
        = hcat [ppr cl, text " is a class", showSrcLoc (className cl)]
@@ -536,6 +530,7 @@ addModule files = do
   state <- getGHCiState
   dflags <- io (getDynFlags)
   io (revertCAFs)			-- always revert CAFs on load/add.
+  files <- mapM expandPath files
   let new_targets = files ++ targets state 
   graph <- io (cmDepAnal (cmstate state) dflags new_targets)
   (cmstate1, ok, mods) <- io (cmLoadModules (cmstate state) dflags graph)
@@ -544,10 +539,17 @@ addModule files = do
   modulesLoadedMsg ok mods dflags
 
 changeDirectory :: String -> GHCi ()
-changeDirectory ('~':d) = do
-   tilde <- io (getEnv "HOME")	-- will fail if HOME not defined
-   io (setCurrentDirectory (tilde ++ '/':d))
-changeDirectory d = io (setCurrentDirectory d)
+changeDirectory dir = do
+  state    <- getGHCiState
+  when (targets state /= []) $
+	io $ putStr "Warning: changing directory causes all loaded modules to be unloaded, \n\ 
+	\because the search path has changed.\n"
+  dflags   <- io getDynFlags
+  cmstate1 <- io (cmUnload (cmstate state) dflags)
+  setGHCiState state{ cmstate = cmstate1, targets = [] }
+  setContextAfterLoad []
+  dir <- expandPath dir
+  io (setCurrentDirectory dir)
 
 defineMacro :: String -> GHCi ()
 defineMacro s = do
@@ -602,6 +604,9 @@ loadModule' files = do
   state <- getGHCiState
   dflags <- io getDynFlags
 
+  -- expand tildes
+  files <- mapM expandPath files
+
   -- do the dependency anal first, so that if it fails we don't throw
   -- away the current set of modules.
   graph <- io (cmDepAnal (cmstate state) dflags files)
@@ -1067,3 +1072,15 @@ revertCAFs = do
 
 foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()  
 	-- Make it "safe", just in case
+
+-- -----------------------------------------------------------------------------
+-- Utils
+
+expandPath :: String -> GHCi String
+expandPath path = 
+  case dropWhile isSpace path of
+   ('~':d) -> do
+	tilde <- io (getEnv "HOME")	-- will fail if HOME not defined
+	return (tilde ++ '/':d)
+   other -> 
+	return other