{-# 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 GHC.Data.Bag (bagToList)

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
_ 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
_ (HsLamCase XLamCase GhcPs
_ LamCaseVariant
_ MG{mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts=(L SrcSpanAnnL
_ [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 SrcSpanAnnL
_ [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
_ LHsToken "let" GhcPs
_ HsLocalBinds GhcPs
binds LHsToken "in" GhcPs
_ 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 SrcSpanAnnL
_ [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 [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 (SrcAnn NoEpAnns) (FieldOcc GhcPs))
      (LocatedA (HsExpr GhcPs)))
 -> Set OccName)
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
         (LocatedA (HsExpr GhcPs)))]
-> [Set OccName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (LocatedA (HsExpr GhcPs)))
-> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars [LHsRecField GhcPs (LHsExpr GhcPs)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (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
_ [LHsRecUpdField GhcPs 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 (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
      (LocatedA (HsExpr GhcPs)))
 -> Set OccName)
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
         (LocatedA (HsExpr GhcPs)))]
-> [Set OccName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
     (LocatedA (HsExpr GhcPs)))
-> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars [LHsRecUpdField GhcPs GhcPs]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc 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 (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
      (LocatedA (HsExpr GhcPs)))
 -> Set OccName)
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
         (LocatedA (HsExpr GhcPs)))]
-> [Set OccName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
     (LocatedA (HsExpr GhcPs)))
-> Set OccName
forall a. FreeVars a => a -> Set OccName
freeVars [LHsRecUpdProj GhcPs]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
      (LocatedA (HsExpr GhcPs)))]
ps
  freeVars (L SrcSpanAnnA
_ (HsMultiIf XMultiIf GhcPs
_ [LGRHS GhcPs (LHsExpr GhcPs)]
grhss)) = Vars -> Set OccName
free ([GenLocated
   (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA (HsExpr GhcPs)))]
-> Vars
forall a. AllVars a => a -> Vars
allVars [LGRHS GhcPs (LHsExpr GhcPs)]
[GenLocated
   (SrcAnn NoEpAnns) (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
_ HsRecSel{}) = Set OccName
forall a. Monoid a => a
mempty -- Variable pointing to a record selector.
  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 (LocatedAn NoEpAnns (FieldOcc GhcPs)) (LocatedA (HsExpr GhcPs)))) where
   freeVars :: GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (LocatedA (HsExpr GhcPs)))
-> Set OccName
freeVars o :: GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (LocatedA (HsExpr GhcPs)))
o@(L SrcSpanAnnA
_ (HsFieldBind XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
_ GenLocated (SrcAnn NoEpAnns) (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 -> XRec GhcPs RdrName
forall pass. FieldOcc pass -> XRec pass RdrName
foLabel (FieldOcc GhcPs -> XRec GhcPs RdrName)
-> FieldOcc GhcPs -> XRec GhcPs RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> FieldOcc GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
x -- a pun
   freeVars o :: GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (LocatedA (HsExpr GhcPs)))
o@(L SrcSpanAnnA
_ (HsFieldBind XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
_ GenLocated (SrcAnn NoEpAnns) (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 (AmbiguousFieldOcc GhcPs)) (LocatedA (HsExpr GhcPs)))) where
  freeVars :: GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
     (LocatedA (HsExpr GhcPs)))
-> Set OccName
freeVars (L SrcSpanAnnA
_ (HsFieldBind XHsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
_ GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc 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
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ AmbiguousFieldOcc GhcPs -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
ambiguousFieldOccRdrName (AmbiguousFieldOcc GhcPs -> RdrName)
-> AmbiguousFieldOcc GhcPs -> RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)
-> AmbiguousFieldOcc GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)
x -- a pun
  freeVars (L SrcSpanAnnA
_ (HsFieldBind XHsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
_ GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc 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 (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
     (LocatedA (HsExpr GhcPs)))
-> Set OccName
freeVars (L SrcSpanAnnA
_ (HsFieldBind XHsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
_ GenLocated (SrcAnn NoEpAnns) (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 LHsToken "@" GhcPs
_ LPat GhcPs
x)) = GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a an. a -> LocatedAn an 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 [LHsRecField GhcPs (LPat GhcPs)]
flds Maybe (XRec GhcPs RecFieldsDotDot)
_)))) = [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> Vars
forall a. AllVars a => a -> Vars
allVars [LHsRecField GhcPs (LPat GhcPs)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (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 a an. a -> LocatedAn an 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 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 (LocatedAn NoEpAnns (FieldOcc GhcPs)) (LocatedA (Pat GhcPs)))) where
   allVars :: GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Vars
allVars (L SrcSpanAnnA
_ (HsFieldBind XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
_ GenLocated (SrcAnn NoEpAnns) (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 a an. a -> LocatedAn an 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
  SrcSpanAnnL
  [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
  SrcSpanAnnL
  [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts) -- A recursive binding for a group of arrows.

  allVars (L SrcSpanAnnA
_ ApplicativeStmt{}) = Vars
forall a. Monoid a => a
mempty -- Generated by the renamer.
  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 (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
Bag (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 SrcSpanAnnL
_ [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 a an. a -> LocatedAn an 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 SrcSpanAnnL
_ [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 (Match GhcPs (LocatedA (HsExpr GhcPs)) -> [LPat GhcPs]
forall p body. Match p body -> [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 p. HsMatchContext p -> LIdP (NoGhcTc p)
mc_fun=LIdP (NoGhcTc GhcPs)
name} [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 a an. a -> LocatedAn an 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 [LPat GhcPs]
[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 GhcPs
ctxt) [LPat GhcPs]
pats GRHSs GhcPs (LocatedA (HsExpr GhcPs))
grhss)) = HsStmtContext GhcPs -> Vars
forall a. AllVars a => a -> Vars
allVars HsStmtContext GhcPs
ctxt 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)]
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 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 [LPat GhcPs]
[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 GhcPs) where
  allVars :: HsStmtContext GhcPs -> Vars
allVars (PatGuard FunRhs{mc_fun :: forall p. HsMatchContext p -> LIdP (NoGhcTc p)
mc_fun=LIdP (NoGhcTc GhcPs)
n}) = GenLocated SrcSpanAnnA (Pat GhcPs) -> Vars
forall a. AllVars a => a -> Vars
allVars (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a an. a -> LocatedAn an 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
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 GhcPs
_ = 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
   (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA (HsExpr GhcPs)))
 -> Vars)
-> [GenLocated
      (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA (HsExpr GhcPs)))]
-> Vars
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA (HsExpr GhcPs)))
-> Vars
forall a. AllVars a => a -> Vars
allVars [LGRHS GhcPs (LocatedA (HsExpr GhcPs))]
[GenLocated
   (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA (HsExpr GhcPs)))]
grhss)

instance AllVars (LocatedAn NoEpAnns (GRHS GhcPs (LocatedA (HsExpr GhcPs)))) where
  allVars :: GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA (HsExpr GhcPs)))
-> Vars
allVars (L SrcAnn NoEpAnns
_ (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