Commit e6e3a960 authored by Ian Lynagh's avatar Ian Lynagh

Make -dppr-cols a dynamic flag

parent 42de5409
......@@ -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 ----------------------------------------------------
......
......@@ -9,4 +9,5 @@ tracingDynFlags :: DynFlags
targetPlatform :: DynFlags -> Platform
pprUserLength :: DynFlags -> Int
pprCols :: DynFlags -> Int
......@@ -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")
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment