Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-new-flavor
http://hackage.haskell.org/trac/ghc/changeset/2183c8797ea7736ad90ff2bd4b922a1e52331f83 >--------------------------------------------------------------- commit 2183c8797ea7736ad90ff2bd4b922a1e52331f83 Author: Dimitrios.Vytiniotis <[email protected]> Date: Wed Apr 4 12:52:39 2012 +0100 More informative tracing for ddump-cs-trace >--------------------------------------------------------------- compiler/typecheck/TcInteract.lhs | 15 +++++++++------ compiler/typecheck/TcSMonad.lhs | 1 + 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index 7dfc75e..1887399 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/compiler/typecheck/TcInteract.lhs @@ -268,8 +268,7 @@ spontaneousSolveStage workItem spont_solve (SPSolved workItem') -- Post: workItem' must be equality = do { bumpStepCountTcS ; traceFireTcS (cc_depth workItem) $ - ptext (sLit "Spontaneous") - <+> parens (ppr (cc_flavor workItem)) <+> ppr workItem + ptext (sLit "Spontaneous:") <+> ppr workItem -- NB: will add the item in the inerts ; kickOutRewritableInerts workItem' @@ -669,9 +668,9 @@ interactWithInertsStage wi interact_next (ContinueWith wi) atomic_inert = do { ir <- doInteractWithInert atomic_inert wi ; let mk_msg rule keep_doc - = text rule <+> keep_doc - <+> vcat [ ptext (sLit "Inert =") <+> ppr atomic_inert - , ptext (sLit "Work =") <+> ppr wi ] + = vcat [ text rule <+> keep_doc + , ptext (sLit "InertItem =") <+> ppr atomic_inert + , ptext (sLit "WorkItem =") <+> ppr wi ] ; case ir of IRWorkItemConsumed { ir_fire = rule } -> do { bumpStepCountTcS @@ -1424,7 +1423,8 @@ tryTopReact wi SomeTopInt rule what_next -> do { bumpStepCountTcS ; traceFireTcS (cc_depth wi) $ - ptext (sLit "Top react:") <+> text rule + vcat [ ptext (sLit "Top react:") <+> text rule + , text "WorkItem =" <+> ppr wi ] ; return what_next } } } @@ -1851,6 +1851,9 @@ matchClassInst inerts clas tys loc = do { let pred = mkClassPred clas tys ; mb_result <- matchClass clas tys ; untch <- getUntouchables + ; traceTcS "matchClassInst" $ vcat [ text "pred =" <+> ppr pred + , text "inerts=" <+> ppr inerts + , text "untouchables=" <+> ppr untch ] ; case mb_result of MatchInstNo -> return NoInstance MatchInstMany -> return NoInstance -- defer any reactions of a multitude until diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index 75cca7d..650d382 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1453,6 +1453,7 @@ matchClass :: Class -> [Type] -> TcS (MatchInstResult (DFunId, [Either TyVar TcT matchClass clas tys = do { let pred = mkClassPred clas tys ; instEnvs <- getInstEnvs + ; traceTcS "matchClass" $ text "instEnvs=" <+> ppr instEnvs ; case lookupInstEnv instEnvs clas tys of { ([], unifs, _) -- Nothing matches -> do { traceTcS "matchClass not matching" _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
