Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/89eb9e92f2c243c831342e111d071a20ad9197da >--------------------------------------------------------------- commit 89eb9e92f2c243c831342e111d071a20ad9197da Author: Simon Peyton Jones <simo...@microsoft.com> Date: Mon Dec 24 13:20:59 2012 +0000 Add traceSmpl for simplifier tracing, now that the simplifier has the IO monad >--------------------------------------------------------------- compiler/main/DynFlags.hs | 3 +++ compiler/simplCore/SimplMonad.lhs | 10 +++++++++- 2 files changed, 12 insertions(+), 1 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c052014..5de11c8 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -202,6 +202,7 @@ data DumpFlag | Opt_D_dump_inlinings | Opt_D_dump_rule_firings | Opt_D_dump_rule_rewrites + | Opt_D_dump_simpl_trace | Opt_D_dump_occur_anal | Opt_D_dump_parsed | Opt_D_dump_rn @@ -1428,6 +1429,7 @@ dopt f dflags = (fromEnum f `IntSet.member` dumpFlags dflags) enableIfVerbose Opt_D_dump_splices = False enableIfVerbose Opt_D_dump_rule_firings = False enableIfVerbose Opt_D_dump_rule_rewrites = False + enableIfVerbose Opt_D_dump_simpl_trace = False enableIfVerbose Opt_D_dump_rtti = False enableIfVerbose Opt_D_dump_inlinings = False enableIfVerbose Opt_D_dump_core_stats = False @@ -2091,6 +2093,7 @@ dynamic_flags = [ , Flag "ddump-inlinings" (setDumpFlag Opt_D_dump_inlinings) , Flag "ddump-rule-firings" (setDumpFlag Opt_D_dump_rule_firings) , Flag "ddump-rule-rewrites" (setDumpFlag Opt_D_dump_rule_rewrites) + , Flag "ddump-simpl-trace" (setDumpFlag Opt_D_dump_simpl_trace) , Flag "ddump-occur-anal" (setDumpFlag Opt_D_dump_occur_anal) , Flag "ddump-parsed" (setDumpFlag Opt_D_dump_parsed) , Flag "ddump-rn" (setDumpFlag Opt_D_dump_rn) diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs index 50d133f..a5eb116 100644 --- a/compiler/simplCore/SimplMonad.lhs +++ b/compiler/simplCore/SimplMonad.lhs @@ -7,7 +7,7 @@ module SimplMonad ( -- The monad SimplM, - initSmpl, + initSmpl, traceSmpl, getSimplRules, getFamEnvs, -- Unique supply @@ -29,6 +29,7 @@ import CoreMonad import Outputable import FastString import MonadUtils +import Control.Monad ( when ) \end{code} %************************************************************************ @@ -121,6 +122,13 @@ thenSmpl_ m k -- {-# SPECIALIZE mapM :: (a -> SimplM b) -> [a] -> SimplM [b] #-} -- {-# SPECIALIZE mapAndUnzipM :: (a -> SimplM (b, c)) -> [a] -> SimplM ([b],[c]) #-} -- {-# SPECIALIZE mapAccumLM :: (acc -> b -> SimplM (acc,c)) -> acc -> [b] -> SimplM (acc, [c]) #-} + +traceSmpl :: String -> SDoc -> SimplM () +traceSmpl herald doc + = do { dflags <- getDynFlags + ; when (dopt Opt_D_dump_simpl_trace dflags) $ liftIO $ + printInfoForUser dflags alwaysQualify $ + hang (text herald) 2 doc } \end{code} _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
