{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}

module GHC.Util.FreeVars (
    vars, varss, pvars,
    Vars (..), FreeVars(..) , AllVars (..)
  ) where

import GHC.Types.Name.Reader
import GHC.Types.Name.Occurrence
import GHC.Types.Name
import GHC.Hs
import GHC.Types.SrcLoc

import Data.Generics.Uniplate.DataOnly
import Data.Monoid
import Data.Semigroup
import Data.List.Extra
import Data.Set (Set)
import Data.Set qualified 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

-- See [Note : Space leaks lurking here?] below.
data Vars = Vars{Vars -> Set OccName
bound :: Set OccName, Vars -> Set OccName
free :: Set OccName}

-- Useful for debugging.
instance Show Vars where
  show :: Vars -> String
show (Vars Set OccName
bs Set OccName
fs) = String
"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]
++
    String
", 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 Set OccName
x1 Set OccName
x2 <> :: Vars -> Vars -> Vars
<> Vars Set OccName
y1 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 [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)

-- A type `a` is a model of `AllVars a` if exists a function
-- `allVars` for producing a pair of the bound and free variable
-- sets in a value of `a`.
class AllVars a where
    -- | Return the variables, erring on the side of more free
    -- variables.
    allVars :: a -> Vars

-- A type `a` is a model of `FreeVars a` if exists a function
-- `freeVars` for producing a set of free variables of a value of
-- `a`.
class FreeVars a where
    -- | Return the variables, erring on the side of more free
    -- variables.
    freeVars :: a -> Set OccName

-- Trivial instances.
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
-- [Note : Space leaks lurking here?]
-- ==================================
-- We make use of `foldr`. @cocreature suggests we want bangs on `data
-- Vars` and replace usages of `mconcat` with `foldl`.
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

-- Construct a `Vars` value with no bound vars.
freeVars_ :: (FreeVars a) => a -> Vars
freeVars_ :: forall a. FreeVars a => 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 a b` is the set of free variables in a together with the
-- free variables in b not bound in a.
inFree :: (AllVars a, FreeVars b) => a -> b -> Set OccName
inFree :: forall a b. (AllVars a, FreeVars b) => a -> b -> Set OccName
inFree a
a 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 a b` is a value of `Vars_` with bound variables the union
-- of the bound variables of a and b and free variables the union
-- of the free variables of a and the free variables of b not
-- bound by a.
inVars :: (AllVars a, AllVars b) => a -> b -> Vars
inVars :: forall a b. (AllVars a, AllVars b) => a -> b -> Vars
inVars a
a 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

-- Get an `OccName` out of a reader name.
unqualNames :: LocatedN RdrName -> [OccName]
unqualNames :: LocatedN RdrName -> [OccName]
unqualNames (L SrcSpanAnnN
_ (Unqual OccName
x)) = [OccName
x]
unqualNames (L SrcSpanAnnN
_ (Exact Name
x)) = [Name -> OccName
nameOccName Name
x]
unqualNames LocatedN RdrName
_ = []

instance FreeVars (LocatedA (HsExpr GhcPs)) where
  freeVars :: LocatedA (HsExpr GhcPs) -> Set OccName
freeVars (L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ LIdP 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
$ LocatedN RdrName -> [OccName]
unqualNames LIdP GhcPs
LocatedN RdrName
x -- Variable.
  freeVars (L SrcSpanAnnA
_ (HsUnboundVar XUnboundVar GhcPs
_ RdrName
x)) = [OccName] -> Set OccName
forall a. Ord a => [a] -> Set a
Set.fromList [RdrName -> OccName
rdrNameOcc RdrName
x] -- Unbound variable; also used for "holes".
  freeVars (L SrcSpanAnnA
_ (HsLam XLam GhcPs
_ HsLamVariant
LamSingle MatchGroup GhcPs (LHsExpr GhcPs)
mg)) = Vars -> Set OccName
free (MatchGroup GhcPs (LocatedA (HsExpr GhcPs)) -> Vars
forall a. AllVars a => a -> Vars
allVars MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (LocatedA (HsExpr GhcPs))
mg) -- Lambda abstraction. Currently always a single match.
  freeVars (L SrcSpanAnnA
_ (HsLam XLam GhcPs
_ HsLamVariant
_ MG{mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts=(L SrcSpanAnnLW
_ [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
ms)})) = Vars -> Set OccName
free ([GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
-> Vars
forall a. AllVars a => a -> Vars
allVars [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
ms) -- Lambda case
  freeVars (L SrcSpanAnnA
_ (HsCase XCase GhcPs
_ LHsExpr GhcPs
of_ MG{mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts=(L SrcSpanAnnLW
_ [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
ms)})) = LocatedA (HsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
of_ Set OccName -> Set OccName -> Set OccName
^+ Vars -> Set OccName
free ([GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
-> Vars
forall a. AllVars a => a -> Vars
allVars [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
ms) -- Case expr.
  freeVars (L SrcSpanAnnA
_ (HsLet XLet GhcPs
_ HsLocalBinds GhcPs
binds LHsExpr GhcPs
e)) = HsLocalBinds GhcPs -> LocatedA (HsExpr GhcPs) -> Set OccName
forall a b. (AllVars a, FreeVars b) => a -> b -> Set OccName
inFree HsLocalBinds GhcPs
binds LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e -- Let (rec).
  freeVars (L SrcSpanAnnA
_ (HsDo XDo GhcPs
_ HsDoFlavour
ctxt (L SrcSpanAnnLW
_ [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts))) = (Set OccName, Set OccName) -> Set OccName
forall a b. (a, b) -> b
snd ((Set OccName, Set OccName) -> Set OccName)
-> (Set OccName, Set OccName) -> Set OccName
forall a b. (a -> b) -> a -> b
$ ((Set OccName, Set OccName)
 -> LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
 -> (Set OccName, Set OccName))
-> (Set OccName, Set OccName)
-> [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> (Set OccName, Set OccName)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Set OccName, Set OccName)
-> LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> (Set OccName, Set OccName)
alg (Set OccName, Set OccName)
forall a. Monoid a => a
mempty [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts -- Do block.
    where
      alg ::
        (Set OccName, Set OccName) ->
        LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))) ->
        (Set OccName, Set OccName)
      alg :: (Set OccName, Set OccName)
-> LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> (Set OccName, Set OccName)
alg (Set OccName
accBound0, Set OccName
accFree0) LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
stmt = (Set OccName
accBound, Set OccName
accFree)
        where
          accBound :: Set OccName
accBound =
            Set OccName
accBound0
              Set OccName -> Set OccName -> Set OccName
^+ ( case LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
stmt of
                     L SrcSpanAnnA
_ (BindStmt XBindStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ LPat GhcPs
pat LocatedA (HsExpr GhcPs)
_) -> Vars -> Set OccName
bound (GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat)
                     L SrcSpanAnnA
_ (LetStmt XLetStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ HsLocalBinds GhcPs
binds) -> Vars -> Set OccName
bound (HsLocalBinds GhcPs -> Vars
forall a. AllVars a => a -> Vars
allVars HsLocalBinds GhcPs
binds)
                     LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
_ -> Set OccName
forall a. Monoid a => a
mempty
                 )
          accFree :: Set OccName
accFree = Set OccName
accFree0 Set OccName -> Set OccName -> Set OccName
^+ (Vars -> Set OccName
free (LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))) -> Vars
forall a. AllVars a => a -> Vars
allVars LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
stmt) Set OccName -> Set OccName -> Set OccName
^- Set OccName
accBound0)
  freeVars (L SrcSpanAnnA
_ (RecordCon XRecordCon GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
_ (HsRecFields XHsRecFields GhcPs
_ [LHsRecField GhcPs (LHsExpr GhcPs)]
flds Maybe (XRec GhcPs RecFieldsDotDot)
_))) = [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
$ (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (LocatedA (HsExpr GhcPs)))
 -> Set OccName)
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
         (LocatedA (HsExpr GhcPs)))]
-> [Set OccName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
     (LocatedA (HsExpr GhcPs)))
-> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars [LHsRecField GhcPs (LHsExpr GhcPs)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (LocatedA (HsExpr GhcPs)))]
flds -- Record construction.
  freeVars (L SrcSpanAnnA
_ (RecordUpd XRecordUpd GhcPs
_ LHsExpr GhcPs
e LHsRecUpdFields GhcPs
flds)) =
    case LHsRecUpdFields GhcPs
flds of
      RegularRecUpdFields XLHsRecUpdLabels GhcPs
_ [LHsRecField GhcPs (LHsExpr GhcPs)]
fs -> [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
$ LocatedA (HsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e Set OccName -> [Set OccName] -> [Set OccName]
forall a. a -> [a] -> [a]
: (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (LocatedA (HsExpr GhcPs)))
 -> Set OccName)
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
         (LocatedA (HsExpr GhcPs)))]
-> [Set OccName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
     (LocatedA (HsExpr GhcPs)))
-> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars [LHsRecField GhcPs (LHsExpr GhcPs)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (LocatedA (HsExpr GhcPs)))]
fs
      OverloadedRecUpdFields XLHsOLRecUpdLabels GhcPs
_ [LHsRecUpdProj GhcPs]
ps -> [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
$ LocatedA (HsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e Set OccName -> [Set OccName] -> [Set OccName]
forall a. a -> [a] -> [a]
: (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated EpAnnCO (FieldLabelStrings GhcPs))
      (LocatedA (HsExpr GhcPs)))
 -> Set OccName)
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated EpAnnCO (FieldLabelStrings GhcPs))
         (LocatedA (HsExpr GhcPs)))]
-> [Set OccName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated EpAnnCO (FieldLabelStrings GhcPs))
     (LocatedA (HsExpr GhcPs)))
-> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars [LHsRecUpdProj GhcPs]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated EpAnnCO (FieldLabelStrings GhcPs))
      (LocatedA (HsExpr GhcPs)))]
ps
  freeVars (L SrcSpanAnnA
_ (HsMultiIf XMultiIf GhcPs
_ [LGRHS GhcPs (LHsExpr GhcPs)]
grhss)) = Vars -> Set OccName
free ([GenLocated EpAnnCO (GRHS GhcPs (LocatedA (HsExpr GhcPs)))] -> Vars
forall a. AllVars a => a -> Vars
allVars [LGRHS GhcPs (LHsExpr GhcPs)]
[GenLocated EpAnnCO (GRHS GhcPs (LocatedA (HsExpr GhcPs)))]
grhss) -- Multi-way if.
  freeVars (L SrcSpanAnnA
_ (HsTypedBracket XTypedBracket GhcPs
_ LHsExpr GhcPs
e)) = LocatedA (HsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e
  freeVars (L SrcSpanAnnA
_ (HsUntypedBracket XUntypedBracket GhcPs
_ (ExpBr XExpBr GhcPs
_ LHsExpr GhcPs
e))) = LocatedA (HsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e
  freeVars (L SrcSpanAnnA
_ (HsUntypedBracket XUntypedBracket GhcPs
_ (VarBr XVarBr GhcPs
_ Bool
_ LIdP GhcPs
v))) = [OccName] -> Set OccName
forall a. Ord a => [a] -> Set a
Set.fromList [RdrName -> OccName
forall name. HasOccName name => name -> OccName
occName (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
LocatedN RdrName
v)]

  freeVars (L SrcSpanAnnA
_ HsOverLabel{}) = Set OccName
forall a. Monoid a => a
mempty -- Overloaded label. The id of the in-scope fromLabel.
  freeVars (L SrcSpanAnnA
_ HsIPVar{}) = Set OccName
forall a. Monoid a => a
mempty -- Implicit parameter.
  freeVars (L SrcSpanAnnA
_ HsOverLit{}) = Set OccName
forall a. Monoid a => a
mempty -- Overloaded literal.
  freeVars (L SrcSpanAnnA
_ HsLit{}) = Set OccName
forall a. Monoid a => a
mempty -- Simple literal.

  -- freeVars (e@(L _ HsAppType{})) = freeVars $ children e -- Visible type application e.g. f @ Int x y.
  -- freeVars (e@(L _ HsApp{})) = freeVars $ children e -- Application.
  -- freeVars (e@(L _ OpApp{})) = freeVars $ children e -- Operator application.
  -- freeVars (e@(L _ NegApp{})) = freeVars $ children e -- Negation operator.
  -- freeVars (e@(L _ HsPar{})) = freeVars $ children e -- Parenthesized expr.
  -- freeVars (e@(L _ SectionL{})) = freeVars $ children e -- Left section.
  -- freeVars (e@(L _ SectionR{})) = freeVars $ children e -- Right section.
  -- freeVars (e@(L _ ExplicitTuple{})) = freeVars $ children e -- Explicit tuple and sections thereof.
  -- freeVars (e@(L _ ExplicitSum{})) = freeVars $ children e -- Used for unboxed sum types.
  -- freeVars (e@(L _ HsIf{})) = freeVars $ children e -- If.
  -- freeVars (e@(L _ ExplicitList{})) = freeVars $ children e -- Syntactic list e.g. [a, b, c].
  -- freeVars (e@(L _ ExprWithTySig{})) = freeVars $ children e -- Expr with type signature.
  -- freeVars (e@(L _ ArithSeq {})) = freeVars $ children e -- Arithmetic sequence.
  -- freeVars (e@(L _ HsSCC{})) = freeVars $ children e -- Set cost center pragma (expr whose const is to be measured).
  -- freeVars (e@(L _ HsCoreAnn{})) = freeVars $ children e -- Pragma.
  -- freeVars (e@(L _ HsBracket{})) = freeVars $ children e -- Haskell bracket.
  -- freeVars (e@(L _ HsSpliceE{})) = freeVars $ children e -- Template haskell splice expr.
  -- freeVars (e@(L _ HsProc{})) = freeVars $ children e -- Proc notation for arrows.
  -- freeVars (e@(L _ HsStatic{})) = freeVars $ children e -- Static pointers extension.
  -- freeVars (e@(L _ HsArrApp{})) = freeVars $ children e -- Arrow tail or arrow application.
  -- freeVars (e@(L _ HsArrForm{})) = freeVars $ children e -- Come back to it. Arrow tail or arrow application.
  -- freeVars (e@(L _ HsTick{})) = freeVars $ children e -- Haskell program coverage (Hpc) support.
  -- freeVars (e@(L _ HsBinTick{})) = freeVars $ children e -- Haskell program coverage (Hpc) support.
  -- freeVars (e@(L _ HsTickPragma{})) = freeVars $ children e -- Haskell program coverage (Hpc) support.
  -- freeVars (e@(L _ EAsPat{})) = freeVars $ children e -- Expr as pat.
  -- freeVars (e@(L _ EViewPat{})) = freeVars $ children e -- View pattern.
  -- freeVars (e@(L _ ELazyPat{})) = freeVars $ children e -- Lazy pattern.

  freeVars LocatedA (HsExpr GhcPs)
e = [LocatedA (HsExpr GhcPs)] -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars ([LocatedA (HsExpr GhcPs)] -> Set OccName)
-> [LocatedA (HsExpr GhcPs)] -> Set OccName
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> [LocatedA (HsExpr GhcPs)]
forall on. Uniplate on => on -> [on]
children LocatedA (HsExpr GhcPs)
e

instance FreeVars (HsTupArg GhcPs) where
  freeVars :: HsTupArg GhcPs -> Set OccName
freeVars (Present XPresent GhcPs
_ LHsExpr GhcPs
args) = LocatedA (HsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
args
  freeVars HsTupArg GhcPs
_ = Set OccName
forall a. Monoid a => a
mempty

instance FreeVars (LocatedA (HsFieldBind (LocatedA (FieldOcc GhcPs)) (LocatedA (HsExpr GhcPs)))) where
   freeVars :: GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
     (LocatedA (HsExpr GhcPs)))
-> Set OccName
freeVars o :: GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
     (LocatedA (HsExpr GhcPs)))
o@(L SrcSpanAnnA
_ (HsFieldBind XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
_ GenLocated SrcSpanAnnA (FieldOcc GhcPs)
x LocatedA (HsExpr GhcPs)
_ Bool
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
$ LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (LocatedN RdrName -> RdrName) -> LocatedN RdrName -> RdrName
forall a b. (a -> b) -> a -> b
$ FieldOcc GhcPs -> LIdP GhcPs
forall pass. FieldOcc pass -> LIdP pass
foLabel (FieldOcc GhcPs -> LIdP GhcPs) -> FieldOcc GhcPs -> LIdP GhcPs
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> FieldOcc GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (FieldOcc GhcPs)
x -- a pun
   freeVars o :: GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
     (LocatedA (HsExpr GhcPs)))
o@(L SrcSpanAnnA
_ (HsFieldBind XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
_ GenLocated SrcSpanAnnA (FieldOcc GhcPs)
_ LocatedA (HsExpr GhcPs)
x Bool
_)) = LocatedA (HsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LocatedA (HsExpr GhcPs)
x

instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) (LocatedA (HsExpr GhcPs)))) where
  freeVars :: GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated EpAnnCO (FieldLabelStrings GhcPs))
     (LocatedA (HsExpr GhcPs)))
-> Set OccName
freeVars (L SrcSpanAnnA
_ (HsFieldBind XHsFieldBind (GenLocated EpAnnCO (FieldLabelStrings GhcPs))
_ GenLocated EpAnnCO (FieldLabelStrings GhcPs)
_ LocatedA (HsExpr GhcPs)
x Bool
_)) = LocatedA (HsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LocatedA (HsExpr GhcPs)
x

instance AllVars (LocatedA (Pat GhcPs)) where
  allVars :: GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
allVars (L SrcSpanAnnA
_ (VarPat XVarPat GhcPs
_ (L SrcSpanAnnN
_ 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
x) Set OccName
forall a. Set a
Set.empty -- Variable pattern.
  allVars (L SrcSpanAnnA
_ (AsPat XAsPat GhcPs
_ LIdP GhcPs
n LPat GhcPs
x)) = GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XVarPat GhcPs -> LIdP GhcPs -> Pat GhcPs
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcPs
NoExtField
noExtField LIdP GhcPs
n :: LocatedA (Pat GhcPs)) Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
x -- As pattern.
  allVars (L SrcSpanAnnA
_ (ConPat XConPat GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
_ (RecCon (HsRecFields XHsRecFields GhcPs
_ [LHsRecField GhcPs (LPat GhcPs)]
flds Maybe (XRec GhcPs RecFieldsDotDot)
_)))) = [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> Vars
forall a. AllVars a => a -> Vars
allVars [LHsRecField GhcPs (LPat GhcPs)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs)))]
flds
  allVars (L SrcSpanAnnA
_ (NPlusKPat XNPlusKPat GhcPs
_ LIdP GhcPs
n XRec GhcPs (HsOverLit GhcPs)
_ HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)) = GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XVarPat GhcPs -> LIdP GhcPs -> Pat GhcPs
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcPs
NoExtField
noExtField LIdP GhcPs
n :: LocatedA (Pat GhcPs)) -- n+k pattern.
  allVars (L SrcSpanAnnA
_ (ViewPat XViewPat GhcPs
_ LHsExpr GhcPs
e LPat GhcPs
p)) = LocatedA (HsExpr GhcPs) -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p -- View pattern.
  allVars (L SrcSpanAnnA
_ WildPat{}) = Vars
forall a. Monoid a => a
mempty -- Wildcard pattern.
  allVars (L SrcSpanAnnA
_ LitPat{}) = Vars
forall a. Monoid a => a
mempty -- Literal pattern.
  allVars (L SrcSpanAnnA
_ NPat{}) = Vars
forall a. Monoid a => a
mempty -- Natural pattern.
  allVars (L SrcSpanAnnA
_ InvisPat {}) = Vars
forall a. Monoid a => a
mempty -- since ghc-9.10.1

  -- allVars p@SplicePat{} = allVars $ children p -- Splice pattern (includes quasi-quotes).
  -- allVars p@SigPat{} = allVars $ children p -- Pattern with a type signature.
  -- allVars p@CoPat{} = allVars $ children p -- Coercion pattern.
  -- allVars p@LazyPat{} = allVars $ children p -- Lazy pattern.
  -- allVars p@ParPat{} = allVars $ children p -- Parenthesized pattern.
  -- allVars p@BangPat{} = allVars $ children p -- Bang pattern.
  -- allVars p@ListPat{} = allVars $ children p -- Syntactic list.
  -- allVars p@TuplePat{} = allVars $ children p -- Tuple sub patterns.
  -- allVars p@SumPat{} = allVars $ children p -- Anonymous sum pattern.

  allVars GenLocated SrcSpanAnnA (Pat GhcPs)
p = [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Vars)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Vars
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (Pat GhcPs)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall on. Uniplate on => on -> [on]
children GenLocated SrcSpanAnnA (Pat GhcPs)
p

instance AllVars (LocatedA (HsFieldBind (LocatedA (FieldOcc GhcPs)) (LocatedA (Pat GhcPs)))) where
   allVars :: GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Vars
allVars (L SrcSpanAnnA
_ (HsFieldBind XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
_ GenLocated SrcSpanAnnA (FieldOcc GhcPs)
_ GenLocated SrcSpanAnnA (Pat GhcPs)
x Bool
_)) = GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars GenLocated SrcSpanAnnA (Pat GhcPs)
x

instance AllVars (LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))) where
  allVars :: LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))) -> Vars
allVars (L SrcSpanAnnA
_ (LastStmt XLastStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ LocatedA (HsExpr GhcPs)
expr Maybe Bool
_ SyntaxExpr GhcPs
_)) = LocatedA (HsExpr GhcPs) -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ LocatedA (HsExpr GhcPs)
expr -- The last stmt of a ListComp, MonadComp, DoExpr,MDoExpr.
  allVars (L SrcSpanAnnA
_ (BindStmt XBindStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ LPat GhcPs
pat LocatedA (HsExpr GhcPs)
expr)) = GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> LocatedA (HsExpr GhcPs) -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ LocatedA (HsExpr GhcPs)
expr -- A generator e.g. x <- [1, 2, 3].
  allVars (L SrcSpanAnnA
_ (BodyStmt XBodyStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ LocatedA (HsExpr GhcPs)
expr SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)) = LocatedA (HsExpr GhcPs) -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ LocatedA (HsExpr GhcPs)
expr -- A boolean guard e.g. even x.
  allVars (L SrcSpanAnnA
_ (LetStmt XLetStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ HsLocalBinds GhcPs
binds)) = HsLocalBinds GhcPs -> Vars
forall a. AllVars a => a -> Vars
allVars HsLocalBinds GhcPs
binds -- A local declaration e.g. let y = x + 1
  allVars (L SrcSpanAnnA
_ (TransStmt XTransStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ TransForm
_ [ExprLStmt GhcPs]
stmts [(IdP GhcPs, IdP GhcPs)]
_ LHsExpr GhcPs
using Maybe (LHsExpr GhcPs)
by SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ HsExpr GhcPs
fmap_)) = [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))] -> Vars
forall a. AllVars a => a -> Vars
allVars [ExprLStmt GhcPs]
[LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> LocatedA (HsExpr GhcPs) -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
using Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> Vars
-> (LocatedA (HsExpr GhcPs) -> Vars)
-> Maybe (LocatedA (HsExpr GhcPs))
-> Vars
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Vars
forall a. Monoid a => a
mempty LocatedA (HsExpr GhcPs) -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ Maybe (LHsExpr GhcPs)
Maybe (LocatedA (HsExpr GhcPs))
by Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> LocatedA (HsExpr GhcPs) -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ (HsExpr GhcPs -> LocatedA (HsExpr GhcPs)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA HsExpr GhcPs
fmap_ :: LocatedA (HsExpr GhcPs)) -- Apply a function to a list of statements in order.
  allVars (L SrcSpanAnnA
_ (RecStmt XRecStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))]
stmts [IdP GhcPs]
_ [IdP GhcPs]
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)) = [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))] -> Vars
forall a. AllVars a => a -> Vars
allVars (GenLocated
  SrcSpanAnnLW
  [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))]
GenLocated
  SrcSpanAnnLW
  [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts) -- A recursive binding for a group of arrows.
  allVars (L SrcSpanAnnA
_ ParStmt{}) = Vars
forall a. Monoid a => a
mempty -- Parallel list thing. Come back to it.

instance AllVars (HsLocalBinds GhcPs) where
  allVars :: HsLocalBinds GhcPs -> Vars
allVars (HsValBinds XHsValBinds GhcPs GhcPs
_ (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
binds [LSig GhcPs]
_)) = [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars LHsBindsLR GhcPs GhcPs
[GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
binds -- Value bindings.
  allVars (HsIPBinds XHsIPBinds GhcPs GhcPs
_ (IPBinds XIPBinds GhcPs
_ [LIPBind GhcPs]
binds)) = [GenLocated SrcSpanAnnA (IPBind GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars [LIPBind GhcPs]
[GenLocated SrcSpanAnnA (IPBind GhcPs)]
binds -- Implicit parameter bindings.
  allVars EmptyLocalBinds{} =  Vars
forall a. Monoid a => a
mempty -- The case of no local bindings (signals the empty `let` or `where` clause).
  allVars HsLocalBinds GhcPs
_ = Vars
forall a. Monoid a => a
mempty -- extension points

instance AllVars (LocatedA (IPBind GhcPs)) where
  allVars :: GenLocated SrcSpanAnnA (IPBind GhcPs) -> Vars
allVars (L SrcSpanAnnA
_ (IPBind XCIPBind GhcPs
_ XRec GhcPs HsIPName
_ LHsExpr GhcPs
e)) = LocatedA (HsExpr GhcPs) -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e

instance AllVars (LocatedA (HsBindLR GhcPs GhcPs)) where
  allVars :: GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs) -> Vars
allVars (L SrcSpanAnnA
_ FunBind{fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id=LIdP 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 -> XRec p [LMatch p body]
mg_alts=(L SrcSpanAnnLW
_ [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
ms)}}) = GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XVarPat GhcPs -> LIdP GhcPs -> Pat GhcPs
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcPs
NoExtField
noExtField LIdP GhcPs
n :: LocatedA (Pat GhcPs)) Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
-> Vars
forall a. AllVars a => a -> Vars
allVars [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
ms -- Function bindings and simple variable bindings e.g. f x = e, f !x = 3, f = e, !x = e, x `f` y = e
  allVars (L SrcSpanAnnA
_ 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}) = GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
n Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> GRHSs GhcPs (LocatedA (HsExpr GhcPs)) -> Vars
forall a. AllVars a => a -> Vars
allVars GRHSs GhcPs (LHsExpr GhcPs)
GRHSs GhcPs (LocatedA (HsExpr GhcPs))
grhss -- Ctor patterns and some other interesting cases e.g. Just x = e, (x) = e, x :: Ty = e.

  allVars (L SrcSpanAnnA
_ (PatSynBind XPatSynBind GhcPs GhcPs
_ PSB{})) = Vars
forall a. Monoid a => a
mempty -- Come back to it.

instance AllVars (MatchGroup GhcPs (LocatedA (HsExpr GhcPs))) where
  allVars :: MatchGroup GhcPs (LocatedA (HsExpr GhcPs)) -> Vars
allVars (MG XMG GhcPs (LocatedA (HsExpr GhcPs))
_ _alts :: XRec GhcPs [LMatch GhcPs (LocatedA (HsExpr GhcPs))]
_alts@(L SrcSpanAnnLW
_ [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
alts)) = (Match GhcPs (LocatedA (HsExpr GhcPs)) -> Vars)
-> [Match GhcPs (LocatedA (HsExpr GhcPs))] -> Vars
forall b a. Monoid b => (a -> b) -> [a] -> b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Match GhcPs (LocatedA (HsExpr GhcPs))
m -> Vars -> Vars -> Vars
forall a b. (AllVars a, AllVars b) => a -> b -> Vars
inVars ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars ((GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall l e. GenLocated l e -> e
unLoc (GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
 -> [GenLocated SrcSpanAnnA (Pat GhcPs)])
-> (Match GhcPs (LocatedA (HsExpr GhcPs))
    -> GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)])
-> Match GhcPs (LocatedA (HsExpr GhcPs))
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs (LocatedA (HsExpr GhcPs)) -> XRec GhcPs [LPat GhcPs]
Match GhcPs (LocatedA (HsExpr GhcPs))
-> GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall p body. Match p body -> XRec p [LPat p]
m_pats) Match GhcPs (LocatedA (HsExpr GhcPs))
m)) (GRHSs GhcPs (LocatedA (HsExpr GhcPs)) -> Vars
forall a. AllVars a => a -> Vars
allVars (Match GhcPs (LocatedA (HsExpr GhcPs))
-> GRHSs GhcPs (LocatedA (HsExpr GhcPs))
forall p body. Match p body -> GRHSs p body
m_grhss Match GhcPs (LocatedA (HsExpr GhcPs))
m))) [Match GhcPs (LocatedA (HsExpr GhcPs))]
ms
    where ms :: [Match GhcPs (LocatedA (HsExpr GhcPs))]
ms = (GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))
 -> Match GhcPs (LocatedA (HsExpr GhcPs)))
-> [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
-> [Match GhcPs (LocatedA (HsExpr GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))
-> Match GhcPs (LocatedA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
alts

instance AllVars (LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))) where
  allVars :: GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))
-> Vars
allVars (L SrcSpanAnnA
_ (Match XCMatch GhcPs (LocatedA (HsExpr GhcPs))
_ FunRhs {mc_fun :: forall fn. HsMatchContext fn -> fn
mc_fun=LIdP (NoGhcTc GhcPs)
name} XRec GhcPs [LPat GhcPs]
pats GRHSs GhcPs (LocatedA (HsExpr GhcPs))
grhss)) = GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XVarPat GhcPs -> LIdP GhcPs -> Pat GhcPs
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcPs
NoExtField
noExtField LIdP (NoGhcTc GhcPs)
LIdP GhcPs
name :: LocatedA (Pat GhcPs)) Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Vars)
-> (GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
    -> [GenLocated SrcSpanAnnA (Pat GhcPs)])
-> GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> Vars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall l e. GenLocated l e -> e
unLoc) XRec GhcPs [LPat GhcPs]
GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
pats Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> GRHSs GhcPs (LocatedA (HsExpr GhcPs)) -> Vars
forall a. AllVars a => a -> Vars
allVars GRHSs GhcPs (LocatedA (HsExpr GhcPs))
grhss -- A pattern matching on an argument of a function binding.
  allVars (L SrcSpanAnnA
_ (Match XCMatch GhcPs (LocatedA (HsExpr GhcPs))
_ (StmtCtxt HsStmtContext (LIdP (NoGhcTc GhcPs))
ctxt) XRec GhcPs [LPat GhcPs]
pats GRHSs GhcPs (LocatedA (HsExpr GhcPs))
grhss)) = HsStmtContext (LocatedN RdrName) -> Vars
forall a. AllVars a => a -> Vars
allVars HsStmtContext (LIdP (NoGhcTc GhcPs))
HsStmtContext (LocatedN RdrName)
ctxt Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Vars)
-> (GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
    -> [GenLocated SrcSpanAnnA (Pat GhcPs)])
-> GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> Vars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall l e. GenLocated l e -> e
unLoc) XRec GhcPs [LPat GhcPs]
GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
pats Vars -> Vars -> Vars
forall a. Semigroup a => a -> a -> a
<> GRHSs GhcPs (LocatedA (HsExpr GhcPs)) -> Vars
forall a. AllVars a => a -> Vars
allVars GRHSs GhcPs (LocatedA (HsExpr GhcPs))
grhss -- Pattern of a do-stmt, list comprehension, pattern guard etc.
  allVars (L SrcSpanAnnA
_ (Match XCMatch GhcPs (LocatedA (HsExpr GhcPs))
_ HsMatchContext (LIdP (NoGhcTc GhcPs))
_ XRec GhcPs [LPat GhcPs]
pats GRHSs GhcPs (LocatedA (HsExpr GhcPs))
grhss)) = Vars -> Vars -> Vars
forall a b. (AllVars a, AllVars b) => a -> b -> Vars
inVars (([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Vars
forall a. AllVars a => a -> Vars
allVars ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Vars)
-> (GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
    -> [GenLocated SrcSpanAnnA (Pat GhcPs)])
-> GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> Vars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall l e. GenLocated l e -> e
unLoc) XRec GhcPs [LPat GhcPs]
GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
pats) (GRHSs GhcPs (LocatedA (HsExpr GhcPs)) -> Vars
forall a. AllVars a => a -> Vars
allVars GRHSs GhcPs (LocatedA (HsExpr GhcPs))
grhss) -- Everything else.

instance AllVars (HsStmtContext (GenLocated SrcSpanAnnN RdrName)) where
  allVars :: HsStmtContext (LocatedN RdrName) -> Vars
allVars (PatGuard FunRhs{mc_fun :: forall fn. HsMatchContext fn -> fn
mc_fun=LocatedN RdrName
n}) = GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XVarPat GhcPs -> LIdP GhcPs -> Pat GhcPs
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcPs
NoExtField
noExtField LIdP GhcPs
LocatedN RdrName
n :: LocatedA (Pat GhcPs))
  allVars ParStmtCtxt{} = Vars
forall a. Monoid a => a
mempty -- Come back to it.
  allVars TransStmtCtxt{}  = Vars
forall a. Monoid a => a
mempty -- Come back to it.
  allVars HsStmtContext (LocatedN RdrName)
_ = Vars
forall a. Monoid a => a
mempty

instance AllVars (GRHSs GhcPs (LocatedA (HsExpr GhcPs))) where
  allVars :: GRHSs GhcPs (LocatedA (HsExpr GhcPs)) -> Vars
allVars (GRHSs XCGRHSs GhcPs (LocatedA (HsExpr GhcPs))
_ [LGRHS GhcPs (LocatedA (HsExpr GhcPs))]
grhss HsLocalBinds GhcPs
binds) = HsLocalBinds GhcPs -> Vars -> Vars
forall a b. (AllVars a, AllVars b) => a -> b -> Vars
inVars HsLocalBinds GhcPs
binds ((GenLocated EpAnnCO (GRHS GhcPs (LocatedA (HsExpr GhcPs))) -> Vars)
-> [GenLocated EpAnnCO (GRHS GhcPs (LocatedA (HsExpr GhcPs)))]
-> Vars
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap GenLocated EpAnnCO (GRHS GhcPs (LocatedA (HsExpr GhcPs))) -> Vars
forall a. AllVars a => a -> Vars
allVars [LGRHS GhcPs (LocatedA (HsExpr GhcPs))]
[GenLocated EpAnnCO (GRHS GhcPs (LocatedA (HsExpr GhcPs)))]
grhss)

instance AllVars (LocatedAn NoEpAnns (GRHS GhcPs (LocatedA (HsExpr GhcPs)))) where
  allVars :: GenLocated EpAnnCO (GRHS GhcPs (LocatedA (HsExpr GhcPs))) -> Vars
allVars (L EpAnnCO
_ (GRHS XCGRHS GhcPs (LocatedA (HsExpr GhcPs))
_ [ExprLStmt GhcPs]
guards LocatedA (HsExpr 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
^+ (LocatedA (HsExpr GhcPs) -> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars LocatedA (HsExpr GhcPs)
expr Set OccName -> Set OccName -> Set OccName
^- Vars -> Set OccName
bound Vars
gs)) where gs :: Vars
gs = [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))] -> Vars
forall a. AllVars a => a -> Vars
allVars [ExprLStmt GhcPs]
[LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
guards

instance AllVars (LocatedA (HsDecl GhcPs)) where
  allVars :: LocatedA (HsDecl GhcPs) -> Vars
allVars (L SrcSpanAnnA
l (ValD XValD GhcPs
_ HsBindLR GhcPs GhcPs
bind)) = GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars (SrcSpanAnnA
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsBindLR GhcPs GhcPs
bind :: LocatedA (HsBindLR GhcPs GhcPs))
  allVars LocatedA (HsDecl GhcPs)
_ = Vars
forall a. Monoid a => a
mempty


vars :: FreeVars a => a -> [String]
vars :: forall a. FreeVars a => 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]
varss :: forall a. AllVars a => a -> [String]
varss = 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 :: forall a. AllVars a => 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