import qualified GHC
import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..),
Module, ModuleName, TyThing(..), Phase,
- BreakIndex, SrcSpan, Resume, SingleStep )
+ BreakIndex, SrcSpan, Resume, SingleStep, Id )
import PprTyThing
import DynFlags
cmdName :: Command -> String
cmdName (n,_,_,_) = n
-commands :: IORef [Command]
-GLOBAL_VAR(commands, builtin_commands, [Command])
+macros_ref :: IORef [Command]
+GLOBAL_VAR(macros_ref, [], [Command])
builtin_commands :: [Command]
builtin_commands = [
("continue", keepGoing continueCmd, False, completeNone),
("cmd", keepGoing cmdCmd, False, completeIdentifier),
("ctags", keepGoing createCTagsFileCmd, False, completeFilename),
- ("def", keepGoing defineMacro, False, completeIdentifier),
+ ("def", keepGoing (defineMacro False), False, completeIdentifier),
+ ("def!", keepGoing (defineMacro True), False, completeIdentifier),
("delete", keepGoing deleteCmd, False, completeNone),
("e", keepGoing editFile, False, completeFilename),
("edit", keepGoing editFile, False, completeFilename),
printForUser $ ptext SLIT("Stopped at") <+>
ppr (GHC.resumeSpan $ head resumes)
-- printTypeOfNames session names
- printTypeAndContentOfNames session names
+ let namesSorted = sortBy compareNames names
+ tythings <- catMaybes `liftM`
+ io (mapM (GHC.lookupName session) namesSorted)
+
+ printTypeAndContents session [id | AnId id <- tythings]
maybe (return ()) runBreakCmd mb_info
-- run the command set with ":set stop <cmd>"
st <- getGHCiState
return (case run_result of GHC.RunOk _ -> True; _ -> False)
- where printTypeAndContentOfNames session names = do
- let namesSorted = sortBy compareNames names
- tythings <- catMaybes `liftM`
- io (mapM (GHC.lookupName session) namesSorted)
- let ids = [id | AnId id <- tythings]
- terms <- mapM (io . GHC.obtainTermB session 10 False) ids
- docs_terms <- mapM (io . showTerm session) terms
- dflags <- getDynFlags
- let pefas = dopt Opt_PrintExplicitForalls dflags
- printForUser $ vcat $ zipWith (\ty cts -> ty <+> equals <+> cts)
- (map (pprTyThing pefas . AnId) ids)
- docs_terms
-
runBreakCmd :: GHC.BreakInfo -> GHCi ()
runBreakCmd info = do
let mod = GHC.breakInfo_module info
Nothing -> return ()
Just thing -> printTyThing thing
+printTypeAndContents :: Session -> [Id] -> GHCi ()
+printTypeAndContents session ids = do
+ terms <- mapM (io . GHC.obtainTermB session 10 False) ids
+ docs_terms <- mapM (io . showTerm session) terms
+ dflags <- getDynFlags
+ let pefas = dopt Opt_PrintExplicitForalls dflags
+ printForUser $ vcat $ zipWith (\ty cts -> ty <+> equals <+> cts)
+ (map (pprTyThing pefas . AnId) ids)
+ docs_terms
+
+
specialCommand :: String -> GHCi Bool
specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
specialCommand str = do
lookupCommand :: String -> IO (Maybe Command)
lookupCommand str = do
- cmds <- readIORef commands
+ macros <- readIORef macros_ref
+ let cmds = builtin_commands ++ macros
-- look for exact match first, then the first prefix match
case [ c | c <- cmds, str == cmdName c ] of
c:_ -> return (Just c)
session <- getSession
io (mapM_ (GHC.addTarget session) targets)
ok <- io (GHC.load session LoadAllTargets)
- afterLoad ok session
+ afterLoad ok session Nothing
changeDirectory :: String -> GHCi ()
changeDirectory dir = do
where fromTarget (GHC.Target (GHC.TargetFile f _) _) = Just f
fromTarget _ = Nothing -- when would we get a module target?
-defineMacro :: String -> GHCi ()
-defineMacro s = do
+defineMacro :: Bool{-overwrite-} -> String -> GHCi ()
+defineMacro overwrite s = do
let (macro_name, definition) = break isSpace s
- cmds <- io (readIORef commands)
+ macros <- io (readIORef macros_ref)
+ let defined = map cmdName macros
if (null macro_name)
- then throwDyn (CmdLineError "invalid macro name")
+ then if null defined
+ then io $ putStrLn "no macros defined"
+ else io $ putStr ("the following macros are defined:\n" ++
+ unlines defined)
else do
- if (macro_name `elem` map cmdName cmds)
+ if (not overwrite && macro_name `elem` defined)
then throwDyn (CmdLineError
- ("command '" ++ macro_name ++ "' is already defined"))
+ ("macro '" ++ macro_name ++ "' is already defined"))
else do
+ let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ]
+
-- give the expression a type signature, so we can be sure we're getting
-- something of the right type.
let new_expr = '(' : definition ++ ") :: String -> IO String"
maybe_hv <- io (GHC.compileExpr cms new_expr)
case maybe_hv of
Nothing -> return ()
- Just hv -> io (writeIORef commands --
- (cmds ++ [(macro_name, runMacro hv, False, completeNone)]))
+ Just hv -> io (writeIORef macros_ref --
+ (filtered ++ [(macro_name, runMacro hv, False, completeNone)]))
runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
runMacro fun s = do
return False
undefineMacro :: String -> GHCi ()
-undefineMacro macro_name = do
- cmds <- io (readIORef commands)
- if (macro_name `elem` map cmdName builtin_commands)
- then throwDyn (CmdLineError
- ("command '" ++ macro_name ++ "' cannot be undefined"))
- else do
- if (macro_name `notElem` map cmdName cmds)
- then throwDyn (CmdLineError
- ("command '" ++ macro_name ++ "' not defined"))
- else do
- io (writeIORef commands (filter ((/= macro_name) . cmdName) cmds))
+undefineMacro str = mapM_ undef (words str)
+ where undef macro_name = do
+ cmds <- io (readIORef macros_ref)
+ if (macro_name `notElem` map cmdName cmds)
+ then throwDyn (CmdLineError
+ ("macro '" ++ macro_name ++ "' is not defined"))
+ else do
+ io (writeIORef macros_ref (filter ((/= macro_name) . cmdName) cmds))
cmdCmd :: String -> GHCi ()
cmdCmd str = do
-- as a ToDo for now.
io (GHC.setTargets session targets)
- doLoad session LoadAllTargets
+ doLoad session False LoadAllTargets
checkModule :: String -> GHCi ()
checkModule m = do
(text "global names: " <+> ppr global) $$
(text "local names: " <+> ppr local)
_ -> empty))
- afterLoad (successIf (isJust result)) session
+ afterLoad (successIf (isJust result)) session Nothing
reloadModule :: String -> GHCi ()
reloadModule m = do
session <- getSession
- doLoad session $ if null m then LoadAllTargets
- else LoadUpTo (GHC.mkModuleName m)
+ doLoad session True $ if null m then LoadAllTargets
+ else LoadUpTo (GHC.mkModuleName m)
return ()
-doLoad :: Session -> LoadHowMuch -> GHCi SuccessFlag
-doLoad session howmuch = do
+doLoad :: Session -> Bool -> LoadHowMuch -> GHCi SuccessFlag
+doLoad session retain_context howmuch = do
-- turn off breakpoints before we load: we can't turn them off later, because
-- the ModBreaks will have gone away.
discardActiveBreakPoints
+ context <- io $ GHC.getContext session
ok <- io (GHC.load session howmuch)
- afterLoad ok session
+ afterLoad ok session (if retain_context then Just context else Nothing)
return ok
-afterLoad :: SuccessFlag -> Session -> GHCi ()
-afterLoad ok session = do
+afterLoad :: SuccessFlag -> Session -> Maybe ([Module],[Module]) -> GHCi ()
+afterLoad ok session maybe_context = do
io (revertCAFs) -- always revert CAFs on load.
discardTickArrays
loaded_mods <- getLoadedModules session
- setContextAfterLoad session loaded_mods
+
+ -- try to retain the old module context for :reload. This might
+ -- not be possible, for example if some modules have gone away, so
+ -- we attempt to set the same context, backing off to the default
+ -- context if that fails.
+ case maybe_context of
+ Nothing -> setContextAfterLoad session loaded_mods
+ Just (as,bs) -> do
+ r <- io $ Exception.try (GHC.setContext session as bs)
+ case r of
+ Left _err -> setContextAfterLoad session loaded_mods
+ Right _ -> return ()
+
modulesLoadedMsg ok (map GHC.ms_mod_name loaded_mods)
setContextAfterLoad :: Session -> [GHC.ModSummary] -> GHCi ()
-> GHCi ([Module],[Module])
separate _ [] as bs = return (as,bs)
separate session (('*':str):ms) as bs = do
- m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
- b <- io $ GHC.moduleIsInterpreted session m
- if b then separate session ms (m:as) bs
- else throwDyn (CmdLineError ("module '"
- ++ GHC.moduleNameString (GHC.moduleName m)
- ++ "' is not interpreted"))
+ m <- wantInterpretedModule str
+ separate session ms (m:as) bs
separate session (str:ms) as bs = do
- m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
+ m <- lookupModule str
separate session ms as (m:bs)
newContext :: [String] -> GHCi ()
showBindings = do
s <- getSession
bindings <- io (GHC.getBindings s)
- mapM_ printTyThing $ sortBy compareTyThings bindings
- return ()
+ printTypeAndContents s [ id | AnId id <- sortBy compareTyThings bindings]
compareTyThings :: TyThing -> TyThing -> Ordering
t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2
completeCmd :: String -> IO [String]
completeCmd w = do
- cmds <- readIORef commands
- return (filter (w `isPrefixOf`) (map (':':) (map cmdName cmds)))
+ cmds <- readIORef macros_ref
+ return (filter (w `isPrefixOf`) (map (':':)
+ (map cmdName (builtin_commands ++ cmds))))
completeMacro w = do
- cmds <- readIORef commands
- let cmds' = [ cmd | cmd <- map cmdName cmds, cmd `elem` map cmdName builtin_commands ]
- return (filter (w `isPrefixOf`) cmds')
+ cmds <- readIORef macros_ref
+ return (filter (w `isPrefixOf`) (map cmdName cmds))
completeIdentifier w = do
s <- restoreSession
projects / ghc-hetmet.git / blobdiff