{-# LANGUAGE UndecidableInstances #-}
module Futhark.IR.Prop.Names
(
Names,
namesIntMap,
namesIntSet,
nameIn,
notNameIn,
oneName,
namesFromList,
namesToList,
namesIntersection,
namesIntersect,
namesSubtract,
mapNames,
FreeIn (..),
freeIn,
freeInStmsAndRes,
boundInBody,
boundByStm,
boundByStms,
boundByLambda,
FreeDec (..),
FV,
fvBind,
fvName,
fvNames,
)
where
import Control.Category
import Control.Monad.State.Strict
import Data.Foldable
import Data.IntMap.Strict qualified as IM
import Data.IntSet qualified as IS
import Data.Map.Strict qualified as M
import Data.Set qualified as S
import Futhark.IR.Prop.Pat
import Futhark.IR.Syntax
import Futhark.IR.Traversals
import Futhark.Util.Pretty
import Prelude hiding (id, (.))
newtype Names = Names (IM.IntMap VName)
deriving (Names -> Names -> Bool
(Names -> Names -> Bool) -> (Names -> Names -> Bool) -> Eq Names
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Names -> Names -> Bool
== :: Names -> Names -> Bool
$c/= :: Names -> Names -> Bool
/= :: Names -> Names -> Bool
Eq, Int -> Names -> ShowS
[Names] -> ShowS
Names -> String
(Int -> Names -> ShowS)
-> (Names -> String) -> ([Names] -> ShowS) -> Show Names
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Names -> ShowS
showsPrec :: Int -> Names -> ShowS
$cshow :: Names -> String
show :: Names -> String
$cshowList :: [Names] -> ShowS
showList :: [Names] -> ShowS
Show)
namesIntMap :: Names -> IM.IntMap VName
namesIntMap :: Names -> IntMap VName
namesIntMap (Names IntMap VName
m) = IntMap VName
m
namesIntSet :: Names -> IS.IntSet
namesIntSet :: Names -> IntSet
namesIntSet (Names IntMap VName
m) = IntMap VName -> IntSet
forall a. IntMap a -> IntSet
IM.keysSet IntMap VName
m
instance Ord Names where
Names
x compare :: Names -> Names -> Ordering
`compare` Names
y = if Names
x Names -> Names -> Bool
forall a. Eq a => a -> a -> Bool
== Names
y then Ordering
EQ else Ordering
LT
instance Semigroup Names where
Names
vs1 <> :: Names -> Names -> Names
<> Names
vs2 = IntMap VName -> Names
Names (IntMap VName -> Names) -> IntMap VName -> Names
forall a b. (a -> b) -> a -> b
$ Names -> IntMap VName
namesIntMap Names
vs1 IntMap VName -> IntMap VName -> IntMap VName
forall a. Semigroup a => a -> a -> a
<> Names -> IntMap VName
namesIntMap Names
vs2
instance Monoid Names where
mempty :: Names
mempty = IntMap VName -> Names
Names IntMap VName
forall a. Monoid a => a
mempty
instance Pretty Names where
pretty :: forall ann. Names -> Doc ann
pretty = [VName] -> Doc ann
forall ann. [VName] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([VName] -> Doc ann) -> (Names -> [VName]) -> Names -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Names -> [VName]
namesToList
nameIn :: VName -> Names -> Bool
nameIn :: VName -> Names -> Bool
nameIn VName
v (Names IntMap VName
vs) = VName -> Int
baseTag VName
v Int -> IntMap VName -> Bool
forall a. Int -> IntMap a -> Bool
`IM.member` IntMap VName
vs
notNameIn :: VName -> Names -> Bool
notNameIn :: VName -> Names -> Bool
notNameIn VName
v (Names IntMap VName
vs) = VName -> Int
baseTag VName
v Int -> IntMap VName -> Bool
forall a. Int -> IntMap a -> Bool
`IM.notMember` IntMap VName
vs
namesFromList :: [VName] -> Names
namesFromList :: [VName] -> Names
namesFromList [VName]
vs = IntMap VName -> Names
Names (IntMap VName -> Names) -> IntMap VName -> Names
forall a b. (a -> b) -> a -> b
$ [(Int, VName)] -> IntMap VName
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, VName)] -> IntMap VName) -> [(Int, VName)] -> IntMap VName
forall a b. (a -> b) -> a -> b
$ [Int] -> [VName] -> [(Int, VName)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((VName -> Int) -> [VName] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map VName -> Int
baseTag [VName]
vs) [VName]
vs
namesToList :: Names -> [VName]
namesToList :: Names -> [VName]
namesToList = IntMap VName -> [VName]
forall a. IntMap a -> [a]
IM.elems (IntMap VName -> [VName])
-> (Names -> IntMap VName) -> Names -> [VName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Names -> IntMap VName
namesIntMap
oneName :: VName -> Names
oneName :: VName -> Names
oneName VName
v = IntMap VName -> Names
Names (IntMap VName -> Names) -> IntMap VName -> Names
forall a b. (a -> b) -> a -> b
$ Int -> VName -> IntMap VName
forall a. Int -> a -> IntMap a
IM.singleton (VName -> Int
baseTag VName
v) VName
v
namesIntersection :: Names -> Names -> Names
namesIntersection :: Names -> Names -> Names
namesIntersection (Names IntMap VName
vs1) (Names IntMap VName
vs2) = IntMap VName -> Names
Names (IntMap VName -> Names) -> IntMap VName -> Names
forall a b. (a -> b) -> a -> b
$ IntMap VName -> IntMap VName -> IntMap VName
forall a b. IntMap a -> IntMap b -> IntMap a
IM.intersection IntMap VName
vs1 IntMap VName
vs2
namesIntersect :: Names -> Names -> Bool
namesIntersect :: Names -> Names -> Bool
namesIntersect Names
vs1 Names
vs2 = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntMap VName -> IntMap VName -> Bool
forall a b. IntMap a -> IntMap b -> Bool
IM.disjoint (Names -> IntMap VName
namesIntMap Names
vs1) (Names -> IntMap VName
namesIntMap Names
vs2)
namesSubtract :: Names -> Names -> Names
namesSubtract :: Names -> Names -> Names
namesSubtract (Names IntMap VName
vs1) (Names IntMap VName
vs2) = IntMap VName -> Names
Names (IntMap VName -> Names) -> IntMap VName -> Names
forall a b. (a -> b) -> a -> b
$ IntMap VName -> IntMap VName -> IntMap VName
forall a b. IntMap a -> IntMap b -> IntMap a
IM.difference IntMap VName
vs1 IntMap VName
vs2
mapNames :: (VName -> VName) -> Names -> Names
mapNames :: (VName -> VName) -> Names -> Names
mapNames VName -> VName
f Names
vs = [VName] -> Names
namesFromList ([VName] -> Names) -> [VName] -> Names
forall a b. (a -> b) -> a -> b
$ (VName -> VName) -> [VName] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map VName -> VName
f ([VName] -> [VName]) -> [VName] -> [VName]
forall a b. (a -> b) -> a -> b
$ Names -> [VName]
namesToList Names
vs
newtype FV = FV {FV -> Names
unFV :: Names}
instance Monoid FV where
mempty :: FV
mempty = Names -> FV
FV Names
forall a. Monoid a => a
mempty
instance Semigroup FV where
FV Names
fv1 <> :: FV -> FV -> FV
<> FV Names
fv2 = Names -> FV
FV (Names -> FV) -> Names -> FV
forall a b. (a -> b) -> a -> b
$ Names
fv1 Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Names
fv2
fvBind :: Names -> FV -> FV
fvBind :: Names -> FV -> FV
fvBind Names
vs (FV Names
fv) = Names -> FV
FV (Names -> FV) -> Names -> FV
forall a b. (a -> b) -> a -> b
$ Names
fv Names -> Names -> Names
`namesSubtract` Names
vs
fvName :: VName -> FV
fvName :: VName -> FV
fvName VName
v = Names -> FV
FV (Names -> FV) -> Names -> FV
forall a b. (a -> b) -> a -> b
$ VName -> Names
oneName VName
v
fvNames :: Names -> FV
fvNames :: Names -> FV
fvNames = Names -> FV
FV
freeWalker ::
( FreeDec (ExpDec rep),
FreeDec (BodyDec rep),
FreeIn (FParamInfo rep),
FreeIn (LParamInfo rep),
FreeIn (LetDec rep),
FreeIn (RetType rep),
FreeIn (BranchType rep),
FreeIn (Op rep)
) =>
Walker rep (State FV)
freeWalker :: forall rep.
(FreeDec (ExpDec rep), FreeDec (BodyDec rep),
FreeIn (FParamInfo rep), FreeIn (LParamInfo rep),
FreeIn (LetDec rep), FreeIn (RetType rep), FreeIn (BranchType rep),
FreeIn (Op rep)) =>
Walker rep (State FV)
freeWalker =
Walker
{ walkOnSubExp :: SubExp -> State FV ()
walkOnSubExp = (FV -> FV) -> State FV ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FV -> FV) -> State FV ())
-> (SubExp -> FV -> FV) -> SubExp -> State FV ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
(<>) (FV -> FV -> FV) -> (SubExp -> FV) -> SubExp -> FV -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SubExp -> FV
forall a. FreeIn a => a -> FV
freeIn',
walkOnBody :: Scope rep -> Body rep -> State FV ()
walkOnBody = \Scope rep
scope Body rep
body -> do
(FV -> FV) -> State FV ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FV -> FV) -> State FV ()) -> (FV -> FV) -> State FV ()
forall a b. (a -> b) -> a -> b
$ FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
(<>) (FV -> FV -> FV) -> FV -> FV -> FV
forall a b. (a -> b) -> a -> b
$ Body rep -> FV
forall a. FreeIn a => a -> FV
freeIn' Body rep
body
(FV -> FV) -> State FV ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FV -> FV) -> State FV ()) -> (FV -> FV) -> State FV ()
forall a b. (a -> b) -> a -> b
$ Names -> FV -> FV
fvBind ([VName] -> Names
namesFromList (Scope rep -> [VName]
forall k a. Map k a -> [k]
M.keys Scope rep
scope)),
walkOnVName :: VName -> State FV ()
walkOnVName = (FV -> FV) -> State FV ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FV -> FV) -> State FV ())
-> (VName -> FV -> FV) -> VName -> State FV ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
(<>) (FV -> FV -> FV) -> (VName -> FV) -> VName -> FV -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VName -> FV
fvName,
walkOnOp :: Op rep -> State FV ()
walkOnOp = (FV -> FV) -> State FV ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FV -> FV) -> State FV ())
-> (Op rep -> FV -> FV) -> Op rep -> State FV ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
(<>) (FV -> FV -> FV) -> (Op rep -> FV) -> Op rep -> FV -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Op rep -> FV
forall a. FreeIn a => a -> FV
freeIn',
walkOnFParam :: Param (FParamInfo rep) -> State FV ()
walkOnFParam = (FV -> FV) -> State FV ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FV -> FV) -> State FV ())
-> (Param (FParamInfo rep) -> FV -> FV)
-> Param (FParamInfo rep)
-> State FV ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
(<>) (FV -> FV -> FV)
-> (Param (FParamInfo rep) -> FV)
-> Param (FParamInfo rep)
-> FV
-> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Param (FParamInfo rep) -> FV
forall a. FreeIn a => a -> FV
freeIn',
walkOnLParam :: Param (LParamInfo rep) -> State FV ()
walkOnLParam = (FV -> FV) -> State FV ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FV -> FV) -> State FV ())
-> (Param (LParamInfo rep) -> FV -> FV)
-> Param (LParamInfo rep)
-> State FV ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
(<>) (FV -> FV -> FV)
-> (Param (LParamInfo rep) -> FV)
-> Param (LParamInfo rep)
-> FV
-> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Param (LParamInfo rep) -> FV
forall a. FreeIn a => a -> FV
freeIn',
walkOnRetType :: RetType rep -> State FV ()
walkOnRetType = (FV -> FV) -> State FV ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FV -> FV) -> State FV ())
-> (RetType rep -> FV -> FV) -> RetType rep -> State FV ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
(<>) (FV -> FV -> FV) -> (RetType rep -> FV) -> RetType rep -> FV -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RetType rep -> FV
forall a. FreeIn a => a -> FV
freeIn',
walkOnBranchType :: BranchType rep -> State FV ()
walkOnBranchType = (FV -> FV) -> State FV ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FV -> FV) -> State FV ())
-> (BranchType rep -> FV -> FV) -> BranchType rep -> State FV ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
(<>) (FV -> FV -> FV)
-> (BranchType rep -> FV) -> BranchType rep -> FV -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BranchType rep -> FV
forall a. FreeIn a => a -> FV
freeIn'
}
freeInStmsAndRes ::
( FreeIn (Op rep),
FreeIn (LetDec rep),
FreeIn (LParamInfo rep),
FreeIn (FParamInfo rep),
FreeDec (BodyDec rep),
FreeIn (RetType rep),
FreeIn (BranchType rep),
FreeDec (ExpDec rep)
) =>
Stms rep ->
Result ->
FV
freeInStmsAndRes :: forall rep.
(FreeIn (Op rep), FreeIn (LetDec rep), FreeIn (LParamInfo rep),
FreeIn (FParamInfo rep), FreeDec (BodyDec rep),
FreeIn (RetType rep), FreeIn (BranchType rep),
FreeDec (ExpDec rep)) =>
Stms rep -> Result -> FV
freeInStmsAndRes Stms rep
stms Result
res =
Names -> FV -> FV
fvBind (Stms rep -> Names
forall rep. Stms rep -> Names
boundByStms Stms rep
stms) (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ (Stm rep -> FV) -> Stms rep -> FV
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Stm rep -> FV
forall a. FreeIn a => a -> FV
freeIn' Stms rep
stms FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Result -> FV
forall a. FreeIn a => a -> FV
freeIn' Result
res
class FreeIn a where
freeIn' :: a -> FV
freeIn' = Names -> FV
fvNames (Names -> FV) -> (a -> Names) -> a -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Names
forall a. FreeIn a => a -> Names
freeIn
freeIn :: (FreeIn a) => a -> Names
freeIn :: forall a. FreeIn a => a -> Names
freeIn = FV -> Names
unFV (FV -> Names) -> (a -> FV) -> a -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> FV
forall a. FreeIn a => a -> FV
freeIn'
instance FreeIn FV where
freeIn' :: FV -> FV
freeIn' = FV -> FV
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
instance FreeIn () where
freeIn' :: () -> FV
freeIn' () = FV
forall a. Monoid a => a
mempty
instance FreeIn Int where
freeIn' :: Int -> FV
freeIn' = FV -> Int -> FV
forall a b. a -> b -> a
const FV
forall a. Monoid a => a
mempty
instance (FreeIn a, FreeIn b) => FreeIn (a, b) where
freeIn' :: (a, b) -> FV
freeIn' (a
a, b
b) = a -> FV
forall a. FreeIn a => a -> FV
freeIn' a
a FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> b -> FV
forall a. FreeIn a => a -> FV
freeIn' b
b
instance (FreeIn a, FreeIn b, FreeIn c) => FreeIn (a, b, c) where
freeIn' :: (a, b, c) -> FV
freeIn' (a
a, b
b, c
c) = a -> FV
forall a. FreeIn a => a -> FV
freeIn' a
a FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> b -> FV
forall a. FreeIn a => a -> FV
freeIn' b
b FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> c -> FV
forall a. FreeIn a => a -> FV
freeIn' c
c
instance (FreeIn a, FreeIn b, FreeIn c, FreeIn d) => FreeIn (a, b, c, d) where
freeIn' :: (a, b, c, d) -> FV
freeIn' (a
a, b
b, c
c, d
d) = a -> FV
forall a. FreeIn a => a -> FV
freeIn' a
a FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> b -> FV
forall a. FreeIn a => a -> FV
freeIn' b
b FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> c -> FV
forall a. FreeIn a => a -> FV
freeIn' c
c FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> d -> FV
forall a. FreeIn a => a -> FV
freeIn' d
d
instance (FreeIn a, FreeIn b) => FreeIn (Either a b) where
freeIn' :: Either a b -> FV
freeIn' = (a -> FV) -> (b -> FV) -> Either a b -> FV
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> FV
forall a. FreeIn a => a -> FV
freeIn' b -> FV
forall a. FreeIn a => a -> FV
freeIn'
instance (FreeIn a) => FreeIn [a] where
freeIn' :: [a] -> FV
freeIn' = (a -> FV) -> [a] -> FV
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> FV
forall a. FreeIn a => a -> FV
freeIn'
instance (FreeIn a) => FreeIn (S.Set a) where
freeIn' :: Set a -> FV
freeIn' = (a -> FV) -> Set a -> FV
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> FV
forall a. FreeIn a => a -> FV
freeIn'
instance FreeIn (NoOp rep) where
freeIn' :: NoOp rep -> FV
freeIn' NoOp rep
NoOp = FV
forall a. Monoid a => a
mempty
instance
( FreeDec (ExpDec rep),
FreeDec (BodyDec rep),
FreeIn (FParamInfo rep),
FreeIn (LParamInfo rep),
FreeIn (LetDec rep),
FreeIn (RetType rep),
FreeIn (BranchType rep),
FreeIn (Op rep)
) =>
FreeIn (FunDef rep)
where
freeIn' :: FunDef rep -> FV
freeIn' (FunDef Maybe EntryPoint
_ Attrs
_ Name
_ [(RetType rep, RetAls)]
rettype [Param (FParamInfo rep)]
params Body rep
body) =
Names -> FV -> FV
fvBind ([VName] -> Names
namesFromList ([VName] -> Names) -> [VName] -> Names
forall a b. (a -> b) -> a -> b
$ (Param (FParamInfo rep) -> VName)
-> [Param (FParamInfo rep)] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param (FParamInfo rep) -> VName
forall dec. Param dec -> VName
paramName [Param (FParamInfo rep)]
params) (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$
((RetType rep, RetAls) -> FV) -> [(RetType rep, RetAls)] -> FV
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (RetType rep -> FV
forall a. FreeIn a => a -> FV
freeIn' (RetType rep -> FV)
-> ((RetType rep, RetAls) -> RetType rep)
-> (RetType rep, RetAls)
-> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (RetType rep, RetAls) -> RetType rep
forall a b. (a, b) -> a
fst) [(RetType rep, RetAls)]
rettype FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> [Param (FParamInfo rep)] -> FV
forall a. FreeIn a => a -> FV
freeIn' [Param (FParamInfo rep)]
params FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Body rep -> FV
forall a. FreeIn a => a -> FV
freeIn' Body rep
body
instance
( FreeDec (ExpDec rep),
FreeDec (BodyDec rep),
FreeIn (FParamInfo rep),
FreeIn (LParamInfo rep),
FreeIn (LetDec rep),
FreeIn (RetType rep),
FreeIn (BranchType rep),
FreeIn (Op rep)
) =>
FreeIn (Lambda rep)
where
freeIn' :: Lambda rep -> FV
freeIn' (Lambda [Param (LParamInfo rep)]
params [Type]
body Body rep
rettype) =
Names -> FV -> FV
fvBind ([VName] -> Names
namesFromList ([VName] -> Names) -> [VName] -> Names
forall a b. (a -> b) -> a -> b
$ (Param (LParamInfo rep) -> VName)
-> [Param (LParamInfo rep)] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param (LParamInfo rep) -> VName
forall dec. Param dec -> VName
paramName [Param (LParamInfo rep)]
params) (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$
Body rep -> FV
forall a. FreeIn a => a -> FV
freeIn' Body rep
rettype FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> [Param (LParamInfo rep)] -> FV
forall a. FreeIn a => a -> FV
freeIn' [Param (LParamInfo rep)]
params FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> [Type] -> FV
forall a. FreeIn a => a -> FV
freeIn' [Type]
body
instance
( FreeDec (ExpDec rep),
FreeDec (BodyDec rep),
FreeIn (FParamInfo rep),
FreeIn (LParamInfo rep),
FreeIn (LetDec rep),
FreeIn (RetType rep),
FreeIn (BranchType rep),
FreeIn (Op rep)
) =>
FreeIn (Body rep)
where
freeIn' :: Body rep -> FV
freeIn' (Body BodyDec rep
dec Stms rep
stms Result
res) =
BodyDec rep -> FV -> FV
forall dec. FreeDec dec => dec -> FV -> FV
precomputed BodyDec rep
dec (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ BodyDec rep -> FV
forall a. FreeIn a => a -> FV
freeIn' BodyDec rep
dec FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Stms rep -> Result -> FV
forall rep.
(FreeIn (Op rep), FreeIn (LetDec rep), FreeIn (LParamInfo rep),
FreeIn (FParamInfo rep), FreeDec (BodyDec rep),
FreeIn (RetType rep), FreeIn (BranchType rep),
FreeDec (ExpDec rep)) =>
Stms rep -> Result -> FV
freeInStmsAndRes Stms rep
stms Result
res
instance
( FreeDec (ExpDec rep),
FreeDec (BodyDec rep),
FreeIn (FParamInfo rep),
FreeIn (LParamInfo rep),
FreeIn (LetDec rep),
FreeIn (RetType rep),
FreeIn (BranchType rep),
FreeIn (Op rep)
) =>
FreeIn (Exp rep)
where
freeIn' :: Exp rep -> FV
freeIn' (Loop [(Param (FParamInfo rep), SubExp)]
merge LoopForm
form Body rep
loopbody) =
let ([Param (FParamInfo rep)]
params, [SubExp]
args) = [(Param (FParamInfo rep), SubExp)]
-> ([Param (FParamInfo rep)], [SubExp])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Param (FParamInfo rep), SubExp)]
merge
bound_here :: Names
bound_here =
case LoopForm
form of
WhileLoop {} -> [VName] -> Names
namesFromList ([VName] -> Names) -> [VName] -> Names
forall a b. (a -> b) -> a -> b
$ (Param (FParamInfo rep) -> VName)
-> [Param (FParamInfo rep)] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param (FParamInfo rep) -> VName
forall dec. Param dec -> VName
paramName [Param (FParamInfo rep)]
params
ForLoop VName
i IntType
_ SubExp
_ -> [VName] -> Names
namesFromList ([VName] -> Names) -> [VName] -> Names
forall a b. (a -> b) -> a -> b
$ VName
i VName -> [VName] -> [VName]
forall a. a -> [a] -> [a]
: (Param (FParamInfo rep) -> VName)
-> [Param (FParamInfo rep)] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param (FParamInfo rep) -> VName
forall dec. Param dec -> VName
paramName [Param (FParamInfo rep)]
params
in Names -> FV -> FV
fvBind Names
bound_here (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$
[SubExp] -> FV
forall a. FreeIn a => a -> FV
freeIn' [SubExp]
args FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> LoopForm -> FV
forall a. FreeIn a => a -> FV
freeIn' LoopForm
form FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> [Param (FParamInfo rep)] -> FV
forall a. FreeIn a => a -> FV
freeIn' [Param (FParamInfo rep)]
params FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Body rep -> FV
forall a. FreeIn a => a -> FV
freeIn' Body rep
loopbody
freeIn' (WithAcc [WithAccInput rep]
inputs Lambda rep
lam) =
[WithAccInput rep] -> FV
forall a. FreeIn a => a -> FV
freeIn' [WithAccInput rep]
inputs FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Lambda rep -> FV
forall a. FreeIn a => a -> FV
freeIn' Lambda rep
lam
freeIn' Exp rep
e = State FV () -> FV -> FV
forall s a. State s a -> s -> s
execState (Walker rep (State FV) -> Exp rep -> State FV ()
forall (m :: * -> *) rep.
Monad m =>
Walker rep m -> Exp rep -> m ()
walkExpM Walker rep (State FV)
forall rep.
(FreeDec (ExpDec rep), FreeDec (BodyDec rep),
FreeIn (FParamInfo rep), FreeIn (LParamInfo rep),
FreeIn (LetDec rep), FreeIn (RetType rep), FreeIn (BranchType rep),
FreeIn (Op rep)) =>
Walker rep (State FV)
freeWalker Exp rep
e) FV
forall a. Monoid a => a
mempty
instance
( FreeDec (ExpDec rep),
FreeDec (BodyDec rep),
FreeIn (FParamInfo rep),
FreeIn (LParamInfo rep),
FreeIn (LetDec rep),
FreeIn (RetType rep),
FreeIn (BranchType rep),
FreeIn (Op rep)
) =>
FreeIn (Stm rep)
where
freeIn' :: Stm rep -> FV
freeIn' (Let Pat (LetDec rep)
pat (StmAux Certs
cs Attrs
attrs ExpDec rep
dec) Exp rep
e) =
Certs -> FV
forall a. FreeIn a => a -> FV
freeIn' Certs
cs
FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Attrs -> FV
forall a. FreeIn a => a -> FV
freeIn' Attrs
attrs
FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> ExpDec rep -> FV -> FV
forall dec. FreeDec dec => dec -> FV -> FV
precomputed ExpDec rep
dec (ExpDec rep -> FV
forall a. FreeIn a => a -> FV
freeIn' ExpDec rep
dec FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp rep -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp rep
e FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Pat (LetDec rep) -> FV
forall a. FreeIn a => a -> FV
freeIn' Pat (LetDec rep)
pat)
instance (FreeIn (Stm rep)) => FreeIn (Stms rep) where
freeIn' :: Stms rep -> FV
freeIn' = (Stm rep -> FV) -> Stms rep -> FV
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Stm rep -> FV
forall a. FreeIn a => a -> FV
freeIn'
instance (FreeIn body) => FreeIn (Case body) where
freeIn' :: Case body -> FV
freeIn' = body -> FV
forall a. FreeIn a => a -> FV
freeIn' (body -> FV) -> (Case body -> body) -> Case body -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Case body -> body
forall body. Case body -> body
caseBody
instance FreeIn Names where
freeIn' :: Names -> FV
freeIn' = Names -> FV
fvNames
instance FreeIn Bool where
freeIn' :: Bool -> FV
freeIn' Bool
_ = FV
forall a. Monoid a => a
mempty
instance (FreeIn a) => FreeIn (Maybe a) where
freeIn' :: Maybe a -> FV
freeIn' = FV -> (a -> FV) -> Maybe a -> FV
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FV
forall a. Monoid a => a
mempty a -> FV
forall a. FreeIn a => a -> FV
freeIn'
instance FreeIn VName where
freeIn' :: VName -> FV
freeIn' = VName -> FV
fvName
instance FreeIn Ident where
freeIn' :: Ident -> FV
freeIn' = Type -> FV
forall a. FreeIn a => a -> FV
freeIn' (Type -> FV) -> (Ident -> Type) -> Ident -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ident -> Type
identType
instance FreeIn SubExp where
freeIn' :: SubExp -> FV
freeIn' (Var VName
v) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
v
freeIn' Constant {} = FV
forall a. Monoid a => a
mempty
instance FreeIn Space where
freeIn' :: Space -> FV
freeIn' (ScalarSpace [SubExp]
d PrimType
_) = [SubExp] -> FV
forall a. FreeIn a => a -> FV
freeIn' [SubExp]
d
freeIn' Space
DefaultSpace = FV
forall a. Monoid a => a
mempty
freeIn' (Space String
_) = FV
forall a. Monoid a => a
mempty
instance (FreeIn d) => FreeIn (ShapeBase d) where
freeIn' :: ShapeBase d -> FV
freeIn' = [d] -> FV
forall a. FreeIn a => a -> FV
freeIn' ([d] -> FV) -> (ShapeBase d -> [d]) -> ShapeBase d -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShapeBase d -> [d]
forall d. ShapeBase d -> [d]
shapeDims
instance (FreeIn d) => FreeIn (Ext d) where
freeIn' :: Ext d -> FV
freeIn' (Free d
x) = d -> FV
forall a. FreeIn a => a -> FV
freeIn' d
x
freeIn' (Ext Int
_) = FV
forall a. Monoid a => a
mempty
instance FreeIn PrimType where
freeIn' :: PrimType -> FV
freeIn' PrimType
_ = FV
forall a. Monoid a => a
mempty
instance (FreeIn shape) => FreeIn (TypeBase shape u) where
freeIn' :: TypeBase shape u -> FV
freeIn' (Array PrimType
t shape
shape u
_) = PrimType -> FV
forall a. FreeIn a => a -> FV
freeIn' PrimType
t FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> shape -> FV
forall a. FreeIn a => a -> FV
freeIn' shape
shape
freeIn' (Mem Space
s) = Space -> FV
forall a. FreeIn a => a -> FV
freeIn' Space
s
freeIn' Prim {} = FV
forall a. Monoid a => a
mempty
freeIn' (Acc VName
acc ShapeBase SubExp
ispace [Type]
ts u
_) = (VName, ShapeBase SubExp, [Type]) -> FV
forall a. FreeIn a => a -> FV
freeIn' (VName
acc, ShapeBase SubExp
ispace, [Type]
ts)
instance (FreeIn dec) => FreeIn (Param dec) where
freeIn' :: Param dec -> FV
freeIn' (Param Attrs
attrs VName
_ dec
dec) = Attrs -> FV
forall a. FreeIn a => a -> FV
freeIn' Attrs
attrs FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> dec -> FV
forall a. FreeIn a => a -> FV
freeIn' dec
dec
instance (FreeIn dec) => FreeIn (PatElem dec) where
freeIn' :: PatElem dec -> FV
freeIn' (PatElem VName
_ dec
dec) = dec -> FV
forall a. FreeIn a => a -> FV
freeIn' dec
dec
instance FreeIn LoopForm where
freeIn' :: LoopForm -> FV
freeIn' (ForLoop VName
_ IntType
_ SubExp
bound) = SubExp -> FV
forall a. FreeIn a => a -> FV
freeIn' SubExp
bound
freeIn' (WhileLoop VName
cond) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
cond
instance (FreeIn d) => FreeIn (DimIndex d) where
freeIn' :: DimIndex d -> FV
freeIn' = (d -> FV) -> DimIndex d -> FV
forall m a. Monoid m => (a -> m) -> DimIndex a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Data.Foldable.foldMap d -> FV
forall a. FreeIn a => a -> FV
freeIn'
instance (FreeIn d) => FreeIn (Slice d) where
freeIn' :: Slice d -> FV
freeIn' = (d -> FV) -> Slice d -> FV
forall m a. Monoid m => (a -> m) -> Slice a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Data.Foldable.foldMap d -> FV
forall a. FreeIn a => a -> FV
freeIn'
instance (FreeIn d) => FreeIn (FlatDimIndex d) where
freeIn' :: FlatDimIndex d -> FV
freeIn' = (d -> FV) -> FlatDimIndex d -> FV
forall m a. Monoid m => (a -> m) -> FlatDimIndex a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Data.Foldable.foldMap d -> FV
forall a. FreeIn a => a -> FV
freeIn'
instance (FreeIn d) => FreeIn (FlatSlice d) where
freeIn' :: FlatSlice d -> FV
freeIn' = (d -> FV) -> FlatSlice d -> FV
forall m a. Monoid m => (a -> m) -> FlatSlice a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Data.Foldable.foldMap d -> FV
forall a. FreeIn a => a -> FV
freeIn'
instance FreeIn SubExpRes where
freeIn' :: SubExpRes -> FV
freeIn' (SubExpRes Certs
cs SubExp
se) = Certs -> FV
forall a. FreeIn a => a -> FV
freeIn' Certs
cs FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> SubExp -> FV
forall a. FreeIn a => a -> FV
freeIn' SubExp
se
instance (FreeIn dec) => FreeIn (Pat dec) where
freeIn' :: Pat dec -> FV
freeIn' (Pat [PatElem dec]
xs) =
Names -> FV -> FV
fvBind Names
bound_here (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ [PatElem dec] -> FV
forall a. FreeIn a => a -> FV
freeIn' [PatElem dec]
xs
where
bound_here :: Names
bound_here = [VName] -> Names
namesFromList ([VName] -> Names) -> [VName] -> Names
forall a b. (a -> b) -> a -> b
$ (PatElem dec -> VName) -> [PatElem dec] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map PatElem dec -> VName
forall dec. PatElem dec -> VName
patElemName [PatElem dec]
xs
instance FreeIn Certs where
freeIn' :: Certs -> FV
freeIn' (Certs [VName]
cs) = [VName] -> FV
forall a. FreeIn a => a -> FV
freeIn' [VName]
cs
instance FreeIn Attrs where
freeIn' :: Attrs -> FV
freeIn' (Attrs Set Attr
_) = FV
forall a. Monoid a => a
mempty
instance (FreeIn dec) => FreeIn (StmAux dec) where
freeIn' :: StmAux dec -> FV
freeIn' (StmAux Certs
cs Attrs
attrs dec
dec) = Certs -> FV
forall a. FreeIn a => a -> FV
freeIn' Certs
cs FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Attrs -> FV
forall a. FreeIn a => a -> FV
freeIn' Attrs
attrs FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> dec -> FV
forall a. FreeIn a => a -> FV
freeIn' dec
dec
instance (FreeIn a) => FreeIn (MatchDec a) where
freeIn' :: MatchDec a -> FV
freeIn' (MatchDec [a]
r MatchSort
_) = [a] -> FV
forall a. FreeIn a => a -> FV
freeIn' [a]
r
class (FreeIn dec) => FreeDec dec where
precomputed :: dec -> FV -> FV
precomputed dec
_ = FV -> FV
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
instance FreeDec ()
instance (FreeDec a, FreeIn b) => FreeDec (a, b) where
precomputed :: (a, b) -> FV -> FV
precomputed (a
a, b
_) = a -> FV -> FV
forall dec. FreeDec dec => dec -> FV -> FV
precomputed a
a
instance (FreeDec a) => FreeDec [a] where
precomputed :: [a] -> FV -> FV
precomputed [] = FV -> FV
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
precomputed (a
a : [a]
_) = a -> FV -> FV
forall dec. FreeDec dec => dec -> FV -> FV
precomputed a
a
instance (FreeDec a) => FreeDec (Maybe a) where
precomputed :: Maybe a -> FV -> FV
precomputed Maybe a
Nothing = FV -> FV
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
precomputed (Just a
a) = a -> FV -> FV
forall dec. FreeDec dec => dec -> FV -> FV
precomputed a
a
instance FreeDec Names where
precomputed :: Names -> FV -> FV
precomputed Names
_ FV
fv = FV
fv
boundInBody :: Body rep -> Names
boundInBody :: forall rep. Body rep -> Names
boundInBody = Stms rep -> Names
forall rep. Stms rep -> Names
boundByStms (Stms rep -> Names) -> (Body rep -> Stms rep) -> Body rep -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Body rep -> Stms rep
forall rep. Body rep -> Stms rep
bodyStms
boundByStm :: Stm rep -> Names
boundByStm :: forall rep. Stm rep -> Names
boundByStm = [VName] -> Names
namesFromList ([VName] -> Names) -> (Stm rep -> [VName]) -> Stm rep -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Pat (LetDec rep) -> [VName]
forall dec. Pat dec -> [VName]
patNames (Pat (LetDec rep) -> [VName])
-> (Stm rep -> Pat (LetDec rep)) -> Stm rep -> [VName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Stm rep -> Pat (LetDec rep)
forall rep. Stm rep -> Pat (LetDec rep)
stmPat
boundByStms :: Stms rep -> Names
boundByStms :: forall rep. Stms rep -> Names
boundByStms = (Stm rep -> Names) -> Seq (Stm rep) -> Names
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Stm rep -> Names
forall rep. Stm rep -> Names
boundByStm
boundByLambda :: Lambda rep -> [VName]
boundByLambda :: forall rep. Lambda rep -> [VName]
boundByLambda Lambda rep
lam = (Param (LParamInfo rep) -> VName)
-> [Param (LParamInfo rep)] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param (LParamInfo rep) -> VName
forall dec. Param dec -> VName
paramName (Lambda rep -> [Param (LParamInfo rep)]
forall rep. Lambda rep -> [LParam rep]
lambdaParams Lambda rep
lam)