diff options
| -rw-r--r-- | compiler/codeGen/CgClosure.lhs | 4 | ||||
| -rw-r--r-- | compiler/rename/RnExpr.lhs | 2 | ||||
| -rw-r--r-- | compiler/typecheck/TcGenDeriv.lhs | 4 | ||||
| -rw-r--r-- | compiler/utils/Outputable.lhs | 15 |
4 files changed, 18 insertions, 7 deletions
diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs index 56f2847052..000f977342 100644 --- a/compiler/codeGen/CgClosure.lhs +++ b/compiler/codeGen/CgClosure.lhs @@ -599,11 +599,11 @@ closureDescription :: Module -- Module -- Not called for StgRhsCon which have global info tables built in -- CgConTbls.lhs with a description generated from the data constructor closureDescription mod_name name - = showSDocDump (char '<' <> + = showSDocDumpOneLine (char '<' <> (if isExternalName name then ppr name -- ppr will include the module name prefix else pprModule mod_name <> char '.' <> ppr name) <> char '>') - -- showSDocDump, because we want to see the unique on the Name. + -- showSDocDumpOneLine, because we want to see the unique on the Name. \end{code} diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index dcb8b97a43..103badca9e 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -1135,7 +1135,7 @@ segsToStmts ((defs, uses, fwds, ss) : segs) fvs_later \begin{code} srcSpanPrimLit :: SrcSpan -> HsExpr Name -srcSpanPrimLit span = HsLit (HsStringPrim (mkFastString (showSDoc (ppr span)))) +srcSpanPrimLit span = HsLit (HsStringPrim (mkFastString (showSDocOneLine (ppr span)))) mkAssertErrorExpr :: RnM (HsExpr Name) -- Return an expression for (assertError "Foo.hs:27") diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs index c579b94bf9..20029e758c 100644 --- a/compiler/typecheck/TcGenDeriv.lhs +++ b/compiler/typecheck/TcGenDeriv.lhs @@ -1098,7 +1098,7 @@ gen_Typeable_binds loc tycon [nlWildPat] (nlHsApps mkTypeRep_RDR [tycon_rep, nlList []]) where - tycon_rep = nlHsVar mkTyConRep_RDR `nlHsApp` nlHsLit (mkHsString (showSDoc (ppr tycon))) + tycon_rep = nlHsVar mkTyConRep_RDR `nlHsApp` nlHsLit (mkHsString (showSDocOneLine (ppr tycon))) mk_typeOf_RDR :: TyCon -> RdrName -- Use the arity of the TyCon to make the right typeOfn function @@ -1623,7 +1623,7 @@ genAuxBind loc (GenMaxTag tycon) genAuxBind loc (MkTyCon tycon) -- $dT = mkVarBind loc (mk_data_type_name tycon) ( nlHsVar mkDataType_RDR - `nlHsApp` nlHsLit (mkHsString (showSDoc (ppr tycon))) + `nlHsApp` nlHsLit (mkHsString (showSDocOneLine (ppr tycon))) `nlHsApp` nlList constrs ) where constrs = [nlHsVar (mk_constr_name con) | con <- tyConDataCons tycon] diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index 8c9c7c72e1..023d7d01d1 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -36,7 +36,9 @@ module Outputable ( printSDoc, printErrs, hPrintDump, printDump, printForC, printForAsm, printForUser, printForUserPartWay, pprCode, mkCodeStyle, - showSDoc, showSDocForUser, showSDocDebug, showSDocDump, showPpr, + showSDoc, showSDocOneLine, + showSDocForUser, showSDocDebug, showSDocDump, showSDocDumpOneLine, + showPpr, showSDocUnqual, showsPrecSDoc, pprInfixVar, pprPrefixVar, @@ -318,6 +320,12 @@ mkCodeStyle = PprCode showSDoc :: SDoc -> String showSDoc d = Pretty.showDocWith PageMode (d defaultUserStyle) +-- This shows an SDoc, but on one line only. It's cheaper than a full +-- showSDoc, designed for when we're getting results like "Foo.bar" +-- and "foo{uniq strictness}" so we don't want fancy layout anyway. +showSDocOneLine :: SDoc -> String +showSDocOneLine d = Pretty.showDocWith PageMode (d defaultUserStyle) + showSDocForUser :: PrintUnqualified -> SDoc -> String showSDocForUser unqual doc = show (doc (mkUserStyle unqual AllTheWay)) @@ -329,7 +337,10 @@ showsPrecSDoc :: Int -> SDoc -> ShowS showsPrecSDoc p d = showsPrec p (d defaultUserStyle) showSDocDump :: SDoc -> String -showSDocDump d = show (d PprDump) +showSDocDump d = Pretty.showDocWith PageMode (d PprDump) + +showSDocDumpOneLine :: SDoc -> String +showSDocDumpOneLine d = Pretty.showDocWith OneLineMode (d PprDump) showSDocDebug :: SDoc -> String showSDocDebug d = show (d PprDebug) |