From 23c8ca46f1b871eff2ecd65d71806ec03684ce2e Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Fri, 20 Mar 1998 11:44:41 +0000
Subject: [PATCH] [project @ 1998-03-20 11:44:30 by simonpj] Fix bug in
 mkIdWithNewUniq

---
 ghc/compiler/basicTypes/Id.lhs       |    4 ++--
 ghc/compiler/coreSyn/CoreUnfold.lhs  |   10 ++++++++--
 ghc/compiler/simplCore/SimplCase.lhs |    9 +++++----
 ghc/compiler/simplCore/SimplEnv.lhs  |    3 +--
 4 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index f8c92bc..cb8b1a1 100644
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -233,7 +233,7 @@ mkVanillaId name ty info
 	idInfo = info}
 
 mkIdWithNewUniq :: Id -> Unique -> Id
-mkIdWithNewUniq id uniq = id {idUnique = uniq}
+mkIdWithNewUniq id uniq = id {idUnique = uniq, idName = changeUnique (idName id) uniq}
 
 mkIdWithNewName :: Id -> Name -> Id
 mkIdWithNewName id new_name
@@ -562,7 +562,7 @@ getIdDemandInfo id = demandInfo (idInfo id)
 addIdDemandInfo :: Id -> DemandInfo -> Id
 addIdDemandInfo id@(Id {idInfo = info}) demand_info
   = id {idInfo = demand_info `setDemandInfo` info}
-\end{code}
+\end{code}p
 
 \begin{code}
 getIdUpdateInfo :: Id -> UpdateInfo
diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index 6449cda..5d285ff 100644
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ b/ghc/compiler/coreSyn/CoreUnfold.lhs
@@ -40,7 +40,7 @@ import Constants	( uNFOLDING_CHEAP_OP_COST,
 			  uNFOLDING_DEAR_OP_COST,
 			  uNFOLDING_NOREP_LIT_COST
 			)
-import BinderInfo	( BinderInfo, isOneSameSCCFunOcc,
+import BinderInfo	( BinderInfo, isOneSameSCCFunOcc, isDeadOcc,
 			  isInlinableOcc, isOneSafeFunOcc
 			)
 import CoreSyn
@@ -538,5 +538,11 @@ okToInline id _ _ _		-- Check the Id first
   | idWantsToBeINLINEd id = True
   | idMustNotBeINLINEd id = False
 
-okToInline id whnf small binder_info = isInlinableOcc whnf small binder_info
+okToInline id whnf small binder_info 
+#ifdef DEBUG
+  | isDeadOcc binder_info
+  = pprTrace "okToInline: dead" (ppr id) False
+  | otherwise
+#endif
+  = isInlinableOcc whnf small binder_info
 \end{code}
diff --git a/ghc/compiler/simplCore/SimplCase.lhs b/ghc/compiler/simplCore/SimplCase.lhs
index c7d3313..0e80f1e 100644
--- a/ghc/compiler/simplCore/SimplCase.lhs
+++ b/ghc/compiler/simplCore/SimplCase.lhs
@@ -610,12 +610,13 @@ simplDefault env (Var scrut_var) (BindDefault binder@(_,occ_info) rhs)
 	     info_from_this_case rhs_c
   = simplBinder env binder 	`thenSmpl` \ (env1, binder') ->
     let
-      env2    = extendEnvGivenUnfolding env1 binder' occ_info info_from_this_case
+      env2 = extendEnvGivenNewRhs env1 scrut_var (Var binder')
 
 	-- Add form details for the default binder
-      scrut_info = lookupUnfolding env scrut_var
-      env3       = extendEnvGivenUnfolding env2 binder' occ_info scrut_info
-      new_env    = extendEnvGivenNewRhs env3 scrut_var (Var binder')
+      scrut_unf = lookupUnfolding env scrut_var
+      new_env   = extendEnvGivenUnfolding env2 binder' noBinderInfo scrut_unf
+			-- Use noBinderInfo rather than occ_info because we've
+			-- added more occurrences by binding the scrut_var to it
     in
     rhs_c new_env rhs			`thenSmpl` \ rhs' ->
     returnSmpl (BindDefault binder' rhs')
diff --git a/ghc/compiler/simplCore/SimplEnv.lhs b/ghc/compiler/simplCore/SimplEnv.lhs
index 7f81320..95bd9c8 100644
--- a/ghc/compiler/simplCore/SimplEnv.lhs
+++ b/ghc/compiler/simplCore/SimplEnv.lhs
@@ -441,8 +441,7 @@ extendEnvGivenUnfolding env@(SimplEnv chkr encl_cc ty_env (in_scope_ids, id_subs
 	              out_id occ_info rhs_info
   = SimplEnv chkr encl_cc ty_env (new_in_scope_ids, id_subst) con_apps
   where
-    new_in_scope_ids = addToUFM_C modifyOutEnvItem in_scope_ids out_id 
-				  (out_id, occ_info, rhs_info)
+    new_in_scope_ids = addToUFM in_scope_ids out_id (out_id, occ_info, rhs_info)
 \end{code}
 
 
-- 
1.7.10.4