[project @ 2004-12-22 12:06:13 by simonpj]

[ghc-hetmet.git] / ghc / compiler / simplCore / OccurAnal.lhs

diff --git a/ghc/compiler/simplCore/OccurAnal.lhs b/ghc/compiler/simplCore/OccurAnal.lhs
index fe035f3..bc45bef 100644 (file)
--- a/ghc/compiler/simplCore/OccurAnal.lhs
+++ b/ghc/compiler/simplCore/OccurAnal.lhs
@@ -20,7 +20,7 @@ module OccurAnal (
 import CoreSyn
 import CoreFVs         ( idRuleVars )
 import CoreUtils       ( exprIsTrivial )
-import Id              ( isDataConWorkId, isOneShotLambda, setOneShotLambda, 
+import Id              ( isDataConWorkId, isOneShotBndr, setOneShotLambda, 
                          idOccInfo, setIdOccInfo,
                          isExportedId, modifyIdInfo, idInfo, idArity,
                          idSpecialisation, isLocalId,
@@ -648,9 +648,9 @@ occAnal env expr@(Lam _ _)
     env2             = env1 `addNewCands` binders      -- Add in-scope binders
     env_body         = vanillaCtxt env2                -- Body is (no longer) an RhsContext
 
-occAnal env (Case scrut bndr alts)
+occAnal env (Case scrut bndr ty alts)
   = case mapAndUnzip (occAnalAlt alt_env bndr) alts of { (alts_usage_s, alts')   -> 
-    case occAnal (vanillaCtxt env) scrut                   of { (scrut_usage, scrut') ->
+    case occAnal (vanillaCtxt env) scrut           of { (scrut_usage, scrut') ->
        -- No need for rhsCtxt
     let
        alts_usage  = foldr1 combineAltsUsageDetails alts_usage_s
@@ -658,7 +658,7 @@ occAnal env (Case scrut bndr alts)
        (alts_usage1, tagged_bndr) = tagBinder alts_usage' bndr
         total_usage = scrut_usage `combineUsageDetails` alts_usage1
     in
-    total_usage `seq` (total_usage, Case scrut' tagged_bndr alts') }}
+    total_usage `seq` (total_usage, Case scrut' tagged_bndr ty alts') }}
   where
     alt_env = env `addNewCand` bndr
 
@@ -837,7 +837,7 @@ isCandidate (OccEnv cands encl _) id = id `elemVarSet` cands
 
 addNewCands :: OccEnv -> [Id] -> OccEnv
 addNewCands (OccEnv cands encl ctxt) ids
-  = OccEnv (cands `unionVarSet` mkVarSet ids) encl ctxt
+  = OccEnv (extendVarSetList cands ids) encl ctxt
 
 addNewCand :: OccEnv -> Id -> OccEnv
 addNewCand (OccEnv cands encl ctxt) id
@@ -859,7 +859,7 @@ oneShotGroup (OccEnv cands encl ctxt) bndrs
   = case go ctxt bndrs [] of
        (new_ctxt, new_bndrs) -> (all is_one_shot new_bndrs, OccEnv cands encl new_ctxt, new_bndrs)
   where
-    is_one_shot b = isId b && isOneShotLambda b
+    is_one_shot b = isId b && isOneShotBndr b
 
     go ctxt [] rev_bndrs = (ctxt, reverse rev_bndrs)