-- Other random utilities
import ErrUtils
+import CmdLineParser
import Digraph
import BasicTypes hiding (isTopLevel)
import Panic hiding (showException)
" <statement> evaluate/run <statement>\n" ++
" : repeat last command\n" ++
" :{\\n ..lines.. \\n:}\\n multiline command\n" ++
- " :add <filename> ... add module(s) to the current target set\n" ++
+ " :add [*]<module> ... add module(s) to the current target set\n" ++
" :browse[!] [[*]<mod>] display the names defined by module <mod>\n" ++
" (!: more details; *: all top-level names)\n" ++
" :cd <dir> change directory to <dir>\n" ++
" :help, :? display this list of commands\n" ++
" :info [<name> ...] display information about the given names\n" ++
" :kind <type> show the kind of <type>\n" ++
- " :load <filename> ... load module(s) and their dependents\n" ++
+ " :load [*]<module> ... load module(s) and their dependents\n" ++
" :main [<arguments> ...] run the main function with the given arguments\n" ++
" :module [+/-] [*]<mod> ... set the context for expression evaluation\n" ++
" :quit exit GHCi\n" ++
#endif
-- initial context is just the Prelude
- prel_mod <- GHC.findModule session (GHC.mkModuleName "Prelude")
- (Just basePackageId)
+ prel_mod <- GHC.findModule session (GHC.mkModuleName "Prelude") Nothing
GHC.setContext session [] [prel_mod]
default_editor <- findEditor
interactiveLoop :: Bool -> Bool -> GHCi ()
interactiveLoop is_tty show_prompt =
-- Ignore ^C exceptions caught here
- ghciHandleDyn (\e -> case e of
+ ghciHandleGhcException (\e -> case e of
Interrupted -> do
#if defined(mingw32_HOST_OS)
io (putStrLn "")
return True
#else
checkPerms name =
- Util.handle (\_ -> return False) $ do
+ handleIO (\_ -> return False) $ do
st <- getFileStatus name
me <- getRealUserID
if fileOwner st /= me then do
runCommands :: GHCi (Maybe String) -> GHCi ()
runCommands = runCommands' handler
-runCommands' :: (Exception -> GHCi Bool) -- Exception handler
+runCommands' :: (SomeException -> GHCi Bool) -- Exception handler
-> GHCi (Maybe String) -> GHCi ()
runCommands' eh getCmd = do
mb_cmd <- noSpace queryQueue
files <- mapM expandPath files
targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
session <- getSession
- io (mapM_ (GHC.addTarget session) targets)
+ -- remove old targets with the same id; e.g. for :add *M
+ io $ mapM_ (GHC.removeTarget session) [ tid | Target tid _ _ <- targets ]
+ io $ mapM_ (GHC.addTarget session) targets
prev_context <- io $ GHC.getContext session
- ok <- io (GHC.load session LoadAllTargets)
+ ok <- io $ GHC.load session LoadAllTargets
afterLoad ok session False prev_context
changeDirectory :: String -> GHCi ()
Just file -> return file
Nothing -> ghcError (CmdLineError "No files to edit.")
- where fromTarget (GHC.Target (GHC.TargetFile f _) _) = Just f
+ where fromTarget (GHC.Target (GHC.TargetFile f _) _ _) = Just f
fromTarget _ = Nothing -- when would we get a module target?
defineMacro :: Bool{-overwrite-} -> String -> GHCi ()
prev_context <- io $ GHC.getContext session
-- unload first
+ io $ GHC.abandonAll session
discardActiveBreakPoints
io (GHC.setTargets session [])
io (GHC.load session LoadAllTargets)
[] -> Nothing
(m:_) -> Just m
- summary `matches` Target (TargetModule m) _
+ summary `matches` Target (TargetModule m) _ _
= GHC.ms_mod_name summary == m
- summary `matches` Target (TargetFile f _) _
+ summary `matches` Target (TargetFile f _) _ _
| Just f' <- GHC.ml_hs_file (GHC.ms_location summary) = f == f'
_ `matches` _
= False
newDynFlags minus_opts = do
dflags <- getDynFlags
let pkg_flags = packageFlags dflags
- (dflags', leftovers, warns) <- io $ GHC.parseDynamicFlags dflags minus_opts
+ (dflags', leftovers, warns) <- io $ GHC.parseDynamicFlags dflags $ map noLoc minus_opts
io $ handleFlagWarnings dflags' warns
if (not (null leftovers))
- then ghcError (CmdLineError ("unrecognised flags: " ++
- unwords leftovers))
- else return ()
+ then ghcError $ errorsToGhcException leftovers
+ else return ()
new_pkgs <- setDynFlags dflags'
-- 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 :: SomeException -> GHCi Bool
handler exception = do
flushInterpBuffers
io installSignalHandlers
ghciHandle handler (showException exception >> return False)
-showException :: Exception -> GHCi ()
+showException :: SomeException -> GHCi ()
+#if __GLASGOW_HASKELL__ < 609
showException (DynException dyn) =
case fromDynamic dyn of
Nothing -> io (putStrLn ("*** Exception: (unknown)"))
showException other_exception
= io (putStrLn ("*** Exception: " ++ show other_exception))
+#else
+showException (SomeException e) =
+ io $ case cast e of
+ Just Interrupted -> putStrLn "Interrupted."
+ -- omit the location for CmdLineError:
+ Just (CmdLineError s) -> putStrLn s
+ -- ditto:
+ Just ph@(PhaseFailed {}) -> putStrLn (showGhcException ph "")
+ Just other_ghc_ex -> print other_ghc_ex
+ Nothing -> putStrLn ("*** Exception: " ++ show e)
+#endif
-----------------------------------------------------------------------------
-- recursive exception handlers
-- in an exception loop (eg. let a = error a in a) the ^C exception
-- may never be delivered. Thanks to Marcin for pointing out the bug.
-ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
+ghciHandle :: (SomeException -> GHCi a) -> GHCi a -> GHCi a
ghciHandle h (GHCi m) = GHCi $ \s ->
Exception.catch (m s)
(\e -> unGHCi (ghciUnblock (h e)) s)
ghciUnblock :: GHCi a -> GHCi a
ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
-ghciTry :: GHCi a -> GHCi (Either Exception a)
+ghciTry :: GHCi a -> GHCi (Either SomeException a)
ghciTry (GHCi m) = GHCi $ \s -> Exception.try (m s)
-- ----------------------------------------------------------------------------
wantInterpretedModule str = do
session <- getSession
modl <- lookupModule str
+ dflags <- getDynFlags
+ when (GHC.modulePackageId modl /= thisPackage dflags) $
+ ghcError (CmdLineError ("module '" ++ str ++ "' is from another package;\nthis command requires an interpreted module"))
is_interpreted <- io (GHC.moduleIsInterpreted session modl)
when (not is_interpreted) $
- ghcError (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
+ ghcError (CmdLineError ("module '" ++ str ++ "' is not interpreted; try \':add *" ++ str ++ "' first"))
return modl
wantNameFromInterpretedModule :: (Name -> SDoc -> GHCi ()) -> String
Nothing -> stepCmd []
Just _ -> do
Just span <- getCurrentBreakSpan
- let f some_span = optSrcSpanFileName span == optSrcSpanFileName some_span
+ let f some_span = srcSpanFileName_maybe span == srcSpanFileName_maybe some_span
doContinue f GHC.SingleStep
stepModuleCmd expression = stepCmd expression
do_bold :: Bool
do_bold = (`isPrefixOf` unsafePerformIO mTerm) `any` ["xterm", "linux"]
where mTerm = System.Environment.getEnv "TERM"
- `Exception.catch` \_ -> return "TERM not set"
+ `catchIO` \_ -> return "TERM not set"
start_bold :: String
start_bold = "\ESC[1m"
projects / ghc-hetmet.git / blobdiff