[commit: ghc] supercompiler: Put the bulk of the tracing under flag control (521b522)
Max Bolingbroke <[email protected]>
| Newsgroups | gmane.comp.lang.haskell.cvs.ghc |
|---|---|
| Message-ID | <[email protected]> |
Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : supercompiler http://hackage.haskell.org/trac/ghc/changeset/521b5228c464876605779ac7a7cbde4e204b07f9 >--------------------------------------------------------------- commit 521b5228c464876605779ac7a7cbde4e204b07f9 Author: Max Bolingbroke <[email protected]> Date: Wed Mar 14 14:38:38 2012 +0000 Put the bulk of the tracing under flag control >--------------------------------------------------------------- .../supercompile/Supercompile/Drive/Process3.hs | 4 +++- compiler/supercompile/Supercompile/StaticFlags.hs | 4 ++++ 2 files changed, 7 insertions(+), 1 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/Process3.hs b/compiler/supercompile/Supercompile/Drive/Process3.hs index d127ec1..d1553bb 100644 --- a/compiler/supercompile/Supercompile/Drive/Process3.hs +++ b/compiler/supercompile/Supercompile/Drive/Process3.hs @@ -207,7 +207,9 @@ scpDepth :: ScpEnv -> Int scpDepth = length . scpParents traceRenderM :: Outputable a => String -> a -> ScpM () -traceRenderM msg x = ScpM $ StateT $ \s -> ReaderT $ \env -> pprTraceSC (replicate (scpDepth env) ' ' ++ msg) (pPrint x) $ pure ((), s) -- TODO: include depth, refine to ScpM monad only +traceRenderM msg x + | tRACE = ScpM $ StateT $ \s -> ReaderT $ \env -> pprTraceSC (replicate (scpDepth env) ' ' ++ msg) (pPrint x) $ pure ((), s) + | otherwise = return () addParentM :: Promise -> (State -> ScpM (Bool, (Deeds, FVedTerm))) -> State -> ScpM (Deeds, FVedTerm) addParentM p opt state = ScpM $ StateT $ \s -> ReaderT $ add_parent s diff --git a/compiler/supercompile/Supercompile/StaticFlags.hs b/compiler/supercompile/Supercompile/StaticFlags.hs index f69314f..f989ed3 100644 --- a/compiler/supercompile/Supercompile/StaticFlags.hs +++ b/compiler/supercompile/Supercompile/StaticFlags.hs @@ -216,3 +216,7 @@ rEDUCE_ROLLBACK = not $ lookUp $ fsLit "-fsupercompiler-no-reduce-rollback" sC_ROLLBACK :: Bool sC_ROLLBACK = not $ lookUp $ fsLit "-fsupercompiler-no-sc-rollback" + + +tRACE :: Bool +tRACE = lookUp $ fsLit "-fsupercompiler-trace"