Commit e6e3a960 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Make -dppr-cols a dynamic flag

parent 42de5409
...@@ -616,6 +616,7 @@ data DynFlags = DynFlags { ...@@ -616,6 +616,7 @@ data DynFlags = DynFlags {
-- Output style options -- Output style options
pprUserLength :: Int, pprUserLength :: Int,
pprCols :: Int,
traceLevel :: Int, -- Standard level is 1. Less verbose is 0. traceLevel :: Int, -- Standard level is 1. Less verbose is 0.
-- | what kind of {-# SCC #-} to add automatically -- | what kind of {-# SCC #-} to add automatically
...@@ -975,6 +976,7 @@ defaultDynFlags mySettings = ...@@ -975,6 +976,7 @@ defaultDynFlags mySettings =
flushOut = defaultFlushOut, flushOut = defaultFlushOut,
flushErr = defaultFlushErr, flushErr = defaultFlushErr,
pprUserLength = 5, pprUserLength = 5,
pprCols = 100,
traceLevel = 1, traceLevel = 1,
profAuto = NoProfAuto, profAuto = NoProfAuto,
llvmVersion = panic "defaultDynFlags: No llvmVersion" llvmVersion = panic "defaultDynFlags: No llvmVersion"
...@@ -1013,7 +1015,8 @@ defaultLogAction dflags severity srcSpan style msg ...@@ -1013,7 +1015,8 @@ defaultLogAction dflags severity srcSpan style msg
defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO () defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()
defaultLogActionHPrintDoc dflags h d sty 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 hFlush h
newtype FlushOut = FlushOut (IO ()) newtype FlushOut = FlushOut (IO ())
...@@ -1620,6 +1623,7 @@ dynamic_flags = [ ...@@ -1620,6 +1623,7 @@ dynamic_flags = [
------ Output style options ----------------------------------------- ------ Output style options -----------------------------------------
, Flag "dppr-user-length" (intSuffix (\n d -> d{ pprUserLength = n })) , 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 })) , Flag "dtrace-level" (intSuffix (\n d -> d{ traceLevel = n }))
------ Debugging ---------------------------------------------------- ------ Debugging ----------------------------------------------------
......
...@@ -9,4 +9,5 @@ tracingDynFlags :: DynFlags ...@@ -9,4 +9,5 @@ tracingDynFlags :: DynFlags
targetPlatform :: DynFlags -> Platform targetPlatform :: DynFlags -> Platform
pprUserLength :: DynFlags -> Int pprUserLength :: DynFlags -> Int
pprCols :: DynFlags -> Int
...@@ -27,7 +27,6 @@ module StaticFlags ( ...@@ -27,7 +27,6 @@ module StaticFlags (
WayName(..), Way(..), v_Ways, isRTSWay, mkBuildTag, WayName(..), Way(..), v_Ways, isRTSWay, mkBuildTag,
-- Output style options -- Output style options
opt_PprCols,
opt_PprStyle_Debug, opt_PprStyle_Debug,
opt_NoDebugOutput, opt_NoDebugOutput,
...@@ -249,19 +248,6 @@ opt_SuppressUniques :: Bool ...@@ -249,19 +248,6 @@ opt_SuppressUniques :: Bool
opt_SuppressUniques opt_SuppressUniques
= lookUp (fsLit "-dsuppress-uniques") = 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 :: Bool
opt_PprStyle_Debug = lookUp (fsLit "-dppr-debug") opt_PprStyle_Debug = lookUp (fsLit "-dppr-debug")
......
...@@ -259,7 +259,7 @@ nativeCodeGen' dflags ncgImpl h us cmms ...@@ -259,7 +259,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
$ Linear.pprStats (concat native) stats) $ Linear.pprStats (concat native) stats)
-- write out the imports -- write out the imports
Pretty.printDoc Pretty.LeftMode h Pretty.printDoc Pretty.LeftMode (pprCols dflags) h
$ withPprStyleDoc dflags (mkCodeStyle AsmStyle) $ withPprStyleDoc dflags (mkCodeStyle AsmStyle)
$ makeImportsDoc dflags (concat imports) $ makeImportsDoc dflags (concat imports)
......
...@@ -72,7 +72,7 @@ module Outputable ( ...@@ -72,7 +72,7 @@ module Outputable (
) where ) where
import {-# SOURCE #-} DynFlags( DynFlags, tracingDynFlags, import {-# SOURCE #-} DynFlags( DynFlags, tracingDynFlags,
targetPlatform, pprUserLength ) targetPlatform, pprUserLength, pprCols )
import {-# SOURCE #-} Module( Module, ModuleName, moduleName ) import {-# SOURCE #-} Module( Module, ModuleName, moduleName )
import {-# SOURCE #-} Name( Name, nameModule ) import {-# SOURCE #-} Name( Name, nameModule )
...@@ -332,7 +332,7 @@ ifPprDebug d = SDoc $ \ctx -> ...@@ -332,7 +332,7 @@ ifPprDebug d = SDoc $ \ctx ->
\begin{code} \begin{code}
hPrintDump :: DynFlags -> Handle -> SDoc -> IO () hPrintDump :: DynFlags -> Handle -> SDoc -> IO ()
hPrintDump dflags h doc = do hPrintDump dflags h doc = do
Pretty.printDoc PageMode h Pretty.printDoc PageMode (pprCols dflags) h
(runSDoc better_doc (initSDocContext dflags defaultDumpStyle)) (runSDoc better_doc (initSDocContext dflags defaultDumpStyle))
hFlush h hFlush h
where where
...@@ -340,24 +340,24 @@ hPrintDump dflags h doc = do ...@@ -340,24 +340,24 @@ hPrintDump dflags h doc = do
printForUser :: DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO () printForUser :: DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO ()
printForUser dflags handle unqual doc printForUser dflags handle unqual doc
= Pretty.printDoc PageMode handle = Pretty.printDoc PageMode (pprCols dflags) handle
(runSDoc doc (initSDocContext dflags (mkUserStyle unqual AllTheWay))) (runSDoc doc (initSDocContext dflags (mkUserStyle unqual AllTheWay)))
printForUserPartWay :: DynFlags -> Handle -> Int -> PrintUnqualified -> SDoc printForUserPartWay :: DynFlags -> Handle -> Int -> PrintUnqualified -> SDoc
-> IO () -> IO ()
printForUserPartWay dflags handle d unqual doc printForUserPartWay dflags handle d unqual doc
= Pretty.printDoc PageMode handle = Pretty.printDoc PageMode (pprCols dflags) handle
(runSDoc doc (initSDocContext dflags (mkUserStyle unqual (PartWay d)))) (runSDoc doc (initSDocContext dflags (mkUserStyle unqual (PartWay d))))
-- printForC, printForAsm do what they sound like -- printForC, printForAsm do what they sound like
printForC :: DynFlags -> Handle -> SDoc -> IO () printForC :: DynFlags -> Handle -> SDoc -> IO ()
printForC dflags handle doc = printForC dflags handle doc =
Pretty.printDoc LeftMode handle Pretty.printDoc LeftMode (pprCols dflags) handle
(runSDoc doc (initSDocContext dflags (PprCode CStyle))) (runSDoc doc (initSDocContext dflags (PprCode CStyle)))
printForAsm :: DynFlags -> Handle -> SDoc -> IO () printForAsm :: DynFlags -> Handle -> SDoc -> IO ()
printForAsm dflags handle doc = printForAsm dflags handle doc =
Pretty.printDoc LeftMode handle Pretty.printDoc LeftMode (pprCols dflags) handle
(runSDoc doc (initSDocContext dflags (PprCode AsmStyle))) (runSDoc doc (initSDocContext dflags (PprCode AsmStyle)))
pprCode :: CodeStyle -> SDoc -> SDoc pprCode :: CodeStyle -> SDoc -> SDoc
......
...@@ -1002,13 +1002,10 @@ spaces n | n <=# _ILIT(0) = "" ...@@ -1002,13 +1002,10 @@ spaces n | n <=# _ILIT(0) = ""
\end{code} \end{code}
\begin{code} \begin{code}
pprCols :: Int printDoc :: Mode -> Int -> Handle -> Doc -> IO ()
pprCols = opt_PprCols printDoc LeftMode _ hdl doc
printDoc :: Mode -> Handle -> Doc -> IO ()
printDoc LeftMode hdl doc
= do { printLeftRender hdl doc; hFlush hdl } = do { printLeftRender hdl doc; hFlush hdl }
printDoc mode hdl doc printDoc mode pprCols hdl doc
= do { fullRender mode pprCols 1.5 put done doc ; = do { fullRender mode pprCols 1.5 put done doc ;
hFlush hdl } hFlush hdl }
where where
......
...@@ -2718,7 +2718,7 @@ ...@@ -2718,7 +2718,7 @@
<row> <row>
<entry><option>-dppr-colsNNN</option></entry> <entry><option>-dppr-colsNNN</option></entry>
<entry>Set the width of debugging output. For example <option>-dppr-cols200</option></entry> <entry>Set the width of debugging output. For example <option>-dppr-cols200</option></entry>
<entry>static</entry> <entry>dynamic</entry>
<entry>-</entry> <entry>-</entry>
</row> </row>
<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