summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Cmm/Dominators.hs6
-rw-r--r--compiler/GHC/Cmm/Parser.y2
-rw-r--r--compiler/GHC/CmmToAsm.hs2
-rw-r--r--compiler/GHC/CmmToLlvm/Base.hs2
-rw-r--r--compiler/GHC/CmmToLlvm/CodeGen.hs18
-rw-r--r--compiler/GHC/CmmToLlvm/Ppr.hs2
-rw-r--r--compiler/GHC/Core/Unfold.hs2
-rw-r--r--compiler/GHC/HsToCore/Foreign/C.hs2
-rw-r--r--compiler/GHC/StgToCmm/Bind.hs2
-rw-r--r--compiler/GHC/StgToCmm/Layout.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Pat.hs7
11 files changed, 19 insertions, 28 deletions
diff --git a/compiler/GHC/Cmm/Dominators.hs b/compiler/GHC/Cmm/Dominators.hs
index 7e55440c3f..8321211e89 100644
--- a/compiler/GHC/Cmm/Dominators.hs
+++ b/compiler/GHC/Cmm/Dominators.hs
@@ -38,9 +38,7 @@ import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Cmm
-import GHC.Utils.Outputable( Outputable(..), text, int, hcat, (<+>)
- , showSDocUnsafe
- )
+import GHC.Utils.Outputable( Outputable(..), text, int, hcat, (<+>))
import GHC.Utils.Misc
import GHC.Utils.Panic
@@ -188,7 +186,7 @@ gwdRPNumber g l = findLabelIn l (gwd_rpnumbering g)
findLabelIn :: HasDebugCallStack => Label -> LabelMap a -> a
findLabelIn lbl = mapFindWithDefault failed lbl
where failed =
- panic $ "label " ++ showSDocUnsafe (ppr lbl) ++ " not found in result of analysis"
+ pprPanic "label not found in result of analysis" (ppr lbl)
-- | Use `gwdDominatorsOf` on the result of the dominator analysis to get
-- a mapping from the `Label` of each reachable block to the dominator
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index 312dc2e4f7..67ce361a02 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -449,7 +449,7 @@ cmmproc :: { CmmParse () }
platform <- getPlatform;
ctx <- getContext;
formals <- sequence (fromMaybe [] $3);
- withName (renderWithContext ctx (pprCLabel platform CStyle entry_ret_label))
+ withName (showSDocOneLine ctx (pprCLabel platform CStyle entry_ret_label))
$4;
return (entry_ret_label, info, stk_formals, formals) }
let do_layout = isJust $3
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index bd548f8876..a4b9fbd039 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -785,7 +785,7 @@ makeImportsDoc config imports
| otherwise
= Outputable.empty
- doPpr lbl = (lbl, renderWithContext
+ doPpr lbl = (lbl, showSDocOneLine
(ncgAsmContext config)
(pprAsmLabel platform lbl))
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index 390ba4c55a..4e3c95771e 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -447,7 +447,7 @@ strCLabel_llvm lbl = do
ctx <- llvmCgContext <$> getConfig
platform <- getPlatform
let sdoc = pprCLabel platform CStyle lbl
- str = Outp.renderWithContext ctx sdoc
+ str = Outp.showSDocOneLine ctx sdoc
return (fsLit str)
-- ----------------------------------------------------------------------------
diff --git a/compiler/GHC/CmmToLlvm/CodeGen.hs b/compiler/GHC/CmmToLlvm/CodeGen.hs
index cd110a0900..1ed843854e 100644
--- a/compiler/GHC/CmmToLlvm/CodeGen.hs
+++ b/compiler/GHC/CmmToLlvm/CodeGen.hs
@@ -1203,10 +1203,10 @@ genStore_slow addr val alignment meta = do
other ->
pprPanic "genStore: ptr not right type!"
- (pdoc platform addr <+> text (
- "Size of Ptr: " ++ show (llvmPtrBits platform) ++
- ", Size of var: " ++ show (llvmWidthInBits platform other) ++
- ", Var: " ++ renderWithContext (llvmCgContext cfg) (ppVar cfg vaddr)))
+ (pdoc platform addr $$
+ text "Size of Ptr:" <+> ppr (llvmPtrBits platform) $$
+ text "Size of var:" <+> ppr (llvmWidthInBits platform other) $$
+ text "Var:" <+> ppVar cfg vaddr)
mkStore :: LlvmVar -> LlvmVar -> AlignmentSpec -> LlvmStatement
mkStore vval vptr alignment =
@@ -1255,7 +1255,7 @@ genExpectLit expLit expTy var = do
lit = LMLitVar $ LMIntLit expLit expTy
llvmExpectName
- | isInt expTy = fsLit $ "llvm.expect." ++ renderWithContext (llvmCgContext cfg) (ppr expTy)
+ | isInt expTy = fsLit $ "llvm.expect." ++ showSDocOneLine (llvmCgContext cfg) (ppr expTy)
| otherwise = panic "genExpectedLit: Type not an int!"
(llvmExpect, stmts, top) <-
@@ -1874,10 +1874,10 @@ genLoad_slow atomic e ty align meta = do
doExprW (cmmToLlvmType ty) (MExpr meta $ mkLoad atomic ptr align)
other -> pprPanic "exprToVar: CmmLoad expression is not right type!"
- (pdoc platform e <+> text (
- "Size of Ptr: " ++ show (llvmPtrBits platform) ++
- ", Size of var: " ++ show (llvmWidthInBits platform other) ++
- ", Var: " ++ renderWithContext (llvmCgContext cfg) (ppVar cfg iptr)))
+ (pdoc platform e $$
+ text "Size of Ptr:" <+> ppr (llvmPtrBits platform) $$
+ text "Size of var:" <+> ppr (llvmWidthInBits platform other) $$
+ text "Var:" <+> (ppVar cfg iptr))
{-
Note [Alignment of vector-typed values]
diff --git a/compiler/GHC/CmmToLlvm/Ppr.hs b/compiler/GHC/CmmToLlvm/Ppr.hs
index e71093adaf..8b0577bad7 100644
--- a/compiler/GHC/CmmToLlvm/Ppr.hs
+++ b/compiler/GHC/CmmToLlvm/Ppr.hs
@@ -56,7 +56,7 @@ pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
funDec <- llvmFunSig live lbl link
cfg <- getConfig
platform <- getPlatform
- let buildArg = fsLit . renderWithContext (llvmCgContext cfg). ppPlainName cfg
+ let buildArg = fsLit . showSDocOneLine (llvmCgContext cfg). ppPlainName cfg
funArgs = map buildArg (llvmFunArgs platform live)
funSect = llvmFunSection cfg (decName funDec)
diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs
index 017a733ec0..8dd6bb6f67 100644
--- a/compiler/GHC/Core/Unfold.hs
+++ b/compiler/GHC/Core/Unfold.hs
@@ -1213,7 +1213,7 @@ tryUnfolding logger opts !case_depth id lone_variable
, text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"]
ctx = log_default_dump_context (logFlags logger)
- str = "Considering inlining: " ++ renderWithContext ctx (ppr id)
+ str = "Considering inlining: " ++ showSDocOneLine ctx (ppr id)
n_val_args = length arg_infos
-- some_benefit is used when the RHS is small enough
diff --git a/compiler/GHC/HsToCore/Foreign/C.hs b/compiler/GHC/HsToCore/Foreign/C.hs
index 63350bf258..a35e3feca6 100644
--- a/compiler/GHC/HsToCore/Foreign/C.hs
+++ b/compiler/GHC/HsToCore/Foreign/C.hs
@@ -333,7 +333,7 @@ dsFCall fn_id co fcall mDeclHeader = do
toCName :: Id -> String
-toCName i = renderWithContext defaultSDocContext (pprCode (ppr (idName i)))
+toCName i = showSDocOneLine defaultSDocContext (pprCode (ppr (idName i)))
toCType :: Type -> (Maybe Header, SDoc)
toCType = f False
diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs
index 2ddba8ad18..177c3f2912 100644
--- a/compiler/GHC/StgToCmm/Bind.hs
+++ b/compiler/GHC/StgToCmm/Bind.hs
@@ -783,5 +783,5 @@ closureDescription
-- Not called for StgRhsCon which have global info tables built in
-- CgConTbls.hs with a description generated from the data constructor
closureDescription mod_name name
- = renderWithContext defaultSDocContext
+ = showSDocOneLine defaultSDocContext
(char '<' <> pprFullName mod_name name <> char '>')
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index 26ebb8a7f1..5b05e846d5 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -208,7 +208,7 @@ slowCall fun stg_args
r <- direct_call "slow_call" NativeNodeCall
(mkRtsApFastLabel rts_fun) arity ((P,Just fun):argsreps)
emitComment $ mkFastString ("slow_call for " ++
- renderWithContext ctx (pdoc platform fun) ++
+ showSDocOneLine ctx (pdoc platform fun) ++
" with pat " ++ unpackFS rts_fun)
return r
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index 4df4307737..c82a6ac1b5 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -20,7 +20,6 @@ module GHC.Tc.Gen.Pat
, tcCheckPat, tcCheckPat_O, tcInferPat
, tcPats
, addDataConStupidTheta
- , polyPatSig
)
where
@@ -36,7 +35,6 @@ import GHC.Tc.Utils.Zonk
import GHC.Tc.Gen.Sig( TcPragEnv, lookupPragEnv, addInlinePrags )
import GHC.Tc.Utils.Monad
import GHC.Tc.Utils.Instantiate
-import GHC.Types.Error
import GHC.Types.FieldLabel
import GHC.Types.Id
import GHC.Types.Var
@@ -1503,8 +1501,3 @@ checkGADT conlike ex_tvs arg_tys = \case
where
has_existentials :: Bool
has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs
-
-polyPatSig :: TcType -> SDoc
-polyPatSig sig_ty
- = hang (text "Illegal polymorphic type signature in pattern:")
- 2 (ppr sig_ty)
View Lorry Controller Status