[commit: ghc] master: Traces and comments only (821b077)

Simon Peyton Jones simonpj at microsoft.com
Thu Jun 6 15:30:37 CEST 2013


Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/821b077fc44e649af06537b2aab2e776ce6efaa6

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

commit 821b077fc44e649af06537b2aab2e776ce6efaa6
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Jun 5 17:46:42 2013 +0100

    Traces and comments only

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

 compiler/stranal/DmdAnal.lhs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 07c592b..572a39d 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -250,7 +250,6 @@ dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)])
     in
 --    pprTrace "dmdAnal:Case1" (vcat [ text "scrut" <+> ppr scrut
 --                                   , text "dmd" <+> ppr dmd
---                                   , text "alt_dmd" <+> ppr alt_dmd
 --                                   , text "case_bndr_dmd" <+> ppr (idDemandInfo case_bndr')
 --                                   , text "scrut_dmd" <+> ppr scrut_dmd
 --                                   , text "scrut_ty" <+> ppr scrut_ty
@@ -262,11 +261,12 @@ dmdAnal env dmd (Case scrut case_bndr ty alts)
   = let      -- Case expression with multiple alternatives
 	(alt_tys, alts')     = mapAndUnzip (dmdAnalAlt env dmd) alts
 	(scrut_ty, scrut')   = dmdAnal env cleanEvalDmd scrut
-	(alt_ty, case_bndr') = annotateBndr env(foldr lubDmdType botDmdType alt_tys) case_bndr
+	(alt_ty, case_bndr') = annotateBndr env (foldr lubDmdType botDmdType alt_tys) case_bndr
         res_ty               = alt_ty `bothDmdType` scrut_ty
     in
 --    pprTrace "dmdAnal:Case2" (vcat [ text "scrut" <+> ppr scrut
 --                                   , text "scrut_ty" <+> ppr scrut_ty
+--                                   , text "alt_tys" <+> ppr alt_tys
 --                                   , text "alt_ty" <+> ppr alt_ty
 --                                   , text "res_ty" <+> ppr res_ty ]) $
     (res_ty, Case scrut' case_bndr' ty alts')
@@ -482,7 +482,7 @@ dmdTransform env var dmd
 
   | isGlobalId var	                         -- Imported function
   = let res = dmdTransformSig (idStrictness var) dmd in
-    -- pprTrace "dmdTransform" (vcat [ppr var, ppr dmd, ppr res]) 
+--    pprTrace "dmdTransform" (vcat [ppr var, ppr (idStrictness var), ppr dmd, ppr res]) 
     res
 
   | Just (sig, top_lvl) <- lookupSigEnv env var  -- Local letrec bound thing
@@ -762,11 +762,11 @@ annotateLamIdBndr :: AnalEnv
 		  -> (DmdType, 	-- Demand type of lambda
 		      Id)	-- and binder annotated with demand	
 
-annotateLamIdBndr env (DmdType fv ds res) one_shot id
+annotateLamIdBndr env _dmd_ty@(DmdType fv ds res) one_shot id
 -- For lambdas we add the demand to the argument demands
 -- Only called for Ids
   = ASSERT( isId id )
-    -- pprTrace "annLamBndr" (vcat [ppr id, ppr dmd_ty]) $
+    -- pprTrace "annLamBndr" (vcat [ppr id, ppr _dmd_ty]) $
     (final_ty, setOneShotness one_shot (set_idDemandInfo env id dmd))
   where
       -- Watch out!  See note [Lambda-bound unfoldings]





More information about the ghc-commits mailing list