[project @ 1996-06-11 13:18:54 by partain]

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

diff --git a/ghc/compiler/simplCore/OccurAnal.lhs b/ghc/compiler/simplCore/OccurAnal.lhs
index 94e9fc6..4d36323 100644 (file)
--- a/ghc/compiler/simplCore/OccurAnal.lhs
+++ b/ghc/compiler/simplCore/OccurAnal.lhs
@@ -17,7 +17,8 @@ module OccurAnal (
        occurAnalyseBinds, occurAnalyseExpr, occurAnalyseGlobalExpr
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
+IMPORT_DELOOPER(IdLoop)        -- paranoia
 
 import BinderInfo
 import CmdLineOpts     ( opt_D_dump_occur_anal, SimplifierSwitch(..) )
@@ -33,14 +34,15 @@ import Id           ( idWantsToBeINLINEd, isConstMethodId,
                          GenId{-instance Eq-}
                        )
 import Maybes          ( maybeToBool )
-import Outputable      ( isExported, Outputable(..){-instance * (,) -} )
+import Name            ( isExported )
+import Outputable      ( Outputable(..){-instance * (,) -} )
 import PprCore
 import PprStyle                ( PprStyle(..) )
 import PprType         ( GenType{-instance Outputable-}, GenTyVar{-ditto-} )
 import Pretty          ( ppAboves )
 import TyVar           ( GenTyVar{-instance Eq-} )
 import Unique          ( Unique{-instance Eq-} )
-import Util            ( assoc, pprTrace, panic )
+import Util            ( assoc, zipEqual, pprTrace, panic )
 
 isSpecPragmaId_maybe = panic "OccurAnal.isSpecPragmaId_maybe (ToDo)"
 \end{code}
@@ -101,14 +103,14 @@ combineUsageDetails, combineAltsUsageDetails
        :: UsageDetails -> UsageDetails -> UsageDetails
 
 combineUsageDetails usage1 usage2
-  = combineIdEnvs combineBinderInfo usage1 usage2
+  = combineIdEnvs addBinderInfo usage1 usage2
 
 combineAltsUsageDetails usage1 usage2
-  = combineIdEnvs combineAltsBinderInfo usage1 usage2
+  = combineIdEnvs orBinderInfo usage1 usage2
 
 addOneOcc :: UsageDetails -> Id -> BinderInfo -> UsageDetails
 addOneOcc usage id info
-  = combineIdEnvs combineBinderInfo usage (unitIdEnv id info)
+  = combineIdEnvs addBinderInfo usage (unitIdEnv id info)
        -- ToDo: make this more efficient
 
 emptyDetails = (nullIdEnv :: UsageDetails)
@@ -205,7 +207,7 @@ occurAnalyseGlobalExpr :: CoreExpr -> SimplifiableCoreExpr
 occurAnalyseGlobalExpr expr
   =    -- Top level expr, so no interesting free vars, and
        -- discard occurence info returned
-    expr' where (_, expr') = occurAnalyseExpr emptyIdSet expr
+    snd (occurAnalyseExpr emptyIdSet expr)
 \end{code}
 
 %************************************************************************
@@ -335,7 +337,7 @@ occAnalBind env (Rec pairs) body_usage
        total_usage                      = foldr combineUsageDetails body_usage rhs_usages
        (combined_usage, tagged_binders) = tagBinders total_usage sCC
 
-       new_bind                         = Rec (tagged_binders `zip` rhss')
+       new_bind = Rec (zipEqual "occAnalBind" tagged_binders rhss')
 \end{code}
 
 @occAnalRhs@ deals with the question of bindings where the Id is marked
@@ -386,6 +388,11 @@ occAnal env (SCC cc body)
   where
     (usage, body') = occAnal env body
 
+occAnal env (Coerce c ty body)
+  = (usage, Coerce c ty body')
+  where
+    (usage, body') = occAnal env body
+
 occAnal env (App fun arg)
   = (fun_usage `combineUsageDetails` arg_usage, App fun' arg)
   where