module Language.Futhark.FreeVars
( freeInExp,
freeInPat,
freeInType,
freeWithout,
FV,
fvVars,
)
where
import Data.Set qualified as S
import Language.Futhark.Prop
import Language.Futhark.Syntax
newtype FV = FV {FV -> Set VName
unFV :: S.Set VName}
deriving (Int -> FV -> ShowS
[FV] -> ShowS
FV -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FV] -> ShowS
$cshowList :: [FV] -> ShowS
show :: FV -> String
$cshow :: FV -> String
showsPrec :: Int -> FV -> ShowS
$cshowsPrec :: Int -> FV -> ShowS
Show)
fvVars :: FV -> S.Set VName
fvVars :: FV -> Set VName
fvVars = FV -> Set VName
unFV
instance Semigroup FV where
FV Set VName
x <> :: FV -> FV -> FV
<> FV Set VName
y = Set VName -> FV
FV forall a b. (a -> b) -> a -> b
$ Set VName
x forall a. Semigroup a => a -> a -> a
<> Set VName
y
instance Monoid FV where
mempty :: FV
mempty = Set VName -> FV
FV forall a. Monoid a => a
mempty
freeWithout :: FV -> S.Set VName -> FV
freeWithout :: FV -> Set VName -> FV
freeWithout (FV Set VName
x) Set VName
y = Set VName -> FV
FV forall a b. (a -> b) -> a -> b
$ Set VName
x forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set VName
y
freeWithoutL :: FV -> [VName] -> FV
freeWithoutL :: FV -> [VName] -> FV
freeWithoutL FV
fv [VName]
y = FV
fv FV -> Set VName -> FV
`freeWithout` forall a. Ord a => [a] -> Set a
S.fromList [VName]
y
ident :: Ident t -> FV
ident :: forall t. Ident t -> FV
ident = Set VName -> FV
FV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Set a
S.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) vn (t :: k). IdentBase f vn t -> vn
identName
freeInExp :: ExpBase Info VName -> FV
freeInExp :: ExpBase Info VName -> FV
freeInExp ExpBase Info VName
expr = case ExpBase Info VName
expr of
Literal {} -> forall a. Monoid a => a
mempty
IntLit {} -> forall a. Monoid a => a
mempty
FloatLit {} -> forall a. Monoid a => a
mempty
StringLit {} -> forall a. Monoid a => a
mempty
Hole {} -> forall a. Monoid a => a
mempty
Parens ExpBase Info VName
e SrcLoc
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e
QualParens (QualName VName, SrcLoc)
_ ExpBase Info VName
e SrcLoc
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e
TupLit [ExpBase Info VName]
es SrcLoc
_ -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ExpBase Info VName -> FV
freeInExp [ExpBase Info VName]
es
RecordLit [FieldBase Info VName]
fs SrcLoc
_ -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FieldBase Info VName -> FV
freeInExpField [FieldBase Info VName]
fs
where
freeInExpField :: FieldBase Info VName -> FV
freeInExpField (RecordFieldExplicit Name
_ ExpBase Info VName
e SrcLoc
_) = ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e
freeInExpField (RecordFieldImplicit VName
vn Info StructType
t SrcLoc
_) = forall t. Ident t -> FV
ident forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) vn (t :: k).
vn -> f t -> SrcLoc -> IdentBase f vn t
Ident VName
vn Info StructType
t forall a. Monoid a => a
mempty
ArrayLit [ExpBase Info VName]
es Info StructType
t SrcLoc
_ ->
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ExpBase Info VName -> FV
freeInExp [ExpBase Info VName]
es forall a. Semigroup a => a -> a -> a
<> forall u. TypeBase (ExpBase Info VName) u -> FV
freeInType (forall a. Info a -> a
unInfo Info StructType
t)
AppExp (Range ExpBase Info VName
e Maybe (ExpBase Info VName)
me Inclusiveness (ExpBase Info VName)
incl SrcLoc
_) Info AppRes
_ ->
ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ExpBase Info VName -> FV
freeInExp Maybe (ExpBase Info VName)
me forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ExpBase Info VName -> FV
freeInExp Inclusiveness (ExpBase Info VName)
incl
Var QualName VName
qn Info StructType
_ SrcLoc
_ -> Set VName -> FV
FV forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
S.singleton forall a b. (a -> b) -> a -> b
$ forall vn. QualName vn -> vn
qualLeaf QualName VName
qn
Ascript ExpBase Info VName
e TypeExp Info VName
_ SrcLoc
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e
Coerce ExpBase Info VName
e TypeExp Info VName
_ (Info StructType
t) SrcLoc
_ ->
ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e forall a. Semigroup a => a -> a -> a
<> forall u. TypeBase (ExpBase Info VName) u -> FV
freeInType StructType
t
AppExp (LetPat [SizeBinder VName]
let_sizes PatBase Info VName StructType
pat ExpBase Info VName
e1 ExpBase Info VName
e2 SrcLoc
_) Info AppRes
_ ->
ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e1
forall a. Semigroup a => a -> a -> a
<> ( (forall u. Pat (TypeBase (ExpBase Info VName) u) -> FV
freeInPat PatBase Info VName StructType
pat forall a. Semigroup a => a -> a -> a
<> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e2)
FV -> [VName] -> FV
`freeWithoutL` (forall t. Pat t -> [VName]
patNames PatBase Info VName StructType
pat forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map forall vn. SizeBinder vn -> vn
sizeName [SizeBinder VName]
let_sizes)
)
AppExp (LetFun VName
vn ([TypeParamBase VName]
tparams, [PatBase Info VName ParamType]
pats, Maybe (TypeExp Info VName)
_, Info ResRetType
_, ExpBase Info VName
e1) ExpBase Info VName
e2 SrcLoc
_) Info AppRes
_ ->
( (ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e1 forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall u. Pat (TypeBase (ExpBase Info VName) u) -> FV
freeInPat [PatBase Info VName ParamType]
pats)
FV -> [VName] -> FV
`freeWithoutL` (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall t. Pat t -> [VName]
patNames [PatBase Info VName ParamType]
pats forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map forall vn. TypeParamBase vn -> vn
typeParamName [TypeParamBase VName]
tparams)
)
forall a. Semigroup a => a -> a -> a
<> (ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e2 FV -> Set VName -> FV
`freeWithout` forall a. a -> Set a
S.singleton VName
vn)
AppExp (If ExpBase Info VName
e1 ExpBase Info VName
e2 ExpBase Info VName
e3 SrcLoc
_) Info AppRes
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e1 forall a. Semigroup a => a -> a -> a
<> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e2 forall a. Semigroup a => a -> a -> a
<> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e3
AppExp (Apply ExpBase Info VName
f NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args SrcLoc
_) Info AppRes
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
f forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ExpBase Info VName -> FV
freeInExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args
Negate ExpBase Info VName
e SrcLoc
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e
Not ExpBase Info VName
e SrcLoc
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e
Lambda [PatBase Info VName ParamType]
pats ExpBase Info VName
e0 Maybe (TypeExp Info VName)
_ (Info (RetType [VName]
dims TypeBase (ExpBase Info VName) Uniqueness
t)) SrcLoc
_ ->
(forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall u. Pat (TypeBase (ExpBase Info VName) u) -> FV
freeInPat [PatBase Info VName ParamType]
pats forall a. Semigroup a => a -> a -> a
<> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e0 forall a. Semigroup a => a -> a -> a
<> forall u. TypeBase (ExpBase Info VName) u -> FV
freeInType TypeBase (ExpBase Info VName) Uniqueness
t)
FV -> [VName] -> FV
`freeWithoutL` (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall t. Pat t -> [VName]
patNames [PatBase Info VName ParamType]
pats forall a. Semigroup a => a -> a -> a
<> [VName]
dims)
OpSection {} -> forall a. Monoid a => a
mempty
OpSectionLeft QualName VName
_ Info StructType
_ ExpBase Info VName
e (Info (PName, ParamType, Maybe VName), Info (PName, ParamType))
_ (Info ResRetType, Info [VName])
_ SrcLoc
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e
OpSectionRight QualName VName
_ Info StructType
_ ExpBase Info VName
e (Info (PName, ParamType), Info (PName, ParamType, Maybe VName))
_ Info ResRetType
_ SrcLoc
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e
ProjectSection {} -> forall a. Monoid a => a
mempty
IndexSection SliceBase Info VName
idxs Info StructType
_ SrcLoc
_ -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DimIndexBase Info VName -> FV
freeInDimIndex SliceBase Info VName
idxs
AppExp (DoLoop [VName]
sparams PatBase Info VName ParamType
pat ExpBase Info VName
e1 LoopFormBase Info VName
form ExpBase Info VName
e3 SrcLoc
_) Info AppRes
_ ->
let (FV
e2fv, [VName]
e2ident) = LoopFormBase Info VName -> (FV, [VName])
formVars LoopFormBase Info VName
form
in ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e1
forall a. Semigroup a => a -> a -> a
<> ( (FV
e2fv forall a. Semigroup a => a -> a -> a
<> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e3)
FV -> [VName] -> FV
`freeWithoutL` ([VName]
sparams forall a. Semigroup a => a -> a -> a
<> forall t. Pat t -> [VName]
patNames PatBase Info VName ParamType
pat forall a. Semigroup a => a -> a -> a
<> [VName]
e2ident)
)
where
formVars :: LoopFormBase Info VName -> (FV, [VName])
formVars (For IdentBase Info VName StructType
v ExpBase Info VName
e2) = (ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e2, [forall {k} (f :: k -> *) vn (t :: k). IdentBase f vn t -> vn
identName IdentBase Info VName StructType
v])
formVars (ForIn PatBase Info VName StructType
p ExpBase Info VName
e2) = (ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e2, forall t. Pat t -> [VName]
patNames PatBase Info VName StructType
p)
formVars (While ExpBase Info VName
e2) = (ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e2, forall a. Monoid a => a
mempty)
AppExp (BinOp (QualName VName
qn, SrcLoc
_) Info StructType
_ (ExpBase Info VName
e1, Info (Maybe VName)
_) (ExpBase Info VName
e2, Info (Maybe VName)
_) SrcLoc
_) Info AppRes
_ ->
Set VName -> FV
FV (forall a. a -> Set a
S.singleton (forall vn. QualName vn -> vn
qualLeaf QualName VName
qn))
forall a. Semigroup a => a -> a -> a
<> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e1
forall a. Semigroup a => a -> a -> a
<> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e2
Project Name
_ ExpBase Info VName
e Info StructType
_ SrcLoc
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e
AppExp (LetWith IdentBase Info VName StructType
id1 IdentBase Info VName StructType
id2 SliceBase Info VName
idxs ExpBase Info VName
e1 ExpBase Info VName
e2 SrcLoc
_) Info AppRes
_ ->
forall t. Ident t -> FV
ident IdentBase Info VName StructType
id2
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DimIndexBase Info VName -> FV
freeInDimIndex SliceBase Info VName
idxs
forall a. Semigroup a => a -> a -> a
<> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e1
forall a. Semigroup a => a -> a -> a
<> (ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e2 FV -> Set VName -> FV
`freeWithout` forall a. a -> Set a
S.singleton (forall {k} (f :: k -> *) vn (t :: k). IdentBase f vn t -> vn
identName IdentBase Info VName StructType
id1))
AppExp (Index ExpBase Info VName
e SliceBase Info VName
idxs SrcLoc
_) Info AppRes
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DimIndexBase Info VName -> FV
freeInDimIndex SliceBase Info VName
idxs
Update ExpBase Info VName
e1 SliceBase Info VName
idxs ExpBase Info VName
e2 SrcLoc
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e1 forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DimIndexBase Info VName -> FV
freeInDimIndex SliceBase Info VName
idxs forall a. Semigroup a => a -> a -> a
<> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e2
RecordUpdate ExpBase Info VName
e1 [Name]
_ ExpBase Info VName
e2 Info StructType
_ SrcLoc
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e1 forall a. Semigroup a => a -> a -> a
<> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e2
Assert ExpBase Info VName
e1 ExpBase Info VName
e2 Info Text
_ SrcLoc
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e1 forall a. Semigroup a => a -> a -> a
<> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e2
Constr Name
_ [ExpBase Info VName]
es Info StructType
_ SrcLoc
_ -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ExpBase Info VName -> FV
freeInExp [ExpBase Info VName]
es
Attr AttrInfo VName
_ ExpBase Info VName
e SrcLoc
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e
AppExp (Match ExpBase Info VName
e NonEmpty (CaseBase Info VName)
cs SrcLoc
_) Info AppRes
_ -> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap CaseBase Info VName -> FV
caseFV NonEmpty (CaseBase Info VName)
cs
where
caseFV :: CaseBase Info VName -> FV
caseFV (CasePat PatBase Info VName StructType
p ExpBase Info VName
eCase SrcLoc
_) =
(forall u. Pat (TypeBase (ExpBase Info VName) u) -> FV
freeInPat PatBase Info VName StructType
p forall a. Semigroup a => a -> a -> a
<> ExpBase Info VName -> FV
freeInExp ExpBase Info VName
eCase)
FV -> [VName] -> FV
`freeWithoutL` forall t. Pat t -> [VName]
patNames PatBase Info VName StructType
p
freeInDimIndex :: DimIndexBase Info VName -> FV
freeInDimIndex :: DimIndexBase Info VName -> FV
freeInDimIndex (DimFix ExpBase Info VName
e) = ExpBase Info VName -> FV
freeInExp ExpBase Info VName
e
freeInDimIndex (DimSlice Maybe (ExpBase Info VName)
me1 Maybe (ExpBase Info VName)
me2 Maybe (ExpBase Info VName)
me3) =
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ExpBase Info VName -> FV
freeInExp) [Maybe (ExpBase Info VName)
me1, Maybe (ExpBase Info VName)
me2, Maybe (ExpBase Info VName)
me3]
freeInPat :: Pat (TypeBase Size u) -> FV
freeInPat :: forall u. Pat (TypeBase (ExpBase Info VName) u) -> FV
freeInPat = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall u. TypeBase (ExpBase Info VName) u -> FV
freeInType
freeInType :: TypeBase Size u -> FV
freeInType :: forall u. TypeBase (ExpBase Info VName) u -> FV
freeInType TypeBase (ExpBase Info VName) u
t =
case TypeBase (ExpBase Info VName) u
t of
Array u
_ Shape (ExpBase Info VName)
s ScalarTypeBase (ExpBase Info VName) NoUniqueness
a ->
forall u. TypeBase (ExpBase Info VName) u -> FV
freeInType (forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar ScalarTypeBase (ExpBase Info VName) NoUniqueness
a) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ExpBase Info VName -> FV
freeInExp (forall dim. Shape dim -> [dim]
shapeDims Shape (ExpBase Info VName)
s)
Scalar (Record Map Name (TypeBase (ExpBase Info VName) u)
fs) ->
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall u. TypeBase (ExpBase Info VName) u -> FV
freeInType Map Name (TypeBase (ExpBase Info VName) u)
fs
Scalar Prim {} ->
forall a. Monoid a => a
mempty
Scalar (Sum Map Name [TypeBase (ExpBase Info VName) u]
cs) ->
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall u. TypeBase (ExpBase Info VName) u -> FV
freeInType) Map Name [TypeBase (ExpBase Info VName) u]
cs
Scalar (Arrow u
_ PName
v Diet
_ StructType
t1 (RetType [VName]
dims TypeBase (ExpBase Info VName) Uniqueness
t2)) ->
Set VName -> FV
FV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Set a -> Set a
S.filter (\VName
k -> PName -> VName -> Bool
notV PName
v VName
k Bool -> Bool -> Bool
&& forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem VName
k [VName]
dims) forall a b. (a -> b) -> a -> b
$
FV -> Set VName
unFV (forall u. TypeBase (ExpBase Info VName) u -> FV
freeInType StructType
t1 forall a. Semigroup a => a -> a -> a
<> forall u. TypeBase (ExpBase Info VName) u -> FV
freeInType TypeBase (ExpBase Info VName) Uniqueness
t2)
Scalar (TypeVar u
_ QualName VName
_ [TypeArg (ExpBase Info VName)]
targs) ->
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TypeArg (ExpBase Info VName) -> FV
typeArgDims [TypeArg (ExpBase Info VName)]
targs
where
typeArgDims :: TypeArg (ExpBase Info VName) -> FV
typeArgDims (TypeArgDim ExpBase Info VName
d) = ExpBase Info VName -> FV
freeInExp ExpBase Info VName
d
typeArgDims (TypeArgType StructType
at) = forall u. TypeBase (ExpBase Info VName) u -> FV
freeInType StructType
at
notV :: PName -> VName -> Bool
notV PName
Unnamed = forall a b. a -> b -> a
const Bool
True
notV (Named VName
v) = (forall a. Eq a => a -> a -> Bool
/= VName
v)