X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FDataflow.hs;fp=compiler%2Fcmm%2FDataflow.hs;h=7f9d0dc20254711b39fcc0990d2dba59c726046d;hb=d5e821c43df34fa228727e7f4e9453d0fde39fb6;hp=093a8a6430f026a1ecea784513a7030e5c4de1b8;hpb=3a42f21026077b8b497852ff53288818a28883d2;p=ghc-hetmet.git

diff --git a/compiler/cmm/Dataflow.hs b/compiler/cmm/Dataflow.hs
index 093a8a6..7f9d0dc 100644
--- a/compiler/cmm/Dataflow.hs
+++ b/compiler/cmm/Dataflow.hs
@@ -1,146 +1,6 @@
-module Dataflow {-(fixedpoint, cmmLivenessComment, cmmLiveness, CmmLive)-} where
-
-import Cmm
-import PprCmm ()
-
-import UniqSet
-import UniqFM
-
-import FastString
-import Outputable
-
-import Maybes
-
-import Data.List
-import Data.Maybe
-
-cmmBranchSources :: [(BlockId, [BlockId])] -> [(BlockId, [BlockId])]
-cmmBranchSources input =
-    [(target, [s | (s, ts) <- input, target `elem` ts])
-     | target <- targets] where
-        targets = nub [t | (s, ts) <- input, t <- ts]
-
-cmmBranchTargets :: CmmBasicBlock -> UniqSet BlockId
-cmmBranchTargets (BasicBlock _ stmts) =
-    mkUniqSet $ concatMap target stmts where
-        target (CmmBranch ident) = [ident]
-        target (CmmCondBranch _ ident) = [ident]
-        target (CmmSwitch _ blocks) = mapMaybe id blocks
-        target _ = []
-
---------------------------------------------------------------------------------
-
--- This should really be a state monad, but that is not in the core libraries
--- so we'll hack around it here.
--- The monad we're using is: type State a = s -> s
-
--- The variables that were made live and killed respectively
-type CmmLive = UniqSet LocalReg
-
-type BlockEntryLiveness = BlockEnv CmmLive	-- The variables live on entry to each block
-
-addLive new_live live = live `unionUniqSets` new_live
-addKilled new_killed live = live `minusUniqSet` new_killed
-
--- Calculate the live and killed registers for a local block
-cmmBlockLive :: UniqFM {-BlockId-} CmmLive -> CmmBasicBlock -> CmmLive
-cmmBlockLive other_live (BasicBlock _ stmts) =
-    foldr ((.) . (cmmStmtLive other_live)) id stmts emptyUniqSet
-
--- Helper for cmmLocalLiveness
-cmmStmtLive :: UniqFM {-BlockId-} CmmLive -> CmmStmt -> (CmmLive -> CmmLive)
-cmmStmtLive _ (CmmNop) = id
-cmmStmtLive _ (CmmComment _) = id
-cmmStmtLive _ (CmmAssign reg expr) =
-    cmmExprLive expr . reg_liveness where
-        reg_liveness =
-            case reg of
-              (CmmLocal reg') -> addKilled $ unitUniqSet reg'
-              (CmmGlobal _) -> id
-cmmStmtLive _ (CmmStore expr1 expr2) =
-    cmmExprLive expr2 . cmmExprLive expr1
-cmmStmtLive _ (CmmCall target results arguments _) =
-    target_liveness .
-    foldr ((.) . cmmExprLive) id (map fst arguments) .
-    addKilled (mkUniqSet $ only_local_regs results) where
-        only_local_regs [] = []
-        only_local_regs ((CmmGlobal _,_):args) = only_local_regs args
-        only_local_regs ((CmmLocal r,_):args) = r:only_local_regs args
-        target_liveness =
-            case target of
-              (CmmForeignCall target _) -> cmmExprLive target
-              (CmmPrim _) -> id
-cmmStmtLive other_live (CmmBranch target) = addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
-cmmStmtLive other_live (CmmCondBranch expr target) = cmmExprLive expr . addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
-cmmStmtLive other_live (CmmSwitch expr targets) =
-    cmmExprLive expr .
-    (foldr ((.) . (addLive . lookupWithDefaultUFM other_live emptyUniqSet)) id (mapCatMaybes id targets))
-cmmStmtLive _ (CmmJump expr params) =
-    const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
-cmmStmtLive _ (CmmReturn params) =
-    const (foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
-
---------
-
--- Helper for cmmLocalLiveness
-cmmExprLive :: CmmExpr -> (CmmLive -> CmmLive)
-cmmExprLive expr = addLive (mkUniqSet $ expr_liveness expr) where
-    expr_liveness (CmmLit _) = []
-    expr_liveness (CmmLoad expr _) = expr_liveness expr
-    expr_liveness (CmmReg reg) = reg_liveness reg
-    expr_liveness (CmmMachOp _ exprs) = concatMap expr_liveness exprs
-    expr_liveness (CmmRegOff reg _) = reg_liveness reg
-    reg_liveness (CmmLocal reg) = [reg]
-    reg_liveness (CmmGlobal _) = []
-
-cmmBlockUpdate ::
-    UniqFM {-BlockId-} CmmBasicBlock
-    -> BlockId
-    -> Maybe BlockId
-    -> UniqFM {-BlockId-} CmmLive
-    -> Maybe (UniqFM {-BlockId-} CmmLive)
-cmmBlockUpdate blocks node _ state =
-    let old_live = lookupWithDefaultUFM state (panic "unknown block id during liveness analysis") node
-        block = lookupWithDefaultUFM blocks (panic "unknown block id during liveness analysis") node
-        new_live = cmmBlockLive state block
-    in if (sizeUniqSet old_live) == (sizeUniqSet new_live)
-       then Nothing
-       else Just $ addToUFM state node new_live
-
-cmmBlockDependants :: UniqFM {-BlockId-} (UniqSet BlockId) -> BlockId -> [BlockId]
-cmmBlockDependants sources ident =
-    uniqSetToList $ lookupWithDefaultUFM sources emptyUniqSet ident
-
-cmmBlockSourcesAndTargets ::
-    [CmmBasicBlock]
-    -> (UniqFM {-BlockId-} (UniqSet BlockId), UniqFM (UniqSet BlockId))
-cmmBlockSourcesAndTargets blocks = foldr aux (emptyUFM, emptyUFM) blocks where
-    aux block (sourcesUFM, targetsUFM)  =
-        (foldUniqSet add_source_edges sourcesUFM targets,
-         addToUFM_Acc unionUniqSets id targetsUFM ident targets) where
-            add_source_edges t ufm =
-                addToUFM_Acc (flip addOneToUniqSet) unitUniqSet ufm t ident
-            targets = cmmBranchTargets block
-            ident = blockId block
-
-cmmBlockNames :: [CmmBasicBlock] -> UniqFM {-BlockId-} CmmBasicBlock
-cmmBlockNames blocks = listToUFM $ map block_name blocks where
-    block_name b = (blockId b, b)
-
-cmmLiveness :: [CmmBasicBlock] -> BlockEnv CmmLive
-cmmLiveness blocks =
-    fixedpoint (cmmBlockDependants sources) (cmmBlockUpdate blocks')
-               (map blockId blocks) (listToUFM [(blockId b, emptyUniqSet) | b <- blocks]) where
-                   (sources, targets) = cmmBlockSourcesAndTargets blocks
-                   blocks' = cmmBlockNames blocks
-
-cmmLivenessComment ::
-    UniqFM {-BlockId-} (UniqSet LocalReg)
-    -> CmmBasicBlock -> CmmBasicBlock
-cmmLivenessComment live (BasicBlock ident stmts) =
-    BasicBlock ident stmts' where
-        stmts' = (CmmComment $ mkFastString $ showSDoc $ ppr $ live'):stmts
-        live' = map CmmLocal $ uniqSetToList $ lookupWithDefaultUFM live emptyUniqSet ident
+module Dataflow (
+        fixedpoint
+  ) where
 
 --------------------------------------------------------------------------------