{-# 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
--
--
-----------------------------------------------------------------------------
module InteractiveUI (
- interactiveUI, -- :: CmState -> [FilePath] -> [LibrarySpec] -> IO ()
+ interactiveUI, -- :: CmState -> [FilePath] -> IO ()
ghciWelcomeMsg
) where
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 )
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
import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
-import GHC.Posix ( setNonBlockingFD )
+import System.Posix.Internals ( setNonBlockingFD )
-----------------------------------------------------------------------------
\ (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
Readline.initialize
#endif
- startGHCi (runGHCi paths dflags)
+ startGHCi (runGHCi srcs dflags)
GHCiState{ progname = "<interactive>",
args = [],
- targets = paths,
+ targets = srcs,
cmstate = cmstate,
options = [] }
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
checkPerms :: String -> IO Bool
checkPerms name =
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
return True
#else
DriverUtil.handle (\_ -> return False) $ 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)]
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)
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
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)
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
projects / ghc-hetmet.git / blobdiff