diff options
Diffstat (limited to 'ghc')
| -rw-r--r-- | ghc/GhciMonad.hs | 9 | ||||
| -rw-r--r-- | ghc/InteractiveUI.hs | 41 | ||||
| -rw-r--r-- | ghc/Main.hs | 4 |
3 files changed, 31 insertions, 23 deletions
diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs index c6eb619995..5cc87cf02e 100644 --- a/ghc/GhciMonad.hs +++ b/ghc/GhciMonad.hs @@ -306,18 +306,19 @@ timeIt action a <- action allocs2 <- liftIO $ getAllocations time2 <- liftIO $ getCPUTime - liftIO $ printTimes (fromIntegral (allocs2 - allocs1)) + dflags <- getDynFlags + liftIO $ printTimes dflags (fromIntegral (allocs2 - allocs1)) (time2 - time1) return a foreign import ccall unsafe "getAllocations" getAllocations :: IO Int64 -- defined in ghc/rts/Stats.c -printTimes :: Integer -> Integer -> IO () -printTimes allocs psecs +printTimes :: DynFlags -> Integer -> Integer -> IO () +printTimes dflags allocs psecs = do let secs = (fromIntegral psecs / (10^(12::Integer))) :: Float secs_str = showFFloat (Just 2) secs - putStrLn (showSDoc ( + putStrLn (showSDoc dflags ( parens (text (secs_str "") <+> text "secs" <> comma <+> text (show allocs) <+> text "bytes"))) diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index a57d8e7213..2cc6f91a46 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -595,7 +595,8 @@ mkPrompt = do f [] = empty st <- getGHCiState - return (showSDoc (f (prompt st))) + dflags <- getDynFlags + return (showSDoc dflags (f (prompt st))) queryQueue :: GHCi (Maybe String) @@ -1174,7 +1175,8 @@ checkModule m = do let modl = GHC.mkModuleName m ok <- handleSourceError (\e -> GHC.printException e >> return False) $ do r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl - liftIO $ putStrLn $ showSDoc $ + dflags <- getDynFlags + liftIO $ putStrLn $ showSDoc dflags $ case GHC.moduleInfo r of cm | Just scope <- GHC.modInfoTopLevelScope cm -> let @@ -1343,9 +1345,9 @@ modulesLoadedMsg ok mods = do punctuate comma (map ppr mods)) <> text "." case ok of Failed -> - liftIO $ putStrLn $ showSDoc (text "Failed, modules loaded: " <> mod_commas) + liftIO $ putStrLn $ showSDoc dflags (text "Failed, modules loaded: " <> mod_commas) Succeeded -> - liftIO $ putStrLn $ showSDoc (text "Ok, modules loaded: " <> mod_commas) + liftIO $ putStrLn $ showSDoc dflags (text "Ok, modules loaded: " <> mod_commas) ----------------------------------------------------------------------------- @@ -1860,8 +1862,9 @@ setiCmd str = showOptions :: Bool -> GHCi () showOptions show_all = do st <- getGHCiState + dflags <- getDynFlags let opts = options st - liftIO $ putStrLn (showSDoc ( + liftIO $ putStrLn (showSDoc dflags ( text "options currently set: " <> if null opts then text "none." @@ -1873,13 +1876,13 @@ showOptions show_all showDynFlags :: Bool -> DynFlags -> IO () showDynFlags show_all dflags = do showLanguages' show_all dflags - putStrLn $ showSDoc $ + putStrLn $ showSDoc dflags $ text "GHCi-specific dynamic flag settings:" $$ nest 2 (vcat (map (setting dopt) ghciFlags)) - putStrLn $ showSDoc $ + putStrLn $ showSDoc dflags $ text "other dynamic, non-language, flag settings:" $$ nest 2 (vcat (map (setting dopt) others)) - putStrLn $ showSDoc $ + putStrLn $ showSDoc dflags $ text "warning settings:" $$ nest 2 (vcat (map (setting wopt) DynFlags.fWarningFlags)) where @@ -2101,12 +2104,13 @@ showiCmd str = do showImports :: GHCi () showImports = do st <- getGHCiState + dflags <- getDynFlags let rem_ctx = reverse (remembered_ctx st) trans_ctx = transient_ctx st show_one (IIModule star_m) = ":module +*" ++ moduleNameString star_m - show_one (IIDecl imp) = showSDoc (ppr imp) + show_one (IIDecl imp) = showPpr dflags imp prel_imp | any isPreludeImport (rem_ctx ++ trans_ctx) = [] @@ -2176,8 +2180,9 @@ showContext = do showPackages :: GHCi () showPackages = do - pkg_flags <- fmap packageFlags getDynFlags - liftIO $ putStrLn $ showSDoc $ vcat $ + dflags <- getDynFlags + let pkg_flags = packageFlags dflags + liftIO $ putStrLn $ showSDoc dflags $ vcat $ text ("active package flags:"++if null pkg_flags then " none" else "") : map showFlag pkg_flags where showFlag (ExposePackage p) = text $ " -package " ++ p @@ -2195,7 +2200,7 @@ showiLanguages = GHC.getInteractiveDynFlags >>= liftIO . showLanguages' False showLanguages' :: Bool -> DynFlags -> IO () showLanguages' show_all dflags = - putStrLn $ showSDoc $ vcat + putStrLn $ showSDoc dflags $ vcat [ text "base language is: " <> case language dflags of Nothing -> text "Haskell2010" @@ -2260,26 +2265,27 @@ completeMacro = wrapIdentCompleter $ \w -> do completeIdentifier = wrapIdentCompleter $ \w -> do rdrs <- GHC.getRdrNamesInScope - return (filter (w `isPrefixOf`) (map (showSDoc.ppr) rdrs)) + dflags <- GHC.getSessionDynFlags + return (filter (w `isPrefixOf`) (map (showPpr dflags) rdrs)) completeModule = wrapIdentCompleter $ \w -> do dflags <- GHC.getSessionDynFlags let pkg_mods = allExposedModules dflags loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules return $ filter (w `isPrefixOf`) - $ map (showSDoc.ppr) $ loaded_mods ++ pkg_mods + $ map (showPpr dflags) $ loaded_mods ++ pkg_mods completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do + dflags <- GHC.getSessionDynFlags modules <- case m of Just '-' -> do imports <- GHC.getContext return $ map iiModuleName imports _ -> do - dflags <- GHC.getSessionDynFlags let pkg_mods = allExposedModules dflags loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules return $ loaded_mods ++ pkg_mods - return $ filter (w `isPrefixOf`) $ map (showSDoc.ppr) modules + return $ filter (w `isPrefixOf`) $ map (showPpr dflags) modules completeHomeModule = wrapIdentCompleter listHomeModules @@ -2287,8 +2293,9 @@ listHomeModules :: String -> GHCi [String] listHomeModules w = do g <- GHC.getModuleGraph let home_mods = map GHC.ms_mod_name g + dflags <- getDynFlags return $ sort $ filter (w `isPrefixOf`) - $ map (showSDoc.ppr) home_mods + $ map (showPpr dflags) home_mods completeSetOptions = wrapCompleter flagWordBreakChars $ \w -> do return (filter (w `isPrefixOf`) opts) diff --git a/ghc/Main.hs b/ghc/Main.hs index 616309009b..1f6fb6c36b 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -770,7 +770,7 @@ abiHash strs = do r <- findImportedModule hsc_env modname Nothing case r of Found _ m -> return m - _error -> ghcError $ CmdLineError $ showSDoc $ + _error -> ghcError $ CmdLineError $ showSDoc dflags $ cannotFindInterface dflags modname r mods <- mapM find_it (map fst strs) @@ -785,7 +785,7 @@ abiHash strs = do mapM_ (put_ bh . mi_mod_hash) ifaces f <- fingerprintBinMem bh - putStrLn (showSDoc (ppr f)) + putStrLn (showPpr dflags f) -- ----------------------------------------------------------------------------- -- Util |