Commit 8cdb98b9 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Make -dtrace-level a dynamic flag

parent 7c987d10
...@@ -616,6 +616,7 @@ data DynFlags = DynFlags { ...@@ -616,6 +616,7 @@ data DynFlags = DynFlags {
-- Output style options -- Output style options
pprUserLength :: Int, pprUserLength :: Int,
traceLevel :: Int, -- Standard level is 1. Less verbose is 0.
-- | what kind of {-# SCC #-} to add automatically -- | what kind of {-# SCC #-} to add automatically
profAuto :: ProfAuto, profAuto :: ProfAuto,
...@@ -974,6 +975,7 @@ defaultDynFlags mySettings = ...@@ -974,6 +975,7 @@ defaultDynFlags mySettings =
flushOut = defaultFlushOut, flushOut = defaultFlushOut,
flushErr = defaultFlushErr, flushErr = defaultFlushErr,
pprUserLength = 5, pprUserLength = 5,
traceLevel = 1,
profAuto = NoProfAuto, profAuto = NoProfAuto,
llvmVersion = panic "defaultDynFlags: No llvmVersion" llvmVersion = panic "defaultDynFlags: No llvmVersion"
} }
...@@ -1618,6 +1620,7 @@ dynamic_flags = [ ...@@ -1618,6 +1620,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 "dtrace-level" (intSuffix (\n d -> d{ traceLevel = n }))
------ Debugging ---------------------------------------------------- ------ Debugging ----------------------------------------------------
, Flag "dstg-stats" (NoArg (setDynFlag Opt_StgStats)) , Flag "dstg-stats" (NoArg (setDynFlag Opt_StgStats))
......
...@@ -28,7 +28,7 @@ module StaticFlags ( ...@@ -28,7 +28,7 @@ module StaticFlags (
-- Output style options -- Output style options
opt_PprCols, opt_PprCols,
opt_PprStyle_Debug, opt_TraceLevel, opt_PprStyle_Debug,
opt_NoDebugOutput, opt_NoDebugOutput,
-- Suppressing boring aspects of core dumps -- Suppressing boring aspects of core dumps
...@@ -266,10 +266,6 @@ opt_PprCols ...@@ -266,10 +266,6 @@ opt_PprCols
opt_PprStyle_Debug :: Bool opt_PprStyle_Debug :: Bool
opt_PprStyle_Debug = lookUp (fsLit "-dppr-debug") opt_PprStyle_Debug = lookUp (fsLit "-dppr-debug")
opt_TraceLevel :: Int
opt_TraceLevel = lookup_def_int "-dtrace-level" 1 -- Standard level is 1
-- Less verbose is 0
opt_Fuel :: Int opt_Fuel :: Int
opt_Fuel = lookup_def_int "-dopt-fuel" maxBound opt_Fuel = lookup_def_int "-dopt-fuel" maxBound
......
...@@ -432,9 +432,9 @@ traceTc = traceTcN 1 ...@@ -432,9 +432,9 @@ traceTc = traceTcN 1
traceTcN :: Int -> String -> SDoc -> TcRn () traceTcN :: Int -> String -> SDoc -> TcRn ()
traceTcN level herald doc traceTcN level herald doc
| level <= opt_TraceLevel = traceOptTcRn Opt_D_dump_tc_trace $ = do dflags <- getDynFlags
hang (text herald) 2 doc when (level <= traceLevel dflags) $
| otherwise = return () traceOptTcRn Opt_D_dump_tc_trace $ hang (text herald) 2 doc
traceRn, traceSplice :: SDoc -> TcRn () traceRn, traceSplice :: SDoc -> TcRn ()
traceRn = traceOptTcRn Opt_D_dump_rn_trace traceRn = traceOptTcRn Opt_D_dump_rn_trace
......
...@@ -34,7 +34,6 @@ import TcRnMonad ...@@ -34,7 +34,6 @@ import TcRnMonad
import ErrUtils import ErrUtils
import Outputable import Outputable
import DynFlags import DynFlags
import StaticFlags
import Control.Monad import Control.Monad
...@@ -125,10 +124,9 @@ emitVt herald doc ...@@ -125,10 +124,9 @@ emitVt herald doc
-- --
traceVt :: String -> SDoc -> VM () traceVt :: String -> SDoc -> VM ()
traceVt herald doc traceVt herald doc
| 1 <= opt_TraceLevel = liftDs $ = do dflags <- getDynFlags
traceOptIf Opt_D_dump_vt_trace $ when (1 <= traceLevel dflags) $
hang (text herald) 2 doc liftDs $ traceOptIf Opt_D_dump_vt_trace $ hang (text herald) 2 doc
| otherwise = return ()
-- |Dump the given program conditionally. -- |Dump the given program conditionally.
-- --
......
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