[commit: ghc] wip/nested-cpr: More tracing in the demand analyser (dc388b4)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nested-cpr
Link       : http://ghc.haskell.org/trac/ghc/changeset/dc388b4feb5f3e5c1317210627dfad13315dbcb6/ghc

>---------------------------------------------------------------

commit dc388b4feb5f3e5c1317210627dfad13315dbcb6
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Jan 21 13:59:51 2014 +0000

    More tracing in the demand analyser


>---------------------------------------------------------------

dc388b4feb5f3e5c1317210627dfad13315dbcb6
 compiler/stranal/DmdAnal.lhs |   14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index d25999e..9e9def0 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -188,8 +188,14 @@ dmdAnal env dmd (Lam var body)
 	env'		 = extendSigsWithLam env var
 	(body_ty, body') = dmdAnal env' body_dmd body
 	(lam_ty, var')   = annotateLamIdBndr env notArgOfDfun body_ty one_shot var
+        lam_ty'          = postProcessUnsat defer_and_use lam_ty
     in
-    (postProcessUnsat defer_and_use lam_ty, Lam var' body')
+    -- pprTrace "dmdAnal:Lam" (vcat [ text "dmd" <+> ppr dmd
+    --                              , text "body_ty" <+> ppr body_ty
+    --                              , text "lam_ty" <+> ppr lam_ty
+    --                              , text "lam_ty'" <+> ppr lam_ty'
+    --                              ]) $
+    (lam_ty', Lam var' body')
 
 dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, bndrs, _)])
   -- Only one alternative with a product constructor, and a complex scrutinee
@@ -337,6 +343,9 @@ dmdAnal env dmd (Let (Rec pairs) body)
         body_ty1                = deleteFVs body_ty (map fst pairs)
 	body_ty2	        = addLazyFVs body_ty1 lazy_fv 
     in
+    -- pprTrace "dmdAnal:LetRec" (vcat [ text "body_ty" <+> ppr body_ty
+    --                                 , text "body_ty1" <+> ppr body_ty1
+    --                                 , text "body_ty2" <+> ppr body_ty2]) $
     body_ty2 `seq`
     (body_ty2,  Let (Rec pairs') body')
 
@@ -390,6 +399,9 @@ dmdAnalAlt env dmd (con,bndrs,rhs)
 	io_hack_reqd = con == DataAlt unboxedPairDataCon &&
 		       idType (head bndrs) `eqType` realWorldStatePrimTy
     in
+    -- pprTrace "dmdAnalAlt" (vcat [ text "rhs_ty" <+> ppr rhs_ty
+    --                             , text "alt_ty" <+> ppr alt_ty
+    --                             ]) $
     (final_alt_ty, (con, bndrs', rhs'))
 \end{code}