-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
+
module CmmLiveZ
( CmmLive
, cmmLivenessZ
import CmmExpr
import CmmTx
import DFMonad
-import Maybes
import PprCmm()
import PprCmmZ()
+import ZipDataflow0
+import ZipCfgCmmRep
+
+import Maybes
import UniqSet
-import ZipDataflow
-import ZipCfgCmm
-----------------------------------------------------------------------------
-- Calculating what variables are live on entry to a basic block
-----------------------------------------------------------------------------
cmmLivenessZ :: CmmGraph -> BlockEntryLiveness
cmmLivenessZ g = env
- where env = runDFA liveLattice $
- do run_b_anal transfer g
- allFacts
- transfer = BComp "liveness analysis" exit last middle first
+ where env = runDFA liveLattice $ do { run_b_anal transfer g; allFacts }
+ transfer = BComp "liveness analysis" exit last middle first
exit = emptyUniqSet
first live _ = live
middle = flip middleLiveness
middleLiveness :: Middle -> CmmLive -> CmmLive
middleLiveness m = middle m
- where middle (MidNop) = id
- middle (MidComment {}) = id
+ where middle (MidComment {}) = id
middle (MidAssign lhs expr) = gen expr . kill lhs
middle (MidStore addr rval) = gen addr . gen rval
middle (MidUnsafeCall tgt ress args) = gen tgt . gen args . kill ress
+ middle (MidAddToContext ra args) = gen ra . gen args
middle (CopyIn _ formals _) = kill formals
- middle (CopyOut _ formals) = gen formals
+ middle (CopyOut _ actuals) = gen actuals
lastLiveness :: Last -> (BlockId -> CmmLive) -> CmmLive
lastLiveness l env = last l
- where last (LastReturn ress) = gen ress emptyUniqSet
- last (LastJump e args) = gen e $ gen args emptyUniqSet
- last (LastBranch id args) = gen args $ env id
- last (LastCall tgt args (Just k)) = gen tgt $ gen args $ env k
- last (LastCall tgt args Nothing) = gen tgt $ gen args $ emptyUniqSet
- last (LastCondBranch e t f) = gen e $ unionUniqSets (env t) (env f)
+ where last (LastReturn) = emptyUniqSet
+ last (LastJump e) = gen e $ emptyUniqSet
+ last (LastBranch id) = env id
+ last (LastCall tgt (Just k)) = gen tgt $ env k
+ last (LastCall tgt Nothing) = gen tgt $ emptyUniqSet
+ last (LastCondBranch e t f) = gen e $ unionUniqSets (env t) (env f)
last (LastSwitch e tbl) = gen e $ unionManyUniqSets $ map env (catMaybes tbl)