{-# LANGUAGE TypeFamilies #-}
module Futhark.Analysis.LastUse
( lastUseSeqMem,
lastUseGPUMem,
lastUseMCMem,
LUTabFun,
LUTabProg,
)
where
import Control.Monad
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Bifunctor (bimap)
import Data.Function ((&))
import Data.Map.Strict qualified as M
import Data.Maybe
import Data.Sequence (Seq (..))
import Futhark.IR.Aliases
import Futhark.IR.GPUMem
import Futhark.IR.GPUMem qualified as GPU
import Futhark.IR.MCMem
import Futhark.IR.MCMem qualified as MC
import Futhark.IR.SeqMem
import Futhark.Optimise.ArrayShortCircuiting.DataStructs
import Futhark.Util
type LUTabFun = M.Map VName Names
type LUTabProg = (LUTabFun, M.Map Name LUTabFun)
type LastUseOp rep = Op (Aliases rep) -> Names -> LastUseM rep (LUTabFun, Names, Names)
data LastUseReader rep = LastUseReader
{ forall rep. LastUseReader rep -> LastUseOp rep
onOp :: LastUseOp rep,
forall rep. LastUseReader rep -> Scope (Aliases rep)
scope :: Scope (Aliases rep)
}
type AliasTab = M.Map VName Names
newtype LastUseM rep a = LastUseM (StateT AliasTab (Reader (LastUseReader rep)) a)
deriving
( forall rep. Applicative (LastUseM rep)
forall a. a -> LastUseM rep a
forall rep a. a -> LastUseM rep a
forall a b. LastUseM rep a -> LastUseM rep b -> LastUseM rep b
forall a b.
LastUseM rep a -> (a -> LastUseM rep b) -> LastUseM rep b
forall rep a b. LastUseM rep a -> LastUseM rep b -> LastUseM rep b
forall rep a b.
LastUseM rep a -> (a -> LastUseM rep b) -> LastUseM rep b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> LastUseM rep a
$creturn :: forall rep a. a -> LastUseM rep a
>> :: forall a b. LastUseM rep a -> LastUseM rep b -> LastUseM rep b
$c>> :: forall rep a b. LastUseM rep a -> LastUseM rep b -> LastUseM rep b
>>= :: forall a b.
LastUseM rep a -> (a -> LastUseM rep b) -> LastUseM rep b
$c>>= :: forall rep a b.
LastUseM rep a -> (a -> LastUseM rep b) -> LastUseM rep b
Monad,
forall a b. a -> LastUseM rep b -> LastUseM rep a
forall a b. (a -> b) -> LastUseM rep a -> LastUseM rep b
forall rep a b. a -> LastUseM rep b -> LastUseM rep a
forall rep a b. (a -> b) -> LastUseM rep a -> LastUseM rep b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> LastUseM rep b -> LastUseM rep a
$c<$ :: forall rep a b. a -> LastUseM rep b -> LastUseM rep a
fmap :: forall a b. (a -> b) -> LastUseM rep a -> LastUseM rep b
$cfmap :: forall rep a b. (a -> b) -> LastUseM rep a -> LastUseM rep b
Functor,
forall rep. Functor (LastUseM rep)
forall a. a -> LastUseM rep a
forall rep a. a -> LastUseM rep a
forall a b. LastUseM rep a -> LastUseM rep b -> LastUseM rep a
forall a b. LastUseM rep a -> LastUseM rep b -> LastUseM rep b
forall a b.
LastUseM rep (a -> b) -> LastUseM rep a -> LastUseM rep b
forall rep a b. LastUseM rep a -> LastUseM rep b -> LastUseM rep a
forall rep a b. LastUseM rep a -> LastUseM rep b -> LastUseM rep b
forall rep a b.
LastUseM rep (a -> b) -> LastUseM rep a -> LastUseM rep b
forall a b c.
(a -> b -> c) -> LastUseM rep a -> LastUseM rep b -> LastUseM rep c
forall rep a b c.
(a -> b -> c) -> LastUseM rep a -> LastUseM rep b -> LastUseM rep c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. LastUseM rep a -> LastUseM rep b -> LastUseM rep a
$c<* :: forall rep a b. LastUseM rep a -> LastUseM rep b -> LastUseM rep a
*> :: forall a b. LastUseM rep a -> LastUseM rep b -> LastUseM rep b
$c*> :: forall rep a b. LastUseM rep a -> LastUseM rep b -> LastUseM rep b
liftA2 :: forall a b c.
(a -> b -> c) -> LastUseM rep a -> LastUseM rep b -> LastUseM rep c
$cliftA2 :: forall rep a b c.
(a -> b -> c) -> LastUseM rep a -> LastUseM rep b -> LastUseM rep c
<*> :: forall a b.
LastUseM rep (a -> b) -> LastUseM rep a -> LastUseM rep b
$c<*> :: forall rep a b.
LastUseM rep (a -> b) -> LastUseM rep a -> LastUseM rep b
pure :: forall a. a -> LastUseM rep a
$cpure :: forall rep a. a -> LastUseM rep a
Applicative,
MonadReader (LastUseReader rep),
MonadState AliasTab
)
instance (RepTypes (Aliases rep)) => HasScope (Aliases rep) (LastUseM rep) where
askScope :: LastUseM rep (Scope (Aliases rep))
askScope = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall rep. LastUseReader rep -> Scope (Aliases rep)
scope
instance (RepTypes (Aliases rep)) => LocalScope (Aliases rep) (LastUseM rep) where
localScope :: forall a. Scope (Aliases rep) -> LastUseM rep a -> LastUseM rep a
localScope Scope (Aliases rep)
sc (LastUseM StateT LUTabFun (Reader (LastUseReader rep)) a
m) = forall rep a.
StateT LUTabFun (Reader (LastUseReader rep)) a -> LastUseM rep a
LastUseM forall a b. (a -> b) -> a -> b
$ do
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\LastUseReader rep
rd -> LastUseReader rep
rd {scope :: Scope (Aliases rep)
scope = forall rep. LastUseReader rep -> Scope (Aliases rep)
scope LastUseReader rep
rd forall a. Semigroup a => a -> a -> a
<> Scope (Aliases rep)
sc}) StateT LUTabFun (Reader (LastUseReader rep)) a
m
type Constraints rep =
( LocalScope (Aliases rep) (LastUseM rep),
HasMemBlock (Aliases rep),
AliasableRep rep
)
runLastUseM :: LastUseOp rep -> LastUseM rep a -> a
runLastUseM :: forall rep a. LastUseOp rep -> LastUseM rep a -> a
runLastUseM LastUseOp rep
onOp (LastUseM StateT LUTabFun (ReaderT (LastUseReader rep) Identity) a
m) =
forall r a. Reader r a -> r -> a
runReader (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT LUTabFun (ReaderT (LastUseReader rep) Identity) a
m forall a. Monoid a => a
mempty) (forall rep.
LastUseOp rep -> Scope (Aliases rep) -> LastUseReader rep
LastUseReader LastUseOp rep
onOp forall a. Monoid a => a
mempty)
aliasLookup :: VName -> LastUseM rep Names
aliasLookup :: forall rep. VName -> LastUseM rep Names
aliasLookup VName
vname =
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
vname
lastUseProg ::
(Constraints rep) =>
Prog (Aliases rep) ->
LastUseM rep LUTabProg
lastUseProg :: forall rep.
Constraints rep =>
Prog (Aliases rep) -> LastUseM rep LUTabProg
lastUseProg Prog (Aliases rep)
prog =
let bound_in_consts :: Names
bound_in_consts =
forall rep. Prog rep -> Stms rep
progConsts Prog (Aliases rep)
prog
forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall dec. Pat dec -> [VName]
patNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep. Stm rep -> Pat (LetDec rep)
stmPat)
forall a b. a -> (a -> b) -> b
& [VName] -> Names
namesFromList
consts :: Stms (Aliases rep)
consts = forall rep. Prog rep -> Stms rep
progConsts Prog (Aliases rep)
prog
funs :: [FunDef (Aliases rep)]
funs = forall rep. Prog rep -> [FunDef rep]
progFuns Prog (Aliases rep)
prog
in forall rep a (m :: * -> *) b.
(Scoped rep a, LocalScope rep m) =>
a -> m b -> m b
inScopeOf Stms (Aliases rep)
consts forall a b. (a -> b) -> a -> b
$ do
(LUTabFun
consts_lu, Names
_) <- forall rep.
Constraints rep =>
Stms (Aliases rep)
-> (LUTabFun, Names) -> [VName] -> LastUseM rep (LUTabFun, Names)
lastUseStms Stms (Aliases rep)
consts forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
[LUTabFun]
lus <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall rep.
Constraints rep =>
Names -> FunDef (Aliases rep) -> LastUseM rep LUTabFun
lastUseFun Names
bound_in_consts) [FunDef (Aliases rep)]
funs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LUTabFun
consts_lu, forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall rep. FunDef rep -> Name
funDefName [FunDef (Aliases rep)]
funs) [LUTabFun]
lus)
lastUseFun ::
(Constraints rep) =>
Names ->
FunDef (Aliases rep) ->
LastUseM rep LUTabFun
lastUseFun :: forall rep.
Constraints rep =>
Names -> FunDef (Aliases rep) -> LastUseM rep LUTabFun
lastUseFun Names
bound_in_consts FunDef (Aliases rep)
f =
forall rep a (m :: * -> *) b.
(Scoped rep a, LocalScope rep m) =>
a -> m b -> m b
inScopeOf FunDef (Aliases rep)
f forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall rep.
Constraints rep =>
Body (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseBody (forall rep. FunDef rep -> Body rep
funDefBody FunDef (Aliases rep)
f) (forall a. Monoid a => a
mempty, Names
bound_in_consts)
lastUseSeqMem :: Prog (Aliases SeqMem) -> LUTabProg
lastUseSeqMem :: Prog (Aliases SeqMem) -> LUTabProg
lastUseSeqMem = forall rep a. LastUseOp rep -> LastUseM rep a -> a
runLastUseM Op (Aliases SeqMem)
-> Names -> LastUseM SeqMem (LUTabFun, Names, Names)
lastUseSeqOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep.
Constraints rep =>
Prog (Aliases rep) -> LastUseM rep LUTabProg
lastUseProg
lastUseGPUMem :: Prog (Aliases GPUMem) -> LUTabProg
lastUseGPUMem :: Prog (Aliases GPUMem) -> LUTabProg
lastUseGPUMem = forall rep a. LastUseOp rep -> LastUseM rep a -> a
runLastUseM (forall (inner :: * -> *) rep.
(inner (Aliases rep)
-> Names -> LastUseM rep (LUTabFun, Names, Names))
-> MemOp inner (Aliases rep)
-> Names
-> LastUseM rep (LUTabFun, Names, Names)
lastUseMemOp HostOp NoOp (Aliases GPUMem)
-> Names -> LastUseM GPUMem (LUTabFun, Names, Names)
lastUseGPUOp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep.
Constraints rep =>
Prog (Aliases rep) -> LastUseM rep LUTabProg
lastUseProg
lastUseMCMem :: Prog (Aliases MCMem) -> LUTabProg
lastUseMCMem :: Prog (Aliases MCMem) -> LUTabProg
lastUseMCMem = forall rep a. LastUseOp rep -> LastUseM rep a -> a
runLastUseM (forall (inner :: * -> *) rep.
(inner (Aliases rep)
-> Names -> LastUseM rep (LUTabFun, Names, Names))
-> MemOp inner (Aliases rep)
-> Names
-> LastUseM rep (LUTabFun, Names, Names)
lastUseMemOp MCOp NoOp (Aliases MCMem)
-> Names -> LastUseM MCMem (LUTabFun, Names, Names)
lastUseMCOp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep.
Constraints rep =>
Prog (Aliases rep) -> LastUseM rep LUTabProg
lastUseProg
lastUseBody ::
(Constraints rep) =>
Body (Aliases rep) ->
(LUTabFun, Names) ->
LastUseM rep (LUTabFun, Names)
lastUseBody :: forall rep.
Constraints rep =>
Body (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseBody bdy :: Body (Aliases rep)
bdy@(Body BodyDec (Aliases rep)
_ Stms (Aliases rep)
stms Result
result) (LUTabFun
lutab, Names
used_nms) =
forall rep a (m :: * -> *) b.
(Scoped rep a, LocalScope rep m) =>
a -> m b -> m b
inScopeOf Stms (Aliases rep)
stms forall a b. (a -> b) -> a -> b
$ do
(LUTabFun
lutab', Names
_) <-
forall rep.
Constraints rep =>
Stms (Aliases rep)
-> (LUTabFun, Names) -> [VName] -> LastUseM rep (LUTabFun, Names)
lastUseStms Stms (Aliases rep)
stms (LUTabFun
lutab, Names
used_nms) forall a b. (a -> b) -> a -> b
$
Names -> [VName]
namesToList forall a b. (a -> b) -> a -> b
$
forall a. FreeIn a => a -> Names
freeIn forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map SubExpRes -> SubExp
resSubExp Result
result
Names
used_in_body <- forall rep. Names -> LastUseM rep Names
aliasTransitiveClosure forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> Names
freeIn Body (Aliases rep)
bdy
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LUTabFun
lutab', Names
used_nms forall a. Semigroup a => a -> a -> a
<> Names
used_in_body)
lastUseKernelBody ::
(Constraints rep) =>
KernelBody (Aliases rep) ->
(LUTabFun, Names) ->
LastUseM rep (LUTabFun, Names)
lastUseKernelBody :: forall rep.
Constraints rep =>
KernelBody (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseKernelBody bdy :: KernelBody (Aliases rep)
bdy@(KernelBody BodyDec (Aliases rep)
_ Stms (Aliases rep)
stms [KernelResult]
result) (LUTabFun
lutab, Names
used_nms) =
forall rep a (m :: * -> *) b.
(Scoped rep a, LocalScope rep m) =>
a -> m b -> m b
inScopeOf Stms (Aliases rep)
stms forall a b. (a -> b) -> a -> b
$ do
(LUTabFun
lutab', Names
_) <-
forall rep.
Constraints rep =>
Stms (Aliases rep)
-> (LUTabFun, Names) -> [VName] -> LastUseM rep (LUTabFun, Names)
lastUseStms Stms (Aliases rep)
stms (LUTabFun
lutab, Names
used_nms) forall a b. (a -> b) -> a -> b
$ Names -> [VName]
namesToList forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> Names
freeIn [KernelResult]
result
Names
used_in_body <- forall rep. Names -> LastUseM rep Names
aliasTransitiveClosure forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> Names
freeIn KernelBody (Aliases rep)
bdy
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LUTabFun
lutab', Names
used_nms forall a. Semigroup a => a -> a -> a
<> Names
used_in_body)
lastUseStms ::
(Constraints rep) =>
Stms (Aliases rep) ->
(LUTabFun, Names) ->
[VName] ->
LastUseM rep (LUTabFun, Names)
lastUseStms :: forall rep.
Constraints rep =>
Stms (Aliases rep)
-> (LUTabFun, Names) -> [VName] -> LastUseM rep (LUTabFun, Names)
lastUseStms Seq (Stm (Aliases rep))
Empty (LUTabFun
lutab, Names
nms) [VName]
res_nms = do
Names
aliases <- forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
concatMapM forall rep. VName -> LastUseM rep Names
aliasLookup [VName]
res_nms
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LUTabFun
lutab, Names
nms forall a. Semigroup a => a -> a -> a
<> Names
aliases forall a. Semigroup a => a -> a -> a
<> [VName] -> Names
namesFromList [VName]
res_nms)
lastUseStms (stm :: Stm (Aliases rep)
stm@(Let Pat (LetDec (Aliases rep))
pat StmAux (ExpDec (Aliases rep))
_ Exp (Aliases rep)
e) :<| Seq (Stm (Aliases rep))
stms) (LUTabFun
lutab, Names
nms) [VName]
res_nms =
forall rep a (m :: * -> *) b.
(Scoped rep a, LocalScope rep m) =>
a -> m b -> m b
inScopeOf Stm (Aliases rep)
stm forall a b. (a -> b) -> a -> b
$ do
let extra_alias :: Names
extra_alias = case Exp (Aliases rep)
e of
BasicOp (Update Safety
_ VName
old Slice SubExp
_ SubExp
_) -> VName -> Names
oneName VName
old
BasicOp (FlatUpdate VName
old FlatSlice SubExp
_ VName
_) -> VName -> Names
oneName VName
old
Exp (Aliases rep)
_ -> forall a. Monoid a => a
mempty
forall dec rep.
AliasesOf dec =>
Names -> Pat dec -> LastUseM rep ()
updateAliasing Names
extra_alias Pat (LetDec (Aliases rep))
pat
(LUTabFun
lutab', Names
nms') <- forall rep.
Constraints rep =>
Stms (Aliases rep)
-> (LUTabFun, Names) -> [VName] -> LastUseM rep (LUTabFun, Names)
lastUseStms Seq (Stm (Aliases rep))
stms (LUTabFun
lutab, Names
nms) [VName]
res_nms
(LUTabFun
lutab'', Names
nms'') <- forall rep.
Constraints rep =>
Stm (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseStm Stm (Aliases rep)
stm (LUTabFun
lutab', Names
nms')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LUTabFun
lutab'', Names
nms'')
lastUseStm ::
(Constraints rep) =>
Stm (Aliases rep) ->
(LUTabFun, Names) ->
LastUseM rep (LUTabFun, Names)
lastUseStm :: forall rep.
Constraints rep =>
Stm (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseStm (Let Pat (LetDec (Aliases rep))
pat StmAux (ExpDec (Aliases rep))
_ Exp (Aliases rep)
e) (LUTabFun
lutab, Names
used_nms) = do
(LUTabFun
lutab', Names
last_uses, Names
used_nms') <- forall rep.
Constraints rep =>
Exp (Aliases rep) -> Names -> LastUseM rep (LUTabFun, Names, Names)
lastUseExp Exp (Aliases rep)
e Names
used_nms
Scope (Aliases rep)
sc <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall rep. LastUseReader rep -> Scope (Aliases rep)
scope
let lu_mems :: Names
lu_mems =
Names -> [VName]
namesToList Names
last_uses
forall a b. a -> (a -> b) -> b
& forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall rep.
HasMemBlock rep =>
VName -> Scope rep -> Maybe ArrayMemBound
`getScopeMemInfo` Scope (Aliases rep)
sc)
forall a b. a -> (a -> b) -> b
& forall a b. (a -> b) -> [a] -> [b]
map ArrayMemBound -> VName
memName
forall a b. a -> (a -> b) -> b
& [VName] -> Names
namesFromList
forall a b. a -> (a -> b) -> b
& forall a b c. (a -> b -> c) -> b -> a -> c
flip Names -> Names -> Names
namesSubtract Names
used_nms
let patnms :: [VName]
patnms = forall dec. Pat dec -> [VName]
patNames Pat (LetDec (Aliases rep))
pat
used_nms'' :: Names
used_nms'' = Names
used_nms' Names -> Names -> Names
`namesSubtract` [VName] -> Names
namesFromList [VName]
patnms
lutab'' :: LUTabFun
lutab'' =
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union LUTabFun
lutab' forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall a. [a] -> a
head [VName]
patnms) (Names
last_uses forall a. Semigroup a => a -> a -> a
<> Names
lu_mems) LUTabFun
lutab
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LUTabFun
lutab'', Names
used_nms'')
lastUseExp ::
(Constraints rep) =>
Exp (Aliases rep) ->
Names ->
LastUseM rep (LUTabFun, Names, Names)
lastUseExp :: forall rep.
Constraints rep =>
Exp (Aliases rep) -> Names -> LastUseM rep (LUTabFun, Names, Names)
lastUseExp (Match [SubExp]
_ [Case (Body (Aliases rep))]
cases Body (Aliases rep)
body MatchDec (BranchType (Aliases rep))
_) Names
used_nms = do
(LUTabFun
lutab_cases, Names
used_cases) <-
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. Monoid a => [a] -> a
mconcat forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall rep.
Constraints rep =>
Body (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseBody (forall k a. Map k a
M.empty, Names
used_nms) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Case body -> body
caseBody) [Case (Body (Aliases rep))]
cases
(LUTabFun
lutab', Names
body_used_nms) <- forall rep.
Constraints rep =>
Body (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseBody Body (Aliases rep)
body (forall k a. Map k a
M.empty, Names
used_nms)
let free_in_body :: Names
free_in_body = forall a. FreeIn a => a -> Names
freeIn Body (Aliases rep)
body
let free_in_cases :: Names
free_in_cases = forall a. FreeIn a => a -> Names
freeIn [Case (Body (Aliases rep))]
cases
let used_nms' :: Names
used_nms' = Names
used_cases forall a. Semigroup a => a -> a -> a
<> Names
body_used_nms
(Names
_, Names
last_used_arrs) <- forall rep. Names -> Names -> LastUseM rep (Names, Names)
lastUsedInNames Names
used_nms forall a b. (a -> b) -> a -> b
$ Names
free_in_body forall a. Semigroup a => a -> a -> a
<> Names
free_in_cases
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LUTabFun
lutab_cases forall a. Semigroup a => a -> a -> a
<> LUTabFun
lutab', Names
last_used_arrs, Names
used_nms')
lastUseExp (Loop [(FParam (Aliases rep), SubExp)]
var_ses LoopForm
form Body (Aliases rep)
body) Names
used_nms0 = forall rep (m :: * -> *) a.
LocalScope rep m =>
Scope rep -> m a -> m a
localScope (forall rep. LoopForm -> Scope rep
scopeOfLoopForm LoopForm
form) forall a b. (a -> b) -> a -> b
$ do
Names
free_in_body <- forall rep. Names -> LastUseM rep Names
aliasTransitiveClosure forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> Names
freeIn Body (Aliases rep)
body
[(VName, Names)]
var_inis <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {dec} {rep}.
Typed dec =>
Names -> (Param dec, SubExp) -> LastUseM rep (Maybe (VName, Names))
initHelper (Names
free_in_body forall a. Semigroup a => a -> a -> a
<> Names
used_nms0)) [(FParam (Aliases rep), SubExp)]
var_ses
let
free_in_body' :: Names
free_in_body' = Names
free_in_body Names -> Names -> Names
`namesSubtract` [VName] -> Names
namesFromList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(VName, Names)]
var_inis)
used_nms :: Names
used_nms = Names
used_nms0 forall a. Semigroup a => a -> a -> a
<> Names
free_in_body' forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> Names
freeIn (forall rep. Body rep -> Result
bodyResult Body (Aliases rep)
body)
(LUTabFun
body_lutab, Names
_) <- forall rep.
Constraints rep =>
Body (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseBody Body (Aliases rep)
body (forall a. Monoid a => a
mempty, Names
used_nms)
let lutab_res :: LUTabFun
lutab_res = LUTabFun
body_lutab forall a. Semigroup a => a -> a -> a
<> forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(VName, Names)]
var_inis
fpar_nms :: Names
fpar_nms = [VName] -> Names
namesFromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Ident -> VName
identName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dec. Typed dec => Param dec -> Ident
paramIdent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(FParam (Aliases rep), SubExp)]
var_ses
used_nms' :: Names
used_nms' = (Names
free_in_body forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> Names
freeIn (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(FParam (Aliases rep), SubExp)]
var_ses)) Names -> Names -> Names
`namesSubtract` Names
fpar_nms
used_nms_res :: Names
used_nms_res = Names
used_nms0 forall a. Semigroup a => a -> a -> a
<> Names
used_nms' forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> Names
freeIn (forall rep. Body rep -> Result
bodyResult Body (Aliases rep)
body)
lu_arrs :: Names
lu_arrs = Names
used_nms' Names -> Names -> Names
`namesSubtract` Names
used_nms0
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LUTabFun
lutab_res, Names
lu_arrs, Names
used_nms_res)
where
initHelper :: Names -> (Param dec, SubExp) -> LastUseM rep (Maybe (VName, Names))
initHelper Names
free_and_used (Param dec
fp, SubExp
se) = do
Names
names <- forall rep. Names -> LastUseM rep Names
aliasTransitiveClosure forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty VName -> Names
oneName forall a b. (a -> b) -> a -> b
$ SubExp -> Maybe VName
subExpVar SubExp
se
if Names
names Names -> Names -> Bool
`namesIntersect` Names
free_and_used
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Ident -> VName
identName forall a b. (a -> b) -> a -> b
$ forall dec. Typed dec => Param dec -> Ident
paramIdent Param dec
fp, Names
names)
lastUseExp (Op Op (Aliases rep)
op) Names
used_nms = do
OpC rep (Aliases rep)
-> Names -> LastUseM rep (LUTabFun, Names, Names)
on_op <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader forall rep. LastUseReader rep -> LastUseOp rep
onOp
OpC rep (Aliases rep)
-> Names -> LastUseM rep (LUTabFun, Names, Names)
on_op Op (Aliases rep)
op Names
used_nms
lastUseExp Exp (Aliases rep)
e Names
used_nms = do
let free_in_e :: Names
free_in_e = forall a. FreeIn a => a -> Names
freeIn Exp (Aliases rep)
e
(Names
used_nms', Names
lu_vars) <- forall rep. Names -> Names -> LastUseM rep (Names, Names)
lastUsedInNames Names
used_nms Names
free_in_e
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k a. Map k a
M.empty, Names
lu_vars, Names
used_nms')
lastUseMemOp ::
(inner (Aliases rep) -> Names -> LastUseM rep (LUTabFun, Names, Names)) ->
MemOp inner (Aliases rep) ->
Names ->
LastUseM rep (LUTabFun, Names, Names)
lastUseMemOp :: forall (inner :: * -> *) rep.
(inner (Aliases rep)
-> Names -> LastUseM rep (LUTabFun, Names, Names))
-> MemOp inner (Aliases rep)
-> Names
-> LastUseM rep (LUTabFun, Names, Names)
lastUseMemOp inner (Aliases rep)
-> Names -> LastUseM rep (LUTabFun, Names, Names)
_ (Alloc SubExp
se Space
sp) Names
used_nms = do
let free_in_e :: Names
free_in_e = forall a. FreeIn a => a -> Names
freeIn SubExp
se forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> Names
freeIn Space
sp
(Names
used_nms', Names
lu_vars) <- forall rep. Names -> Names -> LastUseM rep (Names, Names)
lastUsedInNames Names
used_nms Names
free_in_e
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k a. Map k a
M.empty, Names
lu_vars, Names
used_nms')
lastUseMemOp inner (Aliases rep)
-> Names -> LastUseM rep (LUTabFun, Names, Names)
onInner (Inner inner (Aliases rep)
op) Names
used_nms = inner (Aliases rep)
-> Names -> LastUseM rep (LUTabFun, Names, Names)
onInner inner (Aliases rep)
op Names
used_nms
lastUseSegOp ::
(Constraints rep) =>
SegOp lvl (Aliases rep) ->
Names ->
LastUseM rep (LUTabFun, Names, Names)
lastUseSegOp :: forall rep lvl.
Constraints rep =>
SegOp lvl (Aliases rep)
-> Names -> LastUseM rep (LUTabFun, Names, Names)
lastUseSegOp (SegMap lvl
_ SegSpace
_ [Type]
tps KernelBody (Aliases rep)
kbody) Names
used_nms = do
(Names
used_nms', Names
lu_vars) <- forall rep. Names -> Names -> LastUseM rep (Names, Names)
lastUsedInNames Names
used_nms forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> Names
freeIn [Type]
tps
(LUTabFun
body_lutab, Names
used_nms'') <- forall rep.
Constraints rep =>
KernelBody (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseKernelBody KernelBody (Aliases rep)
kbody (forall a. Monoid a => a
mempty, Names
used_nms')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LUTabFun
body_lutab, Names
lu_vars, Names
used_nms' forall a. Semigroup a => a -> a -> a
<> Names
used_nms'')
lastUseSegOp (SegRed lvl
_ SegSpace
_ [SegBinOp (Aliases rep)]
sbos [Type]
tps KernelBody (Aliases rep)
kbody) Names
used_nms = do
(LUTabFun
lutab_sbo, Names
lu_vars_sbo, Names
used_nms_sbo) <- forall rep.
Constraints rep =>
[SegBinOp (Aliases rep)]
-> Names -> LastUseM rep (LUTabFun, Names, Names)
lastUseSegBinOp [SegBinOp (Aliases rep)]
sbos Names
used_nms
(Names
used_nms', Names
lu_vars) <- forall rep. Names -> Names -> LastUseM rep (Names, Names)
lastUsedInNames Names
used_nms_sbo forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> Names
freeIn [Type]
tps
(LUTabFun
body_lutab, Names
used_nms'') <- forall rep.
Constraints rep =>
KernelBody (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseKernelBody KernelBody (Aliases rep)
kbody (forall a. Monoid a => a
mempty, Names
used_nms')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union LUTabFun
lutab_sbo LUTabFun
body_lutab, Names
lu_vars forall a. Semigroup a => a -> a -> a
<> Names
lu_vars_sbo, Names
used_nms_sbo forall a. Semigroup a => a -> a -> a
<> Names
used_nms' forall a. Semigroup a => a -> a -> a
<> Names
used_nms'')
lastUseSegOp (SegScan lvl
_ SegSpace
_ [SegBinOp (Aliases rep)]
sbos [Type]
tps KernelBody (Aliases rep)
kbody) Names
used_nms = do
(LUTabFun
lutab_sbo, Names
lu_vars_sbo, Names
used_nms_sbo) <- forall rep.
Constraints rep =>
[SegBinOp (Aliases rep)]
-> Names -> LastUseM rep (LUTabFun, Names, Names)
lastUseSegBinOp [SegBinOp (Aliases rep)]
sbos Names
used_nms
(Names
used_nms', Names
lu_vars) <- forall rep. Names -> Names -> LastUseM rep (Names, Names)
lastUsedInNames Names
used_nms_sbo forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> Names
freeIn [Type]
tps
(LUTabFun
body_lutab, Names
used_nms'') <- forall rep.
Constraints rep =>
KernelBody (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseKernelBody KernelBody (Aliases rep)
kbody (forall a. Monoid a => a
mempty, Names
used_nms')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union LUTabFun
lutab_sbo LUTabFun
body_lutab, Names
lu_vars forall a. Semigroup a => a -> a -> a
<> Names
lu_vars_sbo, Names
used_nms_sbo forall a. Semigroup a => a -> a -> a
<> Names
used_nms' forall a. Semigroup a => a -> a -> a
<> Names
used_nms'')
lastUseSegOp (SegHist lvl
_ SegSpace
_ [HistOp (Aliases rep)]
hos [Type]
tps KernelBody (Aliases rep)
kbody) Names
used_nms = do
(LUTabFun
lutab_sbo, Names
lu_vars_sbo, Names
used_nms_sbo) <- forall rep.
Constraints rep =>
[HistOp (Aliases rep)]
-> Names -> LastUseM rep (LUTabFun, Names, Names)
lastUseHistOp [HistOp (Aliases rep)]
hos Names
used_nms
(Names
used_nms', Names
lu_vars) <- forall rep. Names -> Names -> LastUseM rep (Names, Names)
lastUsedInNames Names
used_nms_sbo forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> Names
freeIn [Type]
tps
(LUTabFun
body_lutab, Names
used_nms'') <- forall rep.
Constraints rep =>
KernelBody (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseKernelBody KernelBody (Aliases rep)
kbody (forall a. Monoid a => a
mempty, Names
used_nms')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union LUTabFun
lutab_sbo LUTabFun
body_lutab, Names
lu_vars forall a. Semigroup a => a -> a -> a
<> Names
lu_vars_sbo, Names
used_nms_sbo forall a. Semigroup a => a -> a -> a
<> Names
used_nms' forall a. Semigroup a => a -> a -> a
<> Names
used_nms'')
lastUseGPUOp :: HostOp NoOp (Aliases GPUMem) -> Names -> LastUseM GPUMem (LUTabFun, Names, Names)
lastUseGPUOp :: HostOp NoOp (Aliases GPUMem)
-> Names -> LastUseM GPUMem (LUTabFun, Names, Names)
lastUseGPUOp (GPU.OtherOp NoOp (Aliases GPUMem)
NoOp) Names
used_nms =
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, Names
used_nms)
lastUseGPUOp (SizeOp SizeOp
sop) Names
used_nms = do
(Names
used_nms', Names
lu_vars) <- forall rep. Names -> Names -> LastUseM rep (Names, Names)
lastUsedInNames Names
used_nms forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> Names
freeIn SizeOp
sop
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Monoid a => a
mempty, Names
lu_vars, Names
used_nms')
lastUseGPUOp (GPUBody [Type]
tps Body (Aliases GPUMem)
body) Names
used_nms = do
(Names
used_nms', Names
lu_vars) <- forall rep. Names -> Names -> LastUseM rep (Names, Names)
lastUsedInNames Names
used_nms forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> Names
freeIn [Type]
tps
(LUTabFun
body_lutab, Names
used_nms'') <- forall rep.
Constraints rep =>
Body (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseBody Body (Aliases GPUMem)
body (forall a. Monoid a => a
mempty, Names
used_nms')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LUTabFun
body_lutab, Names
lu_vars, Names
used_nms' forall a. Semigroup a => a -> a -> a
<> Names
used_nms'')
lastUseGPUOp (SegOp SegOp SegLevel (Aliases GPUMem)
op) Names
used_nms =
forall rep lvl.
Constraints rep =>
SegOp lvl (Aliases rep)
-> Names -> LastUseM rep (LUTabFun, Names, Names)
lastUseSegOp SegOp SegLevel (Aliases GPUMem)
op Names
used_nms
lastUseMCOp :: MCOp NoOp (Aliases MCMem) -> Names -> LastUseM MCMem (LUTabFun, Names, Names)
lastUseMCOp :: MCOp NoOp (Aliases MCMem)
-> Names -> LastUseM MCMem (LUTabFun, Names, Names)
lastUseMCOp (MC.OtherOp NoOp (Aliases MCMem)
NoOp) Names
used_nms =
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, Names
used_nms)
lastUseMCOp (MC.ParOp Maybe (SegOp () (Aliases MCMem))
par_op SegOp () (Aliases MCMem)
op) Names
used_nms = do
(LUTabFun
lutab_par_op, Names
lu_vars_par_op, Names
used_names_par_op) <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) (forall rep lvl.
Constraints rep =>
SegOp lvl (Aliases rep)
-> Names -> LastUseM rep (LUTabFun, Names, Names)
`lastUseSegOp` Names
used_nms) Maybe (SegOp () (Aliases MCMem))
par_op
(LUTabFun
lutab_op, Names
lu_vars_op, Names
used_names_op) <-
forall rep lvl.
Constraints rep =>
SegOp lvl (Aliases rep)
-> Names -> LastUseM rep (LUTabFun, Names, Names)
lastUseSegOp SegOp () (Aliases MCMem)
op Names
used_nms
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( LUTabFun
lutab_par_op forall a. Semigroup a => a -> a -> a
<> LUTabFun
lutab_op,
Names
lu_vars_par_op forall a. Semigroup a => a -> a -> a
<> Names
lu_vars_op,
Names
used_names_par_op forall a. Semigroup a => a -> a -> a
<> Names
used_names_op
)
lastUseSegBinOp ::
(Constraints rep) =>
[SegBinOp (Aliases rep)] ->
Names ->
LastUseM rep (LUTabFun, Names, Names)
lastUseSegBinOp :: forall rep.
Constraints rep =>
[SegBinOp (Aliases rep)]
-> Names -> LastUseM rep (LUTabFun, Names, Names)
lastUseSegBinOp [SegBinOp (Aliases rep)]
sbos Names
used_nms = do
([LUTabFun]
lutab, [Names]
lu_vars, [Names]
used_nms') <- forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SegBinOp (Aliases rep) -> LastUseM rep (LUTabFun, Names, Names)
helper [SegBinOp (Aliases rep)]
sbos
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Monoid a => [a] -> a
mconcat [LUTabFun]
lutab, forall a. Monoid a => [a] -> a
mconcat [Names]
lu_vars, forall a. Monoid a => [a] -> a
mconcat [Names]
used_nms')
where
helper :: SegBinOp (Aliases rep) -> LastUseM rep (LUTabFun, Names, Names)
helper (SegBinOp Commutativity
_ l :: Lambda (Aliases rep)
l@(Lambda [LParam (Aliases rep)]
_ [Type]
_ Body (Aliases rep)
body) [SubExp]
neutral ShapeBase SubExp
shp) = forall rep a (m :: * -> *) b.
(Scoped rep a, LocalScope rep m) =>
a -> m b -> m b
inScopeOf Lambda (Aliases rep)
l forall a b. (a -> b) -> a -> b
$ do
(Names
used_nms', Names
lu_vars) <- forall rep. Names -> Names -> LastUseM rep (Names, Names)
lastUsedInNames Names
used_nms forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> Names
freeIn [SubExp]
neutral forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> Names
freeIn ShapeBase SubExp
shp
(LUTabFun
body_lutab, Names
used_nms'') <- forall rep.
Constraints rep =>
Body (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseBody Body (Aliases rep)
body (forall a. Monoid a => a
mempty, Names
used_nms')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LUTabFun
body_lutab, Names
lu_vars, Names
used_nms'')
lastUseHistOp ::
(Constraints rep) =>
[HistOp (Aliases rep)] ->
Names ->
LastUseM rep (LUTabFun, Names, Names)
lastUseHistOp :: forall rep.
Constraints rep =>
[HistOp (Aliases rep)]
-> Names -> LastUseM rep (LUTabFun, Names, Names)
lastUseHistOp [HistOp (Aliases rep)]
hos Names
used_nms = do
([LUTabFun]
lutab, [Names]
lu_vars, [Names]
used_nms') <- forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HistOp (Aliases rep) -> LastUseM rep (LUTabFun, Names, Names)
helper [HistOp (Aliases rep)]
hos
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Monoid a => [a] -> a
mconcat [LUTabFun]
lutab, forall a. Monoid a => [a] -> a
mconcat [Names]
lu_vars, forall a. Monoid a => [a] -> a
mconcat [Names]
used_nms')
where
helper :: HistOp (Aliases rep) -> LastUseM rep (LUTabFun, Names, Names)
helper (HistOp ShapeBase SubExp
shp SubExp
rf [VName]
dest [SubExp]
neutral ShapeBase SubExp
shp' l :: Lambda (Aliases rep)
l@(Lambda [LParam (Aliases rep)]
_ [Type]
_ Body (Aliases rep)
body)) = forall rep a (m :: * -> *) b.
(Scoped rep a, LocalScope rep m) =>
a -> m b -> m b
inScopeOf Lambda (Aliases rep)
l forall a b. (a -> b) -> a -> b
$ do
(Names
used_nms', Names
lu_vars) <- forall rep. Names -> Names -> LastUseM rep (Names, Names)
lastUsedInNames Names
used_nms forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> Names
freeIn ShapeBase SubExp
shp forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> Names
freeIn SubExp
rf forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> Names
freeIn [VName]
dest forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> Names
freeIn [SubExp]
neutral forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> Names
freeIn ShapeBase SubExp
shp'
(LUTabFun
body_lutab, Names
used_nms'') <- forall rep.
Constraints rep =>
Body (Aliases rep)
-> (LUTabFun, Names) -> LastUseM rep (LUTabFun, Names)
lastUseBody Body (Aliases rep)
body (forall a. Monoid a => a
mempty, Names
used_nms')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LUTabFun
body_lutab, Names
lu_vars, Names
used_nms'')
lastUseSeqOp :: Op (Aliases SeqMem) -> Names -> LastUseM SeqMem (LUTabFun, Names, Names)
lastUseSeqOp :: Op (Aliases SeqMem)
-> Names -> LastUseM SeqMem (LUTabFun, Names, Names)
lastUseSeqOp (Alloc SubExp
se Space
sp) Names
used_nms = do
let free_in_e :: Names
free_in_e = forall a. FreeIn a => a -> Names
freeIn SubExp
se forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> Names
freeIn Space
sp
(Names
used_nms', Names
lu_vars) <- forall rep. Names -> Names -> LastUseM rep (Names, Names)
lastUsedInNames Names
used_nms Names
free_in_e
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Monoid a => a
mempty, Names
lu_vars, Names
used_nms')
lastUseSeqOp (Inner NoOp (Aliases SeqMem)
NoOp) Names
used_nms = do
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, Names
used_nms)
lastUsedInNames ::
Names ->
Names ->
LastUseM rep (Names, Names)
lastUsedInNames :: forall rep. Names -> Names -> LastUseM rep (Names, Names)
lastUsedInNames Names
used_nms Names
new_uses = do
Names
new_uses_with_aliases <- forall rep. Names -> LastUseM rep Names
aliasTransitiveClosure Names
new_uses
[VName]
last_uses <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM VName -> LastUseM rep Bool
isLastUse forall a b. (a -> b) -> a -> b
$ Names -> [VName]
namesToList Names
new_uses
Names
last_uses' <- forall rep. Names -> LastUseM rep Names
aliasTransitiveClosure forall a b. (a -> b) -> a -> b
$ [VName] -> Names
namesFromList [VName]
last_uses
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Names
used_nms forall a. Semigroup a => a -> a -> a
<> Names
new_uses_with_aliases, Names
last_uses')
where
isLastUse :: VName -> LastUseM rep Bool
isLastUse VName
x = do
Names
with_aliases <- forall rep. Names -> LastUseM rep Names
aliasTransitiveClosure forall a b. (a -> b) -> a -> b
$ VName -> Names
oneName VName
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Names
with_aliases Names -> Names -> Bool
`namesIntersect` Names
used_nms
aliasTransitiveClosure :: Names -> LastUseM rep Names
aliasTransitiveClosure :: forall rep. Names -> LastUseM rep Names
aliasTransitiveClosure Names
args = do
Names
res <- forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Semigroup a => a -> a -> a
(<>) Names
args forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall rep. VName -> LastUseM rep Names
aliasLookup (Names -> [VName]
namesToList Names
args)
if Names
res forall a. Eq a => a -> a -> Bool
== Names
args
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Names
res
else forall rep. Names -> LastUseM rep Names
aliasTransitiveClosure Names
res
updateAliasing ::
(AliasesOf dec) =>
Names ->
Pat dec ->
LastUseM rep ()
updateAliasing :: forall dec rep.
AliasesOf dec =>
Names -> Pat dec -> LastUseM rep ()
updateAliasing Names
extra_aliases =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall dec rep. AliasesOf dec => PatElem dec -> LastUseM rep ()
update forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dec. Pat dec -> [PatElem dec]
patElems
where
update :: (AliasesOf dec) => PatElem dec -> LastUseM rep ()
update :: forall dec rep. AliasesOf dec => PatElem dec -> LastUseM rep ()
update (PatElem VName
name dec
dec) = do
let aliases :: Names
aliases = forall a. AliasesOf a => a -> Names
aliasesOf dec
dec
Names
aliases' <- forall rep. Names -> LastUseM rep Names
aliasTransitiveClosure forall a b. (a -> b) -> a -> b
$ Names
extra_aliases forall a. Semigroup a => a -> a -> a
<> Names
aliases
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VName
name Names
aliases'