X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmLiveZ.hs;h=07801be49f4d3980c3e982cbef77969f974c3b4a;hb=235edf36cc202bb21c00d0e5e05ebf076fb0542e;hp=87f6c385f341553a60eaa0238e5275ec2aea3362;hpb=8b7eaa404043294bd4cb4a0322ac1f7115bad6a0;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmLiveZ.hs b/compiler/cmm/CmmLiveZ.hs
index 87f6c38..07801be 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 ZipDataflow0
+import ZipCfgCmmRep
+
+import Maybes
 import UniqSet
-import ZipDataflow
-import ZipCfgCmm
 
 -----------------------------------------------------------------------------
 -- Calculating what variables are live on entry to a basic block
@@ -36,14 +37,12 @@ liveLattice = DataflowLattice "live LocalReg's" emptyUniqSet add False
 type BlockEntryLiveness = BlockEnv CmmLive
 
 -----------------------------------------------------------------------------
--- | Calculated liveness info for a list of 'CmmBasicBlock'
+-- | 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
+    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,20 +56,20 @@ 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
-        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)