projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix test T4235 with -O
[ghc-hetmet.git]
/
ghc
/
InteractiveUI.hs
diff --git
a/ghc/InteractiveUI.hs
b/ghc/InteractiveUI.hs
index
f127735
..
11a3c98
100644
(file)
--- a/
ghc/InteractiveUI.hs
+++ b/
ghc/InteractiveUI.hs
@@
-827,7
+827,7
@@
info s = handleSourceError GHC.printExceptionAndWarnings $
mb_stuffs <- mapM GHC.getInfo names
let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
unqual <- GHC.getPrintUnqual
mb_stuffs <- mapM GHC.getInfo names
let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
unqual <- GHC.getPrintUnqual
- outputStrLn $ showSDocForUser unqual $
+ liftIO $ putStrLn $ showSDocForUser unqual $
vcat (intersperse (text "") $
map (pprInfo pefas) filtered)
vcat (intersperse (text "") $
map (pprInfo pefas) filtered)
@@
-894,7
+894,8
@@
changeDirectory "" = do
changeDirectory dir = do
graph <- GHC.getModuleGraph
when (not (null graph)) $
changeDirectory dir = do
graph <- GHC.getModuleGraph
when (not (null graph)) $
- outputStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n"
+ do liftIO $ putStrLn "Warning: changing directory causes all loaded modules to be unloaded,"
+ liftIO $ putStrLn "because the search path has changed."
prev_context <- GHC.getContext
GHC.setTargets []
_ <- GHC.load LoadAllTargets
prev_context <- GHC.getContext
GHC.setTargets []
_ <- GHC.load LoadAllTargets
@@
-1049,7
+1050,7
@@
checkModule m = do
prev_context <- GHC.getContext
ok <- handleSourceError (\e -> GHC.printExceptionAndWarnings e >> return False) $ do
r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl
prev_context <- GHC.getContext
ok <- handleSourceError (\e -> GHC.printExceptionAndWarnings e >> return False) $ do
r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl
- outputStrLn (showSDoc (
+ liftIO $ putStrLn $ showSDoc $
case GHC.moduleInfo r of
cm | Just scope <- GHC.modInfoTopLevelScope cm ->
let
case GHC.moduleInfo r of
cm | Just scope <- GHC.modInfoTopLevelScope cm ->
let
@@
-1058,7
+1059,7
@@
checkModule m = do
in
(text "global names: " <+> ppr global) $$
(text "local names: " <+> ppr local)
in
(text "global names: " <+> ppr global) $$
(text "local names: " <+> ppr local)
- _ -> empty))
+ _ -> empty
return True
afterLoad (successIf ok) False prev_context
return True
afterLoad (successIf ok) False prev_context
@@
-1161,9
+1162,9
@@
modulesLoadedMsg ok mods = do
punctuate comma (map ppr mods)) <> text "."
case ok of
Failed ->
punctuate comma (map ppr mods)) <> text "."
case ok of
Failed ->
- outputStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas))
+ liftIO $ putStrLn $ showSDoc (text "Failed, modules loaded: " <> mod_commas)
Succeeded ->
Succeeded ->
- outputStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas))
+ liftIO $ putStrLn $ showSDoc (text "Ok, modules loaded: " <> mod_commas)
typeOfExpr :: String -> InputT GHCi ()
typeOfExpr :: String -> InputT GHCi ()
@@
-1300,7
+1301,7
@@
browseModule bang modl exports_only = withFlattenedDynflags $ do
let prettyThings = map (pretty pefas) things
prettyThings' | bang = annotate $ zip modNames prettyThings
| otherwise = prettyThings
let prettyThings = map (pretty pefas) things
prettyThings' | bang = annotate $ zip modNames prettyThings
| otherwise = prettyThings
- outputStrLn $ showSDocForUser unqual (vcat prettyThings')
+ liftIO $ putStrLn $ showSDocForUser unqual (vcat prettyThings')
-- ToDo: modInfoInstances currently throws an exception for
-- package modules. When it works, we can do this:
-- $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
-- ToDo: modInfoInstances currently throws an exception for
-- package modules. When it works, we can do this:
-- $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
@@
-1645,11
+1646,6
@@
showPackages = do
io $ putStrLn $ showSDoc $ vcat $
text ("active package flags:"++if null pkg_flags then " none" else "")
: map showFlag pkg_flags
io $ putStrLn $ showSDoc $ vcat $
text ("active package flags:"++if null pkg_flags then " none" else "")
: map showFlag pkg_flags
- pkg_ids <- fmap (preloadPackages . pkgState) getDynFlags
- io $ putStrLn $ showSDoc $ vcat $
- text "packages currently loaded:"
- : map (nest 2 . text . packageIdString)
- (sortBy (compare `on` packageIdFS) pkg_ids)
where showFlag (ExposePackage p) = text $ " -package " ++ p
showFlag (HidePackage p) = text $ " -hide-package " ++ p
showFlag (IgnorePackage p) = text $ " -ignore-package " ++ p
where showFlag (ExposePackage p) = text $ " -package " ++ p
showFlag (HidePackage p) = text $ " -hide-package " ++ p
showFlag (IgnorePackage p) = text $ " -ignore-package " ++ p
@@
-1660,7
+1656,7
@@
showLanguages = do
dflags <- getDynFlags
io $ putStrLn $ showSDoc $ vcat $
text "active language flags:" :
dflags <- getDynFlags
io $ putStrLn $ showSDoc $ vcat $
text "active language flags:" :
- [text (" -X" ++ str) | (str, f, _) <- DynFlags.xFlags, dopt f dflags]
+ [text (" -X" ++ str) | (str, f, _) <- DynFlags.xFlags, xopt f dflags]
-- -----------------------------------------------------------------------------
-- Completion
-- -----------------------------------------------------------------------------
-- Completion
@@
-2177,7
+2173,7
@@
list2 :: [String] -> InputT GHCi ()
list2 [arg] | all isDigit arg = do
(toplevel, _) <- GHC.getContext
case toplevel of
list2 [arg] | all isDigit arg = do
(toplevel, _) <- GHC.getContext
case toplevel of
- [] -> outputStrLn "No module to list"
+ [] -> liftIO $ putStrLn "No module to list"
(mod : _) -> listModuleLine mod (read arg)
list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
mod <- wantInterpretedModule arg1
(mod : _) -> listModuleLine mod (read arg)
list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
mod <- wantInterpretedModule arg1
@@
-2202,7
+2198,7
@@
list2 [arg] = do
noCanDo n why = printForUser $
text "cannot list source code for " <> ppr n <> text ": " <> why
list2 _other =
noCanDo n why = printForUser $
text "cannot list source code for " <> ppr n <> text ": " <> why
list2 _other =
- outputStrLn "syntax: :list [<line> | <module> <line> | <identifier>]"
+ liftIO $ putStrLn "syntax: :list [<line> | <module> <line> | <identifier>]"
listModuleLine :: Module -> Int -> InputT GHCi ()
listModuleLine modl line = do
listModuleLine :: Module -> Int -> InputT GHCi ()
listModuleLine modl line = do
@@
-2243,7
+2239,7
@@
listAround span do_highlight = do
let output = BS.intercalate (BS.pack "\n") prefixed
utf8Decoded <- liftIO $ BS.useAsCStringLen output
$ \(p,n) -> utf8DecodeString (castPtr p) n
let output = BS.intercalate (BS.pack "\n") prefixed
utf8Decoded <- liftIO $ BS.useAsCStringLen output
$ \(p,n) -> utf8DecodeString (castPtr p) n
- outputStrLn utf8Decoded
+ liftIO $ putStrLn utf8Decoded
where
file = GHC.srcSpanFile span
line1 = GHC.srcSpanStartLine span
where
file = GHC.srcSpanFile span
line1 = GHC.srcSpanStartLine span