{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
module GHC.Util.FreeVars (
vars, varss, pvars,
Vars (..), FreeVars(..) , AllVars (..)
) where
import RdrName
import GHC.Hs.Types
import OccName
import Name
import GHC.Hs
import SrcLoc
import Bag (bagToList)
import Data.Generics.Uniplate.DataOnly
import Data.Monoid
import Data.Semigroup
import Data.List.Extra
import Data.Set (Set)
import qualified Data.Set as Set
import Prelude
( ^+ ) :: Set OccName -> Set OccName -> Set OccName
( ^+ ) = Set OccName -> Set OccName -> Set OccName
forall a. Ord a => Set a -> Set a -> Set a
Set.union
( ^- ) :: Set OccName -> Set OccName -> Set OccName
( ^- ) = Set OccName -> Set OccName -> Set OccName
forall a. Ord a => Set a -> Set a -> Set a
Set.difference
data Vars = Vars{Vars -> Set OccName
bound :: Set OccName, Vars -> Set OccName
free :: Set OccName}
instance Show Vars where
show :: Vars -> String
show (Vars bs :: Set OccName
bs fs :: Set OccName
fs) = "bound : " String -> ShowS
forall a. [a] -> [a] -> [a]
++
[String] -> String
forall a. Show a => a -> String
show ((OccName -> String) -> [OccName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map OccName -> String
occNameString (Set OccName -> [OccName]
forall a. Set a -> [a]
Set.toList Set OccName
bs)) String -> ShowS
forall a. [a] -> [a] -> [a]
++
", free : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show ((OccName -> String) -> [OccName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map OccName -> String
occNameString (Set OccName -> [OccName]
forall a. Set a -> [a]
Set.toList Set OccName
fs))
instance Semigroup Vars where
Vars x1 :: Set OccName
x1 x2 :: Set OccName
x2 <> :: Vars -> Vars -> Vars
<> Vars y1 :: Set OccName
y1 y2 :: Set OccName
y2 = Set OccName -> Set OccName -> Vars
Vars (Set OccName
x1 Set OccName -> Set OccName -> Set OccName
^+ Set OccName
y1) (Set OccName
x2 Set OccName -> Set OccName -> Set OccName
^+ Set OccName
y2)
instance Monoid Vars where
mempty :: Vars
mempty = Set OccName -> Set OccName -> Vars
Vars Set OccName
forall a. Set a
Set.empty Set OccName
forall a. Set a
Set.empty
mconcat :: [Vars] -> Vars
mconcat vs :: [Vars]
vs = Set OccName -> Set OccName -> Vars
Vars ([Set OccName] -> Set OccName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set OccName] -> Set OccName) -> [Set OccName] -> Set OccName
forall a b. (a -> b) -> a -> b
$ (Vars -> Set OccName) -> [Vars] -> [Set OccName]
forall a b. (a -> b) -> [a] -> [b]
map Vars -> Set OccName
bound [Vars]
vs) ([Set OccName] -> Set OccName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set OccName] -> Set OccName) -> [Set OccName] -> Set OccName
forall a b. (a -> b) -> a -> b
$ (Vars -> Set OccName) -> [Vars] -> [Set OccName]
forall a b. (a -> b) -> [a] -> [b]
map Vars -> Set OccName
free [Vars]
vs)
class AllVars a where
allVars :: a -> Vars
class FreeVars a where
freeVars :: a -> Set OccName
instance AllVars Vars where allVars :: Vars -> Vars
allVars = Vars -> Vars
forall a. a -> a
id
instance FreeVars (Set OccName) where freeVars :: Set OccName -> Set OccName
freeVars = Set OccName -> Set OccName
forall a. a -> a
id
instance (AllVars a) => AllVars [a] where allVars :: [a] -> Vars
allVars = (a -> Vars) -> [a] -> Vars
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap a -> Vars
forall a. AllVars a => a -> Vars
allVars
instance (FreeVars a) => FreeVars [a] where freeVars :: [a] -> Set OccName
freeVars = [Set OccName] -> Set OccName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set OccName] -> Set OccName)
-> ([a] -> [Set OccName]) -> [a] -> Set OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set OccName) -> [a] -> [Set OccName]
forall a b. (a -> b) -> [a] -> [b]
map a -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars
freeVars_ :: (FreeVars a) => a -> Vars
freeVars_ :: a -> Vars
freeVars_ = Set OccName -> Set OccName -> Vars
Vars Set OccName
forall a. Set a
Set.empty (Set OccName -> Vars) -> (a -> Set OccName) -> a -> Vars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars
inFree :: (AllVars a, FreeVars b) => a -> b -> Set OccName
inFree :: a -> b -> Set OccName
inFree a :: a
a b :: b
b = Vars -> Set OccName
free Vars
aa Set OccName -> Set OccName -> Set OccName
^+ (b -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars b
b Set OccName -> Set OccName -> Set OccName
^- Vars -> Set OccName
bound Vars
aa)
where aa :: Vars
aa = a -> Vars
forall a. AllVars a => a -> Vars
allVars a
a
inVars :: (AllVars a, AllVars b) => a -> b -> Vars
inVars :: a -> b -> Vars
inVars a :: a
a b :: b
b =
Set OccName -> Set OccName -> Vars
Vars (Vars -> Set OccName
bound Vars
aa Set OccName -> Set OccName -> Set OccName
^+ Vars -> Set OccName
bound Vars
bb) (Vars -> Set OccName
free Vars
aa Set OccName -> Set OccName -> Set OccName
^+ (Vars -> Set OccName
free Vars
bb Set OccName -> Set OccName -> Set OccName
^- Vars -> Set OccName
bound Vars
aa))
where aa :: Vars
aa = a -> Vars
forall a. AllVars a => a -> Vars
allVars a
a
bb :: Vars
bb = b -> Vars
forall a. AllVars a => a -> Vars
allVars b
b
unqualNames :: Located RdrName -> [OccName]
unqualNames :: Located RdrName -> [OccName]
unqualNames (L _ (Unqual x :: OccName
x)) = [OccName
x]
unqualNames (L _ (Exact x :: Name
x)) = [Name -> OccName
nameOccName Name
x]
unqualNames _ = []
instance FreeVars (LHsExpr GhcPs) where
freeVars :: LHsExpr GhcPs -> Set OccName
freeVars (L _ (HsVar _ x :: Located (IdP GhcPs)
x)) = [OccName] -> Set OccName
forall a. Ord a => [a] -> Set a
Set.fromList ([OccName] -> Set OccName) -> [OccName] -> Set OccName
forall a b. (a -> b) -> a -> b
$ Located RdrName -> [OccName]
unqualNames Located (IdP GhcPs)
Located RdrName
x
freeVars (L _ (HsUnboundVar _ x :: UnboundVar
x)) = [OccName] -> Set OccName
forall a. Ord a => [a] -> Set a
Set.fromList [UnboundVar -> OccName
unboundVarOcc UnboundVar
x]
freeVars (L _ (HsLam _ mg :: MatchGroup GhcPs (LHsExpr GhcPs)
mg)) = Vars -> Set OccName
free (MatchGroup GhcPs (LHsExpr GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars MatchGroup GhcPs (LHsExpr GhcPs)
mg)
freeVars (L _ (HsLamCase _ MG{mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts=(L _ ms :: [LMatch GhcPs (LHsExpr GhcPs)]
ms)})) = Vars -> Set OccName
free ([LMatch GhcPs (LHsExpr GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars [LMatch GhcPs (LHsExpr GhcPs)]
ms)
freeVars (L _ (HsCase _ of_ :: LHsExpr GhcPs
of_ MG{mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts=(L _ ms :: [LMatch GhcPs (LHsExpr GhcPs)]
ms)})) = LHsExpr GhcPs -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
of_ Set OccName -> Set OccName -> Set OccName
^+ Vars -> Set OccName
free ([LMatch GhcPs (LHsExpr GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars [LMatch GhcPs (LHsExpr GhcPs)]
ms)
freeVars (L _ (HsLet _ binds :: LHsLocalBinds GhcPs
binds e :: LHsExpr GhcPs
e)) = LHsLocalBinds GhcPs -> LHsExpr GhcPs -> Set OccName
forall a b. (AllVars a, FreeVars b) => a -> b -> Set OccName
inFree LHsLocalBinds GhcPs
binds LHsExpr GhcPs
e
freeVars (L _ (HsDo _ ctxt :: HsStmtContext Name
ctxt (L _ stmts :: [ExprLStmt GhcPs]
stmts))) = Vars -> Set OccName
free ([ExprLStmt GhcPs] -> Vars
forall a. AllVars a => a -> Vars
allVars [ExprLStmt GhcPs]
stmts)
freeVars (L _ (RecordCon _ _ (HsRecFields flds :: [LHsRecField GhcPs (LHsExpr GhcPs)]
flds _))) = [Set OccName] -> Set OccName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set OccName] -> Set OccName) -> [Set OccName] -> Set OccName
forall a b. (a -> b) -> a -> b
$ (LHsRecField GhcPs (LHsExpr GhcPs) -> Set OccName)
-> [LHsRecField GhcPs (LHsExpr GhcPs)] -> [Set OccName]
forall a b. (a -> b) -> [a] -> [b]
map LHsRecField GhcPs (LHsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars [LHsRecField GhcPs (LHsExpr GhcPs)]
flds
freeVars (L _ (RecordUpd _ e :: LHsExpr GhcPs
e flds :: [LHsRecUpdField GhcPs]
flds)) = [Set OccName] -> Set OccName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set OccName] -> Set OccName) -> [Set OccName] -> Set OccName
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
e Set OccName -> [Set OccName] -> [Set OccName]
forall a. a -> [a] -> [a]
: (LHsRecUpdField GhcPs -> Set OccName)
-> [LHsRecUpdField GhcPs] -> [Set OccName]
forall a b. (a -> b) -> [a] -> [b]
map LHsRecUpdField GhcPs -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars [LHsRecUpdField GhcPs]
flds
freeVars (L _ (HsMultiIf _ grhss :: [LGRHS GhcPs (LHsExpr GhcPs)]
grhss)) = Vars -> Set OccName
free ([LGRHS GhcPs (LHsExpr GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars [LGRHS GhcPs (LHsExpr GhcPs)]
grhss)
freeVars (L _ HsConLikeOut{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars (L _ HsRecFld{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars (L _ HsOverLabel{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars (L _ HsIPVar{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars (L _ HsOverLit{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars (L _ HsLit{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars (L _ HsRnBracketOut{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars (L _ HsTcBracketOut{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars (L _ HsWrap{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars e :: LHsExpr GhcPs
e = [LHsExpr GhcPs] -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars ([LHsExpr GhcPs] -> Set OccName) -> [LHsExpr GhcPs] -> Set OccName
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> [LHsExpr GhcPs]
forall on. Uniplate on => on -> [on]
children LHsExpr GhcPs
e
instance FreeVars (LHsTupArg GhcPs) where
freeVars :: LHsTupArg GhcPs -> Set OccName
freeVars (L _ (Present _ args :: LHsExpr GhcPs
args)) = LHsExpr GhcPs -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
args
freeVars _ = Set OccName
forall a. Monoid a => a
mempty
instance FreeVars (LHsRecField GhcPs (LHsExpr GhcPs)) where
freeVars :: LHsRecField GhcPs (LHsExpr GhcPs) -> Set OccName
freeVars o :: LHsRecField GhcPs (LHsExpr GhcPs)
o@(L _ (HsRecField x :: Located (FieldOcc GhcPs)
x _ True)) = OccName -> Set OccName
forall a. a -> Set a
Set.singleton (OccName -> Set OccName) -> OccName -> Set OccName
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
forall name. HasOccName name => name -> OccName
occName (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ Located RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located RdrName -> RdrName) -> Located RdrName -> RdrName
forall a b. (a -> b) -> a -> b
$ FieldOcc GhcPs -> Located RdrName
forall pass. FieldOcc pass -> Located RdrName
rdrNameFieldOcc (FieldOcc GhcPs -> Located RdrName)
-> FieldOcc GhcPs -> Located RdrName
forall a b. (a -> b) -> a -> b
$ Located (FieldOcc GhcPs) -> SrcSpanLess (Located (FieldOcc GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (FieldOcc GhcPs)
x
freeVars o :: LHsRecField GhcPs (LHsExpr GhcPs)
o@(L _ (HsRecField _ x :: LHsExpr GhcPs
x _)) = LHsExpr GhcPs -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
x
instance FreeVars (LHsRecUpdField GhcPs) where
freeVars :: LHsRecUpdField GhcPs -> Set OccName
freeVars (L _ (HsRecField _ x :: LHsExpr GhcPs
x _)) = LHsExpr GhcPs -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
x
instance AllVars (Located (Pat GhcPs)) where
allVars :: Located (Pat GhcPs) -> Vars
allVars (L _ (VarPat _ (L _ x :: IdP GhcPs
x))) = Set OccName -> Set OccName -> Vars
Vars (OccName -> Set OccName
forall a. a -> Set a
Set.singleton (OccName -> Set OccName) -> OccName -> Set OccName
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc IdP GhcPs
RdrName
x) Set OccName
forall a. Set a
Set.empty
allVars (L _ (AsPat _ n :: Located (IdP GhcPs)
n x :: LPat GhcPs
x)) = Located (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars (SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs)
-> SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs
forall a b. (a -> b) -> a -> b
$ XVarPat GhcPs -> Located (IdP GhcPs) -> Pat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat NoExtField
XVarPat GhcPs
noExtField Located (IdP GhcPs)
n :: LPat GhcPs) Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> Located (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars LPat GhcPs
Located (Pat GhcPs)
x
allVars (L _ (ConPatIn _ (RecCon (HsRecFields flds :: [LHsRecField GhcPs (LPat GhcPs)]
flds _)))) = [LHsRecField GhcPs (Located (Pat GhcPs))] -> Vars
forall a. AllVars a => a -> Vars
allVars [LHsRecField GhcPs (LPat GhcPs)]
[LHsRecField GhcPs (Located (Pat GhcPs))]
flds
allVars (L _ (NPlusKPat _ n :: Located (IdP GhcPs)
n _ _ _ _)) = Located (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars (SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs)
-> SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs
forall a b. (a -> b) -> a -> b
$ XVarPat GhcPs -> Located (IdP GhcPs) -> Pat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat NoExtField
XVarPat GhcPs
noExtField Located (IdP GhcPs)
n :: LPat GhcPs)
allVars (L _ (ViewPat _ e :: LHsExpr GhcPs
e p :: LPat GhcPs
p)) = LHsExpr GhcPs -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ LHsExpr GhcPs
e Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> Located (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars LPat GhcPs
Located (Pat GhcPs)
p
allVars (L _ WildPat{}) = Vars
forall a. Monoid a => a
mempty
allVars (L _ ConPatOut{}) = Vars
forall a. Monoid a => a
mempty
allVars (L _ LitPat{}) = Vars
forall a. Monoid a => a
mempty
allVars (L _ NPat{}) = Vars
forall a. Monoid a => a
mempty
allVars p :: Located (Pat GhcPs)
p = [Located (Pat GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars ([Located (Pat GhcPs)] -> Vars) -> [Located (Pat GhcPs)] -> Vars
forall a b. (a -> b) -> a -> b
$ Located (Pat GhcPs) -> [Located (Pat GhcPs)]
forall on. Uniplate on => on -> [on]
children Located (Pat GhcPs)
p
instance AllVars (LHsRecField GhcPs (Located (Pat GhcPs))) where
allVars :: LHsRecField GhcPs (Located (Pat GhcPs)) -> Vars
allVars (L _ (HsRecField _ x :: Located (Pat GhcPs)
x _)) = Located (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars Located (Pat GhcPs)
x
instance AllVars (LStmt GhcPs (LHsExpr GhcPs)) where
allVars :: ExprLStmt GhcPs -> Vars
allVars (L _ (LastStmt _ expr :: LHsExpr GhcPs
expr _ _)) = LHsExpr GhcPs -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ LHsExpr GhcPs
expr
allVars (L _ (BindStmt _ pat :: LPat GhcPs
pat expr :: LHsExpr GhcPs
expr _ _)) = Located (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars LPat GhcPs
Located (Pat GhcPs)
pat Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> LHsExpr GhcPs -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ LHsExpr GhcPs
expr
allVars (L _ (BodyStmt _ expr :: LHsExpr GhcPs
expr _ _)) = LHsExpr GhcPs -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ LHsExpr GhcPs
expr
allVars (L _ (LetStmt _ binds :: LHsLocalBinds GhcPs
binds)) = LHsLocalBinds GhcPs -> Vars
forall a. AllVars a => a -> Vars
allVars LHsLocalBinds GhcPs
binds
allVars (L _ (TransStmt _ _ stmts :: [ExprLStmt GhcPs]
stmts _ using :: LHsExpr GhcPs
using by :: Maybe (LHsExpr GhcPs)
by _ _ fmap_ :: HsExpr GhcPs
fmap_)) = [ExprLStmt GhcPs] -> Vars
forall a. AllVars a => a -> Vars
allVars [ExprLStmt GhcPs]
stmts Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> LHsExpr GhcPs -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ LHsExpr GhcPs
using Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> Vars -> (LHsExpr GhcPs -> Vars) -> Maybe (LHsExpr GhcPs) -> Vars
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Vars
forall a. Monoid a => a
mempty LHsExpr GhcPs -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ Maybe (LHsExpr GhcPs)
by Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> LHsExpr GhcPs -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc HsExpr GhcPs
SrcSpanLess (LHsExpr GhcPs)
fmap_ :: Located (HsExpr GhcPs))
allVars (L _ (RecStmt _ stmts :: [ExprLStmt GhcPs]
stmts _ _ _ _ _)) = [ExprLStmt GhcPs] -> Vars
forall a. AllVars a => a -> Vars
allVars [ExprLStmt GhcPs]
stmts
allVars (L _ ApplicativeStmt{}) = Vars
forall a. Monoid a => a
mempty
allVars (L _ ParStmt{}) = Vars
forall a. Monoid a => a
mempty
allVars _ = Vars
forall a. Monoid a => a
mempty
instance AllVars (LHsLocalBinds GhcPs) where
allVars :: LHsLocalBinds GhcPs -> Vars
allVars (L _ (HsValBinds _ (ValBinds _ binds :: LHsBindsLR GhcPs GhcPs
binds _))) = [LHsBindLR GhcPs GhcPs] -> Vars
forall a. AllVars a => a -> Vars
allVars (LHsBindsLR GhcPs GhcPs -> [LHsBindLR GhcPs GhcPs]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
binds)
allVars (L _ (HsIPBinds _ (IPBinds _ binds :: [LIPBind GhcPs]
binds))) = [LIPBind GhcPs] -> Vars
forall a. AllVars a => a -> Vars
allVars [LIPBind GhcPs]
binds
allVars (L _ EmptyLocalBinds{}) = Vars
forall a. Monoid a => a
mempty
allVars _ = Vars
forall a. Monoid a => a
mempty
instance AllVars (LIPBind GhcPs) where
allVars :: LIPBind GhcPs -> Vars
allVars (L _ (IPBind _ _ e :: LHsExpr GhcPs
e)) = LHsExpr GhcPs -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ LHsExpr GhcPs
e
allVars _ = Vars
forall a. Monoid a => a
mempty
instance AllVars (LHsBind GhcPs) where
allVars :: LHsBindLR GhcPs GhcPs -> Vars
allVars (L _ FunBind{fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id=Located (IdP GhcPs)
n, fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches=MG{mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts=(L _ ms :: [LMatch GhcPs (LHsExpr GhcPs)]
ms)}}) = Located (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars (SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs)
-> SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs
forall a b. (a -> b) -> a -> b
$ XVarPat GhcPs -> Located (IdP GhcPs) -> Pat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat NoExtField
XVarPat GhcPs
noExtField Located (IdP GhcPs)
n :: LPat GhcPs) Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> [LMatch GhcPs (LHsExpr GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars [LMatch GhcPs (LHsExpr GhcPs)]
ms
allVars (L _ PatBind{pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs=LPat GhcPs
n, pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_rhs=GRHSs GhcPs (LHsExpr GhcPs)
grhss}) = Located (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars LPat GhcPs
Located (Pat GhcPs)
n Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> GRHSs GhcPs (LHsExpr GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars GRHSs GhcPs (LHsExpr GhcPs)
grhss
allVars (L _ (PatSynBind _ PSB{})) = Vars
forall a. Monoid a => a
mempty
allVars (L _ VarBind{}) = Vars
forall a. Monoid a => a
mempty
allVars (L _ AbsBinds{}) = Vars
forall a. Monoid a => a
mempty
allVars _ = Vars
forall a. Monoid a => a
mempty
instance AllVars (MatchGroup GhcPs (LHsExpr GhcPs)) where
allVars :: MatchGroup GhcPs (LHsExpr GhcPs) -> Vars
allVars (MG _ _alts :: GenLocated SrcSpan [LMatch GhcPs (LHsExpr GhcPs)]
_alts@(L _ alts :: [LMatch GhcPs (LHsExpr GhcPs)]
alts) _) = Vars -> Vars -> Vars
forall a b. (AllVars a, AllVars b) => a -> b -> Vars
inVars ((Match GhcPs (LHsExpr GhcPs) -> Vars)
-> [Match GhcPs (LHsExpr GhcPs)] -> Vars
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([Located (Pat GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars ([Located (Pat GhcPs)] -> Vars)
-> (Match GhcPs (LHsExpr GhcPs) -> [Located (Pat GhcPs)])
-> Match GhcPs (LHsExpr GhcPs)
-> Vars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs (LHsExpr GhcPs) -> [Located (Pat GhcPs)]
forall p body. Match p body -> [LPat p]
m_pats) [Match GhcPs (LHsExpr GhcPs)]
ms) ([GRHSs GhcPs (LHsExpr GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars ((Match GhcPs (LHsExpr GhcPs) -> GRHSs GhcPs (LHsExpr GhcPs))
-> [Match GhcPs (LHsExpr GhcPs)] -> [GRHSs GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map Match GhcPs (LHsExpr GhcPs) -> GRHSs GhcPs (LHsExpr GhcPs)
forall p body. Match p body -> GRHSs p body
m_grhss [Match GhcPs (LHsExpr GhcPs)]
ms))
where ms :: [Match GhcPs (LHsExpr GhcPs)]
ms = (LMatch GhcPs (LHsExpr GhcPs) -> Match GhcPs (LHsExpr GhcPs))
-> [LMatch GhcPs (LHsExpr GhcPs)] -> [Match GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LMatch GhcPs (LHsExpr GhcPs) -> Match GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [LMatch GhcPs (LHsExpr GhcPs)]
alts
allVars _ = Vars
forall a. Monoid a => a
mempty
instance AllVars (LMatch GhcPs (LHsExpr GhcPs)) where
allVars :: LMatch GhcPs (LHsExpr GhcPs) -> Vars
allVars (L _ (Match _ FunRhs {mc_fun :: forall id. HsMatchContext id -> Located id
mc_fun=Located (NameOrRdrName (IdP GhcPs))
name} pats :: [LPat GhcPs]
pats grhss :: GRHSs GhcPs (LHsExpr GhcPs)
grhss)) = Located (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars (SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs)
-> SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs
forall a b. (a -> b) -> a -> b
$ XVarPat GhcPs -> Located (IdP GhcPs) -> Pat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat NoExtField
XVarPat GhcPs
noExtField Located (IdP GhcPs)
Located (NameOrRdrName (IdP GhcPs))
name :: LPat GhcPs) Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> [Located (Pat GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars [LPat GhcPs]
[Located (Pat GhcPs)]
pats Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> GRHSs GhcPs (LHsExpr GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars GRHSs GhcPs (LHsExpr GhcPs)
grhss
allVars (L _ (Match _ (StmtCtxt ctxt :: HsStmtContext (NameOrRdrName (IdP GhcPs))
ctxt) pats :: [LPat GhcPs]
pats grhss :: GRHSs GhcPs (LHsExpr GhcPs)
grhss)) = HsStmtContext RdrName -> Vars
forall a. AllVars a => a -> Vars
allVars HsStmtContext (NameOrRdrName (IdP GhcPs))
HsStmtContext RdrName
ctxt Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> [Located (Pat GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars [LPat GhcPs]
[Located (Pat GhcPs)]
pats Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> GRHSs GhcPs (LHsExpr GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars GRHSs GhcPs (LHsExpr GhcPs)
grhss
allVars (L _ (Match _ _ pats :: [LPat GhcPs]
pats grhss :: GRHSs GhcPs (LHsExpr GhcPs)
grhss)) = Vars -> Vars -> Vars
forall a b. (AllVars a, AllVars b) => a -> b -> Vars
inVars ([Located (Pat GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars [LPat GhcPs]
[Located (Pat GhcPs)]
pats) (GRHSs GhcPs (LHsExpr GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars GRHSs GhcPs (LHsExpr GhcPs)
grhss)
allVars _ = Vars
forall a. Monoid a => a
mempty
instance AllVars (HsStmtContext RdrName) where
allVars :: HsStmtContext RdrName -> Vars
allVars (PatGuard FunRhs{mc_fun :: forall id. HsMatchContext id -> Located id
mc_fun=Located RdrName
n}) = Located (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars (SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs)
-> SrcSpanLess (Located (Pat GhcPs)) -> LPat GhcPs
forall a b. (a -> b) -> a -> b
$ XVarPat GhcPs -> Located (IdP GhcPs) -> Pat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat NoExtField
XVarPat GhcPs
noExtField Located (IdP GhcPs)
Located RdrName
n :: LPat GhcPs)
allVars ParStmtCtxt{} = Vars
forall a. Monoid a => a
mempty
allVars TransStmtCtxt{} = Vars
forall a. Monoid a => a
mempty
allVars _ = Vars
forall a. Monoid a => a
mempty
instance AllVars (GRHSs GhcPs (LHsExpr GhcPs)) where
allVars :: GRHSs GhcPs (LHsExpr GhcPs) -> Vars
allVars (GRHSs _ grhss :: [LGRHS GhcPs (LHsExpr GhcPs)]
grhss binds :: LHsLocalBinds GhcPs
binds) = LHsLocalBinds GhcPs -> Vars -> Vars
forall a b. (AllVars a, AllVars b) => a -> b -> Vars
inVars LHsLocalBinds GhcPs
binds ((LGRHS GhcPs (LHsExpr GhcPs) -> Vars)
-> [LGRHS GhcPs (LHsExpr GhcPs)] -> Vars
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap LGRHS GhcPs (LHsExpr GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars [LGRHS GhcPs (LHsExpr GhcPs)]
grhss)
allVars _ = Vars
forall a. Monoid a => a
mempty
instance AllVars (LGRHS GhcPs (LHsExpr GhcPs)) where
allVars :: LGRHS GhcPs (LHsExpr GhcPs) -> Vars
allVars (L _ (GRHS _ guards :: [ExprLStmt GhcPs]
guards expr :: LHsExpr GhcPs
expr)) = Set OccName -> Set OccName -> Vars
Vars (Vars -> Set OccName
bound Vars
gs) (Vars -> Set OccName
free Vars
gs Set OccName -> Set OccName -> Set OccName
^+ (LHsExpr GhcPs -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
expr Set OccName -> Set OccName -> Set OccName
^- Vars -> Set OccName
bound Vars
gs)) where gs :: Vars
gs = [ExprLStmt GhcPs] -> Vars
forall a. AllVars a => a -> Vars
allVars [ExprLStmt GhcPs]
guards
allVars _ = Vars
forall a. Monoid a => a
mempty
instance AllVars (LHsDecl GhcPs) where
allVars :: LHsDecl GhcPs -> Vars
allVars (L l :: SrcSpan
l (ValD _ bind :: HsBindLR GhcPs GhcPs
bind)) = LHsBindLR GhcPs GhcPs -> Vars
forall a. AllVars a => a -> Vars
allVars (SrcSpan -> HsBindLR GhcPs GhcPs -> LHsBindLR GhcPs GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsBindLR GhcPs GhcPs
bind :: LHsBind GhcPs)
allVars _ = Vars
forall a. Monoid a => a
mempty
vars :: FreeVars a => a -> [String]
vars :: a -> [String]
vars = Set String -> [String]
forall a. Set a -> [a]
Set.toList (Set String -> [String]) -> (a -> Set String) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OccName -> String) -> Set OccName -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map OccName -> String
occNameString (Set OccName -> Set String)
-> (a -> Set OccName) -> a -> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars
varss :: AllVars a => a -> [String]
= Set String -> [String]
forall a. Set a -> [a]
Set.toList (Set String -> [String]) -> (a -> Set String) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OccName -> String) -> Set OccName -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map OccName -> String
occNameString (Set OccName -> Set String)
-> (a -> Set OccName) -> a -> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vars -> Set OccName
free (Vars -> Set OccName) -> (a -> Vars) -> a -> Set OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vars
forall a. AllVars a => a -> Vars
allVars
pvars :: AllVars a => a -> [String]
pvars :: a -> [String]
pvars = Set String -> [String]
forall a. Set a -> [a]
Set.toList (Set String -> [String]) -> (a -> Set String) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OccName -> String) -> Set OccName -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map OccName -> String
occNameString (Set OccName -> Set String)
-> (a -> Set OccName) -> a -> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vars -> Set OccName
bound (Vars -> Set OccName) -> (a -> Vars) -> a -> Set OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vars
forall a. AllVars a => a -> Vars
allVars