X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmLiveZ.hs;h=07801be49f4d3980c3e982cbef77969f974c3b4a;hb=fee569a69a4ce8c8d05b8a1fb8069d804dbd2b9c;hp=8a5d36c65850a282523a2cdb70e9295e2f15bac4;hpb=1241c26f3552a2037263769e5ef7fa68d9f3be36;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmLiveZ.hs b/compiler/cmm/CmmLiveZ.hs index 8a5d36c..07801be 100644 --- a/compiler/cmm/CmmLiveZ.hs +++ b/compiler/cmm/CmmLiveZ.hs @@ -11,13 +11,14 @@ import Cmm import CmmExpr import CmmTx import DFMonad -import Maybes import PprCmm() import PprCmmZ() -import UniqSet -import ZipDataflow +import ZipDataflow0 import ZipCfgCmmRep +import Maybes +import UniqSet + ----------------------------------------------------------------------------- -- Calculating what variables are live on entry to a basic block ----------------------------------------------------------------------------- @@ -40,10 +41,8 @@ type BlockEntryLiveness = BlockEnv CmmLive ----------------------------------------------------------------------------- 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 @@ -57,19 +56,19 @@ kill a live = foldRegsUsed delOneFromUniqSet live a 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 + 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)