X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2FInteractiveUI.hs;h=22bff85338734640ea779af11f76704fa8901827;hb=ba0d4ac137c268397d469ef48684b3505faffab1;hp=1c84846477cfb730db8c21a334a286fb929ef1b2;hpb=9d0c8f842e35dde3d570580cf62a32779f66a6de;p=ghc-hetmet.git
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 1c84846..22bff85 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -1,7 +1,6 @@
{-# OPTIONS -fno-cse #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly
-{-# OPTIONS -#include "Linker.h" #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-----------------------------------------------------------------------------
--
@@ -23,17 +22,17 @@ import Debugger
-- The GHC interface
import qualified GHC hiding (resume, runStmt)
import GHC ( LoadHowMuch(..), Target(..), TargetId(..),
- Module, ModuleName, TyThing(..), Phase,
- BreakIndex, SrcSpan, Resume, SingleStep,
+ TyThing(..), Phase,
+ BreakIndex, Resume, SingleStep,
Ghc, handleSourceError )
import PprTyThing
import DynFlags
import Packages
-import PackageConfig
+-- import PackageConfig
import UniqFM
-import HscTypes ( implicitTyThings, handleFlagWarnings )
+import HscTypes ( handleFlagWarnings )
import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
import Outputable hiding (printForUser, printForUserPartWay)
import Module -- for ModuleEnv
@@ -68,7 +67,6 @@ import Control.Monad.Trans
--import SystemExts
import Exception hiding (catch, block, unblock)
-import qualified Exception
-- import Control.Concurrent
@@ -125,11 +123,11 @@ builtin_commands = [
("check", keepGoing' checkModule, completeHomeModule),
("continue", keepGoing continueCmd, noCompletion),
("cmd", keepGoing cmdCmd, completeExpression),
- ("ctags", keepGoing createCTagsFileCmd, completeFilename),
+ ("ctags", keepGoing createCTagsWithLineNumbersCmd, completeFilename),
+ ("ctags!", keepGoing createCTagsWithRegExesCmd, completeFilename),
("def", keepGoing (defineMacro False), completeExpression),
("def!", keepGoing (defineMacro True), completeExpression),
("delete", keepGoing deleteCmd, noCompletion),
- ("e", keepGoing editFile, completeFilename),
("edit", keepGoing editFile, completeFilename),
("etags", keepGoing createETagsFileCmd, completeFilename),
("force", keepGoing forceCmd, completeExpression),
@@ -205,7 +203,8 @@ helpText =
" (!: more details; *: all top-level names)\n" ++
" :cd
change directory to \n" ++
" :cmd run the commands returned by ::IO String\n" ++
- " :ctags [] create tags file for Vi (default: \"tags\")\n" ++
+ " :ctags[!] [] create tags file for Vi (default: \"tags\")\n" ++
+ " (!: use regex instead of line number)\n" ++
" :def define a command :\n" ++
" :edit edit file\n" ++
" :edit edit last module\n" ++
@@ -329,6 +328,12 @@ interactiveUI srcs maybe_exprs = do
-- We don't want the cmd line to buffer any input that might be
-- intended for the program, so unbuffer stdin.
hSetBuffering stdin NoBuffering
+#if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 611
+ -- On Unix, stdin will use the locale encoding. The IO library
+ -- doesn't do this on Windows (yet), so for now we use UTF-8,
+ -- for consistency with GHC 6.10 and to make the tests work.
+ hSetEncoding stdin utf8
+#endif
-- initial context is just the Prelude
prel_mod <- GHC.lookupModule (GHC.mkModuleName "Prelude") Nothing
@@ -394,7 +399,6 @@ runGHCi paths maybe_exprs = do
-- can we assume this will always be the case?
-- This would be a good place for runFileInputT.
Right hdl -> runInputTWithPrefs defaultPrefs defaultSettings $ do
- setLogAction
runCommands $ fileLoop hdl
where
getDirectory f = case takeDirectory f of "" -> "."; d -> d
@@ -434,6 +438,8 @@ runGHCi paths maybe_exprs = do
-- just evaluate the expression we were given
enqueueCommands exprs
let handle e = do st <- getGHCiState
+ -- flush the interpreter's stdout/stderr on exit (#3890)
+ flushInterpBuffers
-- Jump through some hoops to get the
-- current progname in the exception text:
-- :
@@ -441,7 +447,6 @@ runGHCi paths maybe_exprs = do
-- this used to be topHandlerFastExit, see #2228
$ topHandler e
runInputTWithPrefs defaultPrefs defaultSettings $ do
- setLogAction
runCommands' handle (return Nothing)
-- and finally, exit
@@ -453,9 +458,7 @@ runGHCiInput f = do
(return Nothing)
let settings = setComplete ghciCompleteWord
$ defaultSettings {historyFile = histFile}
- runInputT settings $ do
- setLogAction
- f
+ runInputT settings f
nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe String)
nextInputLine show_prompt is_tty
@@ -749,9 +752,12 @@ lookupCommand str = do
Nothing -> BadCommand
lookupCommand' :: String -> IO (Maybe Command)
-lookupCommand' str = do
+lookupCommand' ":" = return Nothing
+lookupCommand' str' = do
macros <- readIORef macros_ref
- let cmds = builtin_commands ++ macros
+ let{ (str, cmds) = case str' of
+ ':' : rest -> (rest, builtin_commands)
+ _ -> (str', macros ++ builtin_commands) }
-- look for exact match first, then the first prefix match
return $ case [ c | c <- cmds, str == cmdName c ] of
c:_ -> Just c
@@ -818,9 +824,12 @@ info s = handleSourceError GHC.printExceptionAndWarnings $ do
-- constructor in the same type
filterOutChildren :: (a -> TyThing) -> [a] -> [a]
filterOutChildren get_thing xs
- = [x | x <- xs, not (getName (get_thing x) `elemNameSet` implicits)]
+ = filterOut has_parent xs
where
- implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
+ all_names = mkNameSet (map (getName . get_thing) xs)
+ has_parent x = case pprTyThingParent_maybe (get_thing x) of
+ Just p -> getName p `elemNameSet` all_names
+ Nothing -> False
pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc
pprInfo pefas (thing, fixity, insts)
@@ -930,6 +939,8 @@ chooseEditFile =
fromTarget _ = Nothing -- when would we get a module target?
defineMacro :: Bool{-overwrite-} -> String -> GHCi ()
+defineMacro _ (':':_) =
+ io $ putStrLn "macro name cannot start with a colon"
defineMacro overwrite s = do
let (macro_name, definition) = break isSpace s
macros <- io (readIORef macros_ref)
@@ -1139,13 +1150,13 @@ typeOfExpr str
ty <- GHC.exprType str
dflags <- getDynFlags
let pefas = dopt Opt_PrintExplicitForalls dflags
- printForUser' $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]
+ printForUser $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]
kindOfType :: String -> InputT GHCi ()
kindOfType str
= handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
ty <- GHC.typeKind str
- printForUser' $ text str <+> dcolon <+> ppr ty
+ printForUser $ text str <+> dcolon <+> ppr ty
quit :: String -> InputT GHCi Bool
quit _ = return True
@@ -1588,6 +1599,7 @@ showPackages = do
where showFlag (ExposePackage p) = text $ " -package " ++ p
showFlag (HidePackage p) = text $ " -hide-package " ++ p
showFlag (IgnorePackage p) = text $ " -ignore-package " ++ p
+ showFlag (ExposePackageId p) = text $ " -package-id " ++ p
showLanguages :: GHCi ()
showLanguages = do
@@ -1622,9 +1634,13 @@ ghciCompleteWord line@(left,_) = case firstWord of
Nothing -> return completeFilename
completeCmd = wrapCompleter " " $ \w -> do
- cmds <- liftIO $ readIORef macros_ref
- return (filter (w `isPrefixOf`) (map (':':)
- (map cmdName (builtin_commands ++ cmds))))
+ macros <- liftIO $ readIORef macros_ref
+ let macro_names = map (':':) . map cmdName $ macros
+ let command_names = map (':':) . map cmdName $ builtin_commands
+ let{ candidates = case w of
+ ':' : ':' : _ -> map (':':) command_names
+ _ -> nub $ macro_names ++ command_names }
+ return $ filter (w `isPrefixOf`) candidates
completeMacro = wrapIdentCompleter $ \w -> do
cmds <- liftIO $ readIORef macros_ref
@@ -2062,7 +2078,7 @@ listCmd "" = do
mb_span <- lift getCurrentBreakSpan
case mb_span of
Nothing ->
- printForUser' $ text "Not stopped at a breakpoint; nothing to list"
+ printForUser $ text "Not stopped at a breakpoint; nothing to list"
Just span
| GHC.isGoodSrcSpan span -> listAround span True
| otherwise ->
@@ -2074,7 +2090,7 @@ listCmd "" = do
[] -> text "rerunning with :trace,"
_ -> empty
doWhat = traceIt <+> text ":back then :list"
- printForUser' (text "Unable to list source for" <+>
+ printForUser (text "Unable to list source for" <+>
ppr span
$$ text "Try" <+> doWhat)
listCmd str = list2 (words str)
@@ -2105,7 +2121,7 @@ list2 [arg] = do
noCanDo name $ text "can't find its location: " <>
ppr loc
where
- noCanDo n why = printForUser' $
+ noCanDo n why = printForUser $
text "cannot list source code for " <> ppr n <> text ": " <> why
list2 _other =
outputStrLn "syntax: :list [ | | ]"
@@ -2153,9 +2169,9 @@ listAround span do_highlight = do
where
file = GHC.srcSpanFile span
line1 = GHC.srcSpanStartLine span
- col1 = GHC.srcSpanStartCol span
+ col1 = GHC.srcSpanStartCol span - 1
line2 = GHC.srcSpanEndLine span
- col2 = GHC.srcSpanEndCol span
+ col2 = GHC.srcSpanEndCol span - 1
pad_before | line1 == 1 = 0
| otherwise = 1