-{-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-}
+{-# OPTIONS -#include "Linker.h" #-}
-----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.137 2002/10/17 14:49:52 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.142 2002/12/27 12:20:06 panne Exp $
--
-- GHC Interactive User Interface
--
import DriverFlags
import DriverState
import DriverUtil ( remove_spaces, handle )
-import Linker ( initLinker, showLinkerState, linkLibraries )
-import Finder ( flushFinderCache )
+import Linker ( initLinker, showLinkerState, linkLibraries,
+ linkPackages )
import Util
import Id ( isRecordSelector, recordSelectorFieldLabel,
isDataConWrapId, isDataConId, idName )
import GHC.Exts ( unsafeCoerce# )
-import Foreign ( nullPtr )
-import Foreign.C.String ( CString, peekCString, withCString )
import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
import GHC.Posix ( setNonBlockingFD )
dflags <- getDynFlags
- -- packages are loaded "on-demand" now
initLinker
+
+ -- link packages requested explicitly on the command-line
+ expl <- readIORef v_ExplicitPackages
+ linkPackages dflags expl
+
+ -- link libraries from the command-line
linkLibraries dflags cmdline_objs
-- Initialise buffering for the *interpreted* I/O system
l <- io (IO.try (hGetLine hdl))
case l of
Left e | isEOFError e -> return ()
- | otherwise -> throw e
+ | otherwise -> io (ioError e)
Right l ->
case remove_spaces l of
"" -> fileLoop hdl prompt
if quit then return () else readlineLoop
#endif
--- Top level exception handler, just prints out the exception
--- and carries on.
runCommand :: String -> GHCi Bool
-runCommand c =
- ghciHandle ( \exception -> do
- flushInterpBuffers
- showException exception
- return False
- ) $
- doCommand c
+runCommand c = ghciHandle handler (doCommand c)
+
+-- This is the exception handler for exceptions generated by the
+-- user's code; it normally just prints out the exception. The
+-- handler must be recursive, in case showing the exception causes
+-- more exceptions to be raised.
+--
+-- Bugfix: if the user closed stdout or stderr, the flushing will fail,
+-- raising another exception. We therefore don't put the recursive
+-- handler arond the flushing operation, so if stderr is closed
+-- GHCi will just die gracefully rather than going into an infinite loop.
+handler :: Exception -> GHCi Bool
+handler exception = do
+ flushInterpBuffers
+ ghciHandle handler (showException exception >> return False)
showException (DynException dyn) =
case fromDynamic dyn of
mapM_ setOpt plus_opts
-- now, the GHC flags
- pkgs_before <- io (readIORef v_Packages)
+ pkgs_before <- io (readIORef v_ExplicitPackages)
leftovers <- io (processArgs static_flags minus_opts [])
- pkgs_after <- io (readIORef v_Packages)
+ pkgs_after <- io (readIORef v_ExplicitPackages)
-- update things if the users wants more packages
let new_packages = pkgs_after \\ pkgs_before
dflags <- io getDynFlags
cmstate1 <- io (cmUnload (cmstate state) dflags)
setGHCiState state{ cmstate = cmstate1, targets = [] }
+ io (linkPackages dflags new_pkgs)
setContextAfterLoad []
------------------------------------------------------------------------------
+-- ---------------------------------------------------------------------------
-- code for `:show'
showCmd str =
ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
ghciHandle h (GHCi m) = GHCi $ \s ->
Exception.catch (m s)
- (\e -> unGHCi (ghciHandle h (ghciUnblock (h e))) s)
+ (\e -> unGHCi (ghciUnblock (h e)) s)
ghciUnblock :: GHCi a -> GHCi a
ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)