summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/CmmToAsm.hs2
-rw-r--r--compiler/GHC/CmmToAsm/CFG.hs2
-rw-r--r--compiler/GHC/CmmToAsm/X86/CodeGen.hs8
-rw-r--r--compiler/GHC/Driver/Pipeline.hs2
-rw-r--r--compiler/GHC/Driver/Pipeline/Execute.hs8
-rw-r--r--compiler/GHC/Hs/Binds.hs2
-rw-r--r--compiler/GHC/Iface/Binary.hs4
-rw-r--r--compiler/GHC/Iface/Ext/Binary.hs2
-rw-r--r--compiler/GHC/Iface/Ext/Types.hs2
-rw-r--r--compiler/GHC/Iface/Recomp.hs10
-rw-r--r--compiler/GHC/Linker/Types.hs2
-rw-r--r--compiler/GHC/Tc/Deriv.hs2
-rw-r--r--compiler/GHC/Utils/Outputable.hs4
13 files changed, 26 insertions, 24 deletions
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index a4b9fbd039..e0b516bd40 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -696,7 +696,7 @@ maybeDumpCfg logger (Just cfg) msg proc_name
checkLayout :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr]
-> [NatCmmDecl statics instr]
checkLayout procsUnsequenced procsSequenced =
- assertPpr (setNull diff) (ppr "Block sequencing dropped blocks:" <> ppr diff)
+ assertPpr (setNull diff) (text "Block sequencing dropped blocks:" <> ppr diff)
procsSequenced
where
blocks1 = foldl' (setUnion) setEmpty $
diff --git a/compiler/GHC/CmmToAsm/CFG.hs b/compiler/GHC/CmmToAsm/CFG.hs
index 8a8907e6b4..fd20bd1c9f 100644
--- a/compiler/GHC/CmmToAsm/CFG.hs
+++ b/compiler/GHC/CmmToAsm/CFG.hs
@@ -660,7 +660,7 @@ getCfg platform weights graph =
(CmmCall { cml_cont = Nothing }) -> []
other ->
panic "Foo" $
- assertPpr False (ppr "Unknown successor cause:" <>
+ assertPpr False (text "Unknown successor cause:" <>
(pdoc platform branch <+> text "=>" <> pdoc platform (G.successors other))) $
map (\x -> ((bid,x),mkEdgeInfo 0)) $ G.successors other
where
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 295cd9f555..3c34109c64 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -2015,10 +2015,10 @@ genCondBranch' _ bid id false bool = do
-- Use ASSERT so we don't break releases if
-- LTT/LE creep in somehow.
LTT ->
- assertPpr False (ppr "Should have been turned into >")
+ assertPpr False (text "Should have been turned into >")
and_ordered
LE ->
- assertPpr False (ppr "Should have been turned into >=")
+ assertPpr False (text "Should have been turned into >=")
and_ordered
_ -> and_ordered
@@ -3088,9 +3088,9 @@ condFltReg is32Bit cond x y = condFltReg_sse2
GU -> plain_test dst
GEU -> plain_test dst
-- Use ASSERT so we don't break releases if these creep in.
- LTT -> assertPpr False (ppr "Should have been turned into >") $
+ LTT -> assertPpr False (text "Should have been turned into >") $
and_ordered dst
- LE -> assertPpr False (ppr "Should have been turned into >=") $
+ LE -> assertPpr False (text "Should have been turned into >=") $
and_ordered dst
_ -> and_ordered dst)
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index cd2c3e93be..242887b353 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -589,7 +589,7 @@ compileForeign hsc_env lang stub_c = do
-- This should never happen as viaCPipeline should only return `Nothing` when the stop phase is `StopC`.
-- and the same should never happen for asPipeline
-- Future refactoring to not check StopC for this case
- Nothing -> pprPanic "compileForeign" (ppr stub_c)
+ Nothing -> pprPanic "compileForeign" (text stub_c)
Just fp -> return fp
compileEmptyStub :: DynFlags -> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO ()
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index f19cb05ab5..72a9e49278 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -860,9 +860,11 @@ getOutputFilename logger tmpfs stop_phase output basename dflags next_phase mayb
| otherwise = newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule
suffix
where
- getOutputFile_ dflags = case outputFile_ dflags of
- Nothing -> pprPanic "SpecificFile: No filename" (ppr $ (dynamicNow dflags, outputFile_ dflags, dynOutputFile_ dflags))
- Just fn -> fn
+ getOutputFile_ dflags =
+ case outputFile_ dflags of
+ Nothing -> pprPanic "SpecificFile: No filename" (ppr (dynamicNow dflags) $$
+ text (fromMaybe "-" (dynOutputFile_ dflags)))
+ Just fn -> fn
hcsuf = hcSuf dflags
odir = objectDir dflags
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 7ce59266c4..1e759208c1 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -848,7 +848,7 @@ pprTcSpecPrags (SpecPrags ps) = vcat (map (ppr . unLoc) ps)
instance Outputable TcSpecPrag where
ppr (SpecPrag var _ inl)
- = ppr (extractSpecPragName $ inl_src inl) <+> pprSpec var (text "<type>") inl
+ = text (extractSpecPragName $ inl_src inl) <+> pprSpec var (text "<type>") inl
pprMinimalSig :: (OutputableBndr name)
=> LBooleanFormula (GenLocated l name) -> SDoc
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index 8e6fb6f5b7..5d5bacc123 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -118,7 +118,7 @@ readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do
check_tag <- get bh
let tag = profileBuildTag profile
- wantedGot "Way" tag check_tag ppr
+ wantedGot "Way" tag check_tag text
when (checkHiWay == CheckHiWay) $
errorOnMismatch "mismatched interface file profile tag" tag check_tag
@@ -381,7 +381,7 @@ getSymtabName _name_cache _dict symtab bh = do
in
return $! case lookupKnownKeyName u of
Nothing -> pprPanic "getSymtabName:unknown known-key unique"
- (ppr i $$ ppr (unpkUnique u))
+ (ppr i $$ ppr u)
Just n -> n
_ -> pprPanic "getSymtabName:unknown name tag" (ppr i)
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index 1e2e4f7127..86dc042e63 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -331,7 +331,7 @@ fromHieName nc hie_name = do
KnownKeyName u -> case lookupKnownKeyName u of
Nothing -> pprPanic "fromHieName:unknown known-key unique"
- (ppr (unpkUnique u))
+ (ppr u)
Just n -> pure n
-- ** Reading and writing `HieName`'s
diff --git a/compiler/GHC/Iface/Ext/Types.hs b/compiler/GHC/Iface/Ext/Types.hs
index a0a8a41ece..44619808af 100644
--- a/compiler/GHC/Iface/Ext/Types.hs
+++ b/compiler/GHC/Iface/Ext/Types.hs
@@ -774,7 +774,7 @@ hieNameOcc (KnownKeyName u) =
case lookupKnownKeyName u of
Just n -> nameOccName n
Nothing -> pprPanic "hieNameOcc:unknown known-key unique"
- (ppr (unpkUnique u))
+ (ppr u)
toHieName :: Name -> HieName
toHieName name
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index 1a978f9000..860833077f 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -653,14 +653,14 @@ checkDependencies hsc_env summary iface
text "package " <> quotes (ppr old) <>
text "no longer in dependencies"
return $ needsRecompileBecause $ UnitDepRemoved old
- check_packages (new:news) olds
+ check_packages ((new_name, new_unit):news) olds
| Just (old, olds') <- uncons olds
- , snd new == old = check_packages (dropWhile ((== (snd new)) . snd) news) olds'
+ , new_unit == old = check_packages (dropWhile ((== new_unit) . snd) news) olds'
| otherwise = do
trace_hi_diffs logger $
- text "imported package " <> quotes (ppr new) <>
- text " not among previous dependencies"
- return $ needsRecompileBecause $ ModulePackageChanged $ fst new
+ text "imported package" <+> text new_name <+> ppr new_unit <+>
+ text "not among previous dependencies"
+ return $ needsRecompileBecause $ ModulePackageChanged new_name
needInterface :: Module -> (ModIface -> IO RecompileRequired)
diff --git a/compiler/GHC/Linker/Types.hs b/compiler/GHC/Linker/Types.hs
index ac01f35e33..25df199b0f 100644
--- a/compiler/GHC/Linker/Types.hs
+++ b/compiler/GHC/Linker/Types.hs
@@ -244,7 +244,7 @@ data LibrarySpec
| Framework String -- Only used for darwin, but does no harm
instance Outputable LibrarySpec where
- ppr (Objects objs) = text "Objects" <+> ppr objs
+ ppr (Objects objs) = text "Objects" <+> ppr (map text objs)
ppr (Archive a) = text "Archive" <+> text a
ppr (DLL s) = text "DLL" <+> text s
ppr (DLLPath f) = text "DLLPath" <+> text f
diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs
index 7df65bd367..f12fefcffe 100644
--- a/compiler/GHC/Tc/Deriv.hs
+++ b/compiler/GHC/Tc/Deriv.hs
@@ -1926,7 +1926,7 @@ genFamInsts spec@(DS { ds_tvs = tyvars, ds_mechanism = mechanism
-- canDeriveAnyClass should ensure that this code can't be reached
-- unless -XDeriveAnyClass is enabled.
assertPpr (xopt LangExt.DeriveAnyClass dflags)
- (ppr "genFamInsts: bad derived class" <+> ppr clas) $
+ (text "genFamInsts: bad derived class" <+> ppr clas) $
mapM (tcATDefault loc mini_subst emptyNameSet)
(classATItems clas)
pure $ concat tyfam_insts
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index bd8204f856..a9b8ca384e 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -895,8 +895,8 @@ keyword = coloured Col.colBold
class Outputable a where
ppr :: a -> SDoc
-instance Outputable Char where
- ppr c = text [c]
+-- There's no Outputable for Char; it's too easy to use Outputable
+-- on String and have ppr "hello" rendered as "h,e,l,l,o".
instance Outputable Bool where
ppr True = text "True"
View Lorry Controller Status