summaryrefslogtreecommitdiff
path: root/compiler/main
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/main')
-rw-r--r--compiler/main/DriverMkDepend.hs10
-rw-r--r--compiler/main/DriverPipeline.hs7
-rw-r--r--compiler/main/DynFlags.hs6
-rw-r--r--compiler/main/DynamicLoading.hs27
-rw-r--r--compiler/main/ErrUtils.hs7
-rw-r--r--compiler/main/Finder.hs56
-rw-r--r--compiler/main/GhcMake.hs18
-rw-r--r--compiler/main/Hooks.hs4
-rw-r--r--compiler/main/HscMain.hs6
-rw-r--r--compiler/main/HscTypes.hs36
-rw-r--r--compiler/main/Packages.hs16
-rw-r--r--compiler/main/PprTyThing.hs5
-rw-r--r--compiler/main/SysTools.hs6
-rw-r--r--compiler/main/TidyPgm.hs5
14 files changed, 105 insertions, 104 deletions
diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs
index 611d3964c5..46fe4e0aad 100644
--- a/compiler/main/DriverMkDepend.hs
+++ b/compiler/main/DriverMkDepend.hs
@@ -343,16 +343,16 @@ dumpModCycles dflags mod_summaries
= return ()
| null cycles
- = putMsg dflags (ptext (sLit "No module cycles"))
+ = putMsg dflags (text "No module cycles")
| otherwise
- = putMsg dflags (hang (ptext (sLit "Module cycles found:")) 2 pp_cycles)
+ = putMsg dflags (hang (text "Module cycles found:") 2 pp_cycles)
where
cycles :: [[ModSummary]]
cycles = [ c | CyclicSCC c <- GHC.topSortModuleGraph True mod_summaries Nothing ]
- pp_cycles = vcat [ (ptext (sLit "---------- Cycle") <+> int n <+> ptext (sLit "----------"))
+ pp_cycles = vcat [ (text "---------- Cycle" <+> int n <+> ptext (sLit "----------"))
$$ pprCycle c $$ blankLine
| (n,c) <- [1..] `zip` cycles ]
@@ -382,7 +382,7 @@ pprCycle summaries = pp_group (CyclicSCC summaries)
pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' '))
<+> (pp_imps empty (map snd (ms_imps summary)) $$
- pp_imps (ptext (sLit "{-# SOURCE #-}")) (map snd (ms_srcimps summary)))
+ pp_imps (text "{-# SOURCE #-}") (map snd (ms_srcimps summary)))
where
mod_str = moduleNameString (moduleName (ms_mod summary))
@@ -391,7 +391,7 @@ pprCycle summaries = pp_group (CyclicSCC summaries)
pp_imps what lms
= case [m | L _ m <- lms, m `elem` cycle_mods] of
[] -> empty
- ms -> what <+> ptext (sLit "imports") <+>
+ ms -> what <+> text "imports" <+>
pprWithCommas ppr ms
-----------------------------------------------------------------
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 047e12e146..f40efd0f84 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -56,7 +56,6 @@ import StringBuffer ( hGetStringBuffer )
import BasicTypes ( SuccessFlag(..) )
import Maybes ( expectJust )
import SrcLoc
-import FastString
import LlvmCodeGen ( llvmFixupAsm )
import MonadUtils
import Platform
@@ -372,7 +371,7 @@ link' dflags batch_attempt_linking hpt
linking_needed <- linkingNeeded dflags staticLink linkables pkg_deps
if not (gopt Opt_ForceRecomp dflags) && not linking_needed
- then do debugTraceMsg dflags 2 (text exe_file <+> ptext (sLit "is up to date, linking not required."))
+ then do debugTraceMsg dflags 2 (text exe_file <+> text "is up to date, linking not required.")
return Succeeded
else do
@@ -684,7 +683,7 @@ pipeLoop phase input_fn = do
_
-> do liftIO $ debugTraceMsg dflags 4
- (ptext (sLit "Running phase") <+> ppr phase)
+ (text "Running phase" <+> ppr phase)
(next_phase, output_fn) <- runHookedPhase phase input_fn dflags
r <- pipeLoop next_phase output_fn
case phase of
@@ -1618,7 +1617,7 @@ mkExtraObjToLinkIntoBinary dflags = do
else "rtsFalse") <> semi,
case rtsOpts dflags of
Nothing -> Outputable.empty
- Just opts -> ptext (sLit " __conf.rts_opts= ") <>
+ Just opts -> text " __conf.rts_opts= " <>
text (show opts) <> semi,
text " __conf.rts_hs_main = rtsTrue;",
text " return hs_main(argc,argv,&ZCMain_main_closure,__conf);",
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index acaa722d90..d28dd30773 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1106,9 +1106,9 @@ data GhcMode
deriving Eq
instance Outputable GhcMode where
- ppr CompManager = ptext (sLit "CompManager")
- ppr OneShot = ptext (sLit "OneShot")
- ppr MkDepend = ptext (sLit "MkDepend")
+ ppr CompManager = text "CompManager"
+ ppr OneShot = text "OneShot"
+ ppr MkDepend = text "MkDepend"
isOneShot :: GhcMode -> Bool
isOneShot OneShot = True
diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs
index ba351457df..e7a2b953ed 100644
--- a/compiler/main/DynamicLoading.hs
+++ b/compiler/main/DynamicLoading.hs
@@ -84,8 +84,8 @@ loadPlugin' occ_name plugin_name hsc_env mod_name
; case mb_name of {
Nothing ->
throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep
- [ ptext (sLit "The module"), ppr mod_name
- , ptext (sLit "did not export the plugin name")
+ [ text "The module", ppr mod_name
+ , text "did not export the plugin name"
, ppr plugin_rdr_name ]) ;
Just name ->
@@ -94,9 +94,9 @@ loadPlugin' occ_name plugin_name hsc_env mod_name
; case mb_plugin of
Nothing ->
throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep
- [ ptext (sLit "The value"), ppr name
- , ptext (sLit "did not have the type")
- , ppr pluginTyConName, ptext (sLit "as required")])
+ [ text "The value", ppr name
+ , text "did not have the type"
+ , ppr pluginTyConName, text "as required"])
Just plugin -> return plugin } } }
@@ -123,7 +123,7 @@ forceLoadNameModuleInterface hsc_env reason name = do
-- * The name did not exist in the loaded module
forceLoadTyCon :: HscEnv -> Name -> IO TyCon
forceLoadTyCon hsc_env con_name = do
- forceLoadNameModuleInterface hsc_env (ptext (sLit "contains a name used in an invocation of loadTyConTy")) con_name
+ forceLoadNameModuleInterface hsc_env (text "contains a name used in an invocation of loadTyConTy") con_name
mb_con_thing <- lookupTypeHscEnv hsc_env con_name
case mb_con_thing of
@@ -155,7 +155,7 @@ getValueSafely hsc_env val_name expected_type = do
getHValueSafely :: HscEnv -> Name -> Type -> IO (Maybe HValue)
getHValueSafely hsc_env val_name expected_type = do
- forceLoadNameModuleInterface hsc_env (ptext (sLit "contains a name used in an invocation of getHValueSafely")) val_name
+ forceLoadNameModuleInterface hsc_env (text "contains a name used in an invocation of getHValueSafely") val_name
-- Now look up the names for the value and type constructor in the type environment
mb_val_thing <- lookupTypeHscEnv hsc_env val_name
case mb_val_thing of
@@ -185,9 +185,10 @@ getHValueSafely hsc_env val_name expected_type = do
-- if it /does/ segfault
lessUnsafeCoerce :: DynFlags -> String -> a -> IO b
lessUnsafeCoerce dflags context what = do
- debugTraceMsg dflags 3 $ (ptext $ sLit "Coercing a value in") <+> (text context) <> (ptext $ sLit "...")
+ debugTraceMsg dflags 3 $ (text "Coercing a value in") <+> (text context) <>
+ (text "...")
output <- evaluate (unsafeCoerce# what)
- debugTraceMsg dflags 3 $ ptext $ sLit "Successfully evaluated coercion"
+ debugTraceMsg dflags 3 (text "Successfully evaluated coercion")
return output
@@ -225,17 +226,17 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
[] -> return Nothing
_ -> panic "lookupRdrNameInModule"
- Nothing -> throwCmdLineErrorS dflags $ hsep [ptext (sLit "Could not determine the exports of the module"), ppr mod_name]
+ Nothing -> throwCmdLineErrorS dflags $ hsep [text "Could not determine the exports of the module", ppr mod_name]
err -> throwCmdLineErrorS dflags $ cannotFindModule dflags mod_name err
where
dflags = hsc_dflags hsc_env
- doc = ptext (sLit "contains a name used in an invocation of lookupRdrNameInModule")
+ doc = text "contains a name used in an invocation of lookupRdrNameInModule"
wrongTyThingError :: Name -> TyThing -> SDoc
-wrongTyThingError name got_thing = hsep [ptext (sLit "The name"), ppr name, ptext (sLit "is not that of a value but rather a"), pprTyThingCategory got_thing]
+wrongTyThingError name got_thing = hsep [text "The name", ppr name, ptext (sLit "is not that of a value but rather a"), pprTyThingCategory got_thing]
missingTyThingError :: Name -> SDoc
-missingTyThingError name = hsep [ptext (sLit "The name"), ppr name, ptext (sLit "is not in the type environment: are you sure it exists?")]
+missingTyThingError name = hsep [text "The name", ppr name, ptext (sLit "is not in the type environment: are you sure it exists?")]
throwCmdLineErrorS :: DynFlags -> SDoc -> IO a
throwCmdLineErrorS dflags = throwCmdLineError . showSDoc dflags
diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs
index 11b30fd13c..eafe4e802f 100644
--- a/compiler/main/ErrUtils.hs
+++ b/compiler/main/ErrUtils.hs
@@ -53,7 +53,6 @@ import Bag
import Exception
import Outputable
import Panic
-import FastString
import SrcLoc
import DynFlags
@@ -174,9 +173,9 @@ mkLocMessage severity locn msg
-- Add prefixes, like Foo.hs:34: warning:
-- <the warning message>
sev_info = case severity of
- SevWarning -> ptext (sLit "warning:")
- SevError -> ptext (sLit "error:")
- SevFatal -> ptext (sLit "fatal:")
+ SevWarning -> text "warning:"
+ SevError -> text "error:"
+ SevFatal -> text "fatal:"
_ -> empty
makeIntoWarning :: ErrMsg -> ErrMsg
diff --git a/compiler/main/Finder.hs b/compiler/main/Finder.hs
index 2ac0737251..e11480c497 100644
--- a/compiler/main/Finder.hs
+++ b/compiler/main/Finder.hs
@@ -544,7 +544,7 @@ cantFindErr :: LitString -> LitString -> DynFlags -> ModuleName -> FindResult
cantFindErr _ multiple_found _ mod_name (FoundMultiple mods)
| Just pkgs <- unambiguousPackages
= hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
- sep [ptext (sLit "it was found in multiple packages:"),
+ sep [text "it was found in multiple packages:",
hsep (map ppr pkgs) ]
)
| otherwise
@@ -557,16 +557,16 @@ cantFindErr _ multiple_found _ mod_name (FoundMultiple mods)
= Just (moduleUnitId m : xs)
unambiguousPackage _ _ = Nothing
- pprMod (m, o) = ptext (sLit "it is bound as") <+> ppr m <+>
- ptext (sLit "by") <+> pprOrigin m o
+ pprMod (m, o) = text "it is bound as" <+> ppr m <+>
+ text "by" <+> pprOrigin m o
pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
if e == Just True
- then [ptext (sLit "package") <+> ppr (moduleUnitId m)]
+ then [text "package" <+> ppr (moduleUnitId m)]
else [] ++
- map ((ptext (sLit "a reexport in package") <+>)
+ map ((text "a reexport in package" <+>)
.ppr.packageConfigId) res ++
- if f then [ptext (sLit "a package flag")] else []
+ if f then [text "a package flag"] else []
)
cantFindErr cannot_find _ dflags mod_name find_result
@@ -576,8 +576,8 @@ cantFindErr cannot_find _ dflags mod_name find_result
more_info
= case find_result of
NoPackage pkg
- -> ptext (sLit "no unit id matching") <+> quotes (ppr pkg) <+>
- ptext (sLit "was found") $$ looks_like_srcpkgid pkg
+ -> text "no unit id matching" <+> quotes (ppr pkg) <+>
+ text "was found" $$ looks_like_srcpkgid pkg
NotFound { fr_paths = files, fr_pkg = mb_pkg
, fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
@@ -589,7 +589,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
-> pp_suggestions suggest $$ tried_these files
| null files && null mod_hiddens && null pkg_hiddens
- -> ptext (sLit "It is not a module in the current program, or in any known package.")
+ -> text "It is not a module in the current program, or in any known package."
| otherwise
-> vcat (map pkg_hidden pkg_hiddens) $$
@@ -606,26 +606,26 @@ cantFindErr cannot_find _ dflags mod_name find_result
build = if build_tag == "p" then "profiling"
else "\"" ++ build_tag ++ "\""
in
- ptext (sLit "Perhaps you haven't installed the ") <> text build <>
- ptext (sLit " libraries for package ") <> quotes (ppr pkg) <> char '?' $$
+ text "Perhaps you haven't installed the " <> text build <>
+ text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
tried_these files
| otherwise
- = ptext (sLit "There are files missing in the ") <> quotes (ppr pkg) <>
- ptext (sLit " package,") $$
- ptext (sLit "try running 'ghc-pkg check'.") $$
+ = text "There are files missing in the " <> quotes (ppr pkg) <>
+ text " package," $$
+ text "try running 'ghc-pkg check'." $$
tried_these files
tried_these files
| null files = Outputable.empty
| verbosity dflags < 3 =
- ptext (sLit "Use -v to see a list of the files searched for.")
+ text "Use -v to see a list of the files searched for."
| otherwise =
- hang (ptext (sLit "Locations searched:")) 2 $ vcat (map text files)
+ hang (text "Locations searched:") 2 $ vcat (map text files)
pkg_hidden :: UnitId -> SDoc
pkg_hidden pkgid =
- ptext (sLit "It is a member of the hidden package")
+ text "It is a member of the hidden package"
<+> quotes (ppr pkgid)
--FIXME: we don't really want to show the unit id here we should
-- show the source package id or installed package id if it's ambiguous
@@ -633,9 +633,9 @@ cantFindErr cannot_find _ dflags mod_name find_result
cabal_pkg_hidden_hint pkgid
| gopt Opt_BuildingCabalPackage dflags
= let pkg = expectJust "pkg_hidden" (lookupPackage dflags pkgid)
- in ptext (sLit "Perhaps you need to add") <+>
+ in text "Perhaps you need to add" <+>
quotes (ppr (packageName pkg)) <+>
- ptext (sLit "to the build-depends in your .cabal file.")
+ text "to the build-depends in your .cabal file."
| otherwise = Outputable.empty
looks_like_srcpkgid :: UnitId -> SDoc
@@ -651,12 +651,12 @@ cantFindErr cannot_find _ dflags mod_name find_result
| otherwise = Outputable.empty
mod_hidden pkg =
- ptext (sLit "it is a hidden module in the package") <+> quotes (ppr pkg)
+ text "it is a hidden module in the package" <+> quotes (ppr pkg)
pp_suggestions :: [ModuleSuggestion] -> SDoc
pp_suggestions sugs
| null sugs = Outputable.empty
- | otherwise = hang (ptext (sLit "Perhaps you meant"))
+ | otherwise = hang (text "Perhaps you meant")
2 (vcat (map pp_sugg sugs))
-- NB: Prefer the *original* location, and then reexports, and then
@@ -668,14 +668,14 @@ cantFindErr cannot_find _ dflags mod_name find_result
fromExposedReexport = res,
fromPackageFlag = f })
| Just True <- e
- = parens (ptext (sLit "from") <+> ppr (moduleUnitId mod))
+ = parens (text "from" <+> ppr (moduleUnitId mod))
| f && moduleName mod == m
- = parens (ptext (sLit "from") <+> ppr (moduleUnitId mod))
+ = parens (text "from" <+> ppr (moduleUnitId mod))
| (pkg:_) <- res
- = parens (ptext (sLit "from") <+> ppr (packageConfigId pkg)
- <> comma <+> ptext (sLit "reexporting") <+> ppr mod)
+ = parens (text "from" <+> ppr (packageConfigId pkg)
+ <> comma <+> text "reexporting" <+> ppr mod)
| f
- = parens (ptext (sLit "defined via package flags to be")
+ = parens (text "defined via package flags to be"
<+> ppr mod)
| otherwise = Outputable.empty
pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o
@@ -683,9 +683,9 @@ cantFindErr cannot_find _ dflags mod_name find_result
provenance (ModOrigin{ fromOrigPackage = e,
fromHiddenReexport = rhs })
| Just False <- e
- = parens (ptext (sLit "needs flag -package-key")
+ = parens (text "needs flag -package-key"
<+> ppr (moduleUnitId mod))
| (pkg:_) <- rhs
- = parens (ptext (sLit "needs flag -package-id")
+ = parens (text "needs flag -package-id"
<+> ppr (packageConfigId pkg))
| otherwise = Outputable.empty
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 9c6abb89e6..7bbe4be495 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -1560,7 +1560,7 @@ warnUnnecessarySourceImports sccs = do
warn :: DynFlags -> Located ModuleName -> WarnMsg
warn dflags (L loc mod) =
mkPlainErrMsg dflags loc
- (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
+ (text "Warning: {-# SOURCE #-} unnecessary in import of "
<+> quotes (ppr mod))
@@ -2038,8 +2038,8 @@ cyclicModuleErr :: [ModSummary] -> SDoc
cyclicModuleErr mss
= ASSERT( not (null mss) )
case findCycle graph of
- Nothing -> ptext (sLit "Unexpected non-cycle") <+> ppr mss
- Just path -> vcat [ ptext (sLit "Module imports form a cycle:")
+ Nothing -> text "Unexpected non-cycle" <+> ppr mss
+ Just path -> vcat [ text "Module imports form a cycle:"
, nest 2 (show_path path) ]
where
graph :: [Node NodeKey ModSummary]
@@ -2050,14 +2050,14 @@ cyclicModuleErr mss
[ (unLoc m, NotBoot) | m <- ms_home_imps ms ])
show_path [] = panic "show_path"
- show_path [m] = ptext (sLit "module") <+> ppr_ms m
- <+> ptext (sLit "imports itself")
- show_path (m1:m2:ms) = vcat ( nest 7 (ptext (sLit "module") <+> ppr_ms m1)
- : nest 6 (ptext (sLit "imports") <+> ppr_ms m2)
+ show_path [m] = text "module" <+> ppr_ms m
+ <+> text "imports itself"
+ show_path (m1:m2:ms) = vcat ( nest 7 (text "module" <+> ppr_ms m1)
+ : nest 6 (text "imports" <+> ppr_ms m2)
: go ms )
where
- go [] = [ptext (sLit "which imports") <+> ppr_ms m1]
- go (m:ms) = (ptext (sLit "which imports") <+> ppr_ms m) : go ms
+ go [] = [text "which imports" <+> ppr_ms m1]
+ go (m:ms) = (text "which imports" <+> ppr_ms m) : go ms
ppr_ms :: ModSummary -> SDoc
diff --git a/compiler/main/Hooks.hs b/compiler/main/Hooks.hs
index 0b75bc599d..237101bce0 100644
--- a/compiler/main/Hooks.hs
+++ b/compiler/main/Hooks.hs
@@ -43,10 +43,10 @@ import RdrName
import CoreSyn
#ifdef GHCI
import GHCi.RemoteTypes
+import SrcLoc
+import Type
#endif
import BasicTypes
-import Type
-import SrcLoc
import Data.Maybe
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index f8945b2a76..58434e93c6 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -101,6 +101,7 @@ import VarEnv ( emptyTidyEnv )
import THNames ( templateHaskellNames )
import Panic
import ConLike
+import Control.Concurrent
#endif
import Module
@@ -162,7 +163,6 @@ import Stream (Stream)
import Util
import Data.List
-import Control.Concurrent
import Control.Monad
import Data.IORef
import System.FilePath as FilePath
@@ -184,7 +184,9 @@ newHscEnv dflags = do
us <- mkSplitUniqSupply 'r'
nc_var <- newIORef (initNameCache us allKnownKeyNames)
fc_var <- newIORef emptyModuleEnv
+#ifdef GHCI
iserv_mvar <- newMVar Nothing
+#endif
return HscEnv { hsc_dflags = dflags
, hsc_targets = []
, hsc_mod_graph = []
@@ -1621,7 +1623,7 @@ hscImport hsc_env str = runInteractiveHsc hsc_env $ do
[L _ i] -> return i
_ -> liftIO $ throwOneError $
mkPlainErrMsg (hsc_dflags hsc_env) noSrcSpan $
- ptext (sLit "parse error in import declaration")
+ text "parse error in import declaration"
-- | Typecheck an expression (but don't run it)
-- Returns its most general type
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index e8d6d23c0d..6b5458ea79 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -192,13 +192,15 @@ import GHC.Serialized ( Serialized )
import Foreign
import Control.Monad ( guard, liftM, when, ap )
-import Control.Concurrent
import Data.IORef
import Data.Time
import Data.Typeable ( Typeable )
import Exception
import System.FilePath
+#ifdef GHCI
+import Control.Concurrent
import System.Process ( ProcessHandle )
+#endif
-- -----------------------------------------------------------------------------
-- Compilation state
@@ -606,8 +608,8 @@ hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
, let things = case lookupUFM hpt mod of
Just info -> extract info
Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg []
- msg = vcat [ptext (sLit "missing module") <+> ppr mod,
- ptext (sLit "Probable cause: out-of-date interface files")]
+ msg = vcat [text "missing module" <+> ppr mod,
+ text "Probable cause: out-of-date interface files"]
-- This really shouldn't happen, but see Trac #962
-- And get its dfuns
@@ -2664,20 +2666,20 @@ isNoIfaceVectInfo (IfaceVectInfo l1 l2 l3 l4 l5)
instance Outputable VectInfo where
ppr info = vcat
- [ ptext (sLit "variables :") <+> ppr (vectInfoVar info)
- , ptext (sLit "tycons :") <+> ppr (vectInfoTyCon info)
- , ptext (sLit "datacons :") <+> ppr (vectInfoDataCon info)
- , ptext (sLit "parallel vars :") <+> ppr (vectInfoParallelVars info)
- , ptext (sLit "parallel tycons :") <+> ppr (vectInfoParallelTyCons info)
+ [ text "variables :" <+> ppr (vectInfoVar info)
+ , text "tycons :" <+> ppr (vectInfoTyCon info)
+ , text "datacons :" <+> ppr (vectInfoDataCon info)
+ , text "parallel vars :" <+> ppr (vectInfoParallelVars info)
+ , text "parallel tycons :" <+> ppr (vectInfoParallelTyCons info)
]
instance Outputable IfaceVectInfo where
ppr info = vcat
- [ ptext (sLit "variables :") <+> ppr (ifaceVectInfoVar info)
- , ptext (sLit "tycons :") <+> ppr (ifaceVectInfoTyCon info)
- , ptext (sLit "tycons reuse :") <+> ppr (ifaceVectInfoTyConReuse info)
- , ptext (sLit "parallel vars :") <+> ppr (ifaceVectInfoParallelVars info)
- , ptext (sLit "parallel tycons :") <+> ppr (ifaceVectInfoParallelTyCons info)
+ [ text "variables :" <+> ppr (ifaceVectInfoVar info)
+ , text "tycons :" <+> ppr (ifaceVectInfoTyCon info)
+ , text "tycons reuse :" <+> ppr (ifaceVectInfoTyConReuse info)
+ , text "parallel vars :" <+> ppr (ifaceVectInfoParallelVars info)
+ , text "parallel tycons :" <+> ppr (ifaceVectInfoParallelTyCons info)
]
@@ -2742,10 +2744,10 @@ numToTrustInfo 4 = setSafeMode Sf_Safe -- retained for backwards compat, used
numToTrustInfo n = error $ "numToTrustInfo: bad input number! (" ++ show n ++ ")"
instance Outputable IfaceTrustInfo where
- ppr (TrustInfo Sf_None) = ptext $ sLit "none"
- ppr (TrustInfo Sf_Unsafe) = ptext $ sLit "unsafe"
- ppr (TrustInfo Sf_Trustworthy) = ptext $ sLit "trustworthy"
- ppr (TrustInfo Sf_Safe) = ptext $ sLit "safe"
+ ppr (TrustInfo Sf_None) = text "none"
+ ppr (TrustInfo Sf_Unsafe) = text "unsafe"
+ ppr (TrustInfo Sf_Trustworthy) = text "trustworthy"
+ ppr (TrustInfo Sf_Safe) = text "safe"
instance Binary IfaceTrustInfo where
put_ bh iftrust = putByte bh $ trustInfoToNum iftrust
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index e22bf93656..cf181046f0 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -722,17 +722,17 @@ findWiredInPackages dflags pkgs vis_map = do
where
notfound = do
debugTraceMsg dflags 2 $
- ptext (sLit "wired-in package ")
+ text "wired-in package "
<> text wired_pkg
- <> ptext (sLit " not found.")
+ <> text " not found."
return Nothing
pick :: PackageConfig
-> IO (Maybe PackageConfig)
pick pkg = do
debugTraceMsg dflags 2 $
- ptext (sLit "wired-in package ")
+ text "wired-in package "
<> text wired_pkg
- <> ptext (sLit " mapped to ")
+ <> text " mapped to "
<> ppr (unitId pkg)
return (Just pkg)
@@ -801,7 +801,7 @@ type UnusablePackages = Map UnitId
pprReason :: SDoc -> UnusablePackageReason -> SDoc
pprReason pref reason = case reason of
IgnoredWithFlag ->
- pref <+> ptext (sLit "ignored due to an -ignore-package flag")
+ pref <+> text "ignored due to an -ignore-package flag"
MissingDependencies is_shadowed deps ->
pref <+> text "unusable due to"
<+> (if is_shadowed then text "shadowed"
@@ -815,7 +815,7 @@ reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
report (ipid, (_, reason)) =
debugTraceMsg dflags 2 $
pprReason
- (ptext (sLit "package") <+> ppr ipid <+> text "is") reason
+ (text "package" <+> ppr ipid <+> text "is") reason
-- ----------------------------------------------------------------------------
--
@@ -1445,12 +1445,12 @@ add_package pkg_db ps (p, mb_parent)
= add_package pkg_db ps (key, Just p)
missingPackageMsg :: Outputable pkgid => pkgid -> SDoc
-missingPackageMsg p = ptext (sLit "unknown package:") <+> ppr p
+missingPackageMsg p = text "unknown package:" <+> ppr p
missingDependencyMsg :: Maybe UnitId -> SDoc
missingDependencyMsg Nothing = Outputable.empty
missingDependencyMsg (Just parent)
- = space <> parens (ptext (sLit "dependency of") <+> ftext (unitIdFS parent))
+ = space <> parens (text "dependency of" <+> ftext (unitIdFS parent))
-- -----------------------------------------------------------------------------
diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index d55b5083ec..e738d7a4fe 100644
--- a/compiler/main/PprTyThing.hs
+++ b/compiler/main/PprTyThing.hs
@@ -30,7 +30,6 @@ import TcType
import Name
import VarEnv( emptyTidyEnv )
import Outputable
-import FastString
-- -----------------------------------------------------------------------------
-- Pretty-printing entities that we get from the GHC API
@@ -88,7 +87,7 @@ pprFamInst (FamInst { fi_flavor = DataFamilyInst rep_tc })
pprFamInst (FamInst { fi_flavor = SynFamilyInst, fi_axiom = axiom
, fi_tys = lhs_tys, fi_rhs = rhs })
= showWithLoc (pprDefinedAt (getName axiom)) $
- hang (ptext (sLit "type instance") <+> pprTypeApp (coAxiomTyCon axiom) lhs_tys)
+ hang (text "type instance" <+> pprTypeApp (coAxiomTyCon axiom) lhs_tys)
2 (equals <+> ppr rhs)
----------------------------
@@ -162,4 +161,4 @@ showWithLoc loc doc
= hang doc 2 (char '\t' <> comment <+> loc)
-- The tab tries to make them line up a bit
where
- comment = ptext (sLit "--")
+ comment = text "--"
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index 4166b9b43a..c3436edd9e 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -1218,8 +1218,8 @@ removeWith :: DynFlags -> (FilePath -> IO ()) -> FilePath -> IO ()
removeWith dflags remover f = remover f `catchIO`
(\e ->
let msg = if isDoesNotExistError e
- then ptext (sLit "Warning: deleting non-existent") <+> text f
- else ptext (sLit "Warning: exception raised when deleting")
+ then text "Warning: deleting non-existent" <+> text f
+ else text "Warning: exception raised when deleting"
<+> text f <> colon
$$ text (show e)
in debugTraceMsg dflags 2 msg
@@ -1456,7 +1456,7 @@ traceCmd dflags phase_name cmd_line action
}
where
handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n')
- ; debugTraceMsg dflags 2 (ptext (sLit "Failed:") <+> text cmd_line <+> text (show exn))
+ ; debugTraceMsg dflags 2 (text "Failed:" <+> text cmd_line <+> text (show exn))
; throwGhcExceptionIO (ProgramError (show exn))}
{-
diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs
index 8a27fd7b6e..59cb201e8a 100644
--- a/compiler/main/TidyPgm.hs
+++ b/compiler/main/TidyPgm.hs
@@ -57,7 +57,6 @@ import UniqSupply
import ErrUtils (Severity(..))
import Outputable
import SrcLoc
-import FastString
import qualified ErrUtils as Err
import Control.Monad
@@ -385,14 +384,14 @@ tidyProgram hsc_env (ModGuts { mg_module = mod
-- on, print now
; unless (dopt Opt_D_dump_simpl dflags) $
Err.dumpIfSet_dyn dflags Opt_D_dump_rules
- (showSDoc dflags (ppr CoreTidy <+> ptext (sLit "rules")))
+ (showSDoc dflags (ppr CoreTidy <+> text "rules"))
(pprRulesForUser tidy_rules)
-- Print one-line size info
; let cs = coreBindsStats tidy_binds
; when (dopt Opt_D_dump_core_stats dflags)
(log_action dflags dflags SevDump noSrcSpan defaultDumpStyle
- (ptext (sLit "Tidy size (terms,types,coercions)")
+ (text "Tidy size (terms,types,coercions)"
<+> ppr (moduleName mod) <> colon
<+> int (cs_tm cs)
<+> int (cs_ty cs)
View Lorry Controller Status