{-# LANGUAGE FlexibleContexts #-}
module Futhark.Analysis.Usage ( usageInStm ) where

import Futhark.Representation.AST
import Futhark.Representation.AST.Attributes.Aliases
import qualified Futhark.Analysis.UsageTable as UT

usageInStm :: (Attributes lore, Aliased lore) => Stm lore -> UT.UsageTable
usageInStm :: Stm lore -> UsageTable
usageInStm (Let Pattern lore
pat StmAux (ExpAttr lore)
lore Exp lore
e) =
  [UsageTable] -> UsageTable
forall a. Monoid a => [a] -> a
mconcat [UsageTable
usageInPat,
           UsageTable
usageInExpLore,
           Exp lore -> UsageTable
forall lore. Aliased lore => Exp lore -> UsageTable
usageInExp Exp lore
e,
           Names -> UsageTable
UT.usages (Exp lore -> Names
forall a. FreeIn a => a -> Names
freeIn Exp lore
e)]
  where usageInPat :: UsageTable
usageInPat =
          Names -> UsageTable
UT.usages ([Names] -> Names
forall a. Monoid a => [a] -> a
mconcat ((PatElemT (LetAttr lore) -> Names)
-> [PatElemT (LetAttr lore)] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map PatElemT (LetAttr lore) -> Names
forall a. FreeIn a => a -> Names
freeIn ([PatElemT (LetAttr lore)] -> [Names])
-> [PatElemT (LetAttr lore)] -> [Names]
forall a b. (a -> b) -> a -> b
$ Pattern lore -> [PatElemT (LetAttr lore)]
forall attr. PatternT attr -> [PatElemT attr]
patternElements Pattern lore
pat)
                     Names -> Names -> Names
`namesSubtract`
                     [VName] -> Names
namesFromList (Pattern lore -> [VName]
forall attr. PatternT attr -> [VName]
patternNames Pattern lore
pat))
        usageInExpLore :: UsageTable
usageInExpLore =
          Names -> UsageTable
UT.usages (Names -> UsageTable) -> Names -> UsageTable
forall a b. (a -> b) -> a -> b
$ StmAux (ExpAttr lore) -> Names
forall a. FreeIn a => a -> Names
freeIn StmAux (ExpAttr lore)
lore

usageInExp :: Aliased lore => Exp lore -> UT.UsageTable
usageInExp :: Exp lore -> UsageTable
usageInExp (Apply Name
_ [(SubExp, Diet)]
args [RetType lore]
_ (Safety, SrcLoc, [SrcLoc])
_) =
  [UsageTable] -> UsageTable
forall a. Monoid a => [a] -> a
mconcat [ [UsageTable] -> UsageTable
forall a. Monoid a => [a] -> a
mconcat ([UsageTable] -> UsageTable) -> [UsageTable] -> UsageTable
forall a b. (a -> b) -> a -> b
$ (VName -> UsageTable) -> [VName] -> [UsageTable]
forall a b. (a -> b) -> [a] -> [b]
map VName -> UsageTable
UT.consumedUsage ([VName] -> [UsageTable]) -> [VName] -> [UsageTable]
forall a b. (a -> b) -> a -> b
$
            Names -> [VName]
namesToList (Names -> [VName]) -> Names -> [VName]
forall a b. (a -> b) -> a -> b
$ SubExp -> Names
subExpAliases SubExp
arg
          | (SubExp
arg,Diet
d) <- [(SubExp, Diet)]
args, Diet
d Diet -> Diet -> Bool
forall a. Eq a => a -> a -> Bool
== Diet
Consume ]
usageInExp (DoLoop [(FParam lore, SubExp)]
_ [(FParam lore, SubExp)]
merge LoopForm lore
_ BodyT lore
_) =
  [UsageTable] -> UsageTable
forall a. Monoid a => [a] -> a
mconcat [ [UsageTable] -> UsageTable
forall a. Monoid a => [a] -> a
mconcat ([UsageTable] -> UsageTable) -> [UsageTable] -> UsageTable
forall a b. (a -> b) -> a -> b
$ (VName -> UsageTable) -> [VName] -> [UsageTable]
forall a b. (a -> b) -> [a] -> [b]
map VName -> UsageTable
UT.consumedUsage ([VName] -> [UsageTable]) -> [VName] -> [UsageTable]
forall a b. (a -> b) -> a -> b
$
            Names -> [VName]
namesToList (Names -> [VName]) -> Names -> [VName]
forall a b. (a -> b) -> a -> b
$ SubExp -> Names
subExpAliases SubExp
se
          | (FParam lore
v,SubExp
se) <- [(FParam lore, SubExp)]
merge, TypeBase Shape Uniqueness -> Bool
forall shape. TypeBase shape Uniqueness -> Bool
unique (TypeBase Shape Uniqueness -> Bool)
-> TypeBase Shape Uniqueness -> Bool
forall a b. (a -> b) -> a -> b
$ FParam lore -> TypeBase Shape Uniqueness
forall attr.
DeclTyped attr =>
Param attr -> TypeBase Shape Uniqueness
paramDeclType FParam lore
v ]
usageInExp (If SubExp
_ BodyT lore
tbranch BodyT lore
fbranch IfAttr (BranchType lore)
_) =
  (VName -> UsageTable) -> [VName] -> UsageTable
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap VName -> UsageTable
UT.consumedUsage ([VName] -> UsageTable) -> [VName] -> UsageTable
forall a b. (a -> b) -> a -> b
$ Names -> [VName]
namesToList (Names -> [VName]) -> Names -> [VName]
forall a b. (a -> b) -> a -> b
$
  BodyT lore -> Names
forall lore. Aliased lore => Body lore -> Names
consumedInBody BodyT lore
tbranch Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> BodyT lore -> Names
forall lore. Aliased lore => Body lore -> Names
consumedInBody BodyT lore
fbranch
usageInExp (BasicOp (Update VName
src Slice SubExp
_ SubExp
_)) =
  VName -> UsageTable
UT.consumedUsage VName
src
usageInExp (Op Op lore
op) =
  [UsageTable] -> UsageTable
forall a. Monoid a => [a] -> a
mconcat ([UsageTable] -> UsageTable) -> [UsageTable] -> UsageTable
forall a b. (a -> b) -> a -> b
$ (VName -> UsageTable) -> [VName] -> [UsageTable]
forall a b. (a -> b) -> [a] -> [b]
map VName -> UsageTable
UT.consumedUsage (Names -> [VName]
namesToList (Names -> [VName]) -> Names -> [VName]
forall a b. (a -> b) -> a -> b
$ Op lore -> Names
forall op. AliasedOp op => op -> Names
consumedInOp Op lore
op)
usageInExp Exp lore
_ = UsageTable
UT.empty