From: simonpj <unknown>
Date: Wed, 25 Jul 2001 09:19:41 +0000 (+0000)
Subject: [project @ 2001-07-25 09:19:41 by simonpj]
X-Git-Tag: Approximately_9120_patches~1415
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=a47868d5ea4f696e9beb3e4ecbd13c6fd14c676c;p=ghc-hetmet.git

[project @ 2001-07-25 09:19:41 by simonpj]
---------------------------------
	Another long-standing infelicity!
	---------------------------------

CoreTidy was throwing away demand info on let-binders.
This meant that CorePrep would build a let (thunk) instead of
a case, even if the Id is sure to be demanded.

Easily fixed by making CoreTidy retain the demand info.

This demand-analysis stuff is having the excellent side effect
of flushing out performance bugs!
---

diff --git a/ghc/compiler/coreSyn/CoreTidy.lhs b/ghc/compiler/coreSyn/CoreTidy.lhs
index d0234ce..2f45691 100644
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -22,10 +22,11 @@ import Var		( Id, Var )
 import Id		( idType, idInfo, idName, isExportedId, 
 			  idSpecialisation, idUnique, isDataConWrapId,
 			  mkVanillaGlobal, isLocalId, isRecordSelector,
-			  setIdUnfolding, hasNoBinding, mkUserLocal
+			  setIdUnfolding, hasNoBinding, mkUserLocal,
+			  idNewDemandInfo, setIdNewDemandInfo
 			) 
 import IdInfo		{- loads of stuff -}
-import NewDemand	( isBottomingSig, topSig )
+import NewDemand	( isBottomingSig, topSig, isStrictDmd )
 import Name		( getOccName, nameOccName, globaliseName, setNameOcc, 
 		  	  localiseName, isGlobalName, setNameUnique
 			)
@@ -617,7 +618,15 @@ tidyBndrs env vars = mapAccumL tidyBndr env vars
 
 -- tidyBndrWithRhs is used for let binders
 tidyBndrWithRhs :: TidyEnv -> (Id, CoreExpr) -> (TidyEnv, Var)
-tidyBndrWithRhs env (id,rhs) = tidyId env id
+tidyBndrWithRhs env (id,rhs) 
+  = add_dmd_info (tidyId env id)
+  where
+	-- We add demand info for let(rec) binders, because
+	-- that's what tells CorePrep to generate a case instead of a thunk
+    add_dmd_info (env,new_id) 
+	| isStrictDmd dmd_info = (env, setIdNewDemandInfo new_id dmd_info)
+	| otherwise	       = (env, new_id)
+    dmd_info = idNewDemandInfo id
 
 tidyId :: TidyEnv -> Id -> (TidyEnv, Id)
 tidyId env@(tidy_env, var_env) id