projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Don't pin a register for gc_thread on SPARC.
[ghc-hetmet.git]
/
compiler
/
ghci
/
InteractiveUI.hs
diff --git
a/compiler/ghci/InteractiveUI.hs
b/compiler/ghci/InteractiveUI.hs
index
268f05e
..
d62b370
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" ++
@@
-641,11
+637,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.
@@
-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