{-# LANGUAGE GADTs, BangPatterns, RecordWildCards,
GeneralizedNewtypeDeriving, NondecreasingIndentation, TupleSections,
ScopedTypeVariables, OverloadedStrings, LambdaCase, EmptyCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module GHC.Cmm.Info.Build
( CAFSet, CAFEnv, cafAnal, cafAnalData
, doSRTs, ModuleSRTInfo (..), emptySRT
, SRTMap, srtMapNonCAFs
) where
import GHC.Prelude hiding (succ)
import GHC.Platform
import GHC.Platform.Profile
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Cmm.BlockId
import GHC.Cmm.Config
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow
import GHC.Unit.Module
import GHC.Data.Graph.Directed
import GHC.Cmm.CLabel
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Data.Maybe
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Runtime.Heap.Layout
import GHC.Types.Unique.Supply
import GHC.Types.CostCentre
import GHC.StgToCmm.Heap
import Control.Monad
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List (unzip4)
import GHC.Types.Name.Set
newtype CAFfyLabel = CAFfyLabel CLabel
deriving (CAFfyLabel -> CAFfyLabel -> Bool
(CAFfyLabel -> CAFfyLabel -> Bool)
-> (CAFfyLabel -> CAFfyLabel -> Bool) -> Eq CAFfyLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CAFfyLabel -> CAFfyLabel -> Bool
== :: CAFfyLabel -> CAFfyLabel -> Bool
$c/= :: CAFfyLabel -> CAFfyLabel -> Bool
/= :: CAFfyLabel -> CAFfyLabel -> Bool
Eq,Eq CAFfyLabel
Eq CAFfyLabel =>
(CAFfyLabel -> CAFfyLabel -> Ordering)
-> (CAFfyLabel -> CAFfyLabel -> Bool)
-> (CAFfyLabel -> CAFfyLabel -> Bool)
-> (CAFfyLabel -> CAFfyLabel -> Bool)
-> (CAFfyLabel -> CAFfyLabel -> Bool)
-> (CAFfyLabel -> CAFfyLabel -> CAFfyLabel)
-> (CAFfyLabel -> CAFfyLabel -> CAFfyLabel)
-> Ord CAFfyLabel
CAFfyLabel -> CAFfyLabel -> Bool
CAFfyLabel -> CAFfyLabel -> Ordering
CAFfyLabel -> CAFfyLabel -> CAFfyLabel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CAFfyLabel -> CAFfyLabel -> Ordering
compare :: CAFfyLabel -> CAFfyLabel -> Ordering
$c< :: CAFfyLabel -> CAFfyLabel -> Bool
< :: CAFfyLabel -> CAFfyLabel -> Bool
$c<= :: CAFfyLabel -> CAFfyLabel -> Bool
<= :: CAFfyLabel -> CAFfyLabel -> Bool
$c> :: CAFfyLabel -> CAFfyLabel -> Bool
> :: CAFfyLabel -> CAFfyLabel -> Bool
$c>= :: CAFfyLabel -> CAFfyLabel -> Bool
>= :: CAFfyLabel -> CAFfyLabel -> Bool
$cmax :: CAFfyLabel -> CAFfyLabel -> CAFfyLabel
max :: CAFfyLabel -> CAFfyLabel -> CAFfyLabel
$cmin :: CAFfyLabel -> CAFfyLabel -> CAFfyLabel
min :: CAFfyLabel -> CAFfyLabel -> CAFfyLabel
Ord)
deriving newtype instance OutputableP env CLabel => OutputableP env CAFfyLabel
type CAFSet = Set CAFfyLabel
type CAFEnv = LabelMap CAFSet
type DataCAFEnv = Map CLabel CAFSet
mkCAFfyLabel :: Platform -> CLabel -> CAFfyLabel
mkCAFfyLabel :: Platform -> CLabel -> CAFfyLabel
mkCAFfyLabel Platform
platform CLabel
lbl = CLabel -> CAFfyLabel
CAFfyLabel (Platform -> CLabel -> CLabel
toClosureLbl Platform
platform CLabel
lbl)
newtype SRTEntry = SRTEntry CLabel
deriving (SRTEntry -> SRTEntry -> Bool
(SRTEntry -> SRTEntry -> Bool)
-> (SRTEntry -> SRTEntry -> Bool) -> Eq SRTEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SRTEntry -> SRTEntry -> Bool
== :: SRTEntry -> SRTEntry -> Bool
$c/= :: SRTEntry -> SRTEntry -> Bool
/= :: SRTEntry -> SRTEntry -> Bool
Eq, Eq SRTEntry
Eq SRTEntry =>
(SRTEntry -> SRTEntry -> Ordering)
-> (SRTEntry -> SRTEntry -> Bool)
-> (SRTEntry -> SRTEntry -> Bool)
-> (SRTEntry -> SRTEntry -> Bool)
-> (SRTEntry -> SRTEntry -> Bool)
-> (SRTEntry -> SRTEntry -> SRTEntry)
-> (SRTEntry -> SRTEntry -> SRTEntry)
-> Ord SRTEntry
SRTEntry -> SRTEntry -> Bool
SRTEntry -> SRTEntry -> Ordering
SRTEntry -> SRTEntry -> SRTEntry
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SRTEntry -> SRTEntry -> Ordering
compare :: SRTEntry -> SRTEntry -> Ordering
$c< :: SRTEntry -> SRTEntry -> Bool
< :: SRTEntry -> SRTEntry -> Bool
$c<= :: SRTEntry -> SRTEntry -> Bool
<= :: SRTEntry -> SRTEntry -> Bool
$c> :: SRTEntry -> SRTEntry -> Bool
> :: SRTEntry -> SRTEntry -> Bool
$c>= :: SRTEntry -> SRTEntry -> Bool
>= :: SRTEntry -> SRTEntry -> Bool
$cmax :: SRTEntry -> SRTEntry -> SRTEntry
max :: SRTEntry -> SRTEntry -> SRTEntry
$cmin :: SRTEntry -> SRTEntry -> SRTEntry
min :: SRTEntry -> SRTEntry -> SRTEntry
Ord)
deriving newtype instance OutputableP env CLabel => OutputableP env SRTEntry
addCafLabel :: Platform -> CLabel -> CAFSet -> CAFSet
addCafLabel :: Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
addCafLabel Platform
platform CLabel
l Set CAFfyLabel
s
| Just Name
_ <- CLabel -> Maybe Name
hasHaskellName CLabel
l
, let caf_label :: CAFfyLabel
caf_label = Platform -> CLabel -> CAFfyLabel
mkCAFfyLabel Platform
platform CLabel
l
, CLabel -> Bool
hasCAF CLabel
l
= CAFfyLabel -> Set CAFfyLabel -> Set CAFfyLabel
forall a. Ord a => a -> Set a -> Set a
Set.insert CAFfyLabel
caf_label Set CAFfyLabel
s
| Bool
otherwise
= Set CAFfyLabel
s
cafAnalData
:: Platform
-> CmmStatics
-> CAFSet
cafAnalData :: Platform -> GenCmmStatics 'False -> Set CAFfyLabel
cafAnalData Platform
platform GenCmmStatics 'False
st = case GenCmmStatics 'False
st of
CmmStaticsRaw CLabel
_lbl [CmmStatic]
_data -> Set CAFfyLabel
forall a. Set a
Set.empty
CmmStatics CLabel
_lbl CmmInfoTable
_itbl CostCentreStack
_ccs [CmmLit]
payload [CmmLit]
_extras ->
(Set CAFfyLabel -> CmmLit -> Set CAFfyLabel)
-> Set CAFfyLabel -> [CmmLit] -> Set CAFfyLabel
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Set CAFfyLabel -> CmmLit -> Set CAFfyLabel
analyzeStatic Set CAFfyLabel
forall a. Set a
Set.empty [CmmLit]
payload
where
analyzeStatic :: Set CAFfyLabel -> CmmLit -> Set CAFfyLabel
analyzeStatic Set CAFfyLabel
s CmmLit
lit =
case CmmLit
lit of
CmmLabel CLabel
c -> Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
addCafLabel Platform
platform CLabel
c Set CAFfyLabel
s
CmmLabelOff CLabel
c WordOff
_ -> Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
addCafLabel Platform
platform CLabel
c Set CAFfyLabel
s
CmmLabelDiffOff CLabel
c1 CLabel
c2 WordOff
_ Width
_ -> Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
addCafLabel Platform
platform CLabel
c1 (Set CAFfyLabel -> Set CAFfyLabel)
-> Set CAFfyLabel -> Set CAFfyLabel
forall a b. (a -> b) -> a -> b
$! Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
addCafLabel Platform
platform CLabel
c2 Set CAFfyLabel
s
CmmLit
_ -> Set CAFfyLabel
s
cafAnal
:: Platform
-> LabelSet
-> CLabel
-> CmmGraph
-> CAFEnv
cafAnal :: Platform -> LabelSet -> CLabel -> GenCmmGraph CmmNode -> CAFEnv
cafAnal Platform
platform LabelSet
contLbls CLabel
topLbl GenCmmGraph CmmNode
cmmGraph =
DataflowLattice (Set CAFfyLabel)
-> TransferFun' CmmNode (Set CAFfyLabel)
-> GenCmmGraph CmmNode
-> CAFEnv
-> CAFEnv
forall (node :: Extensibility -> Extensibility -> *) f.
NonLocal node =>
DataflowLattice f
-> TransferFun' node f
-> GenCmmGraph node
-> FactBase f
-> FactBase f
analyzeCmmBwd DataflowLattice (Set CAFfyLabel)
cafLattice
(Platform
-> LabelSet
-> BlockId
-> CLabel
-> TransferFun' CmmNode (Set CAFfyLabel)
cafTransfers Platform
platform LabelSet
contLbls (GenCmmGraph CmmNode -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry GenCmmGraph CmmNode
cmmGraph) CLabel
topLbl) GenCmmGraph CmmNode
cmmGraph CAFEnv
forall a. LabelMap a
forall (map :: * -> *) a. IsMap map => map a
mapEmpty
cafLattice :: DataflowLattice CAFSet
cafLattice :: DataflowLattice (Set CAFfyLabel)
cafLattice = Set CAFfyLabel
-> JoinFun (Set CAFfyLabel) -> DataflowLattice (Set CAFfyLabel)
forall a. a -> JoinFun a -> DataflowLattice a
DataflowLattice Set CAFfyLabel
forall a. Set a
Set.empty JoinFun (Set CAFfyLabel)
forall {a}.
Ord a =>
OldFact (Set a) -> NewFact (Set a) -> JoinedFact (Set a)
add
where
add :: OldFact (Set a) -> NewFact (Set a) -> JoinedFact (Set a)
add (OldFact Set a
old) (NewFact Set a
new) =
let !new' :: Set a
new' = Set a
old Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set a
new
in Bool -> Set a -> JoinedFact (Set a)
forall a. Bool -> a -> JoinedFact a
changedIf (Set a -> WordOff
forall a. Set a -> WordOff
Set.size Set a
new' WordOff -> WordOff -> Bool
forall a. Ord a => a -> a -> Bool
> Set a -> WordOff
forall a. Set a -> WordOff
Set.size Set a
old) Set a
new'
cafTransfers :: Platform -> LabelSet -> Label -> CLabel -> TransferFun CAFSet
cafTransfers :: Platform
-> LabelSet
-> BlockId
-> CLabel
-> TransferFun' CmmNode (Set CAFfyLabel)
cafTransfers Platform
platform LabelSet
contLbls BlockId
entry CLabel
topLbl
block :: CmmBlock
block@(BlockCC CmmNode C O
eNode Block CmmNode O O
middle CmmNode O C
xNode) CAFEnv
fBase =
let joined :: CAFSet
joined :: Set CAFfyLabel
joined = CmmNode O C -> Set CAFfyLabel -> Set CAFfyLabel
forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> Set CAFfyLabel -> Set CAFfyLabel
cafsInNode CmmNode O C
xNode (Set CAFfyLabel -> Set CAFfyLabel)
-> Set CAFfyLabel -> Set CAFfyLabel
forall a b. (a -> b) -> a -> b
$! Set CAFfyLabel
live'
result :: CAFSet
!result :: Set CAFfyLabel
result = (CmmNode O O -> Set CAFfyLabel -> Set CAFfyLabel)
-> Block CmmNode O O -> Set CAFfyLabel -> Set CAFfyLabel
forall (node :: Extensibility -> Extensibility -> *) f.
(node O O -> f -> f) -> Block node O O -> f -> f
foldNodesBwdOO CmmNode O O -> Set CAFfyLabel -> Set CAFfyLabel
forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> Set CAFfyLabel -> Set CAFfyLabel
cafsInNode Block CmmNode O O
middle Set CAFfyLabel
joined
facts :: [Set CAFfyLabel]
facts :: [Set CAFfyLabel]
facts = (BlockId -> Maybe (Set CAFfyLabel))
-> [BlockId] -> [Set CAFfyLabel]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BlockId -> Maybe (Set CAFfyLabel)
successorFact (CmmNode O C -> [BlockId]
forall (e :: Extensibility). CmmNode e C -> [BlockId]
forall (thing :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
NonLocal thing =>
thing e C -> [BlockId]
successors CmmNode O C
xNode)
live' :: CAFSet
live' :: Set CAFfyLabel
live' = DataflowLattice (Set CAFfyLabel)
-> [Set CAFfyLabel] -> Set CAFfyLabel
forall f. DataflowLattice f -> [f] -> f
joinFacts DataflowLattice (Set CAFfyLabel)
cafLattice [Set CAFfyLabel]
facts
successorFact :: Label -> Maybe (Set CAFfyLabel)
successorFact :: BlockId -> Maybe (Set CAFfyLabel)
successorFact BlockId
s
| BlockId
s BlockId -> BlockId -> Bool
forall a. Eq a => a -> a -> Bool
== BlockId
entry = Set CAFfyLabel -> Maybe (Set CAFfyLabel)
forall a. a -> Maybe a
Just (Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
addCafLabel Platform
platform CLabel
topLbl Set CAFfyLabel
forall a. Set a
Set.empty)
| ElemOf LabelSet
BlockId
s ElemOf LabelSet -> LabelSet -> Bool
forall set. IsSet set => ElemOf set -> set -> Bool
`setMember` LabelSet
contLbls
= Set CAFfyLabel -> Maybe (Set CAFfyLabel)
forall a. a -> Maybe a
Just (CAFfyLabel -> Set CAFfyLabel
forall a. a -> Set a
Set.singleton (Platform -> CLabel -> CAFfyLabel
mkCAFfyLabel Platform
platform (BlockId -> CLabel
infoTblLbl BlockId
s)))
| Bool
otherwise
= BlockId -> CAFEnv -> Maybe (Set CAFfyLabel)
forall f. BlockId -> FactBase f -> Maybe f
lookupFact BlockId
s CAFEnv
fBase
cafsInNode :: CmmNode e x -> CAFSet -> CAFSet
cafsInNode :: forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> Set CAFfyLabel -> Set CAFfyLabel
cafsInNode CmmNode e x
node Set CAFfyLabel
set = (CmmExpr -> Set CAFfyLabel -> Set CAFfyLabel)
-> CmmNode e x -> Set CAFfyLabel -> Set CAFfyLabel
forall z (e :: Extensibility) (x :: Extensibility).
(CmmExpr -> z -> z) -> CmmNode e x -> z -> z
foldExpDeep CmmExpr -> Set CAFfyLabel -> Set CAFfyLabel
addCafExpr CmmNode e x
node Set CAFfyLabel
set
addCafExpr :: CmmExpr -> Set CAFfyLabel -> Set CAFfyLabel
addCafExpr :: CmmExpr -> Set CAFfyLabel -> Set CAFfyLabel
addCafExpr CmmExpr
expr !Set CAFfyLabel
set =
case CmmExpr
expr of
CmmLit (CmmLabel CLabel
c) ->
Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
addCafLabel Platform
platform CLabel
c Set CAFfyLabel
set
CmmLit (CmmLabelOff CLabel
c WordOff
_) ->
Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
addCafLabel Platform
platform CLabel
c Set CAFfyLabel
set
CmmLit (CmmLabelDiffOff CLabel
c1 CLabel
c2 WordOff
_ Width
_) ->
Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
addCafLabel Platform
platform CLabel
c1 (Set CAFfyLabel -> Set CAFfyLabel)
-> Set CAFfyLabel -> Set CAFfyLabel
forall a b. (a -> b) -> a -> b
$! Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
addCafLabel Platform
platform CLabel
c2 Set CAFfyLabel
set
CmmExpr
_ ->
Set CAFfyLabel
set
in
String -> SDoc -> CAFEnv -> CAFEnv
forall b. String -> SDoc -> b -> b
srtTrace String
"cafTransfers" (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"block:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CmmBlock -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmBlock
block SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"contLbls:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> LabelSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr LabelSet
contLbls SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"entry:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
entry SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"topLbl:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
topLbl SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cafs in exit:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> Set CAFfyLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Set CAFfyLabel
joined SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"result:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> Set CAFfyLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Set CAFfyLabel
result) (CAFEnv -> CAFEnv) -> CAFEnv -> CAFEnv
forall a b. (a -> b) -> a -> b
$
KeyOf LabelMap -> Set CAFfyLabel -> CAFEnv
forall a. KeyOf LabelMap -> a -> LabelMap a
forall (map :: * -> *) a. IsMap map => KeyOf map -> a -> map a
mapSingleton (CmmNode C O -> BlockId
forall (x :: Extensibility). CmmNode C x -> BlockId
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> BlockId
entryLabel CmmNode C O
eNode) Set CAFfyLabel
result
data ModuleSRTInfo = ModuleSRTInfo
{ ModuleSRTInfo -> Module
thisModule :: Module
, ModuleSRTInfo -> Map (Set SRTEntry) SRTEntry
dedupSRTs :: Map (Set SRTEntry) SRTEntry
, ModuleSRTInfo -> Map SRTEntry (Set SRTEntry)
flatSRTs :: Map SRTEntry (Set SRTEntry)
, ModuleSRTInfo -> SRTMap
moduleSRTMap :: SRTMap
}
instance OutputableP env CLabel => OutputableP env ModuleSRTInfo where
pdoc :: env -> ModuleSRTInfo -> SDoc
pdoc env
env ModuleSRTInfo{Map (Set SRTEntry) SRTEntry
Map SRTEntry (Set SRTEntry)
SRTMap
Module
thisModule :: ModuleSRTInfo -> Module
dedupSRTs :: ModuleSRTInfo -> Map (Set SRTEntry) SRTEntry
flatSRTs :: ModuleSRTInfo -> Map SRTEntry (Set SRTEntry)
moduleSRTMap :: ModuleSRTInfo -> SRTMap
thisModule :: Module
dedupSRTs :: Map (Set SRTEntry) SRTEntry
flatSRTs :: Map SRTEntry (Set SRTEntry)
moduleSRTMap :: SRTMap
..} =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ModuleSRTInfo {" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
(WordOff -> SDoc -> SDoc
nest WordOff
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"dedupSRTs =" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> env -> Map (Set SRTEntry) SRTEntry -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env Map (Set SRTEntry) SRTEntry
dedupSRTs SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"flatSRTs =" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> env -> Map SRTEntry (Set SRTEntry) -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env Map SRTEntry (Set SRTEntry)
flatSRTs SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"moduleSRTMap =" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> env -> SRTMap -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env SRTMap
moduleSRTMap) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'}'
emptySRT :: Module -> ModuleSRTInfo
emptySRT :: Module -> ModuleSRTInfo
emptySRT Module
mod =
ModuleSRTInfo
{ thisModule :: Module
thisModule = Module
mod
, dedupSRTs :: Map (Set SRTEntry) SRTEntry
dedupSRTs = Map (Set SRTEntry) SRTEntry
forall k a. Map k a
Map.empty
, flatSRTs :: Map SRTEntry (Set SRTEntry)
flatSRTs = Map SRTEntry (Set SRTEntry)
forall k a. Map k a
Map.empty
, moduleSRTMap :: SRTMap
moduleSRTMap = SRTMap
forall k a. Map k a
Map.empty
}
data SomeLabel
= BlockLabel !Label
| DeclLabel CLabel
deriving (SomeLabel -> SomeLabel -> Bool
(SomeLabel -> SomeLabel -> Bool)
-> (SomeLabel -> SomeLabel -> Bool) -> Eq SomeLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SomeLabel -> SomeLabel -> Bool
== :: SomeLabel -> SomeLabel -> Bool
$c/= :: SomeLabel -> SomeLabel -> Bool
/= :: SomeLabel -> SomeLabel -> Bool
Eq, Eq SomeLabel
Eq SomeLabel =>
(SomeLabel -> SomeLabel -> Ordering)
-> (SomeLabel -> SomeLabel -> Bool)
-> (SomeLabel -> SomeLabel -> Bool)
-> (SomeLabel -> SomeLabel -> Bool)
-> (SomeLabel -> SomeLabel -> Bool)
-> (SomeLabel -> SomeLabel -> SomeLabel)
-> (SomeLabel -> SomeLabel -> SomeLabel)
-> Ord SomeLabel
SomeLabel -> SomeLabel -> Bool
SomeLabel -> SomeLabel -> Ordering
SomeLabel -> SomeLabel -> SomeLabel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SomeLabel -> SomeLabel -> Ordering
compare :: SomeLabel -> SomeLabel -> Ordering
$c< :: SomeLabel -> SomeLabel -> Bool
< :: SomeLabel -> SomeLabel -> Bool
$c<= :: SomeLabel -> SomeLabel -> Bool
<= :: SomeLabel -> SomeLabel -> Bool
$c> :: SomeLabel -> SomeLabel -> Bool
> :: SomeLabel -> SomeLabel -> Bool
$c>= :: SomeLabel -> SomeLabel -> Bool
>= :: SomeLabel -> SomeLabel -> Bool
$cmax :: SomeLabel -> SomeLabel -> SomeLabel
max :: SomeLabel -> SomeLabel -> SomeLabel
$cmin :: SomeLabel -> SomeLabel -> SomeLabel
min :: SomeLabel -> SomeLabel -> SomeLabel
Ord)
instance OutputableP env CLabel => OutputableP env SomeLabel where
pdoc :: env -> SomeLabel -> SDoc
pdoc env
env = \case
BlockLabel BlockId
l -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"b:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> env -> BlockId -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env BlockId
l
DeclLabel CLabel
l -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"s:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> env -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env CLabel
l
getBlockLabel :: SomeLabel -> Maybe Label
getBlockLabel :: SomeLabel -> Maybe BlockId
getBlockLabel (BlockLabel BlockId
l) = BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just BlockId
l
getBlockLabel (DeclLabel CLabel
_) = Maybe BlockId
forall a. Maybe a
Nothing
getBlockLabels :: [SomeLabel] -> [Label]
getBlockLabels :: [SomeLabel] -> [BlockId]
getBlockLabels = (SomeLabel -> Maybe BlockId) -> [SomeLabel] -> [BlockId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SomeLabel -> Maybe BlockId
getBlockLabel
getLabelledBlocks :: Platform -> CmmDecl -> [(SomeLabel, CAFfyLabel)]
getLabelledBlocks :: Platform -> CmmDecl -> [(SomeLabel, CAFfyLabel)]
getLabelledBlocks Platform
platform CmmDecl
decl = case CmmDecl
decl of
CmmData Section
_ (CmmStaticsRaw CLabel
_ [CmmStatic]
_) -> []
CmmData Section
_ (CmmStatics CLabel
lbl CmmInfoTable
info CostCentreStack
_ [CmmLit]
_ [CmmLit]
_) -> [ (CLabel -> SomeLabel
DeclLabel CLabel
lbl, Platform -> CLabel -> CAFfyLabel
mkCAFfyLabel Platform
platform CLabel
lbl)
| Bool -> Bool
not (SMRep -> Bool
isThunkRep (CmmInfoTable -> SMRep
cit_rep CmmInfoTable
info))
]
CmmProc CmmTopInfo
top_info CLabel
_ [GlobalReg]
_ GenCmmGraph CmmNode
_ -> [ (BlockId -> SomeLabel
BlockLabel BlockId
blockId, CAFfyLabel
caf_lbl)
| (BlockId
blockId, CmmInfoTable
info) <- LabelMap CmmInfoTable -> [(KeyOf LabelMap, CmmInfoTable)]
forall a. LabelMap a -> [(KeyOf LabelMap, a)]
forall (map :: * -> *) a. IsMap map => map a -> [(KeyOf map, a)]
mapToList (CmmTopInfo -> LabelMap CmmInfoTable
info_tbls CmmTopInfo
top_info)
, let rep :: SMRep
rep = CmmInfoTable -> SMRep
cit_rep CmmInfoTable
info
, Bool -> Bool
not (SMRep -> Bool
isStaticRep SMRep
rep) Bool -> Bool -> Bool
|| Bool -> Bool
not (SMRep -> Bool
isThunkRep SMRep
rep)
, let !caf_lbl :: CAFfyLabel
caf_lbl = Platform -> CLabel -> CAFfyLabel
mkCAFfyLabel Platform
platform (CmmInfoTable -> CLabel
cit_lbl CmmInfoTable
info)
]
depAnalSRTs
:: Platform
-> CAFEnv
-> Map CLabel CAFSet
-> [CmmDecl]
-> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
depAnalSRTs :: Platform
-> CAFEnv
-> DataCAFEnv
-> [CmmDecl]
-> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
depAnalSRTs Platform
platform CAFEnv
cafEnv DataCAFEnv
cafEnv_static [CmmDecl]
decls =
String
-> SDoc
-> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
-> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
forall b. String -> SDoc -> b -> b
srtTrace String
"depAnalSRTs" (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"decls:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [CmmDecl] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [CmmDecl]
decls SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"nodes:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [(SomeLabel, CAFfyLabel, Set CAFfyLabel)] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform ((Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)
-> (SomeLabel, CAFfyLabel, Set CAFfyLabel))
-> [Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
-> [(SomeLabel, CAFfyLabel, Set CAFfyLabel)]
forall a b. (a -> b) -> [a] -> [b]
map Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)
-> (SomeLabel, CAFfyLabel, Set CAFfyLabel)
forall key payload. Node key payload -> payload
node_payload [Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
nodes) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"graph:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
graph) [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
graph
where
labelledBlocks :: [(SomeLabel, CAFfyLabel)]
labelledBlocks :: [(SomeLabel, CAFfyLabel)]
labelledBlocks = (CmmDecl -> [(SomeLabel, CAFfyLabel)])
-> [CmmDecl] -> [(SomeLabel, CAFfyLabel)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Platform -> CmmDecl -> [(SomeLabel, CAFfyLabel)]
getLabelledBlocks Platform
platform) [CmmDecl]
decls
labelToBlock :: Map CAFfyLabel SomeLabel
labelToBlock :: Map CAFfyLabel SomeLabel
labelToBlock = (Map CAFfyLabel SomeLabel
-> (SomeLabel, CAFfyLabel) -> Map CAFfyLabel SomeLabel)
-> Map CAFfyLabel SomeLabel
-> [(SomeLabel, CAFfyLabel)]
-> Map CAFfyLabel SomeLabel
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map CAFfyLabel SomeLabel
m (SomeLabel
v,CAFfyLabel
k) -> CAFfyLabel
-> SomeLabel
-> Map CAFfyLabel SomeLabel
-> Map CAFfyLabel SomeLabel
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CAFfyLabel
k SomeLabel
v Map CAFfyLabel SomeLabel
m) Map CAFfyLabel SomeLabel
forall k a. Map k a
Map.empty [(SomeLabel, CAFfyLabel)]
labelledBlocks
nodes :: [Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
nodes :: [Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
nodes = [ (SomeLabel, CAFfyLabel, Set CAFfyLabel)
-> SomeLabel
-> [SomeLabel]
-> Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)
forall key payload. payload -> key -> [key] -> Node key payload
DigraphNode (SomeLabel
l,CAFfyLabel
lbl,Set CAFfyLabel
cafs') SomeLabel
l
((CAFfyLabel -> Maybe SomeLabel) -> [CAFfyLabel] -> [SomeLabel]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((CAFfyLabel -> Map CAFfyLabel SomeLabel -> Maybe SomeLabel)
-> Map CAFfyLabel SomeLabel -> CAFfyLabel -> Maybe SomeLabel
forall a b c. (a -> b -> c) -> b -> a -> c
flip CAFfyLabel -> Map CAFfyLabel SomeLabel -> Maybe SomeLabel
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map CAFfyLabel SomeLabel
labelToBlock) (Set CAFfyLabel -> [CAFfyLabel]
forall a. Set a -> [a]
Set.toList Set CAFfyLabel
cafs'))
| (SomeLabel
l, CAFfyLabel
lbl) <- [(SomeLabel, CAFfyLabel)]
labelledBlocks
, Just (Set CAFfyLabel
cafs :: Set CAFfyLabel) <-
[case SomeLabel
l of
BlockLabel BlockId
l -> KeyOf LabelMap -> CAFEnv -> Maybe (Set CAFfyLabel)
forall a. KeyOf LabelMap -> LabelMap a -> Maybe a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
BlockId
l CAFEnv
cafEnv
DeclLabel CLabel
cl -> CLabel -> DataCAFEnv -> Maybe (Set CAFfyLabel)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CLabel
cl DataCAFEnv
cafEnv_static]
, let cafs' :: Set CAFfyLabel
cafs' = CAFfyLabel -> Set CAFfyLabel -> Set CAFfyLabel
forall a. Ord a => a -> Set a -> Set a
Set.delete CAFfyLabel
lbl Set CAFfyLabel
cafs
]
graph :: [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
graph :: [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
graph = [Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
-> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
forall key payload. Ord key => [Node key payload] -> [SCC payload]
stronglyConnCompFromEdgedVerticesOrd [Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
nodes
getCAFs :: Platform -> CAFEnv -> [CmmDecl] -> [(Maybe Label, CAFfyLabel, Set CAFfyLabel)]
getCAFs :: Platform
-> CAFEnv
-> [CmmDecl]
-> [(Maybe BlockId, CAFfyLabel, Set CAFfyLabel)]
getCAFs Platform
platform CAFEnv
cafEnv = (CmmDecl -> Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel))
-> [CmmDecl] -> [(Maybe BlockId, CAFfyLabel, Set CAFfyLabel)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CmmDecl -> Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
getCAFLabel
where
getCAFLabel :: CmmDecl -> Maybe (Maybe Label, CAFfyLabel, Set CAFfyLabel)
getCAFLabel :: CmmDecl -> Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
getCAFLabel (CmmProc CmmTopInfo
top_info CLabel
top_lbl [GlobalReg]
_ GenCmmGraph CmmNode
g)
| Just CmmInfoTable
info <- KeyOf LabelMap -> LabelMap CmmInfoTable -> Maybe CmmInfoTable
forall a. KeyOf LabelMap -> LabelMap a -> Maybe a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup (GenCmmGraph CmmNode -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry GenCmmGraph CmmNode
g) (CmmTopInfo -> LabelMap CmmInfoTable
info_tbls CmmTopInfo
top_info)
, let rep :: SMRep
rep = CmmInfoTable -> SMRep
cit_rep CmmInfoTable
info
, SMRep -> Bool
isStaticRep SMRep
rep Bool -> Bool -> Bool
&& SMRep -> Bool
isThunkRep SMRep
rep
, Just Set CAFfyLabel
cafs <- KeyOf LabelMap -> CAFEnv -> Maybe (Set CAFfyLabel)
forall a. KeyOf LabelMap -> LabelMap a -> Maybe a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup (GenCmmGraph CmmNode -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry GenCmmGraph CmmNode
g) CAFEnv
cafEnv
= (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
-> Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
forall a. a -> Maybe a
Just (BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just (GenCmmGraph CmmNode -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry GenCmmGraph CmmNode
g), Platform -> CLabel -> CAFfyLabel
mkCAFfyLabel Platform
platform CLabel
top_lbl, Set CAFfyLabel
cafs)
| Bool
otherwise
= Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
forall a. Maybe a
Nothing
getCAFLabel (CmmData Section
_ (CmmStatics CLabel
top_lbl CmmInfoTable
info CostCentreStack
_ccs [CmmLit]
_payload [CmmLit]
_extras))
| SMRep -> Bool
isThunkRep (CmmInfoTable -> SMRep
cit_rep CmmInfoTable
info)
= (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
-> Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
forall a. a -> Maybe a
Just (Maybe BlockId
forall a. Maybe a
Nothing, Platform -> CLabel -> CAFfyLabel
mkCAFfyLabel Platform
platform CLabel
top_lbl, Set CAFfyLabel
forall a. Set a
Set.empty)
| Bool
otherwise
= Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
forall a. Maybe a
Nothing
getCAFLabel (CmmData Section
_ (CmmStaticsRaw CLabel
_lbl [CmmStatic]
_payload))
= Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
forall a. Maybe a
Nothing
getStaticFuns :: [CmmDecl] -> [(BlockId, CLabel)]
getStaticFuns :: [CmmDecl] -> [(BlockId, CLabel)]
getStaticFuns [CmmDecl]
decls =
[ (GenCmmGraph CmmNode -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry GenCmmGraph CmmNode
g, CLabel
lbl)
| CmmProc CmmTopInfo
top_info CLabel
_ [GlobalReg]
_ GenCmmGraph CmmNode
g <- [CmmDecl]
decls
, Just CmmInfoTable
info <- [KeyOf LabelMap -> LabelMap CmmInfoTable -> Maybe CmmInfoTable
forall a. KeyOf LabelMap -> LabelMap a -> Maybe a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup (GenCmmGraph CmmNode -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry GenCmmGraph CmmNode
g) (CmmTopInfo -> LabelMap CmmInfoTable
info_tbls CmmTopInfo
top_info)]
, Just (Id
id, CostCentreStack
_) <- [CmmInfoTable -> Maybe (Id, CostCentreStack)
cit_clo CmmInfoTable
info]
, let rep :: SMRep
rep = CmmInfoTable -> SMRep
cit_rep CmmInfoTable
info
, SMRep -> Bool
isStaticRep SMRep
rep Bool -> Bool -> Bool
&& SMRep -> Bool
isFunRep SMRep
rep
, let !lbl :: CLabel
lbl = Name -> CafInfo -> CLabel
mkClosureLabel (Id -> Name
idName Id
id) (Id -> CafInfo
idCafInfo Id
id)
]
type SRTMap = Map CAFfyLabel (Maybe SRTEntry)
srtMapNonCAFs :: SRTMap -> NonCaffySet
srtMapNonCAFs :: SRTMap -> NonCaffySet
srtMapNonCAFs SRTMap
srtMap =
NameSet -> NonCaffySet
NonCaffySet (NameSet -> NonCaffySet) -> NameSet -> NonCaffySet
forall a b. (a -> b) -> a -> b
$ [Name] -> NameSet
mkNameSet (((CAFfyLabel, Maybe SRTEntry) -> Maybe Name)
-> [(CAFfyLabel, Maybe SRTEntry)] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (CAFfyLabel, Maybe SRTEntry) -> Maybe Name
forall {a}. (CAFfyLabel, Maybe a) -> Maybe Name
get_name (SRTMap -> [(CAFfyLabel, Maybe SRTEntry)]
forall k a. Map k a -> [(k, a)]
Map.toList SRTMap
srtMap))
where
get_name :: (CAFfyLabel, Maybe a) -> Maybe Name
get_name (CAFfyLabel CLabel
l, Maybe a
Nothing) = CLabel -> Maybe Name
hasHaskellName CLabel
l
get_name (CAFfyLabel
_l, Just a
_srt_entry) = Maybe Name
forall a. Maybe a
Nothing
resolveCAF :: Platform -> SRTMap -> CAFfyLabel -> Maybe SRTEntry
resolveCAF :: Platform -> SRTMap -> CAFfyLabel -> Maybe SRTEntry
resolveCAF Platform
platform SRTMap
srtMap lbl :: CAFfyLabel
lbl@(CAFfyLabel CLabel
l) =
String -> SDoc -> Maybe SRTEntry -> Maybe SRTEntry
forall b. String -> SDoc -> b -> b
srtTrace String
"resolveCAF" (SDoc
"l:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
l SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"resolved:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> Maybe SRTEntry -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Maybe SRTEntry
ret) Maybe SRTEntry
ret
where
ret :: Maybe SRTEntry
ret = Maybe SRTEntry -> CAFfyLabel -> SRTMap -> Maybe SRTEntry
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (SRTEntry -> Maybe SRTEntry
forall a. a -> Maybe a
Just (CLabel -> SRTEntry
SRTEntry (Platform -> CLabel -> CLabel
toClosureLbl Platform
platform CLabel
l))) CAFfyLabel
lbl SRTMap
srtMap
anyCafRefs :: [CafInfo] -> CafInfo
anyCafRefs :: [CafInfo] -> CafInfo
anyCafRefs [CafInfo]
caf_infos = case (CafInfo -> Bool) -> [CafInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CafInfo -> Bool
mayHaveCafRefs [CafInfo]
caf_infos of
Bool
True -> CafInfo
MayHaveCafRefs
Bool
False -> CafInfo
NoCafRefs
doSRTs
:: CmmConfig
-> ModuleSRTInfo
-> [(CAFEnv, [CmmDecl])]
-> [(CAFSet, CmmDataDecl)]
-> IO (ModuleSRTInfo, [CmmDeclSRTs])
doSRTs :: CmmConfig
-> ModuleSRTInfo
-> [(CAFEnv, [CmmDecl])]
-> [(Set CAFfyLabel, CmmDataDecl)]
-> IO (ModuleSRTInfo, [CmmDeclSRTs])
doSRTs CmmConfig
cfg ModuleSRTInfo
moduleSRTInfo [(CAFEnv, [CmmDecl])]
procs [(Set CAFfyLabel, CmmDataDecl)]
data_ = do
UniqSupply
us <- Char -> IO UniqSupply
mkSplitUniqSupply Char
'u'
let profile :: Profile
profile = CmmConfig -> Profile
cmmProfile CmmConfig
cfg
let static_data_env :: DataCAFEnv
static_data_env :: DataCAFEnv
static_data_env =
[(CLabel, Set CAFfyLabel)] -> DataCAFEnv
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(CLabel, Set CAFfyLabel)] -> DataCAFEnv)
-> [(CLabel, Set CAFfyLabel)] -> DataCAFEnv
forall a b. (a -> b) -> a -> b
$
(((Set CAFfyLabel, CmmDataDecl) -> (CLabel, Set CAFfyLabel))
-> [(Set CAFfyLabel, CmmDataDecl)] -> [(CLabel, Set CAFfyLabel)])
-> [(Set CAFfyLabel, CmmDataDecl)]
-> ((Set CAFfyLabel, CmmDataDecl) -> (CLabel, Set CAFfyLabel))
-> [(CLabel, Set CAFfyLabel)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Set CAFfyLabel, CmmDataDecl) -> (CLabel, Set CAFfyLabel))
-> [(Set CAFfyLabel, CmmDataDecl)] -> [(CLabel, Set CAFfyLabel)]
forall a b. (a -> b) -> [a] -> [b]
map [(Set CAFfyLabel, CmmDataDecl)]
data_ (((Set CAFfyLabel, CmmDataDecl) -> (CLabel, Set CAFfyLabel))
-> [(CLabel, Set CAFfyLabel)])
-> ((Set CAFfyLabel, CmmDataDecl) -> (CLabel, Set CAFfyLabel))
-> [(CLabel, Set CAFfyLabel)]
forall a b. (a -> b) -> a -> b
$
\(Set CAFfyLabel
set, CmmDataDecl
decl) ->
case CmmDataDecl
decl of
CmmProc Void
void CLabel
_ [GlobalReg]
_ Void
_ -> case Void
void of
CmmData Section
_ GenCmmStatics 'False
static ->
case GenCmmStatics 'False
static of
CmmStatics CLabel
lbl CmmInfoTable
_ CostCentreStack
_ [CmmLit]
_ [CmmLit]
_ -> (CLabel
lbl, Set CAFfyLabel
set)
CmmStaticsRaw CLabel
lbl [CmmStatic]
_ -> (CLabel
lbl, Set CAFfyLabel
set)
([CAFEnv]
proc_envs, [[CmmDecl]]
procss) = [(CAFEnv, [CmmDecl])] -> ([CAFEnv], [[CmmDecl]])
forall a b. [(a, b)] -> ([a], [b])
unzip [(CAFEnv, [CmmDecl])]
procs
cafEnv :: CAFEnv
cafEnv = [CAFEnv] -> CAFEnv
forall (map :: * -> *) a. IsMap map => [map a] -> map a
mapUnions [CAFEnv]
proc_envs
decls :: [CmmDecl]
decls = ((Set CAFfyLabel, CmmDataDecl) -> CmmDecl)
-> [(Set CAFfyLabel, CmmDataDecl)] -> [CmmDecl]
forall a b. (a -> b) -> [a] -> [b]
map (CmmDataDecl -> CmmDecl
forall d h g. GenCmmDataDecl d -> GenCmmDecl d h g
cmmDataDeclCmmDecl (CmmDataDecl -> CmmDecl)
-> ((Set CAFfyLabel, CmmDataDecl) -> CmmDataDecl)
-> (Set CAFfyLabel, CmmDataDecl)
-> CmmDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set CAFfyLabel, CmmDataDecl) -> CmmDataDecl
forall a b. (a, b) -> b
snd) [(Set CAFfyLabel, CmmDataDecl)]
data_ [CmmDecl] -> [CmmDecl] -> [CmmDecl]
forall a. [a] -> [a] -> [a]
++ [[CmmDecl]] -> [CmmDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[CmmDecl]]
procss
staticFuns :: LabelMap CLabel
staticFuns = [(KeyOf LabelMap, CLabel)] -> LabelMap CLabel
forall a. [(KeyOf LabelMap, a)] -> LabelMap a
forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
mapFromList ([CmmDecl] -> [(BlockId, CLabel)]
getStaticFuns [CmmDecl]
decls)
platform :: Platform
platform = CmmConfig -> Platform
cmmPlatform CmmConfig
cfg
let
sccs :: [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
sccs :: [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
sccs = {-# SCC depAnalSRTs #-} Platform
-> CAFEnv
-> DataCAFEnv
-> [CmmDecl]
-> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
depAnalSRTs Platform
platform CAFEnv
cafEnv DataCAFEnv
static_data_env [CmmDecl]
decls
cafsWithSRTs :: [(Maybe Label, CAFfyLabel, Set CAFfyLabel)]
cafsWithSRTs :: [(Maybe BlockId, CAFfyLabel, Set CAFfyLabel)]
cafsWithSRTs = Platform
-> CAFEnv
-> [CmmDecl]
-> [(Maybe BlockId, CAFfyLabel, Set CAFfyLabel)]
getCAFs Platform
platform CAFEnv
cafEnv [CmmDecl]
decls
String -> SDoc -> IO ()
forall (f :: * -> *). Applicative f => String -> SDoc -> f ()
srtTraceM String
"doSRTs" (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"data:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [(Set CAFfyLabel, CmmDataDecl)] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [(Set CAFfyLabel, CmmDataDecl)]
data_ SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"procs:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [(CAFEnv, [CmmDecl])] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [(CAFEnv, [CmmDecl])]
procs SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"static_data_env:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> DataCAFEnv -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform DataCAFEnv
static_data_env SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"sccs:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
sccs SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cafsWithSRTs:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [(Maybe BlockId, CAFfyLabel, Set CAFfyLabel)] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [(Maybe BlockId, CAFfyLabel, Set CAFfyLabel)]
cafsWithSRTs)
let result ::
[ ( [CmmDeclSRTs]
, [(Label, CLabel)]
, [(Label, [SRTEntry])]
, CafInfo
) ]
([([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
result, ModuleSRTInfo
moduleSRTInfo') =
UniqSupply
-> UniqSM
([([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)],
ModuleSRTInfo)
-> ([([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)],
ModuleSRTInfo)
forall a. UniqSupply -> UniqSM a -> a
initUs_ UniqSupply
us (UniqSM
([([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)],
ModuleSRTInfo)
-> ([([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)],
ModuleSRTInfo))
-> UniqSM
([([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)],
ModuleSRTInfo)
-> ([([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)],
ModuleSRTInfo)
forall a b. (a -> b) -> a -> b
$
(StateT
ModuleSRTInfo
UniqSM
[([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
-> ModuleSRTInfo
-> UniqSM
([([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)],
ModuleSRTInfo))
-> ModuleSRTInfo
-> StateT
ModuleSRTInfo
UniqSM
[([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
-> UniqSM
([([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)],
ModuleSRTInfo)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
ModuleSRTInfo
UniqSM
[([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
-> ModuleSRTInfo
-> UniqSM
([([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)],
ModuleSRTInfo)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ModuleSRTInfo
moduleSRTInfo (StateT
ModuleSRTInfo
UniqSM
[([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
-> UniqSM
([([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)],
ModuleSRTInfo))
-> StateT
ModuleSRTInfo
UniqSM
[([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
-> UniqSM
([([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)],
ModuleSRTInfo)
forall a b. (a -> b) -> a -> b
$ do
[([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
nonCAFs <- (SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo))
-> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
-> StateT
ModuleSRTInfo
UniqSM
[([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CmmConfig
-> LabelMap CLabel
-> DataCAFEnv
-> SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
doSCC CmmConfig
cfg LabelMap CLabel
staticFuns DataCAFEnv
static_data_env) [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
sccs
[([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
cAFs <- [(Maybe BlockId, CAFfyLabel, Set CAFfyLabel)]
-> ((Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo))
-> StateT
ModuleSRTInfo
UniqSM
[([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Maybe BlockId, CAFfyLabel, Set CAFfyLabel)]
cafsWithSRTs (((Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo))
-> StateT
ModuleSRTInfo
UniqSM
[([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)])
-> ((Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo))
-> StateT
ModuleSRTInfo
UniqSM
[([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
forall a b. (a -> b) -> a -> b
$ \(Maybe BlockId
l, CAFfyLabel
cafLbl, Set CAFfyLabel
cafs) ->
CmmConfig
-> LabelMap CLabel
-> [SomeLabel]
-> [CAFfyLabel]
-> Bool
-> Set CAFfyLabel
-> DataCAFEnv
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
oneSRT CmmConfig
cfg LabelMap CLabel
staticFuns ((BlockId -> SomeLabel) -> [BlockId] -> [SomeLabel]
forall a b. (a -> b) -> [a] -> [b]
map BlockId -> SomeLabel
BlockLabel (Maybe BlockId -> [BlockId]
forall a. Maybe a -> [a]
maybeToList Maybe BlockId
l)) [CAFfyLabel
cafLbl]
Bool
True Set CAFfyLabel
cafs DataCAFEnv
static_data_env
[([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
-> StateT
ModuleSRTInfo
UniqSM
[([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
forall a. a -> StateT ModuleSRTInfo UniqSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
nonCAFs [([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
-> [([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
-> [([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
forall a. [a] -> [a] -> [a]
++ [([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
cAFs)
([[CmmDeclSRTs]]
srt_declss, [[(BlockId, CLabel)]]
pairs, [[(BlockId, [SRTEntry])]]
funSRTs, [CafInfo]
has_caf_refs) = [([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
-> ([[CmmDeclSRTs]], [[(BlockId, CLabel)]],
[[(BlockId, [SRTEntry])]], [CafInfo])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 [([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)]
result
srt_decls :: [CmmDeclSRTs]
srt_decls = [[CmmDeclSRTs]] -> [CmmDeclSRTs]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[CmmDeclSRTs]]
srt_declss
let
srtFieldMap :: LabelMap CLabel
srtFieldMap = [(KeyOf LabelMap, CLabel)] -> LabelMap CLabel
forall a. [(KeyOf LabelMap, a)] -> LabelMap a
forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
mapFromList ([[(BlockId, CLabel)]] -> [(BlockId, CLabel)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(BlockId, CLabel)]]
pairs)
funSRTMap :: LabelMap [SRTEntry]
funSRTMap = [(KeyOf LabelMap, [SRTEntry])] -> LabelMap [SRTEntry]
forall a. [(KeyOf LabelMap, a)] -> LabelMap a
forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
mapFromList ([[(BlockId, [SRTEntry])]] -> [(BlockId, [SRTEntry])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(BlockId, [SRTEntry])]]
funSRTs)
has_caf_refs' :: CafInfo
has_caf_refs' = [CafInfo] -> CafInfo
anyCafRefs [CafInfo]
has_caf_refs
decls' :: [CmmDeclSRTs]
decls' =
(CmmDecl -> [CmmDeclSRTs]) -> [CmmDecl] -> [CmmDeclSRTs]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Profile
-> LabelMap CLabel
-> LabelMap [SRTEntry]
-> CafInfo
-> CmmDecl
-> [CmmDeclSRTs]
updInfoSRTs Profile
profile LabelMap CLabel
srtFieldMap LabelMap [SRTEntry]
funSRTMap CafInfo
has_caf_refs') [CmmDecl]
decls
let srtMap_w_raws :: SRTMap
srtMap_w_raws =
(SRTMap -> (Set CAFfyLabel, CmmDataDecl) -> SRTMap)
-> SRTMap -> [(Set CAFfyLabel, CmmDataDecl)] -> SRTMap
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(SRTMap
srtMap :: SRTMap) (Set CAFfyLabel
_, CmmDataDecl
decl) ->
case CmmDataDecl
decl of
CmmData Section
_ CmmStatics{} ->
SRTMap
srtMap
CmmData Section
_ (CmmStaticsRaw CLabel
lbl [CmmStatic]
_)
| CLabel -> Bool
isIdLabel CLabel
lbl Bool -> Bool -> Bool
&& Bool -> Bool
not (CLabel -> Bool
isTickyLabel CLabel
lbl) ->
CAFfyLabel -> Maybe SRTEntry -> SRTMap -> SRTMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Platform -> CLabel -> CAFfyLabel
mkCAFfyLabel Platform
platform CLabel
lbl) Maybe SRTEntry
forall a. Maybe a
Nothing SRTMap
srtMap
| Bool
otherwise ->
SRTMap
srtMap
CmmProc Void
void CLabel
_ [GlobalReg]
_ Void
_ -> case Void
void of)
(ModuleSRTInfo -> SRTMap
moduleSRTMap ModuleSRTInfo
moduleSRTInfo') [(Set CAFfyLabel, CmmDataDecl)]
data_
(ModuleSRTInfo, [CmmDeclSRTs]) -> IO (ModuleSRTInfo, [CmmDeclSRTs])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleSRTInfo
moduleSRTInfo'{ moduleSRTMap = srtMap_w_raws }, [CmmDeclSRTs]
srt_decls [CmmDeclSRTs] -> [CmmDeclSRTs] -> [CmmDeclSRTs]
forall a. [a] -> [a] -> [a]
++ [CmmDeclSRTs]
decls')
doSCC
:: CmmConfig
-> LabelMap CLabel
-> DataCAFEnv
-> SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)
-> StateT ModuleSRTInfo UniqSM
( [CmmDeclSRTs]
, [(Label, CLabel)]
, [(Label, [SRTEntry])]
, CafInfo
)
doSCC :: CmmConfig
-> LabelMap CLabel
-> DataCAFEnv
-> SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
doSCC CmmConfig
cfg LabelMap CLabel
staticFuns DataCAFEnv
static_data_env (AcyclicSCC (SomeLabel
l, CAFfyLabel
cafLbl, Set CAFfyLabel
cafs)) =
CmmConfig
-> LabelMap CLabel
-> [SomeLabel]
-> [CAFfyLabel]
-> Bool
-> Set CAFfyLabel
-> DataCAFEnv
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
oneSRT CmmConfig
cfg LabelMap CLabel
staticFuns [SomeLabel
l] [CAFfyLabel
cafLbl] Bool
False Set CAFfyLabel
cafs DataCAFEnv
static_data_env
doSCC CmmConfig
cfg LabelMap CLabel
staticFuns DataCAFEnv
static_data_env (CyclicSCC [(SomeLabel, CAFfyLabel, Set CAFfyLabel)]
nodes) = do
let ([SomeLabel]
lbls, [CAFfyLabel]
caf_lbls, [Set CAFfyLabel]
cafsets) = [(SomeLabel, CAFfyLabel, Set CAFfyLabel)]
-> ([SomeLabel], [CAFfyLabel], [Set CAFfyLabel])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(SomeLabel, CAFfyLabel, Set CAFfyLabel)]
nodes
cafs :: Set CAFfyLabel
cafs = [Set CAFfyLabel] -> Set CAFfyLabel
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set CAFfyLabel]
cafsets
CmmConfig
-> LabelMap CLabel
-> [SomeLabel]
-> [CAFfyLabel]
-> Bool
-> Set CAFfyLabel
-> DataCAFEnv
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
oneSRT CmmConfig
cfg LabelMap CLabel
staticFuns [SomeLabel]
lbls [CAFfyLabel]
caf_lbls Bool
False Set CAFfyLabel
cafs DataCAFEnv
static_data_env
oneSRT
:: CmmConfig
-> LabelMap CLabel
-> [SomeLabel]
-> [CAFfyLabel]
-> Bool
-> Set CAFfyLabel
-> DataCAFEnv
-> StateT ModuleSRTInfo UniqSM
( [CmmDeclSRTs]
, [(Label, CLabel)]
, [(Label, [SRTEntry])]
, CafInfo
)
oneSRT :: CmmConfig
-> LabelMap CLabel
-> [SomeLabel]
-> [CAFfyLabel]
-> Bool
-> Set CAFfyLabel
-> DataCAFEnv
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
oneSRT CmmConfig
cfg LabelMap CLabel
staticFuns [SomeLabel]
lbls [CAFfyLabel]
caf_lbls Bool
isCAF Set CAFfyLabel
cafs DataCAFEnv
static_data_env = do
ModuleSRTInfo
topSRT <- StateT ModuleSRTInfo UniqSM ModuleSRTInfo
forall (m :: * -> *) s. Monad m => StateT s m s
get
let
this_mod :: Module
this_mod = ModuleSRTInfo -> Module
thisModule ModuleSRTInfo
topSRT
profile :: Profile
profile = CmmConfig -> Profile
cmmProfile CmmConfig
cfg
platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
srtMap :: SRTMap
srtMap = ModuleSRTInfo -> SRTMap
moduleSRTMap ModuleSRTInfo
topSRT
blockids :: [BlockId]
blockids = [SomeLabel] -> [BlockId]
getBlockLabels [SomeLabel]
lbls
maybeFunClosure :: Maybe (CLabel, Label)
otherFunLabels :: [CLabel]
(Maybe (CLabel, BlockId)
maybeFunClosure, [CLabel]
otherFunLabels) =
case [ (CLabel
l,BlockId
b) | BlockId
b <- [BlockId]
blockids, Just CLabel
l <- [KeyOf LabelMap -> LabelMap CLabel -> Maybe CLabel
forall a. KeyOf LabelMap -> LabelMap a -> Maybe a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
BlockId
b LabelMap CLabel
staticFuns] ] of
[] -> (Maybe (CLabel, BlockId)
forall a. Maybe a
Nothing, [])
((CLabel
l,BlockId
b):[(CLabel, BlockId)]
xs) -> ((CLabel, BlockId) -> Maybe (CLabel, BlockId)
forall a. a -> Maybe a
Just (CLabel
l,BlockId
b), ((CLabel, BlockId) -> CLabel) -> [(CLabel, BlockId)] -> [CLabel]
forall a b. (a -> b) -> [a] -> [b]
map (CLabel, BlockId) -> CLabel
forall a b. (a, b) -> a
fst [(CLabel, BlockId)]
xs)
nonRec :: Set CAFfyLabel
nonRec :: Set CAFfyLabel
nonRec = Set CAFfyLabel
cafs Set CAFfyLabel -> Set CAFfyLabel -> Set CAFfyLabel
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` [CAFfyLabel] -> Set CAFfyLabel
forall a. Ord a => [a] -> Set a
Set.fromList [CAFfyLabel]
caf_lbls
resolved :: [SRTEntry]
resolved :: [SRTEntry]
resolved = (CAFfyLabel -> Maybe SRTEntry) -> [CAFfyLabel] -> [SRTEntry]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Platform -> SRTMap -> CAFfyLabel -> Maybe SRTEntry
resolveCAF Platform
platform SRTMap
srtMap) (Set CAFfyLabel -> [CAFfyLabel]
forall a. Set a -> [a]
Set.toList Set CAFfyLabel
nonRec)
allBelow :: Set SRTEntry
allBelow =
[Set SRTEntry] -> Set SRTEntry
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [ Set SRTEntry
lbls | SRTEntry
caf <- [SRTEntry]
resolved
, Just Set SRTEntry
lbls <- [SRTEntry -> Map SRTEntry (Set SRTEntry) -> Maybe (Set SRTEntry)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SRTEntry
caf (ModuleSRTInfo -> Map SRTEntry (Set SRTEntry)
flatSRTs ModuleSRTInfo
topSRT)] ]
filtered0 :: Set SRTEntry
filtered0 = [SRTEntry] -> Set SRTEntry
forall a. Ord a => [a] -> Set a
Set.fromList [SRTEntry]
resolved Set SRTEntry -> Set SRTEntry -> Set SRTEntry
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set SRTEntry
allBelow
String -> SDoc -> StateT ModuleSRTInfo UniqSM ()
forall (f :: * -> *). Applicative f => String -> SDoc -> f ()
srtTraceM String
"oneSRT:"
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"srtMap:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> SRTMap -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform SRTMap
srtMap SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"nonRec:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> Set CAFfyLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Set CAFfyLabel
nonRec SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lbls:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [SomeLabel] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [SomeLabel]
lbls SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"caf_lbls:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [CAFfyLabel] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [CAFfyLabel]
caf_lbls SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"static_data_env:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> DataCAFEnv -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform DataCAFEnv
static_data_env SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cafs:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> Set CAFfyLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Set CAFfyLabel
cafs SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"blockids:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [BlockId] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [BlockId]
blockids SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"maybeFunClosure:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> Maybe (CLabel, BlockId) -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Maybe (CLabel, BlockId)
maybeFunClosure SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"otherFunLabels:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [CLabel] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [CLabel]
otherFunLabels SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"resolved:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [SRTEntry] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [SRTEntry]
resolved SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"allBelow:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> Set SRTEntry -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Set SRTEntry
allBelow SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"filtered0:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> Set SRTEntry -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Set SRTEntry
filtered0)
let
isStaticFun :: Bool
isStaticFun = Maybe (CLabel, BlockId) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (CLabel, BlockId)
maybeFunClosure
updateSRTMap :: Maybe SRTEntry -> StateT ModuleSRTInfo UniqSM ()
updateSRTMap :: Maybe SRTEntry -> StateT ModuleSRTInfo UniqSM ()
updateSRTMap Maybe SRTEntry
srtEntry =
String
-> SDoc
-> StateT ModuleSRTInfo UniqSM ()
-> StateT ModuleSRTInfo UniqSM ()
forall b. String -> SDoc -> b -> b
srtTrace String
"updateSRTMap"
(Platform -> Maybe SRTEntry -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Maybe SRTEntry
srtEntry SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"isCAF:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
isCAF SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
SDoc
"isStaticFun:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
isStaticFun) (StateT ModuleSRTInfo UniqSM () -> StateT ModuleSRTInfo UniqSM ())
-> StateT ModuleSRTInfo UniqSM () -> StateT ModuleSRTInfo UniqSM ()
forall a b. (a -> b) -> a -> b
$
Bool
-> StateT ModuleSRTInfo UniqSM () -> StateT ModuleSRTInfo UniqSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isCAF Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
isStaticFun Bool -> Bool -> Bool
|| Maybe SRTEntry -> Bool
forall a. Maybe a -> Bool
isNothing Maybe SRTEntry
srtEntry)) (StateT ModuleSRTInfo UniqSM () -> StateT ModuleSRTInfo UniqSM ())
-> StateT ModuleSRTInfo UniqSM () -> StateT ModuleSRTInfo UniqSM ()
forall a b. (a -> b) -> a -> b
$
(ModuleSRTInfo -> ModuleSRTInfo) -> StateT ModuleSRTInfo UniqSM ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((ModuleSRTInfo -> ModuleSRTInfo)
-> StateT ModuleSRTInfo UniqSM ())
-> (ModuleSRTInfo -> ModuleSRTInfo)
-> StateT ModuleSRTInfo UniqSM ()
forall a b. (a -> b) -> a -> b
$ \ModuleSRTInfo
state ->
let !srt_map :: SRTMap
srt_map =
(SRTMap -> CAFfyLabel -> SRTMap)
-> SRTMap -> [CAFfyLabel] -> SRTMap
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\SRTMap
srt_map cafLbl :: CAFfyLabel
cafLbl@(CAFfyLabel CLabel
clbl) ->
if Bool -> Bool
not (CLabel -> DataCAFEnv -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member CLabel
clbl DataCAFEnv
static_data_env) Bool -> Bool -> Bool
|| Maybe SRTEntry -> Bool
forall a. Maybe a -> Bool
isNothing Maybe SRTEntry
srtEntry then
CAFfyLabel -> Maybe SRTEntry -> SRTMap -> SRTMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CAFfyLabel
cafLbl Maybe SRTEntry
srtEntry SRTMap
srt_map
else
SRTMap
srt_map)
(ModuleSRTInfo -> SRTMap
moduleSRTMap ModuleSRTInfo
state)
[CAFfyLabel]
caf_lbls
in
ModuleSRTInfo
state{ moduleSRTMap = srt_map }
allStaticData :: Bool
allStaticData =
(CAFfyLabel -> Bool) -> [CAFfyLabel] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(CAFfyLabel CLabel
clbl) -> CLabel -> DataCAFEnv -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member CLabel
clbl DataCAFEnv
static_data_env) [CAFfyLabel]
caf_lbls
if Set SRTEntry -> Bool
forall a. Set a -> Bool
Set.null Set SRTEntry
filtered0 then do
String -> SDoc -> StateT ModuleSRTInfo UniqSM ()
forall (f :: * -> *). Applicative f => String -> SDoc -> f ()
srtTraceM String
"oneSRT: empty" (Platform -> [CAFfyLabel] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [CAFfyLabel]
caf_lbls)
Maybe SRTEntry -> StateT ModuleSRTInfo UniqSM ()
updateSRTMap Maybe SRTEntry
forall a. Maybe a
Nothing
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
forall a. a -> StateT ModuleSRTInfo UniqSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [], [], CafInfo
NoCafRefs)
else do
let allBelow_funs :: Set SRTEntry
allBelow_funs =
[SRTEntry] -> Set SRTEntry
forall a. Ord a => [a] -> Set a
Set.fromList ((CLabel -> SRTEntry) -> [CLabel] -> [SRTEntry]
forall a b. (a -> b) -> [a] -> [b]
map (CLabel -> SRTEntry
SRTEntry (CLabel -> SRTEntry) -> (CLabel -> CLabel) -> CLabel -> SRTEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> CLabel -> CLabel
toClosureLbl Platform
platform) [CLabel]
otherFunLabels)
let allBelow_data :: Set SRTEntry
allBelow_data =
[SRTEntry] -> Set SRTEntry
forall a. Ord a => [a] -> Set a
Set.fromList
[ CLabel -> SRTEntry
SRTEntry (CLabel -> SRTEntry) -> CLabel -> SRTEntry
forall a b. (a -> b) -> a -> b
$ Platform -> CLabel -> CLabel
toClosureLbl Platform
platform CLabel
lbl
| DeclLabel CLabel
lbl <- [SomeLabel]
lbls
, Just Set CAFfyLabel
refs <- Maybe (Set CAFfyLabel) -> [Maybe (Set CAFfyLabel)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Set CAFfyLabel) -> [Maybe (Set CAFfyLabel)])
-> Maybe (Set CAFfyLabel) -> [Maybe (Set CAFfyLabel)]
forall a b. (a -> b) -> a -> b
$ CLabel -> DataCAFEnv -> Maybe (Set CAFfyLabel)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CLabel
lbl DataCAFEnv
static_data_env
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set CAFfyLabel -> Bool
forall a. Set a -> Bool
Set.null Set CAFfyLabel
refs
]
let filtered :: Set SRTEntry
filtered = Set SRTEntry
filtered0 Set SRTEntry -> Set SRTEntry -> Set SRTEntry
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set SRTEntry
allBelow_funs Set SRTEntry -> Set SRTEntry -> Set SRTEntry
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set SRTEntry
allBelow_data
String -> SDoc -> StateT ModuleSRTInfo UniqSM ()
forall (f :: * -> *). Applicative f => String -> SDoc -> f ()
srtTraceM String
"oneSRT" (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"filtered:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> Set SRTEntry -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Set SRTEntry
filtered SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"allBelow_funs:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> Set SRTEntry -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Set SRTEntry
allBelow_funs)
case Set SRTEntry -> [SRTEntry]
forall a. Set a -> [a]
Set.toList Set SRTEntry
filtered of
[] -> String
-> SDoc
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"oneSRT" SDoc
forall doc. IsOutput doc => doc
empty
[one :: SRTEntry
one@(SRTEntry CLabel
lbl)]
|
Bool -> Bool
not (Module -> Platform -> Bool -> CLabel -> Bool
labelDynamic Module
this_mod Platform
platform (CmmConfig -> Bool
cmmExternalDynamicRefs CmmConfig
cfg) CLabel
lbl)
Bool -> Bool -> Bool
&& (Bool -> Bool
not (OS -> Bool
osMachOTarget (OS -> Bool) -> OS -> Bool
forall a b. (a -> b) -> a -> b
$ Platform -> OS
platformOS (Platform -> OS) -> Platform -> OS
forall a b. (a -> b) -> a -> b
$ Profile -> Platform
profilePlatform Profile
profile)
Bool -> Bool -> Bool
|| Module -> CLabel -> Bool
isLocalCLabel Module
this_mod CLabel
lbl) -> do
case Maybe (CLabel, BlockId)
maybeFunClosure of
Just (CLabel
staticFunLbl,BlockId
staticFunBlock) ->
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
forall a. a -> StateT ModuleSRTInfo UniqSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [(BlockId, CLabel)]
withLabels, [], CafInfo
MayHaveCafRefs)
where
withLabels :: [(BlockId, CLabel)]
withLabels =
[ (BlockId
b, if BlockId
b BlockId -> BlockId -> Bool
forall a. Eq a => a -> a -> Bool
== BlockId
staticFunBlock then CLabel
lbl else CLabel
staticFunLbl)
| BlockId
b <- [BlockId]
blockids ]
Maybe (CLabel, BlockId)
Nothing -> do
String -> SDoc -> StateT ModuleSRTInfo UniqSM ()
forall (f :: * -> *). Applicative f => String -> SDoc -> f ()
srtTraceM String
"oneSRT: one" (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"caf_lbls:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [CAFfyLabel] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [CAFfyLabel]
caf_lbls SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"one:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> SRTEntry -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform SRTEntry
one)
Maybe SRTEntry -> StateT ModuleSRTInfo UniqSM ()
updateSRTMap (SRTEntry -> Maybe SRTEntry
forall a. a -> Maybe a
Just SRTEntry
one)
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
forall a. a -> StateT ModuleSRTInfo UniqSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], (BlockId -> (BlockId, CLabel)) -> [BlockId] -> [(BlockId, CLabel)]
forall a b. (a -> b) -> [a] -> [b]
map (,CLabel
lbl) [BlockId]
blockids, [], CafInfo
MayHaveCafRefs)
[SRTEntry]
cafList | Bool
allStaticData ->
let caffiness :: CafInfo
caffiness = if [SRTEntry] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SRTEntry]
cafList then CafInfo
NoCafRefs else CafInfo
MayHaveCafRefs
in ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
forall a. a -> StateT ModuleSRTInfo UniqSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [], [], CafInfo
caffiness)
[SRTEntry]
cafList ->
case Set SRTEntry -> Map (Set SRTEntry) SRTEntry -> Maybe SRTEntry
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Set SRTEntry
filtered (ModuleSRTInfo -> Map (Set SRTEntry) SRTEntry
dedupSRTs ModuleSRTInfo
topSRT) of
Just srtEntry :: SRTEntry
srtEntry@(SRTEntry CLabel
srtLbl) -> do
String -> SDoc -> StateT ModuleSRTInfo UniqSM ()
forall (f :: * -> *). Applicative f => String -> SDoc -> f ()
srtTraceM String
"oneSRT [Common]" (Platform -> [CAFfyLabel] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [CAFfyLabel]
caf_lbls SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
srtLbl)
Maybe SRTEntry -> StateT ModuleSRTInfo UniqSM ()
updateSRTMap (SRTEntry -> Maybe SRTEntry
forall a. a -> Maybe a
Just SRTEntry
srtEntry)
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
forall a. a -> StateT ModuleSRTInfo UniqSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], (BlockId -> (BlockId, CLabel)) -> [BlockId] -> [(BlockId, CLabel)]
forall a b. (a -> b) -> [a] -> [b]
map (,CLabel
srtLbl) [BlockId]
blockids, [], CafInfo
MayHaveCafRefs)
Maybe SRTEntry
Nothing -> do
([CmmDeclSRTs]
decls, [(BlockId, [SRTEntry])]
funSRTs, SRTEntry
srtEntry) <-
case Maybe (CLabel, BlockId)
maybeFunClosure of
Just (CLabel
fun,BlockId
block) ->
([CmmDeclSRTs], [(BlockId, [SRTEntry])], SRTEntry)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, [SRTEntry])], SRTEntry)
forall a. a -> StateT ModuleSRTInfo UniqSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ( [], [(BlockId
block, [SRTEntry]
cafList)], CLabel -> SRTEntry
SRTEntry CLabel
fun )
Maybe (CLabel, BlockId)
Nothing -> do
([CmmDeclSRTs]
decls, SRTEntry
entry) <- UniqSM ([CmmDeclSRTs], SRTEntry)
-> StateT ModuleSRTInfo UniqSM ([CmmDeclSRTs], SRTEntry)
forall (m :: * -> *) a. Monad m => m a -> StateT ModuleSRTInfo m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (UniqSM ([CmmDeclSRTs], SRTEntry)
-> StateT ModuleSRTInfo UniqSM ([CmmDeclSRTs], SRTEntry))
-> UniqSM ([CmmDeclSRTs], SRTEntry)
-> StateT ModuleSRTInfo UniqSM ([CmmDeclSRTs], SRTEntry)
forall a b. (a -> b) -> a -> b
$ Profile -> [SRTEntry] -> UniqSM ([CmmDeclSRTs], SRTEntry)
buildSRTChain Profile
profile [SRTEntry]
cafList
([CmmDeclSRTs], [(BlockId, [SRTEntry])], SRTEntry)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, [SRTEntry])], SRTEntry)
forall a. a -> StateT ModuleSRTInfo UniqSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CmmDeclSRTs]
decls, [], SRTEntry
entry)
Maybe SRTEntry -> StateT ModuleSRTInfo UniqSM ()
updateSRTMap (SRTEntry -> Maybe SRTEntry
forall a. a -> Maybe a
Just SRTEntry
srtEntry)
let allBelowThis :: Set SRTEntry
allBelowThis = Set SRTEntry -> Set SRTEntry -> Set SRTEntry
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set SRTEntry
allBelow Set SRTEntry
filtered
newFlatSRTs :: Map SRTEntry (Set SRTEntry)
newFlatSRTs = SRTEntry
-> Set SRTEntry
-> Map SRTEntry (Set SRTEntry)
-> Map SRTEntry (Set SRTEntry)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SRTEntry
srtEntry Set SRTEntry
allBelowThis (ModuleSRTInfo -> Map SRTEntry (Set SRTEntry)
flatSRTs ModuleSRTInfo
topSRT)
newDedupSRTs :: Map (Set SRTEntry) SRTEntry
newDedupSRTs = Set SRTEntry
-> SRTEntry
-> Map (Set SRTEntry) SRTEntry
-> Map (Set SRTEntry) SRTEntry
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Set SRTEntry
filtered SRTEntry
srtEntry (ModuleSRTInfo -> Map (Set SRTEntry) SRTEntry
dedupSRTs ModuleSRTInfo
topSRT)
(ModuleSRTInfo -> ModuleSRTInfo) -> StateT ModuleSRTInfo UniqSM ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (\ModuleSRTInfo
state -> ModuleSRTInfo
state{ dedupSRTs = newDedupSRTs,
flatSRTs = newFlatSRTs })
String -> SDoc -> StateT ModuleSRTInfo UniqSM ()
forall (f :: * -> *). Applicative f => String -> SDoc -> f ()
srtTraceM String
"oneSRT: new" (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"caf_lbls:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [CAFfyLabel] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [CAFfyLabel]
caf_lbls SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"filtered:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> Set SRTEntry -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Set SRTEntry
filtered SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"srtEntry:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> SRTEntry -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform SRTEntry
srtEntry SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"newDedupSRTs:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> Map (Set SRTEntry) SRTEntry -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Map (Set SRTEntry) SRTEntry
newDedupSRTs SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"newFlatSRTs:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> Map SRTEntry (Set SRTEntry) -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Map SRTEntry (Set SRTEntry)
newFlatSRTs)
let SRTEntry CLabel
lbl = SRTEntry
srtEntry
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
-> StateT
ModuleSRTInfo
UniqSM
([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
CafInfo)
forall a. a -> StateT ModuleSRTInfo UniqSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CmmDeclSRTs]
decls, (BlockId -> (BlockId, CLabel)) -> [BlockId] -> [(BlockId, CLabel)]
forall a b. (a -> b) -> [a] -> [b]
map (,CLabel
lbl) [BlockId]
blockids, [(BlockId, [SRTEntry])]
funSRTs, CafInfo
MayHaveCafRefs)
buildSRTChain
:: Profile
-> [SRTEntry]
-> UniqSM
( [CmmDeclSRTs]
, SRTEntry
)
buildSRTChain :: Profile -> [SRTEntry] -> UniqSM ([CmmDeclSRTs], SRTEntry)
buildSRTChain Profile
profile [SRTEntry]
cafSet =
case WordOff -> [SRTEntry] -> ([SRTEntry], [SRTEntry])
forall a. WordOff -> [a] -> ([a], [a])
splitAt WordOff
mAX_SRT_SIZE [SRTEntry]
cafSet of
([], [SRTEntry]
_) -> String -> UniqSM ([CmmDeclSRTs], SRTEntry)
forall a. HasCallStack => String -> a
panic String
"buildSRT: empty"
([SRTEntry]
these, []) -> do
(CmmDeclSRTs
decl,SRTEntry
lbl) <- Profile -> [SRTEntry] -> UniqSM (CmmDeclSRTs, SRTEntry)
buildSRT Profile
profile [SRTEntry]
these
([CmmDeclSRTs], SRTEntry) -> UniqSM ([CmmDeclSRTs], SRTEntry)
forall a. a -> UniqSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CmmDeclSRTs
decl], SRTEntry
lbl)
(SRTEntry
this:[SRTEntry]
these,[SRTEntry]
those) -> do
([CmmDeclSRTs]
rest, SRTEntry
rest_lbl) <- Profile -> [SRTEntry] -> UniqSM ([CmmDeclSRTs], SRTEntry)
buildSRTChain Profile
profile (SRTEntry
this SRTEntry -> [SRTEntry] -> [SRTEntry]
forall a. a -> [a] -> [a]
: [SRTEntry]
those)
(CmmDeclSRTs
decl,SRTEntry
lbl) <- Profile -> [SRTEntry] -> UniqSM (CmmDeclSRTs, SRTEntry)
buildSRT Profile
profile (SRTEntry
rest_lbl SRTEntry -> [SRTEntry] -> [SRTEntry]
forall a. a -> [a] -> [a]
: [SRTEntry]
these)
([CmmDeclSRTs], SRTEntry) -> UniqSM ([CmmDeclSRTs], SRTEntry)
forall a. a -> UniqSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmDeclSRTs
declCmmDeclSRTs -> [CmmDeclSRTs] -> [CmmDeclSRTs]
forall a. a -> [a] -> [a]
:[CmmDeclSRTs]
rest, SRTEntry
lbl)
where
mAX_SRT_SIZE :: WordOff
mAX_SRT_SIZE = WordOff
16
buildSRT :: Profile -> [SRTEntry] -> UniqSM (CmmDeclSRTs, SRTEntry)
buildSRT :: Profile -> [SRTEntry] -> UniqSM (CmmDeclSRTs, SRTEntry)
buildSRT Profile
profile [SRTEntry]
refs = do
Unique
id <- UniqSM Unique
forall (m :: * -> *). MonadUnique m => m Unique
getUniqueM
let
lbl :: CLabel
lbl = Unique -> CLabel
mkSRTLabel Unique
id
platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
srt_n_info :: CLabel
srt_n_info = WordOff -> CLabel
mkSRTInfoLabel ([SRTEntry] -> WordOff
forall a. [a] -> WordOff
forall (t :: * -> *) a. Foldable t => t a -> WordOff
length [SRTEntry]
refs)
fields :: [CmmLit]
fields =
Profile
-> CLabel
-> CostCentreStack
-> [CmmLit]
-> [CmmLit]
-> [CmmLit]
-> [CmmLit]
-> [CmmLit]
-> [CmmLit]
mkStaticClosure Profile
profile CLabel
srt_n_info CostCentreStack
dontCareCCS
[ CLabel -> CmmLit
CmmLabel CLabel
lbl | SRTEntry CLabel
lbl <- [SRTEntry]
refs ]
[]
[Platform -> WordOff -> CmmLit
mkIntCLit Platform
platform WordOff
0]
[]
[]
(CmmDeclSRTs, SRTEntry) -> UniqSM (CmmDeclSRTs, SRTEntry)
forall a. a -> UniqSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Section -> CLabel -> [CmmLit] -> CmmDeclSRTs
forall (raw :: Bool) info stmt.
Section
-> CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
mkDataLits (SectionType -> CLabel -> Section
Section SectionType
Data CLabel
lbl) CLabel
lbl [CmmLit]
fields, CLabel -> SRTEntry
SRTEntry CLabel
lbl)
updInfoSRTs
:: Profile
-> LabelMap CLabel
-> LabelMap [SRTEntry]
-> CafInfo
-> CmmDecl
-> [CmmDeclSRTs]
updInfoSRTs :: Profile
-> LabelMap CLabel
-> LabelMap [SRTEntry]
-> CafInfo
-> CmmDecl
-> [CmmDeclSRTs]
updInfoSRTs Profile
_ LabelMap CLabel
_ LabelMap [SRTEntry]
_ CafInfo
_ (CmmData Section
s (CmmStaticsRaw CLabel
lbl [CmmStatic]
statics))
= [Section -> RawCmmStatics -> CmmDeclSRTs
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
s (CLabel -> [CmmStatic] -> RawCmmStatics
forall (rawOnly :: Bool).
CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
CmmStaticsRaw CLabel
lbl [CmmStatic]
statics)]
updInfoSRTs Profile
profile LabelMap CLabel
_ LabelMap [SRTEntry]
_ CafInfo
caffy (CmmData Section
s (CmmStatics CLabel
lbl CmmInfoTable
itbl CostCentreStack
ccs [CmmLit]
payload [CmmLit]
extras))
= [Section -> RawCmmStatics -> CmmDeclSRTs
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
s (CLabel -> [CmmStatic] -> RawCmmStatics
forall (rawOnly :: Bool).
CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
CmmStaticsRaw CLabel
lbl ((CmmLit -> CmmStatic) -> [CmmLit] -> [CmmStatic]
forall a b. (a -> b) -> [a] -> [b]
map CmmLit -> CmmStatic
CmmStaticLit [CmmLit]
field_lits))]
where
field_lits :: [CmmLit]
field_lits = Profile
-> CmmInfoTable
-> CostCentreStack
-> CafInfo
-> [CmmLit]
-> [CmmLit]
-> [CmmLit]
mkStaticClosureFields Profile
profile CmmInfoTable
itbl CostCentreStack
ccs CafInfo
caffy [CmmLit]
payload [CmmLit]
extras
updInfoSRTs Profile
profile LabelMap CLabel
srt_env LabelMap [SRTEntry]
funSRTEnv CafInfo
caffy (CmmProc CmmTopInfo
top_info CLabel
top_l [GlobalReg]
live GenCmmGraph CmmNode
g)
| Just (CmmInfoTable
_,CmmDeclSRTs
closure) <- Maybe (CmmInfoTable, CmmDeclSRTs)
maybeStaticClosure = [ CmmDeclSRTs
proc, CmmDeclSRTs
closure ]
| Bool
otherwise = [ CmmDeclSRTs
proc ]
where
proc :: CmmDeclSRTs
proc = CmmTopInfo
-> CLabel -> [GlobalReg] -> GenCmmGraph CmmNode -> CmmDeclSRTs
forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc CmmTopInfo
top_info { info_tbls = newTopInfo } CLabel
top_l [GlobalReg]
live GenCmmGraph CmmNode
g
newTopInfo :: LabelMap CmmInfoTable
newTopInfo = (KeyOf LabelMap -> CmmInfoTable -> CmmInfoTable)
-> LabelMap CmmInfoTable -> LabelMap CmmInfoTable
forall a b. (KeyOf LabelMap -> a -> b) -> LabelMap a -> LabelMap b
forall (map :: * -> *) a b.
IsMap map =>
(KeyOf map -> a -> b) -> map a -> map b
mapMapWithKey KeyOf LabelMap -> CmmInfoTable -> CmmInfoTable
BlockId -> CmmInfoTable -> CmmInfoTable
updInfoTbl (CmmTopInfo -> LabelMap CmmInfoTable
info_tbls CmmTopInfo
top_info)
updInfoTbl :: BlockId -> CmmInfoTable -> CmmInfoTable
updInfoTbl BlockId
l CmmInfoTable
info_tbl
| BlockId
l BlockId -> BlockId -> Bool
forall a. Eq a => a -> a -> Bool
== GenCmmGraph CmmNode -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry GenCmmGraph CmmNode
g, Just (CmmInfoTable
inf, CmmDeclSRTs
_) <- Maybe (CmmInfoTable, CmmDeclSRTs)
maybeStaticClosure = CmmInfoTable
inf
| Bool
otherwise = CmmInfoTable
info_tbl { cit_srt = mapLookup l srt_env }
maybeStaticClosure :: Maybe (CmmInfoTable, CmmDeclSRTs)
maybeStaticClosure :: Maybe (CmmInfoTable, CmmDeclSRTs)
maybeStaticClosure
| Just info_tbl :: CmmInfoTable
info_tbl@CmmInfoTable{Maybe (Id, CostCentreStack)
Maybe CLabel
CLabel
SMRep
ProfilingInfo
cit_rep :: CmmInfoTable -> SMRep
cit_lbl :: CmmInfoTable -> CLabel
cit_clo :: CmmInfoTable -> Maybe (Id, CostCentreStack)
cit_srt :: CmmInfoTable -> Maybe CLabel
cit_lbl :: CLabel
cit_rep :: SMRep
cit_prof :: ProfilingInfo
cit_srt :: Maybe CLabel
cit_clo :: Maybe (Id, CostCentreStack)
cit_prof :: CmmInfoTable -> ProfilingInfo
..} <-
KeyOf LabelMap -> LabelMap CmmInfoTable -> Maybe CmmInfoTable
forall a. KeyOf LabelMap -> LabelMap a -> Maybe a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup (GenCmmGraph CmmNode -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry GenCmmGraph CmmNode
g) (CmmTopInfo -> LabelMap CmmInfoTable
info_tbls CmmTopInfo
top_info)
, Just (Id
id, CostCentreStack
ccs) <- Maybe (Id, CostCentreStack)
cit_clo
, SMRep -> Bool
isStaticRep SMRep
cit_rep =
let
(CmmInfoTable
newInfo, [CmmLit]
srtEntries) = case KeyOf LabelMap -> LabelMap [SRTEntry] -> Maybe [SRTEntry]
forall a. KeyOf LabelMap -> LabelMap a -> Maybe a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup (GenCmmGraph CmmNode -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry GenCmmGraph CmmNode
g) LabelMap [SRTEntry]
funSRTEnv of
Maybe [SRTEntry]
Nothing ->
(CmmInfoTable
info_tbl { cit_srt = mapLookup (g_entry g) srt_env }, [])
Just [SRTEntry]
srtEntries -> String
-> SDoc -> (CmmInfoTable, [CmmLit]) -> (CmmInfoTable, [CmmLit])
forall b. String -> SDoc -> b -> b
srtTrace String
"maybeStaticFun" (Platform -> [CmmLit] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc (Profile -> Platform
profilePlatform Profile
profile) [CmmLit]
res)
(CmmInfoTable
info_tbl { cit_rep = new_rep }, [CmmLit]
res)
where res :: [CmmLit]
res = [ CLabel -> CmmLit
CmmLabel CLabel
lbl | SRTEntry CLabel
lbl <- [SRTEntry]
srtEntries ]
fields :: [CmmLit]
fields = Profile
-> CmmInfoTable
-> CostCentreStack
-> CafInfo
-> [CmmLit]
-> [CmmLit]
-> [CmmLit]
mkStaticClosureFields Profile
profile CmmInfoTable
info_tbl CostCentreStack
ccs CafInfo
caffy [CmmLit]
srtEntries []
new_rep :: SMRep
new_rep = case SMRep
cit_rep of
HeapRep Bool
sta WordOff
ptrs WordOff
nptrs ClosureTypeInfo
ty ->
Bool -> WordOff -> WordOff -> ClosureTypeInfo -> SMRep
HeapRep Bool
sta (WordOff
ptrs WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
+ [CmmLit] -> WordOff
forall a. [a] -> WordOff
forall (t :: * -> *) a. Foldable t => t a -> WordOff
length [CmmLit]
srtEntries) WordOff
nptrs ClosureTypeInfo
ty
SMRep
_other -> String -> SMRep
forall a. HasCallStack => String -> a
panic String
"maybeStaticFun"
lbl :: CLabel
lbl = Name -> CafInfo -> CLabel
mkClosureLabel (Id -> Name
idName Id
id) CafInfo
caffy
in
(CmmInfoTable, CmmDeclSRTs) -> Maybe (CmmInfoTable, CmmDeclSRTs)
forall a. a -> Maybe a
Just (CmmInfoTable
newInfo, Section -> CLabel -> [CmmLit] -> CmmDeclSRTs
forall (raw :: Bool) info stmt.
Section
-> CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
mkDataLits (SectionType -> CLabel -> Section
Section SectionType
Data CLabel
lbl) CLabel
lbl [CmmLit]
fields)
| Bool
otherwise = Maybe (CmmInfoTable, CmmDeclSRTs)
forall a. Maybe a
Nothing
srtTrace :: String -> SDoc -> b -> b
srtTrace :: forall b. String -> SDoc -> b -> b
srtTrace String
_ SDoc
_ b
b = b
b
srtTraceM :: Applicative f => String -> SDoc -> f ()
srtTraceM :: forall (f :: * -> *). Applicative f => String -> SDoc -> f ()
srtTraceM String
str SDoc
doc = String -> SDoc -> f () -> f ()
forall b. String -> SDoc -> b -> b
srtTrace String
str SDoc
doc (() -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())