[project @ 2001-07-25 09:19:41 by simonpj]
authorsimonpj <unknown>
Wed, 25 Jul 2001 09:19:41 +0000 (09:19 +0000)
committersimonpj <unknown>
Wed, 25 Jul 2001 09:19:41 +0000 (09:19 +0000)
---------------------------------
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!

ghc/compiler/coreSyn/CoreTidy.lhs

index d0234ce..2f45691 100644 (file)
@@ -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