Make -dppr-cols a dynamic flag

compiler/main/DynFlags.hs

@@ -616,6 +616,7 @@ data DynFlags = DynFlags {
 
   -- Output style options
   pprUserLength         :: Int,
+  pprCols               :: Int,
   traceLevel            :: Int, -- Standard level is 1. Less verbose is 0.
 
   -- | what kind of {-# SCC #-} to add automatically
@@ -975,6 +976,7 @@ defaultDynFlags mySettings =
         flushOut = defaultFlushOut,
         flushErr = defaultFlushErr,
         pprUserLength = 5,
+        pprCols = 100,
         traceLevel = 1,
         profAuto = NoProfAuto,
         llvmVersion = panic "defaultDynFlags: No llvmVersion"
@@ -1013,7 +1015,8 @@ defaultLogAction dflags severity srcSpan style msg
 
 defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()
 defaultLogActionHPrintDoc dflags h d sty
-    = do Pretty.printDoc Pretty.PageMode h (runSDoc d (initSDocContext dflags sty))
+    = do let doc = runSDoc d (initSDocContext dflags sty)
+         Pretty.printDoc Pretty.PageMode (pprCols dflags) h doc
          hFlush h
 
 newtype FlushOut = FlushOut (IO ())
@@ -1620,6 +1623,7 @@ dynamic_flags = [
 
         ------ Output style options -----------------------------------------
   , Flag "dppr-user-length" (intSuffix (\n d -> d{ pprUserLength = n }))
+  , Flag "dppr-cols"        (intSuffix (\n d -> d{ pprCols = n }))
   , Flag "dtrace-level"     (intSuffix (\n d -> d{ traceLevel = n }))
 
         ------ Debugging ----------------------------------------------------

compiler/main/DynFlags.hs-boot

@@ -9,4 +9,5 @@ tracingDynFlags :: DynFlags
 
 targetPlatform :: DynFlags -> Platform
 pprUserLength :: DynFlags -> Int
+pprCols :: DynFlags -> Int
 

compiler/main/StaticFlags.hs

@@ -27,7 +27,6 @@ module StaticFlags (
 	WayName(..), Way(..), v_Ways, isRTSWay, mkBuildTag,
 
 	-- Output style options
-	opt_PprCols,
 	opt_PprStyle_Debug,
         opt_NoDebugOutput,
 
@@ -249,19 +248,6 @@ opt_SuppressUniques :: Bool
 opt_SuppressUniques
 	=  lookUp  (fsLit "-dsuppress-uniques")
 
--- | Set the maximum width of the dumps
---   If GHC's command line options are bad then the options parser uses the
---   pretty printer display the error message. In this case the staticFlags
---   won't be initialized yet, so we must check for this case explicitly
---   and return the default value.
-opt_PprCols :: Int
-opt_PprCols
- = unsafePerformIO
- $ do	ready <- readIORef v_opt_C_ready
-	if (not ready)
-		then return 100
-		else return $ lookup_def_int "-dppr-cols" 100
-
 
 opt_PprStyle_Debug  :: Bool
 opt_PprStyle_Debug              = lookUp  (fsLit "-dppr-debug")

compiler/nativeGen/AsmCodeGen.lhs

@@ -259,7 +259,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
                                 $ Linear.pprStats (concat native) stats)
 
         -- write out the imports
-        Pretty.printDoc Pretty.LeftMode h
+        Pretty.printDoc Pretty.LeftMode (pprCols dflags) h
                 $ withPprStyleDoc dflags (mkCodeStyle AsmStyle)
                 $ makeImportsDoc dflags (concat imports)
 

compiler/utils/Outputable.lhs

@@ -72,7 +72,7 @@ module Outputable (
     ) where
 
 import {-# SOURCE #-}   DynFlags( DynFlags, tracingDynFlags,
-                                  targetPlatform, pprUserLength )
+                                  targetPlatform, pprUserLength, pprCols )
 import {-# SOURCE #-}   Module( Module, ModuleName, moduleName )
 import {-# SOURCE #-}   Name( Name, nameModule )
 
@@ -332,7 +332,7 @@ ifPprDebug d = SDoc $ \ctx ->
 \begin{code}
 hPrintDump :: DynFlags -> Handle -> SDoc -> IO ()
 hPrintDump dflags h doc = do
-   Pretty.printDoc PageMode h
+   Pretty.printDoc PageMode (pprCols dflags) h
      (runSDoc better_doc (initSDocContext dflags defaultDumpStyle))
    hFlush h
  where
@@ -340,24 +340,24 @@ hPrintDump dflags h doc = do
 
 printForUser :: DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO ()
 printForUser dflags handle unqual doc
-  = Pretty.printDoc PageMode handle
+  = Pretty.printDoc PageMode (pprCols dflags) handle
       (runSDoc doc (initSDocContext dflags (mkUserStyle unqual AllTheWay)))
 
 printForUserPartWay :: DynFlags -> Handle -> Int -> PrintUnqualified -> SDoc
                     -> IO ()
 printForUserPartWay dflags handle d unqual doc
-  = Pretty.printDoc PageMode handle
+  = Pretty.printDoc PageMode (pprCols dflags) handle
       (runSDoc doc (initSDocContext dflags (mkUserStyle unqual (PartWay d))))
 
 -- printForC, printForAsm do what they sound like
 printForC :: DynFlags -> Handle -> SDoc -> IO ()
 printForC dflags handle doc =
-  Pretty.printDoc LeftMode handle
+  Pretty.printDoc LeftMode (pprCols dflags) handle
     (runSDoc doc (initSDocContext dflags (PprCode CStyle)))
 
 printForAsm :: DynFlags -> Handle -> SDoc -> IO ()
 printForAsm dflags handle doc =
-  Pretty.printDoc LeftMode handle
+  Pretty.printDoc LeftMode (pprCols dflags) handle
     (runSDoc doc (initSDocContext dflags (PprCode AsmStyle)))
 
 pprCode :: CodeStyle -> SDoc -> SDoc

compiler/utils/Pretty.lhs

@@ -1002,13 +1002,10 @@ spaces n | n <=# _ILIT(0) = ""
 \end{code}
 
 \begin{code}
-pprCols :: Int
-pprCols = opt_PprCols
-
-printDoc :: Mode -> Handle -> Doc -> IO ()
-printDoc LeftMode hdl doc
+printDoc :: Mode -> Int -> Handle -> Doc -> IO ()
+printDoc LeftMode _ hdl doc
   = do { printLeftRender hdl doc; hFlush hdl }
-printDoc mode hdl doc
+printDoc mode pprCols hdl doc
   = do { fullRender mode pprCols 1.5 put done doc ;
          hFlush hdl }
   where

docs/users_guide/flags.xml

@@ -2718,7 +2718,7 @@
           <row>
             <entry><option>-dppr-colsNNN</option></entry>
             <entry>Set the width of debugging output. For example <option>-dppr-cols200</option></entry>
-            <entry>static</entry>
+            <entry>dynamic</entry>
             <entry>-</entry>
           </row>
           <row>