X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2FInteractiveUI.hs;h=22bff85338734640ea779af11f76704fa8901827;hb=55df91112614bbe9ede9e90925c8b7011c5bf157;hp=367539863cfae08f96b00a9258536a0088fff2d1;hpb=cab2a4c125b422d675aa5ba086e3f94e97e9f81b;p=ghc-hetmet.git diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 3675398..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 #-} ----------------------------------------------------------------------------- -- @@ -33,7 +32,7 @@ import Packages -- 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 @@ -124,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), @@ -204,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" ++ @@ -399,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 @@ -439,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: -- : @@ -446,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 @@ -458,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 @@ -754,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 @@ -823,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) @@ -935,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) @@ -1144,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 @@ -1593,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 @@ -1627,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 @@ -2067,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 -> @@ -2079,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) @@ -2110,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 [ | | ]" @@ -2158,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