--- Section:
------------------------------------------------------------------------------
------------------------------------------------------------------------------
--- CmmBlockLive, cmmStmtListLive and helpers
------------------------------------------------------------------------------
-
--- Calculate the live registers for a local block (list of statements)
-
-cmmStmtListLive :: BlockEntryLiveness -> [CmmStmt] -> CmmLive
-cmmStmtListLive other_live stmts =
- foldr ((.) . (cmmStmtLive other_live)) id stmts emptyUniqSet
-
------------------------------------------------------------------------------
--- This code is written in the style of a state monad,
--- but since Control.Monad.State is not in the core
--- we can't use it in GHC, so we'll fake one here.
--- We don't need a return value so well leave it out.
--- Thus 'bind' reduces to function composition.
-
-type CmmLivenessTransformer = CmmLive -> CmmLive
-
--- Helpers for the "Monad"
-addLive, addKilled :: CmmLive -> CmmLivenessTransformer
-addLive new_live live = live `unionUniqSets` new_live
-addKilled new_killed live = live `minusUniqSet` new_killed
-
---------------------------------
--- Liveness of a CmmStmt
---------------------------------
-cmmFormalsToLiveLocals :: HintedCmmFormals -> [LocalReg]
-cmmFormalsToLiveLocals formals = map hintlessCmm formals
-
-cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
-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 hintlessCmm arguments) .
- addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
- target_liveness =
- case target of
- (CmmCallee target _) -> cmmExprLive target
- (CmmPrim _) -> id
-cmmStmtLive other_live (CmmBranch target) =
- addLive (lookupWithDefaultBEnv other_live emptyUniqSet target)
-cmmStmtLive other_live (CmmCondBranch expr target) =
- cmmExprLive expr .
- addLive (lookupWithDefaultBEnv other_live emptyUniqSet target)
-cmmStmtLive other_live (CmmSwitch expr targets) =
- cmmExprLive expr .
- (foldr ((.) . (addLive .
- lookupWithDefaultBEnv other_live emptyUniqSet))
- id
- (mapCatMaybes id targets))
-cmmStmtLive _ (CmmJump expr params) =
- const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet)
-cmmStmtLive _ (CmmReturn params) =
- const (foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet)
-
---------------------------------
--- Liveness of a CmmExpr
---------------------------------
-cmmExprLive :: CmmExpr -> CmmLivenessTransformer
-cmmExprLive expr = addLive (mkUniqSet $ expr_liveness expr) where
- expr_liveness :: CmmExpr -> [LocalReg]
- 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
- expr_liveness (CmmStackSlot _ _) = panic "cmmExprLive CmmStackSlot"