-{-# 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/CodingStyle#Warnings
--- for details
-
module CmmProcPoint (
calculateProcPoints
) where
#include "HsVersions.h"
-import Cmm
+import BlockId
import CmmBrokenBlock
import Dataflow
import UniqSet
-import UniqFM
import Panic
-- Determine the proc points for a set of basic blocks.
then unitUniqSet child_id
else emptyUniqSet
where
- parent_owners = lookupWithDefaultUFM owners emptyUniqSet parent_id
- child_owners = lookupWithDefaultUFM owners emptyUniqSet child_id
+ parent_owners = lookupWithDefaultBEnv owners emptyUniqSet parent_id
+ child_owners = lookupWithDefaultBEnv owners emptyUniqSet child_id
needs_proc_point =
-- only if parent isn't dead
(not $ isEmptyUniqSet parent_owners) &&
-> [BrokenBlock]
-> BlockEnv (UniqSet BlockId)
calculateOwnership blocks_ufm proc_points blocks =
- fixedpoint dependants update (map brokenBlockId blocks) emptyUFM
+ fixedpoint dependants update (map brokenBlockId blocks) emptyBlockEnv
where
dependants :: BlockId -> [BlockId]
dependants ident =
- brokenBlockTargets $ lookupWithDefaultUFM
+ brokenBlockTargets $ lookupWithDefaultBEnv
blocks_ufm unknown_block ident
update :: BlockId
update ident cause owners =
case (cause, ident `elementOfUniqSet` proc_points) of
(Nothing, True) ->
- Just $ addToUFM owners ident (unitUniqSet ident)
+ Just $ extendBlockEnv owners ident (unitUniqSet ident)
(Nothing, False) -> Nothing
- (Just cause', True) -> Nothing
+ (Just _, True) -> Nothing
(Just cause', False) ->
if (sizeUniqSet old) == (sizeUniqSet new)
then Nothing
- else Just $ addToUFM owners ident new
+ else Just $ extendBlockEnv owners ident new
where
- old = lookupWithDefaultUFM owners emptyUniqSet ident
+ old = lookupWithDefaultBEnv owners emptyUniqSet ident
new = old `unionUniqSets`
- lookupWithDefaultUFM owners emptyUniqSet cause'
+ lookupWithDefaultBEnv owners emptyUniqSet cause'
unknown_block = panic "unknown BlockId in calculateOwnership"