projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
692cbe6
)
Make some showSDoc's use OneLineMode rather than PageMode
author
Ian Lynagh
<igloo@earth.li>
Tue, 31 Mar 2009 18:19:48 +0000
(18:19 +0000)
committer
Ian Lynagh
<igloo@earth.li>
Tue, 31 Mar 2009 18:19:48 +0000
(18:19 +0000)
compiler/codeGen/CgClosure.lhs
patch
|
blob
|
history
compiler/rename/RnExpr.lhs
patch
|
blob
|
history
compiler/typecheck/TcGenDeriv.lhs
patch
|
blob
|
history
compiler/utils/Outputable.lhs
patch
|
blob
|
history
diff --git
a/compiler/codeGen/CgClosure.lhs
b/compiler/codeGen/CgClosure.lhs
index
56f2847
..
000f977
100644
(file)
--- 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
-- 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 '>')
(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}
\end{code}
diff --git
a/compiler/rename/RnExpr.lhs
b/compiler/rename/RnExpr.lhs
index
dcb8b97
..
103badc
100644
(file)
--- 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
\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")
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
c579b94
..
20029e7
100644
(file)
--- 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
[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
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
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]
`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
8c9c7c7
..
023d7d0
100644
(file)
--- 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,
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,
showSDocUnqual, showsPrecSDoc,
pprInfixVar, pprPrefixVar,
@@
-318,6
+320,12
@@
mkCodeStyle = PprCode
showSDoc :: SDoc -> String
showSDoc d = Pretty.showDocWith PageMode (d defaultUserStyle)
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))
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
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)
showSDocDebug :: SDoc -> String
showSDocDebug d = show (d PprDebug)