Make some showSDoc's use OneLineMode rather than PageMode
authorIan Lynagh <igloo@earth.li>
Tue, 31 Mar 2009 18:19:48 +0000 (18:19 +0000)
committerIan Lynagh <igloo@earth.li>
Tue, 31 Mar 2009 18:19:48 +0000 (18:19 +0000)
compiler/codeGen/CgClosure.lhs
compiler/rename/RnExpr.lhs
compiler/typecheck/TcGenDeriv.lhs
compiler/utils/Outputable.lhs

index 56f2847..000f977 100644 (file)
@@ -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}
   
index dcb8b97..103badc 100644 (file)
@@ -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")
index c579b94..20029e7 100644 (file)
@@ -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]
index 8c9c7c7..023d7d0 100644 (file)
@@ -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)