X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmLiveZ.hs;h=4dc0874eb7c1c1e41920062df23113493a12672c;hb=3269b15da0e701820b765003eeb3b931560bf645;hp=00a649188f0fee38fdf737cb2c3a34afed1c6635;hpb=b822c1e46cd64d1dba23fbab0f775b731bf0f12b;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmLiveZ.hs b/compiler/cmm/CmmLiveZ.hs
index 00a6491..4dc0874 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
@@ -7,17 +7,20 @@ module CmmLiveZ
     ) 
 where
 
-import Cmm
+import BlockId
 import CmmExpr
 import CmmTx
 import DFMonad
-import Maybes
+import Monad
 import PprCmm()
 import PprCmmZ()
-import UniqSet
+import ZipCfg
 import ZipDataflow
 import ZipCfgCmmRep
 
+import Maybes
+import UniqSet
+
 -----------------------------------------------------------------------------
 -- Calculating what variables are live on entry to a basic block
 -----------------------------------------------------------------------------
@@ -38,16 +41,14 @@ type BlockEntryLiveness = BlockEnv CmmLive
 -----------------------------------------------------------------------------
 -- | Calculated liveness info for a CmmGraph
 -----------------------------------------------------------------------------
-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
-          exit         = emptyUniqSet
-          first live _ = live
-          middle       = flip middleLiveness
-          last         = flip lastLiveness
+cmmLivenessZ :: CmmGraph -> FuelMonad BlockEntryLiveness
+cmmLivenessZ g = liftM zdfFpFacts $ (res :: FuelMonad (CmmBackwardFixedPoint CmmLive))
+  where res = zdfSolveFrom emptyBlockEnv "liveness analysis" liveLattice transfers
+                           emptyUniqSet (graphOfLGraph g)
+        transfers = BackwardTransfers first middle last
+        first live _ = live
+        middle       = flip middleLiveness
+        last         = flip lastLiveness
 
 -- | The transfer equations use the traditional 'gen' and 'kill'
 -- notations, which should be familiar from the dragon book.
@@ -57,19 +58,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)