Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
e6e3a960
Commit
e6e3a960
authored
Jun 18, 2012
by
Ian Lynagh
Browse files
Make -dppr-cols a dynamic flag
parent
42de5409
Changes
7
Hide whitespace changes
Inline
Side-by-side
compiler/main/DynFlags.hs
View file @
e6e3a960
...
...
@@ -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
View file @
e6e3a960
...
...
@@ -9,4 +9,5 @@ tracingDynFlags :: DynFlags
targetPlatform
::
DynFlags
->
Platform
pprUserLength
::
DynFlags
->
Int
pprCols
::
DynFlags
->
Int
compiler/main/StaticFlags.hs
View file @
e6e3a960
...
...
@@ -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
View file @
e6e3a960
...
...
@@ -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
View file @
e6e3a960
...
...
@@ -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
View file @
e6e3a960
...
...
@@ -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
View file @
e6e3a960
...
...
@@ -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>
stat
ic
</entry>
<entry>
dynam
ic
</entry>
<entry>
-
</entry>
</row>
<row>
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment