X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmLiveZ.hs;h=9b2fa56d5b34ed04142026666105bbe9de0215a2;hb=e64dbac62758a2c95d0d8faea37b22287d585479;hp=66cb3f1541531f076d9b3a69c3ed4155e0b3c4aa;hpb=7ed4f0716220b03fe5e04100ddbbc9e37d5323fe;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmLiveZ.hs b/compiler/cmm/CmmLiveZ.hs index 66cb3f1..9b2fa56 100644 --- a/compiler/cmm/CmmLiveZ.hs +++ b/compiler/cmm/CmmLiveZ.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -Wall -fno-warn-name-shadowing #-} + module CmmLiveZ ( CmmLive , cmmLivenessZ @@ -11,12 +11,13 @@ import Cmm import CmmExpr import CmmTx import DFMonad -import Maybes import PprCmm() import PprCmmZ() -import UniqSet import ZipDataflow -import ZipCfgCmm +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 @@ -63,14 +62,14 @@ middleLiveness m = middle m middle (MidStore addr rval) = gen addr . gen rval middle (MidUnsafeCall tgt ress args) = gen tgt . gen args . kill ress 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)