{-# LANGUAGE Strict #-}
module Futhark.Analysis.UsageTable
( UsageTable,
without,
lookup,
used,
expand,
isConsumed,
isInResult,
isUsedDirectly,
isSize,
usages,
usage,
consumedUsage,
inResultUsage,
sizeUsage,
sizeUsages,
withoutU,
Usages,
consumedU,
presentU,
usageInStm,
usageInPat,
)
where
import Data.Bits
import Data.Foldable qualified as Foldable
import Data.IntMap.Strict qualified as IM
import Data.List (foldl')
import Futhark.IR
import Futhark.IR.Prop.Aliases
import Prelude hiding (lookup)
newtype UsageTable = UsageTable (IM.IntMap Usages)
deriving (UsageTable -> UsageTable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UsageTable -> UsageTable -> Bool
$c/= :: UsageTable -> UsageTable -> Bool
== :: UsageTable -> UsageTable -> Bool
$c== :: UsageTable -> UsageTable -> Bool
Eq, Int -> UsageTable -> ShowS
[UsageTable] -> ShowS
UsageTable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UsageTable] -> ShowS
$cshowList :: [UsageTable] -> ShowS
show :: UsageTable -> String
$cshow :: UsageTable -> String
showsPrec :: Int -> UsageTable -> ShowS
$cshowsPrec :: Int -> UsageTable -> ShowS
Show)
instance Semigroup UsageTable where
UsageTable IntMap Usages
table1 <> :: UsageTable -> UsageTable -> UsageTable
<> UsageTable IntMap Usages
table2 =
IntMap Usages -> UsageTable
UsageTable forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith forall a. Semigroup a => a -> a -> a
(<>) IntMap Usages
table1 IntMap Usages
table2
instance Monoid UsageTable where
mempty :: UsageTable
mempty = IntMap Usages -> UsageTable
UsageTable forall a. Monoid a => a
mempty
without :: UsageTable -> [VName] -> UsageTable
without :: UsageTable -> [VName] -> UsageTable
without (UsageTable IntMap Usages
table) =
IntMap Usages -> UsageTable
UsageTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> IntMap a -> IntMap a
IM.delete) IntMap Usages
table forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map VName -> Int
baseTag
lookup :: VName -> UsageTable -> Maybe Usages
lookup :: VName -> UsageTable -> Maybe Usages
lookup VName
name (UsageTable IntMap Usages
table) = forall a. Int -> IntMap a -> Maybe a
IM.lookup (VName -> Int
baseTag VName
name) IntMap Usages
table
lookupPred :: (Usages -> Bool) -> VName -> UsageTable -> Bool
lookupPred :: (Usages -> Bool) -> VName -> UsageTable -> Bool
lookupPred Usages -> Bool
f VName
name = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Usages -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> UsageTable -> Maybe Usages
lookup VName
name
used :: VName -> UsageTable -> Bool
used :: VName -> UsageTable -> Bool
used = (Usages -> Bool) -> VName -> UsageTable -> Bool
lookupPred forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Bool
True
expand :: (VName -> Names) -> UsageTable -> UsageTable
expand :: (VName -> Names) -> UsageTable -> UsageTable
expand VName -> Names
look (UsageTable IntMap Usages
m) = IntMap Usages -> UsageTable
UsageTable forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntMap Usages -> (Int, Usages) -> IntMap Usages
grow IntMap Usages
m forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [(Int, a)]
IM.toList IntMap Usages
m
where
grow :: IntMap Usages -> (Int, Usages) -> IntMap Usages
grow IntMap Usages
m' (Int
k, Usages
v) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
(forall {a}. Semigroup a => a -> IntMap a -> VName -> IntMap a
grow'' forall a b. (a -> b) -> a -> b
$ Usages
v Usages -> Usages -> Usages
`withoutU` Usages
presentU)
IntMap Usages
m'
(Names -> IntMap VName
namesIntMap forall a b. (a -> b) -> a -> b
$ VName -> Names
look forall a b. (a -> b) -> a -> b
$ Name -> Int -> VName
VName (String -> Name
nameFromString String
"") Int
k)
grow'' :: a -> IntMap a -> VName -> IntMap a
grow'' a
v IntMap a
m'' VName
k = forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith forall a. Semigroup a => a -> a -> a
(<>) (VName -> Int
baseTag VName
k) a
v IntMap a
m''
is :: Usages -> VName -> UsageTable -> Bool
is :: Usages -> VName -> UsageTable -> Bool
is = (Usages -> Bool) -> VName -> UsageTable -> Bool
lookupPred forall b c a. (b -> c) -> (a -> b) -> a -> c
. Usages -> Usages -> Bool
matches
isConsumed :: VName -> UsageTable -> Bool
isConsumed :: VName -> UsageTable -> Bool
isConsumed = Usages -> VName -> UsageTable -> Bool
is Usages
consumedU
isInResult :: VName -> UsageTable -> Bool
isInResult :: VName -> UsageTable -> Bool
isInResult = Usages -> VName -> UsageTable -> Bool
is Usages
inResultU
isUsedDirectly :: VName -> UsageTable -> Bool
isUsedDirectly :: VName -> UsageTable -> Bool
isUsedDirectly = Usages -> VName -> UsageTable -> Bool
is Usages
presentU
isSize :: VName -> UsageTable -> Bool
isSize :: VName -> UsageTable -> Bool
isSize = Usages -> VName -> UsageTable -> Bool
is Usages
sizeU
usages :: Names -> UsageTable
usages :: Names -> UsageTable
usages = IntMap Usages -> UsageTable
UsageTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map (forall a b. a -> b -> a
const Usages
presentU) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> IntMap VName
namesIntMap
usage :: VName -> Usages -> UsageTable
usage :: VName -> Usages -> UsageTable
usage VName
name Usages
uses = IntMap Usages -> UsageTable
UsageTable forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> IntMap a
IM.singleton (VName -> Int
baseTag VName
name) Usages
uses
consumedUsage :: VName -> UsageTable
consumedUsage :: VName -> UsageTable
consumedUsage VName
name = IntMap Usages -> UsageTable
UsageTable forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> IntMap a
IM.singleton (VName -> Int
baseTag VName
name) Usages
consumedU
inResultUsage :: VName -> UsageTable
inResultUsage :: VName -> UsageTable
inResultUsage VName
name = IntMap Usages -> UsageTable
UsageTable forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> IntMap a
IM.singleton (VName -> Int
baseTag VName
name) Usages
inResultU
sizeUsage :: VName -> UsageTable
sizeUsage :: VName -> UsageTable
sizeUsage VName
name = IntMap Usages -> UsageTable
UsageTable forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> IntMap a
IM.singleton (VName -> Int
baseTag VName
name) Usages
sizeU
sizeUsages :: Names -> UsageTable
sizeUsages :: Names -> UsageTable
sizeUsages = IntMap Usages -> UsageTable
UsageTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map (forall a b. a -> b -> a
const (Usages
sizeU forall a. Semigroup a => a -> a -> a
<> Usages
presentU)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> IntMap VName
namesIntMap
newtype Usages = Usages Int
deriving (Usages -> Usages -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Usages -> Usages -> Bool
$c/= :: Usages -> Usages -> Bool
== :: Usages -> Usages -> Bool
$c== :: Usages -> Usages -> Bool
Eq, Eq Usages
Usages -> Usages -> Bool
Usages -> Usages -> Ordering
Usages -> Usages -> Usages
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
min :: Usages -> Usages -> Usages
$cmin :: Usages -> Usages -> Usages
max :: Usages -> Usages -> Usages
$cmax :: Usages -> Usages -> Usages
>= :: Usages -> Usages -> Bool
$c>= :: Usages -> Usages -> Bool
> :: Usages -> Usages -> Bool
$c> :: Usages -> Usages -> Bool
<= :: Usages -> Usages -> Bool
$c<= :: Usages -> Usages -> Bool
< :: Usages -> Usages -> Bool
$c< :: Usages -> Usages -> Bool
compare :: Usages -> Usages -> Ordering
$ccompare :: Usages -> Usages -> Ordering
Ord, Int -> Usages -> ShowS
[Usages] -> ShowS
Usages -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Usages] -> ShowS
$cshowList :: [Usages] -> ShowS
show :: Usages -> String
$cshow :: Usages -> String
showsPrec :: Int -> Usages -> ShowS
$cshowsPrec :: Int -> Usages -> ShowS
Show)
instance Semigroup Usages where
Usages Int
x <> :: Usages -> Usages -> Usages
<> Usages Int
y = Int -> Usages
Usages forall a b. (a -> b) -> a -> b
$ Int
x forall a. Bits a => a -> a -> a
.|. Int
y
instance Monoid Usages where
mempty :: Usages
mempty = Int -> Usages
Usages Int
0
consumedU, inResultU, presentU, sizeU :: Usages
consumedU :: Usages
consumedU = Int -> Usages
Usages Int
1
inResultU :: Usages
inResultU = Int -> Usages
Usages Int
2
presentU :: Usages
presentU = Int -> Usages
Usages Int
4
sizeU :: Usages
sizeU = Int -> Usages
Usages Int
8
matches :: Usages -> Usages -> Bool
matches :: Usages -> Usages -> Bool
matches (Usages Int
x) (Usages Int
y) = Int
x forall a. Eq a => a -> a -> Bool
== (Int
x forall a. Bits a => a -> a -> a
.&. Int
y)
withoutU :: Usages -> Usages -> Usages
withoutU :: Usages -> Usages -> Usages
withoutU (Usages Int
x) (Usages Int
y) = Int -> Usages
Usages forall a b. (a -> b) -> a -> b
$ Int
x forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Int
y
usageInBody :: Aliased rep => Body rep -> UsageTable
usageInBody :: forall rep. Aliased rep => Body rep -> UsageTable
usageInBody = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap VName -> UsageTable
consumedUsage forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> [VName]
namesToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep. Aliased rep => Body rep -> Names
consumedInBody
usageInStm :: Aliased rep => Stm rep -> UsageTable
usageInStm :: forall rep. Aliased rep => Stm rep -> UsageTable
usageInStm (Let Pat (LetDec rep)
pat StmAux (ExpDec rep)
rep Exp rep
e) =
forall a. Monoid a => [a] -> a
mconcat
[ forall t. FreeIn t => Pat t -> UsageTable
usageInPat Pat (LetDec rep)
pat UsageTable -> [VName] -> UsageTable
`without` forall dec. Pat dec -> [VName]
patNames Pat (LetDec rep)
pat,
Names -> UsageTable
usages forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> Names
freeIn StmAux (ExpDec rep)
rep,
forall rep. Aliased rep => Exp rep -> UsageTable
usageInExp Exp rep
e,
Names -> UsageTable
usages (forall a. FreeIn a => a -> Names
freeIn Exp rep
e)
]
usageInPat :: FreeIn t => Pat t -> UsageTable
usageInPat :: forall t. FreeIn t => Pat t -> UsageTable
usageInPat = Names -> UsageTable
sizeUsages forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. FreeIn a => a -> Names
freeIn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dec. Pat dec -> [PatElem dec]
patElems
usageInExp :: Aliased rep => Exp rep -> UsageTable
usageInExp :: forall rep. Aliased rep => Exp rep -> UsageTable
usageInExp (Apply Name
_ [(SubExp, Diet)]
args [RetType rep]
_ (Safety, SrcLoc, [SrcLoc])
_) =
forall a. Monoid a => [a] -> a
mconcat
[ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map VName -> UsageTable
consumedUsage forall a b. (a -> b) -> a -> b
$ Names -> [VName]
namesToList forall a b. (a -> b) -> a -> b
$ SubExp -> Names
subExpAliases SubExp
arg
| (SubExp
arg, Diet
d) <- [(SubExp, Diet)]
args,
Diet
d forall a. Eq a => a -> a -> Bool
== Diet
Consume
]
usageInExp e :: Exp rep
e@DoLoop {} =
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap VName -> UsageTable
consumedUsage forall a b. (a -> b) -> a -> b
$ Names -> [VName]
namesToList forall a b. (a -> b) -> a -> b
$ forall rep. Aliased rep => Exp rep -> Names
consumedInExp Exp rep
e
usageInExp (Match [SubExp]
_ [Case (Body rep)]
cases Body rep
defbody MatchDec (BranchType rep)
_) =
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall rep. Aliased rep => Body rep -> UsageTable
usageInBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Case body -> body
caseBody) [Case (Body rep)]
cases forall a. Semigroup a => a -> a -> a
<> forall rep. Aliased rep => Body rep -> UsageTable
usageInBody Body rep
defbody
usageInExp (WithAcc [WithAccInput rep]
inputs Lambda rep
lam) =
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {t :: * -> *} {a} {c}.
Foldable t =>
(a, t VName, c) -> UsageTable
inputUsage [WithAccInput rep]
inputs forall a. Semigroup a => a -> a -> a
<> forall rep. Aliased rep => Body rep -> UsageTable
usageInBody (forall rep. Lambda rep -> Body rep
lambdaBody Lambda rep
lam)
where
inputUsage :: (a, t VName, c) -> UsageTable
inputUsage (a
_, t VName
arrs, c
_) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap VName -> UsageTable
consumedUsage t VName
arrs
usageInExp (BasicOp (Update Safety
_ VName
src Slice SubExp
_ SubExp
_)) =
VName -> UsageTable
consumedUsage VName
src
usageInExp (BasicOp (FlatUpdate VName
src FlatSlice SubExp
_ VName
_)) =
VName -> UsageTable
consumedUsage VName
src
usageInExp (Op OpC rep rep
op) =
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map VName -> UsageTable
consumedUsage (Names -> [VName]
namesToList forall a b. (a -> b) -> a -> b
$ forall op. AliasedOp op => op -> Names
consumedInOp OpC rep rep
op)
usageInExp (BasicOp BasicOp
_) = forall a. Monoid a => a
mempty