diff options
Diffstat (limited to 'compiler/main')
-rw-r--r-- | compiler/main/DriverMkDepend.hs | 10 | ||||
-rw-r--r-- | compiler/main/DriverPipeline.hs | 7 | ||||
-rw-r--r-- | compiler/main/DynFlags.hs | 6 | ||||
-rw-r--r-- | compiler/main/DynamicLoading.hs | 27 | ||||
-rw-r--r-- | compiler/main/ErrUtils.hs | 7 | ||||
-rw-r--r-- | compiler/main/Finder.hs | 56 | ||||
-rw-r--r-- | compiler/main/GhcMake.hs | 18 | ||||
-rw-r--r-- | compiler/main/Hooks.hs | 4 | ||||
-rw-r--r-- | compiler/main/HscMain.hs | 6 | ||||
-rw-r--r-- | compiler/main/HscTypes.hs | 36 | ||||
-rw-r--r-- | compiler/main/Packages.hs | 16 | ||||
-rw-r--r-- | compiler/main/PprTyThing.hs | 5 | ||||
-rw-r--r-- | compiler/main/SysTools.hs | 6 | ||||
-rw-r--r-- | compiler/main/TidyPgm.hs | 5 |
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) |