{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module GHC.Util.FreeVars (
vars', varss', pvars', freeVarSet'
, Vars' (..), FreeVars'(..) , AllVars' (..)
) where
import RdrName
import HsTypes
import OccName
import Name
import HsSyn
import SrcLoc
import Bag (bagToList)
import Data.Generics.Uniplate.Data ()
import Data.Generics.Uniplate.Operations
import Data.Monoid
import Data.Semigroup
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' = [Vars'] -> Vars'
forall a. Monoid a => [a] -> a
mconcat ([Vars'] -> Vars') -> ([a] -> [Vars']) -> [a] -> Vars'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Vars') -> [a] -> [Vars']
forall a b. (a -> b) -> [a] -> [b]
map 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' (Located RdrName -> Located (SrcSpanLess (Located RdrName))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (Unqual x)) = [OccName
x]
unqualNames' (Located RdrName -> Located (SrcSpanLess (Located RdrName))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (Exact x)) = [Name -> OccName
nameOccName Name
x]
unqualNames' _ = []
instance FreeVars' (LHsExpr GhcPs) where
freeVars' :: LHsExpr GhcPs -> Set OccName
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (HsVar _ 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 RdrName
Located (IdP GhcPs)
x
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (HsUnboundVar _ x)) = [OccName] -> Set OccName
forall a. Ord a => [a] -> Set a
Set.fromList [UnboundVar -> OccName
unboundVarOcc UnboundVar
x]
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (HsLam _ mg)) = Vars' -> Set OccName
free' (MatchGroup GhcPs (LHsExpr GhcPs) -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' MatchGroup GhcPs (LHsExpr GhcPs)
mg)
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (HsLamCase _ mg)) = Vars' -> Set OccName
free' (MatchGroup GhcPs (LHsExpr GhcPs) -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' MatchGroup GhcPs (LHsExpr GhcPs)
mg)
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (HsCase _ of_ MG{mg_alts=(dL -> L _ 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)]
SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
ms)
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (HsLet _ binds 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' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (HsDo _ ctxt (dL -> L _ stmts))) = Vars' -> Set OccName
free' ([ExprLStmt GhcPs] -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' [ExprLStmt GhcPs]
SrcSpanLess (Located [ExprLStmt GhcPs])
stmts)
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (RecordCon _ _ (HsRecFields 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' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (RecordUpd _ e 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' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (HsMultiIf _ grhss)) = Vars' -> Set OccName
free' ([LGRHS GhcPs (LHsExpr GhcPs)] -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' [LGRHS GhcPs (LHsExpr GhcPs)]
grhss)
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ HsConLikeOut{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ HsRecFld{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ HsOverLabel{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ HsIPVar{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ HsOverLit{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ HsLit{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ HsRnBracketOut{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ HsTcBracketOut{}) = Set OccName
forall a. Monoid a => a
mempty
freeVars' (LHsExpr GhcPs -> Located (SrcSpanLess (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> 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' (LHsRecField GhcPs (LHsExpr GhcPs)) where
freeVars' :: LHsRecField GhcPs (LHsExpr GhcPs) -> Set OccName
freeVars' (LHsRecField GhcPs (LHsExpr GhcPs)
-> Located (SrcSpanLess (LHsRecField GhcPs (LHsExpr GhcPs)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (HsRecField _ 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' (LHsRecUpdField GhcPs
-> Located (SrcSpanLess (LHsRecUpdField GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (HsRecField _ x _)) = LHsExpr GhcPs -> Set OccName
forall a. FreeVars' a => a -> Set OccName
freeVars' LHsExpr GhcPs
x
instance AllVars' (LPat GhcPs) where
allVars' :: LPat GhcPs -> Vars'
allVars' (VarPat _ (Located (IdP GhcPs) -> Located (SrcSpanLess (Located RdrName))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ x :: SrcSpanLess (Located RdrName)
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 RdrName
SrcSpanLess (Located RdrName)
x) Set OccName
forall a. Set a
Set.empty
allVars' (AsPat _ n :: Located (IdP GhcPs)
n x :: LPat GhcPs
x) = LPat GhcPs -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' (XVarPat GhcPs -> Located (IdP GhcPs) -> LPat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat NoExt
XVarPat GhcPs
noExt Located (IdP GhcPs)
n :: Pat GhcPs) Vars' -> Vars' -> Vars'
forall a. Semigroup a => a -> a -> a
<> LPat GhcPs -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' LPat GhcPs
x
allVars' (ConPatIn _ (RecCon (HsRecFields flds :: [LHsRecField GhcPs (LPat GhcPs)]
flds _))) = [LHsRecField GhcPs (LPat GhcPs)] -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' [LHsRecField GhcPs (LPat GhcPs)]
flds
allVars' (NPlusKPat _ n :: Located (IdP GhcPs)
n _ _ _ _) = LPat GhcPs -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' (XVarPat GhcPs -> Located (IdP GhcPs) -> LPat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat NoExt
XVarPat GhcPs
noExt Located (IdP GhcPs)
n :: Pat GhcPs)
allVars' (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
<> LPat GhcPs -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' LPat GhcPs
p
allVars' WildPat{} = Vars'
forall a. Monoid a => a
mempty
allVars' ConPatOut{} = Vars'
forall a. Monoid a => a
mempty
allVars' LitPat{} = Vars'
forall a. Monoid a => a
mempty
allVars' NPat{} = Vars'
forall a. Monoid a => a
mempty
allVars' p :: LPat GhcPs
p = [LPat GhcPs] -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' ([LPat GhcPs] -> Vars') -> [LPat GhcPs] -> Vars'
forall a b. (a -> b) -> a -> b
$ LPat GhcPs -> [LPat GhcPs]
forall on. Uniplate on => on -> [on]
children LPat GhcPs
p
instance AllVars' (LHsRecField GhcPs (LPat GhcPs)) where
allVars' :: LHsRecField GhcPs (LPat GhcPs) -> Vars'
allVars' (LHsRecField GhcPs (LPat GhcPs)
-> Located (SrcSpanLess (LHsRecField GhcPs (LPat GhcPs)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (HsRecField _ x _)) = LPat GhcPs -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' LPat GhcPs
x
instance AllVars' (LStmt GhcPs (LHsExpr GhcPs)) where
allVars' :: ExprLStmt GhcPs -> Vars'
allVars' (ExprLStmt GhcPs -> Located (SrcSpanLess (ExprLStmt GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (LastStmt _ expr _ _)) = LHsExpr GhcPs -> Vars'
forall a. FreeVars' a => a -> Vars'
freeVars_' LHsExpr GhcPs
expr
allVars' (ExprLStmt GhcPs -> Located (SrcSpanLess (ExprLStmt GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (BindStmt _ pat expr _ _)) = LPat GhcPs -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' LPat 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' (ExprLStmt GhcPs -> Located (SrcSpanLess (ExprLStmt GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (BodyStmt _ expr _ _)) = LHsExpr GhcPs -> Vars'
forall a. FreeVars' a => a -> Vars'
freeVars_' LHsExpr GhcPs
expr
allVars' (ExprLStmt GhcPs -> Located (SrcSpanLess (ExprLStmt GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (LetStmt _ binds)) = LHsLocalBinds GhcPs -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' LHsLocalBinds GhcPs
binds
allVars' (ExprLStmt GhcPs -> Located (SrcSpanLess (ExprLStmt GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (TransStmt _ _ stmts _ using by _ _ 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 SrcSpanLess (LHsExpr GhcPs)
HsExpr GhcPs
fmap_ :: Located (HsExpr GhcPs))
allVars' (ExprLStmt GhcPs -> Located (SrcSpanLess (ExprLStmt GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (RecStmt _ stmts _ _ _ _ _)) = [ExprLStmt GhcPs] -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' [ExprLStmt GhcPs]
stmts
allVars' (ExprLStmt GhcPs -> Located (SrcSpanLess (ExprLStmt GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ ApplicativeStmt{}) = Vars'
forall a. Monoid a => a
mempty
allVars' (ExprLStmt GhcPs -> Located (SrcSpanLess (ExprLStmt GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> 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' (LHsLocalBinds GhcPs -> Located (SrcSpanLess (LHsLocalBinds GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (HsValBinds _ (ValBinds _ binds _))) = [LHsBindLR GhcPs GhcPs] -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' (Bag (LHsBindLR GhcPs GhcPs) -> [LHsBindLR GhcPs GhcPs]
forall a. Bag a -> [a]
bagToList Bag (LHsBindLR GhcPs GhcPs)
binds)
allVars' (LHsLocalBinds GhcPs -> Located (SrcSpanLess (LHsLocalBinds GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (HsIPBinds _ (IPBinds _ binds))) = [LIPBind GhcPs] -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' [LIPBind GhcPs]
binds
allVars' (LHsLocalBinds GhcPs -> Located (SrcSpanLess (LHsLocalBinds GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> 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' (LIPBind GhcPs -> Located (SrcSpanLess (LIPBind GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (IPBind _ _ 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' (LHsBindLR GhcPs GhcPs
-> Located (SrcSpanLess (LHsBindLR GhcPs GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ FunBind{fun_id=n, fun_matches=MG{mg_alts=(dL -> L _ ms)}}) = LPat GhcPs -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' (XVarPat GhcPs -> Located (IdP GhcPs) -> LPat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat NoExt
XVarPat GhcPs
noExt Located (IdP GhcPs)
n :: Pat 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)]
SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
ms
allVars' (LHsBindLR GhcPs GhcPs
-> Located (SrcSpanLess (LHsBindLR GhcPs GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ PatBind{pat_lhs=n, pat_rhs=grhss}) = LPat GhcPs -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' LPat 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' (LHsBindLR GhcPs GhcPs
-> Located (SrcSpanLess (LHsBindLR GhcPs GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (PatSynBind _ PSB{})) = Vars'
forall a. Monoid a => a
mempty
allVars' (LHsBindLR GhcPs GhcPs
-> Located (SrcSpanLess (LHsBindLR GhcPs GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ VarBind{}) = Vars'
forall a. Monoid a => a
mempty
allVars' (LHsBindLR GhcPs GhcPs
-> Located (SrcSpanLess (LHsBindLR GhcPs GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> 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 :: Located [LMatch GhcPs (LHsExpr GhcPs)]
_alts@(Located [LMatch GhcPs (LHsExpr GhcPs)]
-> Located (SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)]))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ alts :: SrcSpanLess (Located [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 ([LPat GhcPs] -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' ([LPat GhcPs] -> Vars')
-> (Match GhcPs (LHsExpr GhcPs) -> [LPat GhcPs])
-> Match GhcPs (LHsExpr GhcPs)
-> Vars'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs (LHsExpr GhcPs) -> [LPat 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)]
SrcSpanLess (Located [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' (LMatch GhcPs (LHsExpr GhcPs)
-> Located (SrcSpanLess (LMatch GhcPs (LHsExpr GhcPs)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (Match _ FunRhs {mc_fun=name} pats grhss)) = LPat GhcPs -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' (XVarPat GhcPs -> Located (IdP GhcPs) -> LPat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat NoExt
XVarPat GhcPs
noExt Located (IdP GhcPs)
Located (NameOrRdrName (IdP GhcPs))
name :: Pat GhcPs) Vars' -> Vars' -> Vars'
forall a. Semigroup a => a -> a -> a
<> [LPat GhcPs] -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' [LPat 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' (LMatch GhcPs (LHsExpr GhcPs)
-> Located (SrcSpanLess (LMatch GhcPs (LHsExpr GhcPs)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (Match _ (StmtCtxt ctxt) pats grhss)) = HsStmtContext RdrName -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' HsStmtContext RdrName
HsStmtContext (NameOrRdrName (IdP GhcPs))
ctxt Vars' -> Vars' -> Vars'
forall a. Semigroup a => a -> a -> a
<> [LPat GhcPs] -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' [LPat 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' (LMatch GhcPs (LHsExpr GhcPs)
-> Located (SrcSpanLess (LMatch GhcPs (LHsExpr GhcPs)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (Match _ _ pats grhss)) = Vars' -> Vars' -> Vars'
forall a b. (AllVars' a, AllVars' b) => a -> b -> Vars'
inVars' ([LPat GhcPs] -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' [LPat 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}) = LPat GhcPs -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' (XVarPat GhcPs -> Located (IdP GhcPs) -> LPat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat NoExt
XVarPat GhcPs
noExt Located RdrName
Located (IdP GhcPs)
n :: Pat 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 ([Vars'] -> Vars'
forall a. Monoid a => [a] -> a
mconcat ((LGRHS GhcPs (LHsExpr GhcPs) -> Vars')
-> [LGRHS GhcPs (LHsExpr GhcPs)] -> [Vars']
forall a b. (a -> b) -> [a] -> [b]
map 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' (LGRHS GhcPs (LHsExpr GhcPs)
-> Located (SrcSpanLess (LGRHS GhcPs (LHsExpr GhcPs)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L _ (GRHS _ guards 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' (LHsDecl GhcPs -> Located (SrcSpanLess (LHsDecl GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL -> L l :: SrcSpan
l (ValD _ bind)) = LHsBindLR GhcPs GhcPs -> Vars'
forall a. AllVars' a => a -> Vars'
allVars' (SrcSpan
-> SrcSpanLess (LHsBindLR GhcPs GhcPs) -> LHsBindLR GhcPs GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (LHsBindLR GhcPs GhcPs)
HsBind 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'
freeVarSet' :: FreeVars' a => a -> Set String
freeVarSet' :: a -> Set String
freeVarSet' = (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'