X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmLive.hs;h=93372fc461fb301550221bbe7dc7e19008e061af;hp=8d13505d36d86c59eed4ecdd883a94c115a3d784;hb=176fa33f17dd78355cc572e006d2ab26898e2c69;hpb=b3ccd6d5a4366dc8089fd9c49f5edf43077de009

diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index 8d13505..93372fc 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -1,11 +1,20 @@
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module CmmLive (
-        CmmLive, BlockEntryLiveness,
+        CmmLive,
+        BlockEntryLiveness,
         cmmLiveness,
-        cmmFormalsToLiveLocals
+        cmmFormalsToLiveLocals,
   ) where
 
 #include "HsVersions.h"
 
+import BlockId
 import Cmm
 import Dataflow
 
@@ -14,20 +23,24 @@ import Panic
 import UniqFM
 import UniqSet
 
-import Data.List
-
 -----------------------------------------------------------------------------
 -- Calculating what variables are live on entry to a basic block
 -----------------------------------------------------------------------------
 
--- The variables live on entry to a block
+-- | The variables live on entry to a block
 type CmmLive = UniqSet LocalReg
 
--- A mapping from block labels to the variables live on entry
+-- | A mapping from block labels to the variables live on entry
 type BlockEntryLiveness = BlockEnv CmmLive
 
+-- | A mapping from block labels to the blocks that target it
+type BlockSources = BlockEnv (UniqSet BlockId)
+
+-- | A mapping from block labels to the statements in the block
+type BlockStmts = BlockEnv [CmmStmt]
+
 -----------------------------------------------------------------------------
--- cmmLiveness and helpers
+-- | Calculated liveness info for a list of 'CmmBasicBlock'
 -----------------------------------------------------------------------------
 cmmLiveness :: [CmmBasicBlock] -> BlockEntryLiveness
 cmmLiveness blocks =
@@ -36,8 +49,14 @@ cmmLiveness blocks =
                (map blockId blocks)
                (listToUFM [(blockId b, emptyUniqSet) | b <- blocks])
     where
+      sources :: BlockSources
       sources = cmmBlockSources blocks
-      blocks' = cmmBlockNames blocks
+
+      blocks' :: BlockStmts
+      blocks' = listToUFM $ map block_name blocks
+
+      block_name :: CmmBasicBlock -> (BlockId, [CmmStmt])
+      block_name b = (blockId b, blockStmts b)
 
 {-
 -- For debugging, annotate each block with a comment indicating
@@ -51,27 +70,24 @@ cmmLivenessComment live (BasicBlock ident stmts) =
 -}
 
 
---------------------------------
--- cmmBlockSources
---
--- Calculates a table of blocks
--- that might need updating after
--- a given block is updated
---------------------------------
-cmmBlockSources :: [CmmBasicBlock] -> BlockEnv (UniqSet BlockId)
+-----------------------------------------------------------------------------
+-- | Calculates a table of where one can lookup the blocks that might
+-- need updating after a given block is updated in the liveness analysis
+-----------------------------------------------------------------------------
+cmmBlockSources :: [CmmBasicBlock] -> BlockSources
 cmmBlockSources blocks = foldr aux emptyUFM blocks
     where
       aux :: CmmBasicBlock
-          -> BlockEnv (UniqSet BlockId)
-          -> BlockEnv (UniqSet BlockId)
+          -> BlockSources
+          -> BlockSources
       aux block sourcesUFM =
           foldUniqSet (add_source_edges $ blockId block)
                       sourcesUFM
                       (branch_targets $ blockStmts block)
 
       add_source_edges :: BlockId -> BlockId
-                       -> BlockEnv (UniqSet BlockId)
-                       -> BlockEnv (UniqSet BlockId)
+                       -> BlockSources
+                       -> BlockSources
       add_source_edges source target ufm =
           addToUFM_Acc (flip addOneToUniqSet) unitUniqSet ufm target source
 
@@ -83,40 +99,22 @@ cmmBlockSources blocks = foldr aux emptyUFM blocks
               target (CmmSwitch _ blocks) = mapMaybe id blocks
               target _ = []
 
---------------------------------
--- cmmBlockNames
---
--- Calculates a table that maps
--- block names to the list
--- of statements inside them
---------------------------------
-cmmBlockNames :: [CmmBasicBlock] -> BlockEnv [CmmStmt]
-cmmBlockNames blocks = listToUFM $ map block_name blocks where
-    block_name b = (blockId b, blockStmts b)
-
---------------------------------
--- cmmBlockDependants
+-----------------------------------------------------------------------------
+-- | Given the table calculated by 'cmmBlockSources', list all blocks
+-- that depend on the result of a particular block.
 --
--- Given the table calculated
--- by cmmBlockSources created,
--- list all blocks that depend
--- on the result of a particular
--- block.
---------------------------------
-cmmBlockDependants :: BlockEnv (UniqSet BlockId) -> BlockId -> [BlockId]
+-- Used by the call to 'fixedpoint'.
+-----------------------------------------------------------------------------
+cmmBlockDependants :: BlockSources -> BlockId -> [BlockId]
 cmmBlockDependants sources ident =
     uniqSetToList $ lookupWithDefaultUFM sources emptyUniqSet ident
 
---------------------------------
--- cmmBlockUpdate
---
--- Given the table from
--- cmmBlockNames and a block
--- that was updated, calculate
--- an updated BlockEntryLiveness
---------------------------------
+-----------------------------------------------------------------------------
+-- | Given the table of type 'BlockStmts' and a block that was updated,
+-- calculate an updated BlockEntryLiveness
+-----------------------------------------------------------------------------
 cmmBlockUpdate ::
-    BlockEnv [CmmStmt]
+    BlockStmts
     -> BlockId
     -> Maybe BlockId
     -> BlockEntryLiveness
@@ -126,13 +124,20 @@ cmmBlockUpdate blocks node _ state =
       then Nothing
       else Just $ addToUFM state node new_live
     where
-      new_live = cmmStmtListLive state block
+      new_live, old_live :: CmmLive
+      new_live = cmmStmtListLive state block_stmts
       old_live = lookupWithDefaultUFM state missing_live node
-      block = lookupWithDefaultUFM blocks missing_block node
+
+      block_stmts :: [CmmStmt]
+      block_stmts = lookupWithDefaultUFM blocks missing_block node
+
       missing_live = panic "unknown block id during liveness analysis"
       missing_block = panic "unknown block id during liveness analysis"
 
 -----------------------------------------------------------------------------
+-- Section: 
+-----------------------------------------------------------------------------
+-----------------------------------------------------------------------------
 -- CmmBlockLive, cmmStmtListLive and helpers
 -----------------------------------------------------------------------------
 
@@ -159,10 +164,8 @@ addKilled new_killed live = live `minusUniqSet` new_killed
 --------------------------------
 -- Liveness of a CmmStmt
 --------------------------------
-cmmFormalsToLiveLocals :: CmmFormals -> [LocalReg]
-cmmFormalsToLiveLocals [] = []
-cmmFormalsToLiveLocals ((CmmGlobal _,_):args) = cmmFormalsToLiveLocals args
-cmmFormalsToLiveLocals ((CmmLocal r,_):args) = r:cmmFormalsToLiveLocals args
+cmmFormalsToLiveLocals :: HintedCmmFormals -> [LocalReg]
+cmmFormalsToLiveLocals formals = map hintlessCmm formals
 
 cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
 cmmStmtLive _ (CmmNop) = id
@@ -175,13 +178,13 @@ cmmStmtLive _ (CmmAssign reg expr) =
               (CmmGlobal _) -> id
 cmmStmtLive _ (CmmStore expr1 expr2) =
     cmmExprLive expr2 . cmmExprLive expr1
-cmmStmtLive _ (CmmCall target results arguments _) =
+cmmStmtLive _ (CmmCall target results arguments _ _) =
     target_liveness .
-    foldr ((.) . cmmExprLive) id (map fst arguments) .
+    foldr ((.) . cmmExprLive) id (map hintlessCmm arguments) .
     addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
         target_liveness =
             case target of
-              (CmmForeignCall target _) -> cmmExprLive target
+              (CmmCallee target _) -> cmmExprLive target
               (CmmPrim _) -> id
 cmmStmtLive other_live (CmmBranch target) =
     addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
@@ -195,9 +198,9 @@ cmmStmtLive other_live (CmmSwitch expr targets) =
            id
            (mapCatMaybes id targets))
 cmmStmtLive _ (CmmJump expr params) =
-    const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
+    const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet)
 cmmStmtLive _ (CmmReturn params) =
-    const (foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
+    const (foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet)
 
 --------------------------------
 -- Liveness of a CmmExpr