projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
NCG: Rename MachRegs, MachInstrs -> Regs, Instrs to reflect arch specific naming
[ghc-hetmet.git]
/
compiler
/
ghci
/
InteractiveUI.hs
diff --git
a/compiler/ghci/InteractiveUI.hs
b/compiler/ghci/InteractiveUI.hs
index
268f05e
..
8a70787
100644
(file)
--- a/
compiler/ghci/InteractiveUI.hs
+++ b/
compiler/ghci/InteractiveUI.hs
@@
-34,7
+34,8
@@
import PackageConfig
import UniqFM
#endif
import UniqFM
#endif
-import HscTypes ( implicitTyThings, reflectGhc, reifyGhc )
+import HscTypes ( implicitTyThings, reflectGhc, reifyGhc
+ , handleFlagWarnings )
import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
import Outputable hiding (printForUser, printForUserPartWay)
import Module -- for ModuleEnv
import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
import Outputable hiding (printForUser, printForUserPartWay)
import Module -- for ModuleEnv
@@
-42,7
+43,6
@@
import Name
import SrcLoc
-- Other random utilities
import SrcLoc
-- Other random utilities
-import ErrUtils
import CmdLineParser
import Digraph
import BasicTypes hiding (isTopLevel)
import CmdLineParser
import Digraph
import BasicTypes hiding (isTopLevel)
@@
-52,7
+52,7
@@
import StaticFlags
import Linker
import Util
import NameSet
import Linker
import Util
import NameSet
-import Maybes ( orElse )
+import Maybes ( orElse, expectJust )
import FastString
import Encoding
import MonadUtils ( liftIO )
import FastString
import Encoding
import MonadUtils ( liftIO )
@@
-96,10
+96,6
@@
import GHC.TopHandler
import Data.IORef ( IORef, readIORef, writeIORef )
import Data.IORef ( IORef, readIORef, writeIORef )
-#ifdef USE_EDITLINE
-import System.Posix.Internals ( setNonBlockingFD )
-#endif
-
-----------------------------------------------------------------------------
ghciWelcomeMsg :: String
-----------------------------------------------------------------------------
ghciWelcomeMsg :: String
@@
-147,7
+143,7
@@
builtin_commands = [
("reload", keepGoing reloadModule, Nothing, completeNone),
("run", keepGoing runRun, Nothing, completeIdentifier),
("set", keepGoing setCmd, Just flagWordBreakChars, completeSetOptions),
("reload", keepGoing reloadModule, Nothing, completeNone),
("run", keepGoing runRun, Nothing, completeIdentifier),
("set", keepGoing setCmd, Just flagWordBreakChars, completeSetOptions),
- ("show", keepGoing showCmd, Nothing, completeNone),
+ ("show", keepGoing showCmd, Nothing, completeShowOptions),
("sprint", keepGoing sprintCmd, Nothing, completeIdentifier),
("step", keepGoing stepCmd, Nothing, completeIdentifier),
("steplocal", keepGoing stepLocalCmd, Nothing, completeIdentifier),
("sprint", keepGoing sprintCmd, Nothing, completeIdentifier),
("step", keepGoing stepCmd, Nothing, completeIdentifier),
("steplocal", keepGoing stepLocalCmd, Nothing, completeIdentifier),
@@
-255,7
+251,7
@@
helpText =
" :set prog <progname> set the value returned by System.getProgName\n" ++
" :set prompt <prompt> set the prompt used in GHCi\n" ++
" :set editor <cmd> set the command used for :edit\n" ++
" :set prog <progname> set the value returned by System.getProgName\n" ++
" :set prompt <prompt> set the prompt used in GHCi\n" ++
" :set editor <cmd> set the command used for :edit\n" ++
- " :set stop <cmd> set the command to run when a breakpoint is hit\n" ++
+ " :set stop [<n>] <cmd> set the command to run when a breakpoint is hit\n" ++
" :unset <option> ... unset options\n" ++
"\n" ++
" Options for ':set' and ':unset':\n" ++
" :unset <option> ... unset options\n" ++
"\n" ++
" Options for ':set' and ':unset':\n" ++
@@
-344,8
+340,6
@@
interactiveUI srcs maybe_exprs = withTerminalReset $ do
default_editor <- liftIO $ findEditor
default_editor <- liftIO $ findEditor
- cwd <- liftIO $ getCurrentDirectory
-
startGHCi (runGHCi srcs maybe_exprs)
GHCiState{ progname = "<interactive>",
args = [],
startGHCi (runGHCi srcs maybe_exprs)
GHCiState{ progname = "<interactive>",
args = [],
@@
-361,7
+355,6
@@
interactiveUI srcs maybe_exprs = withTerminalReset $ do
last_command = Nothing,
cmdqueue = [],
remembered_ctx = [],
last_command = Nothing,
cmdqueue = [],
remembered_ctx = [],
- virtual_path = cwd,
ghc_e = isJust maybe_exprs
}
ghc_e = isJust maybe_exprs
}
@@
-641,11
+634,8
@@
readlineLoop = do
return (Just str)
withReadline :: IO a -> IO a
return (Just str)
withReadline :: IO a -> IO a
-withReadline = bracket_ stopTimer (do startTimer; setNonBlockingFD 0)
- -- Two problems are being worked around here:
- -- 1. readline sometimes puts stdin into blocking mode,
- -- so we need to put it back for the IO library
- -- 2. editline doesn't handle some of its system calls returning
+withReadline = bracket_ stopTimer startTimer
+ -- editline doesn't handle some of its system calls returning
-- EINTR, so our timer signal confuses it, hence we turn off
-- the timer signal when making calls to editline. (#2277)
-- If editline is ever fixed, we can remove this.
-- EINTR, so our timer signal confuses it, hence we turn off
-- the timer signal when making calls to editline. (#2277)
-- If editline is ever fixed, we can remove this.
@@
-1040,6
+1030,9
@@
defineMacro overwrite s = do
runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
runMacro fun s = do
str <- io ((unsafeCoerce# fun :: String -> IO String) s)
runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
runMacro fun s = do
str <- io ((unsafeCoerce# fun :: String -> IO String) s)
+ -- make sure we force any exceptions in the result, while we are still
+ -- inside the exception handler for commands:
+ seqList str (return ())
enqueueCommands (lines str)
return False
enqueueCommands (lines str)
return False
@@
-1217,8
+1210,7
@@
typeOfExpr str
ty <- GHC.exprType str
dflags <- getDynFlags
let pefas = dopt Opt_PrintExplicitForalls dflags
ty <- GHC.exprType str
dflags <- getDynFlags
let pefas = dopt Opt_PrintExplicitForalls dflags
- printForUser $ text str <+> dcolon
- <+> pprTypeForUser pefas ty
+ printForUser $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]
kindOfType :: String -> GHCi ()
kindOfType str
kindOfType :: String -> GHCi ()
kindOfType str
@@
-1499,10
+1491,13
@@
setPrompt value = do
st <- getGHCiState
if null value
then io $ hPutStrLn stderr $ "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
st <- getGHCiState
if null value
then io $ hPutStrLn stderr $ "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
- else setGHCiState st{ prompt = remQuotes value }
- where
- remQuotes ('\"':xs) | not (null xs) && last xs == '\"' = init xs
- remQuotes x = x
+ else case value of
+ '\"' : _ -> case reads value of
+ [(value', xs)] | all isSpace xs ->
+ setGHCiState (st { prompt = value' })
+ _ ->
+ io $ hPutStrLn stderr "Can't parse prompt string. Use Haskell syntax."
+ _ -> setGHCiState (st { prompt = value })
setOptions wds =
do -- first, deal with the GHCi opts (+s, +t, etc.)
setOptions wds =
do -- first, deal with the GHCi opts (+s, +t, etc.)
@@
-1516,7
+1511,7
@@
newDynFlags minus_opts = do
dflags <- getDynFlags
let pkg_flags = packageFlags dflags
(dflags', leftovers, warns) <- io $ GHC.parseDynamicFlags dflags $ map noLoc minus_opts
dflags <- getDynFlags
let pkg_flags = packageFlags dflags
(dflags', leftovers, warns) <- io $ GHC.parseDynamicFlags dflags $ map noLoc minus_opts
- io $ handleFlagWarnings dflags' warns
+ handleFlagWarnings dflags' warns
if (not (null leftovers))
then ghcError $ errorsToGhcException leftovers
if (not (null leftovers))
then ghcError $ errorsToGhcException leftovers
@@
-1679,8
+1674,8
@@
completeNone :: String -> IO [String]
completeNone _w = return []
completeMacro, completeIdentifier, completeModule,
completeNone _w = return []
completeMacro, completeIdentifier, completeModule,
- completeHomeModule, completeSetOptions, completeFilename,
- completeHomeModuleOrFile
+ completeHomeModule, completeSetOptions, completeShowOptions,
+ completeFilename, completeHomeModuleOrFile
:: String -> IO [String]
#ifdef USE_EDITLINE
:: String -> IO [String]
#ifdef USE_EDITLINE
@@
-1754,9
+1749,15
@@
completeHomeModule w = do
completeSetOptions w = do
return (filter (w `isPrefixOf`) options)
completeSetOptions w = do
return (filter (w `isPrefixOf`) options)
- where options = "args":"prog":flagList
+ where options = "args":"prog":"prompt":"editor":"stop":flagList
flagList = map head $ group $ sort allFlags
flagList = map head $ group $ sort allFlags
+completeShowOptions w = do
+ return (filter (w `isPrefixOf`) options)
+ where options = ["args", "prog", "prompt", "editor", "stop",
+ "modules", "bindings", "linker", "breaks",
+ "context", "packages", "languages"]
+
completeFilename w = do
ws <- Readline.filenameCompletionFunction w
case ws of
completeFilename w = do
ws <- Readline.filenameCompletionFunction w
case ws of
@@
-1805,12
+1806,13
@@
allExposedModules dflags
where
pkg_db = pkgIdMap (pkgState dflags)
#else
where
pkg_db = pkgIdMap (pkgState dflags)
#else
-completeMacro = completeNone
-completeIdentifier = completeNone
-completeModule = completeNone
-completeHomeModule = completeNone
-completeSetOptions = completeNone
-completeFilename = completeNone
+completeMacro = completeNone
+completeIdentifier = completeNone
+completeModule = completeNone
+completeHomeModule = completeNone
+completeSetOptions = completeNone
+completeShowOptions = completeNone
+completeFilename = completeNone
completeHomeModuleOrFile=completeNone
#endif
completeHomeModuleOrFile=completeNone
#endif
@@
-2244,7
+2246,7
@@
listModuleLine modl line = do
case this of
[] -> panic "listModuleLine"
summ:_ -> do
case this of
[] -> panic "listModuleLine"
summ:_ -> do
- let filename = fromJust (ml_hs_file (GHC.ms_location summ))
+ let filename = expectJust "listModuleLine" (ml_hs_file (GHC.ms_location summ))
loc = GHC.mkSrcLoc (mkFastString (filename)) line 0
io $ listAround (GHC.srcLocSpan loc) False
loc = GHC.mkSrcLoc (mkFastString (filename)) line 0
io $ listAround (GHC.srcLocSpan loc) False