diff options
Diffstat (limited to 'ghc/InteractiveUI.hs')
| -rw-r--r-- | ghc/InteractiveUI.hs | 101 |
1 files changed, 69 insertions, 32 deletions
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index b41c2db45a..ef48c348bd 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, TupleSections #-} {-# OPTIONS -fno-cse #-} -- -fno-cse is needed for GLOBAL_VAR's to behave properly @@ -27,6 +28,7 @@ import Debugger -- The GHC interface import DynFlags +import ErrUtils import GhcMonad ( modifySession ) import qualified GHC import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..), @@ -71,7 +73,7 @@ import Data.Array import qualified Data.ByteString.Char8 as BS import Data.Char import Data.Function -import Data.IORef ( IORef, readIORef, writeIORef ) +import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef ) import Data.List ( find, group, intercalate, intersperse, isPrefixOf, nub, partition, sort, sortBy ) import Data.Maybe @@ -103,7 +105,6 @@ import GHC.IO.Exception ( IOErrorType(InvalidArgument) ) import GHC.IO.Handle ( hFlushAll ) import GHC.TopHandler ( topHandler ) - ----------------------------------------------------------------------------- data GhciSettings = GhciSettings { @@ -379,6 +380,12 @@ interactiveUI config srcs maybe_exprs = do $ dflags GHC.setInteractiveDynFlags dflags' + lastErrLocationsRef <- liftIO $ newIORef [] + progDynFlags <- GHC.getProgramDynFlags + _ <- GHC.setProgramDynFlags $ + progDynFlags { log_action = ghciLogAction lastErrLocationsRef } + + liftIO $ when (isNothing maybe_exprs) $ do -- Only for GHCi (not runghc and ghc -e): @@ -399,31 +406,46 @@ interactiveUI config srcs maybe_exprs = do #endif default_editor <- liftIO $ findEditor - startGHCi (runGHCi srcs maybe_exprs) - GHCiState{ progname = default_progname, - GhciMonad.args = default_args, - prompt = defPrompt config, - prompt2 = defPrompt2 config, - stop = default_stop, - editor = default_editor, - options = [], - line_number = 1, - break_ctr = 0, - breaks = [], - tickarrays = emptyModuleEnv, - ghci_commands = availableCommands config, - last_command = Nothing, - cmdqueue = [], - remembered_ctx = [], - transient_ctx = [], - ghc_e = isJust maybe_exprs, - short_help = shortHelpText config, - long_help = fullHelpText config + GHCiState{ progname = default_progname, + GhciMonad.args = default_args, + prompt = defPrompt config, + prompt2 = defPrompt2 config, + stop = default_stop, + editor = default_editor, + options = [], + line_number = 1, + break_ctr = 0, + breaks = [], + tickarrays = emptyModuleEnv, + ghci_commands = availableCommands config, + last_command = Nothing, + cmdqueue = [], + remembered_ctx = [], + transient_ctx = [], + ghc_e = isJust maybe_exprs, + short_help = shortHelpText config, + long_help = fullHelpText config, + lastErrorLocations = lastErrLocationsRef } - + return () +resetLastErrorLocations :: GHCi () +resetLastErrorLocations = do + st <- getGHCiState + liftIO $ writeIORef (lastErrorLocations st) [] + +ghciLogAction :: IORef [(FastString, Int)] -> LogAction +ghciLogAction lastErrLocations dflags severity srcSpan style msg = do + defaultLogAction dflags severity srcSpan style msg + case severity of + SevError -> case srcSpan of + RealSrcSpan rsp -> modifyIORef lastErrLocations + (++ [(srcLocFile (realSrcSpanStart rsp), srcLocLine (realSrcSpanStart rsp))]) + _ -> return () + _ -> return () + withGhcAppData :: (FilePath -> IO a) -> IO a -> IO a withGhcAppData right left = do either_dir <- tryIO (getAppUserDataDirectory "ghc") @@ -1119,9 +1141,10 @@ runMain s = case toArgs s of Left err -> liftIO (hPutStrLn stderr err) Right args -> do dflags <- getDynFlags - case mainFunIs dflags of - Nothing -> doWithArgs args "main" - Just f -> doWithArgs args f + let main = fromMaybe "main" (mainFunIs dflags) + -- Wrap the main function in 'void' to discard its value instead + -- of printing it (#9086). See Haskell 2010 report Chapter 5. + doWithArgs args $ "Control.Monad.void (" ++ main ++ ")" ----------------------------------------------------------------------------- -- :run @@ -1169,10 +1192,18 @@ editFile :: String -> InputT GHCi () editFile str = do file <- if null str then lift chooseEditFile else expandPath str st <- lift getGHCiState + errs <- liftIO $ readIORef $ lastErrorLocations st let cmd = editor st when (null cmd) $ throwGhcException (CmdLineError "editor not set, use :set editor") - code <- liftIO $ system (cmd ++ ' ':file) + lineOpt <- liftIO $ do + curFileErrs <- filterM (\(f, _) -> unpackFS f `sameFile` file) errs + return $ case curFileErrs of + (_, line):_ -> " +" ++ show line + _ -> "" + let cmdArgs = ' ':(file ++ lineOpt) + code <- liftIO $ system (cmd ++ cmdArgs) + when (code == ExitSuccess) $ reloadModule "" @@ -1363,6 +1394,7 @@ doLoad retain_context howmuch = do -- the ModBreaks will have gone away. lift discardActiveBreakPoints + lift resetLastErrorLocations -- Enable buffering stdout and stderr as we're compiling. Keeping these -- handles unbuffered will just slow the compilation down, especially when -- compiling in parallel. @@ -1387,7 +1419,6 @@ afterLoad ok retain_context = do modulesLoadedMsg ok loaded_mods lift $ setContextAfterLoad retain_context loaded_mod_summaries - setContextAfterLoad :: Bool -> [GHC.ModSummary] -> GHCi () setContextAfterLoad keep_ctxt [] = do setContextKeepingPackageModules keep_ctxt [] @@ -1493,7 +1524,7 @@ kindOfType norm str $ do (ty, kind) <- GHC.typeKind norm str printForUser $ vcat [ text str <+> dcolon <+> pprTypeForUser kind - , ppWhen norm $ equals <+> ppr ty ] + , ppWhen norm $ equals <+> pprTypeForUser ty ] ----------------------------------------------------------------------------- @@ -2505,14 +2536,14 @@ unionComplete f1 f2 line = do wrapCompleter :: String -> (String -> GHCi [String]) -> CompletionFunc GHCi wrapCompleter breakChars fun = completeWord Nothing breakChars - $ fmap (map simpleCompletion) . fmap sort . fun + $ fmap (map simpleCompletion . nubSort) . fun wrapIdentCompleter :: (String -> GHCi [String]) -> CompletionFunc GHCi wrapIdentCompleter = wrapCompleter word_break_chars wrapIdentCompleterWithModifier :: String -> (Maybe Char -> String -> GHCi [String]) -> CompletionFunc GHCi wrapIdentCompleterWithModifier modifChars fun = completeWordWithPrev Nothing word_break_chars - $ \rest -> fmap (map simpleCompletion) . fmap sort . fun (getModifier rest) + $ \rest -> fmap (map simpleCompletion . nubSort) . fun (getModifier rest) where getModifier = find (`elem` modifChars) @@ -3117,7 +3148,13 @@ expandPathIO p = tilde <- getHomeDirectory -- will fail if HOME not defined return (tilde ++ '/':d) other -> - return other + return other + +sameFile :: FilePath -> FilePath -> IO Bool +sameFile path1 path2 = do + absPath1 <- canonicalizePath path1 + absPath2 <- canonicalizePath path2 + return $ absPath1 == absPath2 wantInterpretedModule :: GHC.GhcMonad m => String -> m Module wantInterpretedModule str = wantInterpretedModuleName (GHC.mkModuleName str) |