{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

Taken quite directly from the Peyton Jones/Lester paper.
-}

{-# LANGUAGE TypeFamilies #-}

-- | A module concerned with finding the free variables of an expression.
module GHC.Core.FVs (
        -- * Free variables of expressions and binding groups
        exprFreeVars,     exprsFreeVars,
        exprFreeVarsDSet,
        exprFreeVarsList, exprsFreeVarsList,
        exprFreeIds,      exprsFreeIds,
        exprFreeIdsDSet,  exprsFreeIdsDSet,
        exprFreeIdsList,  exprsFreeIdsList,
        bindFreeVars,

        -- * Selective shallow free variables of expressions
        InterestingVarFun,
        exprSomeFreeVars, exprsSomeFreeVars,
        exprSomeFreeVarsList, exprsSomeFreeVarsList, exprsSomeFreeVarsDSet,
        deepExprsFreeVarsDSet,

        -- * Free variables of Rules, Vars and Ids
        bndrTypeTyCoFVs, bndrFVs, dBndrFreeVars,
        idUnfoldingVars, bndrFreeVars,
        bndrRuleAndUnfoldingVarsDSet,
        bndrRuleAndUnfoldingVars,
        idRuleVars, stableUnfoldingVars,
        ruleFreeVars, rulesFreeVars,
        rulesFreeVarsDSet, mkRuleInfo,
        ruleLhsFreeIds, ruleLhsFreeIdsList,
        ruleRhsFreeVars, rulesRhsFreeIds,

        exprFVs, addCoreBndrFV, addCoreBndrsFV, unitFV,

        -- * Orphan names
        orphNamesOfType, orphNamesOfTypes, orphNamesOfAxiomLHS,
        orphNamesOfExprs,

        -- * Core syntax tree annotation with free variables
        FVAnn,                  -- annotation, abstract
        CoreExprWithFVs,        -- = AnnExpr Id FVAnn
        CoreExprWithFVs',       -- = AnnExpr' Id FVAnn
        CoreBindWithFVs,        -- = AnnBind Id FVAnn
        CoreAltWithFVs,         -- = AnnAlt Id FVAnn
        freeVars,               -- CoreExpr -> CoreExprWithFVs
        freeVarsBind,           -- CoreBind -> DVarSet -> (DVarSet, CoreBindWithFVs)
        freeVarsOf,             -- CoreExprWithFVs -> DIdSet
        freeVarsOfAnn
    ) where

import GHC.Prelude

import GHC.Core
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Name.Set
import GHC.Types.Name
import GHC.Types.Tickish
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Var.FV
import GHC.Core.Type
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.FVs
import GHC.Core.TyCon
import GHC.Core.Coercion.Axiom
import GHC.Builtin.Types( unrestrictedFunTyConName )
import GHC.Builtin.Types.Prim( fUNTyCon )
import GHC.Data.Maybe( orElse )

import GHC.Utils.EndoOS
import GHC.Utils.Misc
import GHC.Utils.Panic.Plain

{-
************************************************************************
*                                                                      *
       Find the shallow free variables of term
*                                                                      *
************************************************************************

Note [Free variables of an expression]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This function simply finds the shallow free variables of an expression.
So far as type variables are concerned, it only finds tyvars that are
        * free in type arguments,
        * free in the type of a binder,
but not those that are free in the type of variable occurrences.

(FVE1) For /types/ we have a shallow free-var finder and a deep free-var finder,
  both implemented via TyCoFolder.  For /terms/ we have just one free-var
  finder (shallow).

  If we want the deep free vars (as in `deepExprsFreeVarsDSet`) we use
  `closeOverKinds`. There is no deep reason for this.  Maybe we should
  make a folder for terms as well.
-}


-- | Find all locally-defined free Ids or type variables in an expression
-- returning a non-deterministic set.
exprFreeVars :: CoreExpr -> VarSet
exprFreeVars :: CoreExpr -> VarSet
exprFreeVars = DVarSet -> VarSet
dVarSetToVarSet (DVarSet -> VarSet) -> (CoreExpr -> DVarSet) -> CoreExpr -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> DVarSet
exprFreeVarsDSet

-- | Find all locally-defined free Ids or type variables in an expression
-- returning a deterministic set.
exprFreeVarsDSet :: CoreExpr -> DVarSet
exprFreeVarsDSet :: CoreExpr -> DVarSet
exprFreeVarsDSet = InterestingVarFun -> SelectiveDFV -> DVarSet
runFVSelective InterestingVarFun
isLocalVar (SelectiveDFV -> DVarSet)
-> (CoreExpr -> SelectiveDFV) -> CoreExpr -> DVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> SelectiveDFV
exprFVs

-- | Find all locally-defined free Ids or type variables in several expressions
-- returning a non-deterministic set.
exprsFreeVars :: [CoreExpr] -> VarSet
exprsFreeVars :: [CoreExpr] -> VarSet
exprsFreeVars = DVarSet -> VarSet
dVarSetToVarSet (DVarSet -> VarSet)
-> ([CoreExpr] -> DVarSet) -> [CoreExpr] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CoreExpr] -> DVarSet
exprsFreeVarsDSet

-- | Find all locally-defined free Ids or type variables in several expressions
-- returning a deterministically ordered list.
exprsFreeVarsList :: [CoreExpr] -> [Var]
exprsFreeVarsList :: [CoreExpr] -> [Var]
exprsFreeVarsList = InterestingVarFun -> SelectiveDFV -> [Var]
runFVSelectiveList InterestingVarFun
isLocalVar (SelectiveDFV -> [Var])
-> ([CoreExpr] -> SelectiveDFV) -> [CoreExpr] -> [Var]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CoreExpr] -> SelectiveDFV
exprsFVs

exprsFreeVarsDSet :: [CoreExpr] -> DVarSet
exprsFreeVarsDSet :: [CoreExpr] -> DVarSet
exprsFreeVarsDSet = InterestingVarFun -> SelectiveDFV -> DVarSet
runFVSelective InterestingVarFun
isLocalVar (SelectiveDFV -> DVarSet)
-> ([CoreExpr] -> SelectiveDFV) -> [CoreExpr] -> DVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CoreExpr] -> SelectiveDFV
exprsFVs

deepExprsFreeVarsDSet :: [CoreExpr] -> DVarSet
-- See (FVE1) in Note [Free variables of an expression]
deepExprsFreeVarsDSet :: [CoreExpr] -> DVarSet
deepExprsFreeVarsDSet = DVarSet -> DVarSet
closeOverKindsDSet (DVarSet -> DVarSet)
-> ([CoreExpr] -> DVarSet) -> [CoreExpr] -> DVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CoreExpr] -> DVarSet
exprsFreeVarsDSet

-- | Find all locally-defined free Ids or type variables in an expression
-- returning a deterministically ordered list.
exprFreeVarsList :: CoreExpr -> [Var]
exprFreeVarsList :: CoreExpr -> [Var]
exprFreeVarsList = DVarSet -> [Var]
dVarSetElems (DVarSet -> [Var]) -> (CoreExpr -> DVarSet) -> CoreExpr -> [Var]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> DVarSet
exprFreeVarsDSet

-- | Find all locally-defined free Ids in an expression
exprFreeIds :: CoreExpr -> IdSet        -- Find all locally-defined free Ids
exprFreeIds :: CoreExpr -> VarSet
exprFreeIds = DVarSet -> VarSet
dVarSetToVarSet (DVarSet -> VarSet) -> (CoreExpr -> DVarSet) -> CoreExpr -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> DVarSet
exprFreeIdsDSet

exprsFreeIds :: [CoreExpr] -> IdSet        -- Find all locally-defined free Ids
exprsFreeIds :: [CoreExpr] -> VarSet
exprsFreeIds = DVarSet -> VarSet
dVarSetToVarSet (DVarSet -> VarSet)
-> ([CoreExpr] -> DVarSet) -> [CoreExpr] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CoreExpr] -> DVarSet
exprsFreeIdsDSet

-- | Find all locally-defined free Ids in an expression
-- returning a deterministic set.
exprFreeIdsDSet :: CoreExpr -> DIdSet -- Find all locally-defined free Ids
exprFreeIdsDSet :: CoreExpr -> DVarSet
exprFreeIdsDSet = InterestingVarFun -> SelectiveDFV -> DVarSet
runFVSelective InterestingVarFun
isLocalId (SelectiveDFV -> DVarSet)
-> (CoreExpr -> SelectiveDFV) -> CoreExpr -> DVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> SelectiveDFV
exprFVs

-- | Find all locally-defined free Ids in several expressions
-- returning a deterministic set.
exprsFreeIdsDSet :: [CoreExpr] -> DIdSet -- Find all locally-defined free Ids
exprsFreeIdsDSet :: [CoreExpr] -> DVarSet
exprsFreeIdsDSet = InterestingVarFun -> SelectiveDFV -> DVarSet
runFVSelective InterestingVarFun
isLocalId (SelectiveDFV -> DVarSet)
-> ([CoreExpr] -> SelectiveDFV) -> [CoreExpr] -> DVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CoreExpr] -> SelectiveDFV
exprsFVs

-- | Find all locally-defined free Ids in an expression
-- returning a deterministically ordered list.
exprFreeIdsList :: CoreExpr -> [Id] -- Find all locally-defined free Ids
exprFreeIdsList :: CoreExpr -> [Var]
exprFreeIdsList = DVarSet -> [Var]
dVarSetElems (DVarSet -> [Var]) -> (CoreExpr -> DVarSet) -> CoreExpr -> [Var]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> DVarSet
exprFreeIdsDSet

-- | Find all locally-defined free Ids in several expressions
-- returning a deterministically ordered list.
exprsFreeIdsList :: [CoreExpr] -> [Id]   -- Find all locally-defined free Ids
exprsFreeIdsList :: [CoreExpr] -> [Var]
exprsFreeIdsList = DVarSet -> [Var]
dVarSetElems (DVarSet -> [Var])
-> ([CoreExpr] -> DVarSet) -> [CoreExpr] -> [Var]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CoreExpr] -> DVarSet
exprsFreeIdsDSet

-- | Find all locally defined free Ids in a binding group
bindFreeVars :: CoreBind -> VarSet
bindFreeVars :: CoreBind -> VarSet
bindFreeVars = InterestingVarFun -> SelectiveDFV -> VarSet
runFVSelectiveSet InterestingVarFun
isLocalVar (SelectiveDFV -> VarSet)
-> (CoreBind -> SelectiveDFV) -> CoreBind -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreBind -> SelectiveDFV
bind_fvs

bind_fvs :: CoreBind -> SelectiveDFV
bind_fvs :: CoreBind -> SelectiveDFV
bind_fvs (NonRec Var
b CoreExpr
r) = (Var, CoreExpr) -> SelectiveDFV
rhs_fvs (Var
b,CoreExpr
r)
bind_fvs (Rec [(Var, CoreExpr)]
prs)    = [Var] -> SelectiveDFV -> SelectiveDFV
forall f a. [Var] -> FV (f, VarSet) a -> FV (f, VarSet) a
addBndrsSelectiveFV (((Var, CoreExpr) -> Var) -> [(Var, CoreExpr)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, CoreExpr) -> Var
forall a b. (a, b) -> a
fst [(Var, CoreExpr)]
prs) (SelectiveDFV -> SelectiveDFV) -> SelectiveDFV -> SelectiveDFV
forall a b. (a -> b) -> a -> b
$
                        ((Var, CoreExpr) -> SelectiveDFV)
-> [(Var, CoreExpr)] -> SelectiveDFV
forall (t :: * -> *) acc a env.
(Foldable t, Monoid acc) =>
(a -> FV env acc) -> t a -> FV env acc
mapUnionFV (Var, CoreExpr) -> SelectiveDFV
rhs_fvs [(Var, CoreExpr)]
prs

-- | Finds free variables in an expression selected by a predicate
exprSomeFreeVars :: InterestingVarFun   -- ^ Says which 'Var's are interesting
                 -> CoreExpr
                 -> VarSet
exprSomeFreeVars :: InterestingVarFun -> CoreExpr -> VarSet
exprSomeFreeVars InterestingVarFun
fv_cand = DVarSet -> VarSet
dVarSetToVarSet (DVarSet -> VarSet) -> (CoreExpr -> DVarSet) -> CoreExpr -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterestingVarFun -> CoreExpr -> DVarSet
exprSomeFreeVarsDSet InterestingVarFun
fv_cand

-- | Finds free variables in an expression selected by a predicate
-- returning a deterministically ordered list.
exprSomeFreeVarsList :: InterestingVarFun -- ^ Says which 'Var's are interesting
                     -> CoreExpr
                     -> [Var]
exprSomeFreeVarsList :: InterestingVarFun -> CoreExpr -> [Var]
exprSomeFreeVarsList InterestingVarFun
fv_cand = DVarSet -> [Var]
dVarSetElems (DVarSet -> [Var]) -> (CoreExpr -> DVarSet) -> CoreExpr -> [Var]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterestingVarFun -> CoreExpr -> DVarSet
exprSomeFreeVarsDSet InterestingVarFun
fv_cand

-- | Finds free variables in an expression selected by a predicate
-- returning a deterministic set.
exprSomeFreeVarsDSet :: InterestingVarFun -- ^ Says which 'Var's are interesting
                     -> CoreExpr
                     -> DVarSet
exprSomeFreeVarsDSet :: InterestingVarFun -> CoreExpr -> DVarSet
exprSomeFreeVarsDSet InterestingVarFun
fv_cand = InterestingVarFun -> SelectiveDFV -> DVarSet
runFVSelective InterestingVarFun
fv_cand (SelectiveDFV -> DVarSet)
-> (CoreExpr -> SelectiveDFV) -> CoreExpr -> DVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> SelectiveDFV
exprFVs

-- | Finds free variables in several expressions selected by a predicate
exprsSomeFreeVars :: InterestingVarFun  -- Says which 'Var's are interesting
                  -> [CoreExpr]
                  -> VarSet
exprsSomeFreeVars :: InterestingVarFun -> [CoreExpr] -> VarSet
exprsSomeFreeVars InterestingVarFun
fv_cand = DVarSet -> VarSet
dVarSetToVarSet (DVarSet -> VarSet)
-> ([CoreExpr] -> DVarSet) -> [CoreExpr] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterestingVarFun -> [CoreExpr] -> DVarSet
exprsSomeFreeVarsDSet InterestingVarFun
fv_cand

-- | Finds free variables in several expressions selected by a predicate
-- returning a deterministically ordered list.
exprsSomeFreeVarsList :: InterestingVarFun  -- Says which 'Var's are interesting
                      -> [CoreExpr]
                      -> [Var]
exprsSomeFreeVarsList :: InterestingVarFun -> [CoreExpr] -> [Var]
exprsSomeFreeVarsList InterestingVarFun
fv_cand = DVarSet -> [Var]
dVarSetElems (DVarSet -> [Var])
-> ([CoreExpr] -> DVarSet) -> [CoreExpr] -> [Var]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterestingVarFun -> [CoreExpr] -> DVarSet
exprsSomeFreeVarsDSet InterestingVarFun
fv_cand

-- | Finds free variables in several expressions selected by a predicate
-- returning a deterministic set.
exprsSomeFreeVarsDSet :: InterestingVarFun -- ^ Says which 'Var's are interesting
                      -> [CoreExpr]
                      -> DVarSet
exprsSomeFreeVarsDSet :: InterestingVarFun -> [CoreExpr] -> DVarSet
exprsSomeFreeVarsDSet InterestingVarFun
fv_cand = InterestingVarFun -> SelectiveDFV -> DVarSet
runFVSelective InterestingVarFun
fv_cand (SelectiveDFV -> DVarSet)
-> ([CoreExpr] -> SelectiveDFV) -> [CoreExpr] -> DVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CoreExpr] -> SelectiveDFV
exprsFVs

addCoreBndrFV :: CoreBndr -> SelectiveDFV -> SelectiveDFV
addCoreBndrFV :: Var -> SelectiveDFV -> SelectiveDFV
addCoreBndrFV Var
bndr SelectiveDFV
fvr
  = Var -> SelectiveDFV
bndrTypeTyCoFVs Var
bndr SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Monoid a => a -> a -> a
`mappend`
        -- Include type variables in the binder's type
        --      (not just Ids; coercion variables too!)
    Var -> SelectiveDFV -> SelectiveDFV
forall f a. Var -> FV (f, VarSet) a -> FV (f, VarSet) a
addBndrSelectiveFV Var
bndr SelectiveDFV
fvr

addCoreBndrsFV :: [CoreBndr] -> SelectiveDFV -> SelectiveDFV
addCoreBndrsFV :: [Var] -> SelectiveDFV -> SelectiveDFV
addCoreBndrsFV [Var]
bndrs SelectiveDFV
fv = (Var -> SelectiveDFV -> SelectiveDFV)
-> SelectiveDFV -> [Var] -> SelectiveDFV
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Var -> SelectiveDFV -> SelectiveDFV
addCoreBndrFV SelectiveDFV
fv [Var]
bndrs

unitFV :: Var -> SelectiveDFV
-- Deals with an occurrence
-- Shallow: does not look at the kind
unitFV :: Var -> SelectiveDFV
unitFV Var
v = ((InterestingVarFun, VarSet) -> EndoOS DVarSet) -> SelectiveDFV
forall env acc. (env -> acc) -> FV env acc
MkFV (\(InterestingVarFun, VarSet)
bvs -> (DVarSet -> DVarSet) -> EndoOS DVarSet
forall a. (a -> a) -> EndoOS a
EndoOS ((InterestingVarFun, VarSet) -> DVarSet -> DVarSet
do_it (InterestingVarFun, VarSet)
bvs))
  where
    do_it :: (InterestingVarFun, VarSet) -> DVarSet -> DVarSet
do_it (InterestingVarFun
is_interesting,VarSet
bvs) DVarSet
acc
      | Bool -> Bool
not (InterestingVarFun
is_interesting Var
v) = DVarSet
acc  -- The "selective" bit
      | Var
v Var -> VarSet -> Bool
`elemVarSet` VarSet
bvs     = DVarSet
acc
      | Var
v Var -> DVarSet -> Bool
`elemDVarSet` DVarSet
acc    = DVarSet
acc
      | Bool
otherwise              = DVarSet
acc DVarSet -> Var -> DVarSet
`extendDVarSet` Var
v

exprsFVs :: [CoreExpr] -> SelectiveDFV
exprsFVs :: [CoreExpr] -> SelectiveDFV
exprsFVs = (CoreExpr -> SelectiveDFV) -> [CoreExpr] -> SelectiveDFV
forall (t :: * -> *) acc a env.
(Foldable t, Monoid acc) =>
(a -> FV env acc) -> t a -> FV env acc
mapUnionFV CoreExpr -> SelectiveDFV
exprFVs

exprFVs :: CoreExpr -> SelectiveDFV
exprFVs :: CoreExpr -> SelectiveDFV
exprFVs (Type Type
ty)       = Type -> SelectiveDFV
shallowSelTypeFV Type
ty
exprFVs (Coercion Coercion
co)   = Coercion -> SelectiveDFV
shallowSelCoFV Coercion
co
exprFVs (Var Var
var)       = Var -> SelectiveDFV
unitFV Var
var
exprFVs (Lit Literal
_)         = SelectiveDFV
forall a. Monoid a => a
mempty
exprFVs (Tick CoreTickish
t CoreExpr
expr)   = CoreTickish -> SelectiveDFV
tickish_fvs CoreTickish
t SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Monoid a => a -> a -> a
`mappend` CoreExpr -> SelectiveDFV
exprFVs CoreExpr
expr
exprFVs (App CoreExpr
fun CoreExpr
arg)   = CoreExpr -> SelectiveDFV
exprFVs CoreExpr
fun SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Monoid a => a -> a -> a
`mappend` CoreExpr -> SelectiveDFV
exprFVs CoreExpr
arg
exprFVs (Lam Var
bndr CoreExpr
body) = Var -> SelectiveDFV -> SelectiveDFV
addCoreBndrFV Var
bndr (CoreExpr -> SelectiveDFV
exprFVs CoreExpr
body)
exprFVs (Cast CoreExpr
expr Coercion
co)  = CoreExpr -> SelectiveDFV
exprFVs CoreExpr
expr SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Monoid a => a -> a -> a
`mappend` Coercion -> SelectiveDFV
shallowSelCoFV Coercion
co
exprFVs (Case CoreExpr
scrut Var
bndr Type
ty [Alt Var]
alts)
  = CoreExpr -> SelectiveDFV
exprFVs CoreExpr
scrut SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Monoid a => a -> a -> a
`mappend` Type -> SelectiveDFV
shallowSelTypeFV Type
ty SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Monoid a => a -> a -> a
`mappend`
    Var -> SelectiveDFV -> SelectiveDFV
addCoreBndrFV Var
bndr ((Alt Var -> SelectiveDFV) -> [Alt Var] -> SelectiveDFV
forall (t :: * -> *) acc a env.
(Foldable t, Monoid acc) =>
(a -> FV env acc) -> t a -> FV env acc
mapUnionFV Alt Var -> SelectiveDFV
alt_fvs [Alt Var]
alts)
  where
    alt_fvs :: Alt Var -> SelectiveDFV
alt_fvs (Alt AltCon
_ [Var]
bndrs CoreExpr
rhs) = [Var] -> SelectiveDFV -> SelectiveDFV
addCoreBndrsFV [Var]
bndrs (CoreExpr -> SelectiveDFV
exprFVs CoreExpr
rhs)
exprFVs (Let (NonRec Var
bndr CoreExpr
rhs) CoreExpr
body)
  = (Var, CoreExpr) -> SelectiveDFV
rhs_fvs (Var
bndr, CoreExpr
rhs) SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Monoid a => a -> a -> a
`mappend` Var -> SelectiveDFV -> SelectiveDFV
addCoreBndrFV Var
bndr (CoreExpr -> SelectiveDFV
exprFVs CoreExpr
body)
exprFVs (Let (Rec [(Var, CoreExpr)]
pairs) CoreExpr
body)
  = [Var] -> SelectiveDFV -> SelectiveDFV
addCoreBndrsFV (((Var, CoreExpr) -> Var) -> [(Var, CoreExpr)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, CoreExpr) -> Var
forall a b. (a, b) -> a
fst [(Var, CoreExpr)]
pairs) (SelectiveDFV -> SelectiveDFV) -> SelectiveDFV -> SelectiveDFV
forall a b. (a -> b) -> a -> b
$
    ((Var, CoreExpr) -> SelectiveDFV)
-> [(Var, CoreExpr)] -> SelectiveDFV
forall (t :: * -> *) acc a env.
(Foldable t, Monoid acc) =>
(a -> FV env acc) -> t a -> FV env acc
mapUnionFV (Var, CoreExpr) -> SelectiveDFV
rhs_fvs [(Var, CoreExpr)]
pairs SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Monoid a => a -> a -> a
`mappend` CoreExpr -> SelectiveDFV
exprFVs CoreExpr
body

---------
rhs_fvs :: (Id, CoreExpr) -> SelectiveDFV
rhs_fvs :: (Var, CoreExpr) -> SelectiveDFV
rhs_fvs (Var
bndr, CoreExpr
rhs) = CoreExpr -> SelectiveDFV
exprFVs CoreExpr
rhs SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Monoid a => a -> a -> a
`mappend`
                      Var -> SelectiveDFV
bndrRuleAndUnfoldingFVs Var
bndr
        -- Treat any RULES as extra RHSs of the binding

---------
tickish_fvs :: CoreTickish -> SelectiveDFV
tickish_fvs :: CoreTickish -> SelectiveDFV
tickish_fvs (Breakpoint XBreakpoint 'TickishPassCore
_ BreakpointId
_ [XTickishId 'TickishPassCore]
ids) = (Var -> SelectiveDFV) -> [Var] -> SelectiveDFV
forall (t :: * -> *) acc a env.
(Foldable t, Monoid acc) =>
(a -> FV env acc) -> t a -> FV env acc
mapUnionFV Var -> SelectiveDFV
unitFV [Var]
[XTickishId 'TickishPassCore]
ids
tickish_fvs CoreTickish
_ = SelectiveDFV
forall a. Monoid a => a
mempty

---------
bndrTypeTyCoFVs :: Var -> SelectiveDFV
-- Find the free variables of a binder.
-- In the case of ids, don't forget the multiplicity field!
bndrTypeTyCoFVs :: Var -> SelectiveDFV
bndrTypeTyCoFVs Var
var
  = Type -> SelectiveDFV
shallowSelTypeFV (Var -> Type
varType Var
var) SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Monoid a => a -> a -> a
`mappend` SelectiveDFV
mult_fvs
  where
    mult_fvs :: SelectiveDFV
mult_fvs = case Var -> Maybe Type
varMultMaybe Var
var of
                 Just Type
mult -> Type -> SelectiveDFV
shallowSelTypeFV Type
mult
                 Maybe Type
Nothing   -> SelectiveDFV
forall a. Monoid a => a
mempty

dBndrTypeTyCoVars :: Var -> DTyCoVarSet
-- Find the type/kind/coercion variables free in the type of the id/tyvar
dBndrTypeTyCoVars :: Var -> DVarSet
dBndrTypeTyCoVars = InterestingVarFun -> SelectiveDFV -> DVarSet
runFVSelective InterestingVarFun
isLocalVar (SelectiveDFV -> DVarSet)
-> (Var -> SelectiveDFV) -> Var -> DVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> SelectiveDFV
bndrTypeTyCoFVs

bndrFreeVars :: Id -> VarSet
bndrFreeVars :: Var -> VarSet
bndrFreeVars Var
id = Bool -> VarSet -> VarSet
forall a. HasCallStack => Bool -> a -> a
assert (InterestingVarFun
isId Var
id) (VarSet -> VarSet) -> VarSet -> VarSet
forall a b. (a -> b) -> a -> b
$
                  DVarSet -> VarSet
dVarSetToVarSet  (DVarSet -> VarSet) -> DVarSet -> VarSet
forall a b. (a -> b) -> a -> b
$
                  Var -> DVarSet
dBndrFreeVars Var
id

dBndrFreeVars :: Id -> DVarSet
-- Shallow free vars
dBndrFreeVars :: Var -> DVarSet
dBndrFreeVars Var
id = InterestingVarFun -> SelectiveDFV -> DVarSet
runFVSelective InterestingVarFun
isLocalVar (SelectiveDFV -> DVarSet) -> SelectiveDFV -> DVarSet
forall a b. (a -> b) -> a -> b
$ Var -> SelectiveDFV
bndrFVs Var
id

bndrFVs :: Id -> SelectiveDFV
-- Shallow free vars of types, rules, and inlining
bndrFVs :: Var -> SelectiveDFV
bndrFVs Var
id = Bool -> SelectiveDFV -> SelectiveDFV
forall a. HasCallStack => Bool -> a -> a
assert (InterestingVarFun
isId Var
id) (SelectiveDFV -> SelectiveDFV) -> SelectiveDFV -> SelectiveDFV
forall a b. (a -> b) -> a -> b
$
             Var -> SelectiveDFV
bndrTypeTyCoFVs Var
id SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Monoid a => a -> a -> a
`mappend`
             Var -> SelectiveDFV
bndrRuleAndUnfoldingFVs Var
id

bndrRuleAndUnfoldingVarsDSet :: Id -> DVarSet
bndrRuleAndUnfoldingVarsDSet :: Var -> DVarSet
bndrRuleAndUnfoldingVarsDSet = InterestingVarFun -> SelectiveDFV -> DVarSet
runFVSelective InterestingVarFun
isLocalVar (SelectiveDFV -> DVarSet)
-> (Var -> SelectiveDFV) -> Var -> DVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> SelectiveDFV
bndrRuleAndUnfoldingFVs

bndrRuleAndUnfoldingVars :: Id -> VarSet
bndrRuleAndUnfoldingVars :: Var -> VarSet
bndrRuleAndUnfoldingVars = DVarSet -> VarSet
dVarSetToVarSet (DVarSet -> VarSet) -> (Var -> DVarSet) -> Var -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> DVarSet
bndrRuleAndUnfoldingVarsDSet

bndrRuleAndUnfoldingFVs :: Id -> SelectiveDFV
bndrRuleAndUnfoldingFVs :: Var -> SelectiveDFV
bndrRuleAndUnfoldingFVs Var
id
  | InterestingVarFun
isId Var
id   = Var -> SelectiveDFV
idRuleFVs Var
id SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Monoid a => a -> a -> a
`mappend` Var -> SelectiveDFV
idUnfoldingFVs Var
id
  | Bool
otherwise = SelectiveDFV
forall a. Monoid a => a
mempty

idRuleVars :: Id -> VarSet  -- Does *not* include CoreUnfolding vars
idRuleVars :: Var -> VarSet
idRuleVars = DVarSet -> VarSet
dVarSetToVarSet (DVarSet -> VarSet) -> (Var -> DVarSet) -> Var -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleInfo -> DVarSet
ruleInfoFreeVars (RuleInfo -> DVarSet) -> (Var -> RuleInfo) -> Var -> DVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> RuleInfo
idSpecialisation

idRuleFVs :: Id -> SelectiveDFV
idRuleFVs :: Var -> SelectiveDFV
idRuleFVs Var
id = Bool -> SelectiveDFV -> SelectiveDFV
forall a. HasCallStack => Bool -> a -> a
assert (InterestingVarFun
isId Var
id) (SelectiveDFV -> SelectiveDFV) -> SelectiveDFV -> SelectiveDFV
forall a b. (a -> b) -> a -> b
$
               (Var -> SelectiveDFV -> SelectiveDFV)
-> SelectiveDFV -> DVarSet -> SelectiveDFV
forall a r. (a -> r -> r) -> r -> UniqDSet a -> r
strictFoldDVarSet (SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Monoid a => a -> a -> a
mappend (SelectiveDFV -> SelectiveDFV -> SelectiveDFV)
-> (Var -> SelectiveDFV) -> Var -> SelectiveDFV -> SelectiveDFV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> SelectiveDFV
unitFV) SelectiveDFV
forall a. Monoid a => a
mempty (DVarSet -> SelectiveDFV) -> DVarSet -> SelectiveDFV
forall a b. (a -> b) -> a -> b
$
               RuleInfo -> DVarSet
ruleInfoFreeVars (Var -> RuleInfo
idSpecialisation Var
id)

idUnfoldingVars :: Id -> VarSet
-- Produce free vars for an unfolding, but NOT for an ordinary
-- (non-inline) unfolding, since it is a dup of the rhs
-- and we'll get exponential behaviour if we look at both unf and rhs!
-- But do look at the *real* unfolding, even for loop breakers, else
-- we might get out-of-scope variables
idUnfoldingVars :: Var -> VarSet
idUnfoldingVars = InterestingVarFun -> SelectiveDFV -> VarSet
runFVSelectiveSet InterestingVarFun
isLocalVar (SelectiveDFV -> VarSet) -> (Var -> SelectiveDFV) -> Var -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> SelectiveDFV
idUnfoldingFVs

idUnfoldingFVs :: Id -> SelectiveDFV
idUnfoldingFVs :: Var -> SelectiveDFV
idUnfoldingFVs Var
id = Unfolding -> Maybe SelectiveDFV
stableUnfoldingFVs (Var -> Unfolding
realIdUnfolding Var
id) Maybe SelectiveDFV -> SelectiveDFV -> SelectiveDFV
forall a. Maybe a -> a -> a
`orElse` SelectiveDFV
forall a. Monoid a => a
mempty

stableUnfoldingVars :: Unfolding -> Maybe VarSet
stableUnfoldingVars :: Unfolding -> Maybe VarSet
stableUnfoldingVars Unfolding
unf = (SelectiveDFV -> VarSet) -> Maybe SelectiveDFV -> Maybe VarSet
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (InterestingVarFun -> SelectiveDFV -> VarSet
runFVSelectiveSet InterestingVarFun
isLocalVar) (Maybe SelectiveDFV -> Maybe VarSet)
-> Maybe SelectiveDFV -> Maybe VarSet
forall a b. (a -> b) -> a -> b
$
                          Unfolding -> Maybe SelectiveDFV
stableUnfoldingFVs Unfolding
unf

stableUnfoldingFVs :: Unfolding -> Maybe SelectiveDFV
stableUnfoldingFVs :: Unfolding -> Maybe SelectiveDFV
stableUnfoldingFVs Unfolding
unf
  = case Unfolding
unf of
      CoreUnfolding { uf_tmpl :: Unfolding -> CoreExpr
uf_tmpl = CoreExpr
rhs, uf_src :: Unfolding -> UnfoldingSource
uf_src = UnfoldingSource
src }
         | UnfoldingSource -> Bool
isStableSource UnfoldingSource
src
         -> SelectiveDFV -> Maybe SelectiveDFV
forall a. a -> Maybe a
Just (CoreExpr -> SelectiveDFV
exprFVs CoreExpr
rhs)
      DFunUnfolding { df_bndrs :: Unfolding -> [Var]
df_bndrs = [Var]
bndrs, df_args :: Unfolding -> [CoreExpr]
df_args = [CoreExpr]
args }
         -> SelectiveDFV -> Maybe SelectiveDFV
forall a. a -> Maybe a
Just ([Var] -> SelectiveDFV -> SelectiveDFV
addCoreBndrsFV [Var]
bndrs ([CoreExpr] -> SelectiveDFV
exprsFVs [CoreExpr]
args))
            -- DFuns are top level, so no fvs from types of bndrs
      Unfolding
_other -> Maybe SelectiveDFV
forall a. Maybe a
Nothing


--      Comment about obsolete code
-- We used to gather the free variables the RULES at a variable occurrence
-- with the following cryptic comment:
--     "At a variable occurrence, add in any free variables of its rule rhss
--     Curiously, we gather the Id's free *type* variables from its binding
--     site, but its free *rule-rhs* variables from its usage sites.  This
--     is a little weird.  The reason is that the former is more efficient,
--     but the latter is more fine grained, and a makes a difference when
--     a variable mentions itself one of its own rule RHSs"
-- Not only is this "weird", but it's also pretty bad because it can make
-- a function seem more recursive than it is.  Suppose
--      f  = ...g...
--      g  = ...
--         RULE g x = ...f...
-- Then f is not mentioned in its own RHS, and needn't be a loop breaker
-- (though g may be).  But if we collect the rule fvs from g's occurrence,
-- it looks as if f mentions itself.  (This bites in the eftInt/eftIntFB
-- code in GHC.Enum.)
--
-- Anyway, it seems plain wrong.  The RULE is like an extra RHS for the
-- function, so its free variables belong at the definition site.
--
-- Deleted code looked like
--     foldVarSet add_rule_var var_itself_set (idRuleVars var)
--     add_rule_var var set | keep_it fv_cand in_scope var = extendVarSet set var
--                          | otherwise                    = set
--      SLPJ Feb06


{- **********************************************************************
%*                                                                      *
                    Orphan names
%*                                                                      *
%********************************************************************* -}

{- Note [Finding orphan names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The functions here (orphNamesOfType, orphNamesOfExpr etc) traverse a template:
  * the head of an class instance decl
  * the LHS of a type-family instance
  * the arguments of a RULE
to find TyCons or (in the case of a RULE) Ids, that will be matched against when
matching the template. If none of these orphNames are locally defined, the instance
or RULE is an orphan: see Note [Orphans] in GHC.Core

Wrinkles:
 (ON1) We do not need to look inside coercions, because we never match against
       them.  Indeed, it'd be wrong to do so, because it could make an instance
       into a non-orphan, when it really is an orphan.

 (ON2) These orphNames functions are also (rather separately) used by GHCi, to
       implement :info.  When you say ":info Foo", we show all the instances that
       involve `Foo`; that is, all the instances whose oprhNames include `Foo`.

       To support `:info (->)` we need to ensure that (->) is treated as an orphName
       of FunTy, which is a bit messy since the "real" TyCon is `FUN`
-}

orphNamesOfTyCon :: TyCon -> NameSet
orphNamesOfTyCon :: TyCon -> NameSet
orphNamesOfTyCon TyCon
tycon = Name -> NameSet
unitNameSet (TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tycon) NameSet -> NameSet -> NameSet
`unionNameSet` case TyCon -> Maybe Class
tyConClass_maybe TyCon
tycon of
    Maybe Class
Nothing  -> NameSet
emptyNameSet
    Just Class
cls -> Name -> NameSet
unitNameSet (Class -> Name
forall a. NamedThing a => a -> Name
getName Class
cls)

orphNamesOfType :: Type -> NameSet
orphNamesOfType :: Type -> NameSet
orphNamesOfType Type
ty | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = Type -> NameSet
orphNamesOfType Type
ty'
                -- Look through type synonyms (#4912)
orphNamesOfType (TyVarTy Var
_)          = NameSet
emptyNameSet
orphNamesOfType (LitTy {})           = NameSet
emptyNameSet
orphNamesOfType (ForAllTy ForAllTyBinder
bndr Type
res)  = Type -> NameSet
orphNamesOfType (ForAllTyBinder -> Type
forall argf. VarBndr Var argf -> Type
binderType ForAllTyBinder
bndr)
                                       NameSet -> NameSet -> NameSet
`unionNameSet` Type -> NameSet
orphNamesOfType Type
res
orphNamesOfType (AppTy Type
fun Type
arg)      = Type -> NameSet
orphNamesOfType Type
fun NameSet -> NameSet -> NameSet
`unionNameSet` Type -> NameSet
orphNamesOfType Type
arg

orphNamesOfType (TyConApp TyCon
tycon [Type]
tys) = NameSet
func
                                       NameSet -> NameSet -> NameSet
`unionNameSet` TyCon -> NameSet
orphNamesOfTyCon TyCon
tycon
                                       NameSet -> NameSet -> NameSet
`unionNameSet` [Type] -> NameSet
orphNamesOfTypes [Type]
tys
        where func :: NameSet
func = case [Type]
tys of
                       Type
arg:[Type]
_ | TyCon
tycon TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
fUNTyCon -> Type -> NameSet
orph_names_of_fun_ty_con Type
arg
                       [Type]
_ -> NameSet
emptyNameSet

orphNamesOfType (FunTy FunTyFlag
af Type
w Type
arg Type
res) =  NameSet
func
                                       NameSet -> NameSet -> NameSet
`unionNameSet` Name -> NameSet
unitNameSet Name
fun_tc
                                       NameSet -> NameSet -> NameSet
`unionNameSet` Type -> NameSet
orphNamesOfType Type
w
                                       NameSet -> NameSet -> NameSet
`unionNameSet` Type -> NameSet
orphNamesOfType Type
arg
                                       NameSet -> NameSet -> NameSet
`unionNameSet` Type -> NameSet
orphNamesOfType Type
res
        where func :: NameSet
func | FunTyFlag -> Bool
isVisibleFunArg FunTyFlag
af = Type -> NameSet
orph_names_of_fun_ty_con Type
w
                   | Bool
otherwise          = NameSet
emptyNameSet

              fun_tc :: Name
fun_tc = TyCon -> Name
tyConName (FunTyFlag -> TyCon
funTyFlagTyCon FunTyFlag
af)

-- Coercions: see wrinkle (ON1) of Note [Finding orphan names]
orphNamesOfType (CastTy Type
ty Coercion
_co)  = Type -> NameSet
orphNamesOfType Type
ty
orphNamesOfType (CoercionTy Coercion
_co) = NameSet
emptyNameSet

orphNamesOfThings :: (a -> NameSet) -> [a] -> NameSet
orphNamesOfThings :: forall a. (a -> NameSet) -> [a] -> NameSet
orphNamesOfThings a -> NameSet
f = (a -> NameSet -> NameSet) -> NameSet -> [a] -> NameSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (NameSet -> NameSet -> NameSet
unionNameSet (NameSet -> NameSet -> NameSet)
-> (a -> NameSet) -> a -> NameSet -> NameSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NameSet
f) NameSet
emptyNameSet

orphNamesOfTypes :: [Type] -> NameSet
orphNamesOfTypes :: [Type] -> NameSet
orphNamesOfTypes = (Type -> NameSet) -> [Type] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
orphNamesOfThings Type -> NameSet
orphNamesOfType

-- | `orphNamesOfAxiomLHS` collects the names of the concrete types and
-- type constructors that make up the LHS of a type family instance,
-- including the family name itself.
--
-- For instance, given `type family Foo a b`:
-- `type instance Foo (F (G (H a))) b = ...` would yield [Foo,F,G,H]
--
-- Used (via orphNamesOfFamInst) in the implementation of ":info" in GHCi.
-- and when determining orphan-hood for a FamInst or module
orphNamesOfAxiomLHS :: CoAxiom br -> NameSet
orphNamesOfAxiomLHS :: forall (br :: BranchFlag). CoAxiom br -> NameSet
orphNamesOfAxiomLHS CoAxiom br
axiom
  = ([Type] -> NameSet
orphNamesOfTypes ([Type] -> NameSet) -> [Type] -> NameSet
forall a b. (a -> b) -> a -> b
$ (CoAxBranch -> [Type]) -> [CoAxBranch] -> [Type]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CoAxBranch -> [Type]
coAxBranchLHS ([CoAxBranch] -> [Type]) -> [CoAxBranch] -> [Type]
forall a b. (a -> b) -> a -> b
$ Branches br -> [CoAxBranch]
forall (br :: BranchFlag). Branches br -> [CoAxBranch]
fromBranches (Branches br -> [CoAxBranch]) -> Branches br -> [CoAxBranch]
forall a b. (a -> b) -> a -> b
$ CoAxiom br -> Branches br
forall (br :: BranchFlag). CoAxiom br -> Branches br
coAxiomBranches CoAxiom br
axiom)
    NameSet -> Name -> NameSet
`extendNameSet` TyCon -> Name
forall a. NamedThing a => a -> Name
getName (CoAxiom br -> TyCon
forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom br
axiom)

-- Detect (FUN 'Many) as an application of (->), so that :i (->) works as expected
-- (see #8535) Issue #16475 describes a more robust solution
-- See wrinkle (ON2) of Note [Finding orphan names]
orph_names_of_fun_ty_con :: Mult -> NameSet
orph_names_of_fun_ty_con :: Type -> NameSet
orph_names_of_fun_ty_con Type
ManyTy = Name -> NameSet
unitNameSet Name
unrestrictedFunTyConName
orph_names_of_fun_ty_con Type
_      = NameSet
emptyNameSet

-- | Finds the free /external/ names of an expression, notably
-- including the names of type constructors (which of course do not show
-- up in 'exprFreeVars').
orphNamesOfExpr :: CoreExpr -> NameSet
-- There's no need to delete local binders, because they will all
-- be /internal/ names.
orphNamesOfExpr :: CoreExpr -> NameSet
orphNamesOfExpr CoreExpr
e
  = CoreExpr -> NameSet
go CoreExpr
e
  where
    go :: CoreExpr -> NameSet
go (Var Var
v)
      | Name -> Bool
isExternalName Name
n    = Name -> NameSet
unitNameSet Name
n
      | Bool
otherwise           = NameSet
emptyNameSet
      where n :: Name
n = Var -> Name
idName Var
v
    go (Lit Literal
_)              = NameSet
emptyNameSet
    go (Type Type
ty)            = Type -> NameSet
orphNamesOfType Type
ty        -- Don't need free tyvars
    go (Coercion Coercion
_co)       = NameSet
emptyNameSet -- See wrinkle (ON1) of Note [Finding orphan names]
    go (App CoreExpr
e1 CoreExpr
e2)          = CoreExpr -> NameSet
go CoreExpr
e1 NameSet -> NameSet -> NameSet
`unionNameSet` CoreExpr -> NameSet
go CoreExpr
e2
    go (Lam Var
v CoreExpr
e)            = CoreExpr -> NameSet
go CoreExpr
e NameSet -> Name -> NameSet
`delFromNameSet` Var -> Name
idName Var
v
    go (Tick CoreTickish
_ CoreExpr
e)           = CoreExpr -> NameSet
go CoreExpr
e
    go (Cast CoreExpr
e Coercion
_co)         = CoreExpr -> NameSet
go CoreExpr
e  -- See wrinkle (ON1) of Note [Finding orphan names]
    go (Let (NonRec Var
_ CoreExpr
r) CoreExpr
e) = CoreExpr -> NameSet
go CoreExpr
e NameSet -> NameSet -> NameSet
`unionNameSet` CoreExpr -> NameSet
go CoreExpr
r
    go (Let (Rec [(Var, CoreExpr)]
prs) CoreExpr
e)    = [CoreExpr] -> NameSet
orphNamesOfExprs (((Var, CoreExpr) -> CoreExpr) -> [(Var, CoreExpr)] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map (Var, CoreExpr) -> CoreExpr
forall a b. (a, b) -> b
snd [(Var, CoreExpr)]
prs) NameSet -> NameSet -> NameSet
`unionNameSet` CoreExpr -> NameSet
go CoreExpr
e
    go (Case CoreExpr
e Var
_ Type
ty [Alt Var]
as)     = CoreExpr -> NameSet
go CoreExpr
e NameSet -> NameSet -> NameSet
`unionNameSet` Type -> NameSet
orphNamesOfType Type
ty
                              NameSet -> NameSet -> NameSet
`unionNameSet` [NameSet] -> NameSet
unionNameSets ((Alt Var -> NameSet) -> [Alt Var] -> [NameSet]
forall a b. (a -> b) -> [a] -> [b]
map Alt Var -> NameSet
go_alt [Alt Var]
as)

    go_alt :: Alt Var -> NameSet
go_alt (Alt AltCon
_ [Var]
_ CoreExpr
r)      = CoreExpr -> NameSet
go CoreExpr
r

-- | Finds the free /external/ names of several expressions: see 'exprOrphNames' for details
orphNamesOfExprs :: [CoreExpr] -> NameSet
orphNamesOfExprs :: [CoreExpr] -> NameSet
orphNamesOfExprs [CoreExpr]
es = (CoreExpr -> NameSet -> NameSet)
-> NameSet -> [CoreExpr] -> NameSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (NameSet -> NameSet -> NameSet
unionNameSet (NameSet -> NameSet -> NameSet)
-> (CoreExpr -> NameSet) -> CoreExpr -> NameSet -> NameSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> NameSet
orphNamesOfExpr) NameSet
emptyNameSet [CoreExpr]
es


{-
************************************************************************
*                                                                      *
\section[freevars-everywhere]{Attaching free variables to every sub-expression}
*                                                                      *
************************************************************************
-}

data RuleFVsFrom
  = LhsOnly
  | RhsOnly
  | BothSides

-- | Those locally-defined variables free in the left and/or right hand sides
-- of the rule, depending on the first argument.
ruleFVs :: RuleFVsFrom -> CoreRule -> SelectiveDFV
ruleFVs :: RuleFVsFrom -> CoreRule -> SelectiveDFV
ruleFVs !RuleFVsFrom
_   (BuiltinRule {}) = SelectiveDFV
forall a. Monoid a => a
mempty
ruleFVs RuleFVsFrom
from (Rule { ru_fn :: CoreRule -> Name
ru_fn = Name
_do_not_include
                     -- See Note [Rule free var hack]
                   , ru_bndrs :: CoreRule -> [Var]
ru_bndrs = [Var]
bndrs
                   , ru_rhs :: CoreRule -> CoreExpr
ru_rhs = CoreExpr
rhs, ru_args :: CoreRule -> [CoreExpr]
ru_args = [CoreExpr]
args })
  = [Var] -> SelectiveDFV -> SelectiveDFV
addCoreBndrsFV [Var]
bndrs ([CoreExpr] -> SelectiveDFV
exprsFVs [CoreExpr]
exprs)
  where
    exprs :: [CoreExpr]
exprs = case RuleFVsFrom
from of
      RuleFVsFrom
LhsOnly   -> [CoreExpr]
args
      RuleFVsFrom
RhsOnly   -> [CoreExpr
rhs]
      RuleFVsFrom
BothSides -> CoreExpr
rhsCoreExpr -> [CoreExpr] -> [CoreExpr]
forall a. a -> [a] -> [a]
:[CoreExpr]
args

-- | Those locally-defined variables free in the left and/or right hand sides
-- from several rules, depending on the first argument.
rulesFVs :: RuleFVsFrom -> [CoreRule] -> SelectiveDFV
rulesFVs :: RuleFVsFrom -> [CoreRule] -> SelectiveDFV
rulesFVs RuleFVsFrom
from = (CoreRule -> SelectiveDFV) -> [CoreRule] -> SelectiveDFV
forall (t :: * -> *) acc a env.
(Foldable t, Monoid acc) =>
(a -> FV env acc) -> t a -> FV env acc
mapUnionFV (RuleFVsFrom -> CoreRule -> SelectiveDFV
ruleFVs RuleFVsFrom
from)

-- | Those variables free in the right hand side of a rule returned as a
-- non-deterministic set
ruleRhsFreeVars :: CoreRule -> VarSet
ruleRhsFreeVars :: CoreRule -> VarSet
ruleRhsFreeVars = InterestingVarFun -> SelectiveDFV -> VarSet
runFVSelectiveSet InterestingVarFun
isLocalId (SelectiveDFV -> VarSet)
-> (CoreRule -> SelectiveDFV) -> CoreRule -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleFVsFrom -> CoreRule -> SelectiveDFV
ruleFVs RuleFVsFrom
RhsOnly

-- | Those locally-defined free 'Id's in the right hand side of several rules
-- returned as a non-deterministic set
rulesRhsFreeIds :: [CoreRule] -> VarSet
rulesRhsFreeIds :: [CoreRule] -> VarSet
rulesRhsFreeIds = InterestingVarFun -> SelectiveDFV -> VarSet
runFVSelectiveSet InterestingVarFun
isLocalId (SelectiveDFV -> VarSet)
-> ([CoreRule] -> SelectiveDFV) -> [CoreRule] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleFVsFrom -> [CoreRule] -> SelectiveDFV
rulesFVs RuleFVsFrom
RhsOnly

ruleLhsFreeIds :: CoreRule -> VarSet
-- ^ This finds all locally-defined free Ids on the left hand side of a rule
-- and returns them as a non-deterministic set
ruleLhsFreeIds :: CoreRule -> VarSet
ruleLhsFreeIds = InterestingVarFun -> SelectiveDFV -> VarSet
runFVSelectiveSet InterestingVarFun
isLocalId (SelectiveDFV -> VarSet)
-> (CoreRule -> SelectiveDFV) -> CoreRule -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleFVsFrom -> CoreRule -> SelectiveDFV
ruleFVs RuleFVsFrom
LhsOnly

ruleLhsFreeIdsList :: CoreRule -> [Var]
-- ^ This finds all locally-defined free Ids on the left hand side of a rule
-- and returns them as a deterministically ordered list
ruleLhsFreeIdsList :: CoreRule -> [Var]
ruleLhsFreeIdsList = InterestingVarFun -> SelectiveDFV -> [Var]
runFVSelectiveList InterestingVarFun
isLocalId (SelectiveDFV -> [Var])
-> (CoreRule -> SelectiveDFV) -> CoreRule -> [Var]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleFVsFrom -> CoreRule -> SelectiveDFV
ruleFVs RuleFVsFrom
LhsOnly

-- | Those variables free in the both the left right hand sides of a rule
-- returned as a non-deterministic set
ruleFreeVars :: CoreRule -> VarSet
ruleFreeVars :: CoreRule -> VarSet
ruleFreeVars = InterestingVarFun -> SelectiveDFV -> VarSet
runFVSelectiveSet InterestingVarFun
isLocalVar (SelectiveDFV -> VarSet)
-> (CoreRule -> SelectiveDFV) -> CoreRule -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleFVsFrom -> CoreRule -> SelectiveDFV
ruleFVs RuleFVsFrom
BothSides

-- | Those variables free in the both the left right hand sides of rules
-- returned as a deterministic set
rulesFreeVarsDSet :: [CoreRule] -> DVarSet
rulesFreeVarsDSet :: [CoreRule] -> DVarSet
rulesFreeVarsDSet = InterestingVarFun -> SelectiveDFV -> DVarSet
runFVSelective InterestingVarFun
isLocalVar (SelectiveDFV -> DVarSet)
-> ([CoreRule] -> SelectiveDFV) -> [CoreRule] -> DVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleFVsFrom -> [CoreRule] -> SelectiveDFV
rulesFVs RuleFVsFrom
BothSides

-- | Those variables free in both the left right hand sides of several rules
rulesFreeVars :: [CoreRule] -> VarSet
rulesFreeVars :: [CoreRule] -> VarSet
rulesFreeVars = DVarSet -> VarSet
dVarSetToVarSet (DVarSet -> VarSet)
-> ([CoreRule] -> DVarSet) -> [CoreRule] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CoreRule] -> DVarSet
rulesFreeVarsDSet

-- | Make a 'RuleInfo' containing a number of 'CoreRule's, suitable
-- for putting into an 'IdInfo'
mkRuleInfo :: [CoreRule] -> RuleInfo
mkRuleInfo :: [CoreRule] -> RuleInfo
mkRuleInfo [CoreRule]
rules = [CoreRule] -> DVarSet -> RuleInfo
RuleInfo [CoreRule]
rules ([CoreRule] -> DVarSet
rulesFreeVarsDSet [CoreRule]
rules)

{-
Note [Rule free var hack]  (Not a hack any more)
~~~~~~~~~~~~~~~~~~~~~~~~~
We used not to include the Id in its own rhs free-var set.
Otherwise the occurrence analyser makes bindings recursive:
        f x y = x+y
        RULE:  f (f x y) z  ==>  f x (f y z)
However, the occurrence analyser distinguishes "non-rule loop breakers"
from "rule-only loop breakers" (see BasicTypes.OccInfo).  So it will
put this 'f' in a Rec block, but will mark the binding as a non-rule loop
breaker, which is perfectly inlinable.
-}

{-
************************************************************************
*                                                                      *
          Attaching free variables to every sub-expression

   The free variable pass annotates every node in the expression
   with its DEEP (non-global) free variables and type variables.
*                                                                      *
************************************************************************

Note [The FVAnn invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~
Invariant: a FVAnn, say S, is closed:
  That is: if v is in S,
           then freevars( v's type/kind ) is also in S
So FVAnn computes /deep/ free variables
-}

type FVAnn = DVarSet  -- See Note [The FVAnn invariant]

-- | Every node in a binding group annotated with its
-- (non-global) free variables, both Ids and TyVars, and type.
type CoreBindWithFVs = AnnBind Id FVAnn

-- | Every node in an expression annotated with its
-- (non-global) free variables, both Ids and TyVars, and type.
-- NB: see Note [The FVAnn invariant]
type CoreExprWithFVs  = AnnExpr  Id FVAnn
type CoreExprWithFVs' = AnnExpr' Id FVAnn

-- | Every node in an expression annotated with its
-- (non-global) free variables, both Ids and TyVars, and type.
type CoreAltWithFVs = AnnAlt Id FVAnn

freeVarsOf :: CoreExprWithFVs -> DIdSet
-- ^ Inverse function to 'freeVars'
freeVarsOf :: CoreExprWithFVs -> DVarSet
freeVarsOf (DVarSet
fvs, AnnExpr' Var DVarSet
_) = DVarSet
fvs

-- | Extract the vars reported in a FVAnn
freeVarsOfAnn :: FVAnn -> DIdSet
freeVarsOfAnn :: DVarSet -> DVarSet
freeVarsOfAnn DVarSet
fvs = DVarSet
fvs

aFreeVar :: Var -> DVarSet
aFreeVar :: Var -> DVarSet
aFreeVar = Var -> DVarSet
unitDVarSet

delBindersFV :: [Var] -> DVarSet -> DVarSet
delBindersFV :: [Var] -> DVarSet -> DVarSet
delBindersFV [Var]
bs DVarSet
fvs = (Var -> DVarSet -> DVarSet) -> DVarSet -> [Var] -> DVarSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Var -> DVarSet -> DVarSet
delBinderFV DVarSet
fvs [Var]
bs

delBinderFV :: Var -> DVarSet -> DVarSet
-- This way round, so we can do it multiple times using foldr

-- (b `delBinderFV` s)
--   * removes the binder b from the free variable set s,
--   * AND *adds* to s the free variables of b's type
--
-- This is really important for some lambdas:
--      In (\x::a -> x) the only mention of "a" is in the binder.
--
-- Also in
--      let x::a = b in ...
-- we should really note that "a" is free in this expression.
-- It'll be pinned inside the /\a by the binding for b, but
-- it seems cleaner to make sure that a is in the free-var set
-- when it is mentioned.
--
-- This also shows up in recursive bindings.  Consider:
--      /\a -> letrec x::a = x in E
-- Now, there are no explicit free type variables in the RHS of x,
-- but nevertheless "a" is free in its definition.  So we add in
-- the free tyvars of the types of the binders, and include these in the
-- free vars of the group, attached to the top level of each RHS.
--
-- This actually happened in the defn of errorIO in IOBase.hs:
--      errorIO (ST io) = case (errorIO# io) of
--                          _ -> bottom
--                        where
--                          bottom = bottom -- Never evaluated

delBinderFV :: Var -> DVarSet -> DVarSet
delBinderFV Var
b DVarSet
s = (DVarSet
s DVarSet -> Var -> DVarSet
`delDVarSet` Var
b) DVarSet -> DVarSet -> DVarSet
`unionDVarSet` Var -> DVarSet
dBndrTypeTyCoVars Var
b
        -- Include coercion variables too!

freeVarsBind :: CoreBind
             -> DVarSet                     -- Free vars of scope of binding
             -> (CoreBindWithFVs, DVarSet)  -- Return free vars of binding + scope
freeVarsBind :: CoreBind -> DVarSet -> (CoreBindWithFVs, DVarSet)
freeVarsBind (NonRec Var
binder CoreExpr
rhs) DVarSet
body_fvs
  = ( Var -> CoreExprWithFVs -> CoreBindWithFVs
forall bndr annot. bndr -> AnnExpr bndr annot -> AnnBind bndr annot
AnnNonRec Var
binder CoreExprWithFVs
rhs2
    , CoreExprWithFVs -> DVarSet
freeVarsOf CoreExprWithFVs
rhs2 DVarSet -> DVarSet -> DVarSet
`unionDVarSet` DVarSet
body_fvs2
                      DVarSet -> DVarSet -> DVarSet
`unionDVarSet` Var -> DVarSet
bndrRuleAndUnfoldingVarsDSet Var
binder )
    where
      rhs2 :: CoreExprWithFVs
rhs2      = CoreExpr -> CoreExprWithFVs
freeVars CoreExpr
rhs
      body_fvs2 :: DVarSet
body_fvs2 = Var
binder Var -> DVarSet -> DVarSet
`delBinderFV` DVarSet
body_fvs

freeVarsBind (Rec [(Var, CoreExpr)]
binds) DVarSet
body_fvs
  = ( [(Var, CoreExprWithFVs)] -> CoreBindWithFVs
forall bndr annot.
[(bndr, AnnExpr bndr annot)] -> AnnBind bndr annot
AnnRec ([Var]
binders [Var] -> [CoreExprWithFVs] -> [(Var, CoreExprWithFVs)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [CoreExprWithFVs]
rhss2)
    , [Var] -> DVarSet -> DVarSet
delBindersFV [Var]
binders DVarSet
all_fvs )
  where
    ([Var]
binders, [CoreExpr]
rhss) = [(Var, CoreExpr)] -> ([Var], [CoreExpr])
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzip [(Var, CoreExpr)]
binds
    rhss2 :: [CoreExprWithFVs]
rhss2        = (CoreExpr -> CoreExprWithFVs) -> [CoreExpr] -> [CoreExprWithFVs]
forall a b. (a -> b) -> [a] -> [b]
map CoreExpr -> CoreExprWithFVs
freeVars [CoreExpr]
rhss
    rhs_body_fvs :: DVarSet
rhs_body_fvs = (CoreExprWithFVs -> DVarSet -> DVarSet)
-> DVarSet -> [CoreExprWithFVs] -> DVarSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (DVarSet -> DVarSet -> DVarSet
unionDVarSet (DVarSet -> DVarSet -> DVarSet)
-> (CoreExprWithFVs -> DVarSet)
-> CoreExprWithFVs
-> DVarSet
-> DVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExprWithFVs -> DVarSet
freeVarsOf) DVarSet
body_fvs [CoreExprWithFVs]
rhss2
    binders_fvs :: DVarSet
binders_fvs  = InterestingVarFun -> SelectiveDFV -> DVarSet
runFVSelective InterestingVarFun
isLocalVar (SelectiveDFV -> DVarSet) -> SelectiveDFV -> DVarSet
forall a b. (a -> b) -> a -> b
$ (Var -> SelectiveDFV) -> [Var] -> SelectiveDFV
forall (t :: * -> *) acc a env.
(Foldable t, Monoid acc) =>
(a -> FV env acc) -> t a -> FV env acc
mapUnionFV Var -> SelectiveDFV
bndrRuleAndUnfoldingFVs [Var]
binders
                   -- See Note [The FVAnn invariant]
    all_fvs :: DVarSet
all_fvs      = DVarSet
rhs_body_fvs DVarSet -> DVarSet -> DVarSet
`unionDVarSet` DVarSet
binders_fvs
            -- The "delBinderFV" happens after adding the idSpecVars,
            -- since the latter may add some of the binders as fvs

freeVars :: CoreExpr -> CoreExprWithFVs
-- ^ Annotate a 'CoreExpr' with its (non-global) free type
--   and value variables at every tree node.
freeVars :: CoreExpr -> CoreExprWithFVs
freeVars = CoreExpr -> CoreExprWithFVs
go
  where
    go :: CoreExpr -> CoreExprWithFVs
    go :: CoreExpr -> CoreExprWithFVs
go (Var Var
v)
      | InterestingVarFun
isLocalVar Var
v = (Var -> DVarSet
aFreeVar Var
v DVarSet -> DVarSet -> DVarSet
`unionDVarSet` DVarSet
ty_fvs DVarSet -> DVarSet -> DVarSet
`unionDVarSet` DVarSet
mult_vars, Var -> AnnExpr' Var DVarSet
forall bndr annot. Var -> AnnExpr' bndr annot
AnnVar Var
v)
      | Bool
otherwise    = (DVarSet
emptyDVarSet,                 Var -> AnnExpr' Var DVarSet
forall bndr annot. Var -> AnnExpr' bndr annot
AnnVar Var
v)
      where
        mult_vars :: DVarSet
mult_vars = Type -> DVarSet
tyCoVarsOfTypeDSet (HasDebugCallStack => Var -> Type
Var -> Type
idMult Var
v)
        ty_fvs :: DVarSet
ty_fvs = Var -> DVarSet
dBndrTypeTyCoVars Var
v
                 -- See Note [The FVAnn invariant]

    go (Lit Literal
lit) = (DVarSet
emptyDVarSet, Literal -> AnnExpr' Var DVarSet
forall bndr annot. Literal -> AnnExpr' bndr annot
AnnLit Literal
lit)
    go (Lam Var
b CoreExpr
body)
      = ( DVarSet
b_fvs DVarSet -> DVarSet -> DVarSet
`unionDVarSet` (Var
b Var -> DVarSet -> DVarSet
`delBinderFV` DVarSet
body_fvs)
        , Var -> CoreExprWithFVs -> AnnExpr' Var DVarSet
forall bndr annot.
bndr -> AnnExpr bndr annot -> AnnExpr' bndr annot
AnnLam Var
b CoreExprWithFVs
body' )
      where
        body' :: CoreExprWithFVs
body'@(DVarSet
body_fvs, AnnExpr' Var DVarSet
_) = CoreExpr -> CoreExprWithFVs
go CoreExpr
body
        b_ty :: Type
b_ty  = Var -> Type
idType Var
b
        b_fvs :: DVarSet
b_fvs = Type -> DVarSet
tyCoVarsOfTypeDSet Type
b_ty
                -- See Note [The FVAnn invariant]

    go (App CoreExpr
fun CoreExpr
arg)
      = ( CoreExprWithFVs -> DVarSet
freeVarsOf CoreExprWithFVs
fun' DVarSet -> DVarSet -> DVarSet
`unionDVarSet` CoreExprWithFVs -> DVarSet
freeVarsOf CoreExprWithFVs
arg'
        , CoreExprWithFVs -> CoreExprWithFVs -> AnnExpr' Var DVarSet
forall bndr annot.
AnnExpr bndr annot -> AnnExpr bndr annot -> AnnExpr' bndr annot
AnnApp CoreExprWithFVs
fun' CoreExprWithFVs
arg' )
      where
        fun' :: CoreExprWithFVs
fun'   = CoreExpr -> CoreExprWithFVs
go CoreExpr
fun
        arg' :: CoreExprWithFVs
arg'   = CoreExpr -> CoreExprWithFVs
go CoreExpr
arg

    go (Case CoreExpr
scrut Var
bndr Type
ty [Alt Var]
alts)
      = ( (Var
bndr Var -> DVarSet -> DVarSet
`delBinderFV` DVarSet
alts_fvs)
           DVarSet -> DVarSet -> DVarSet
`unionDVarSet` CoreExprWithFVs -> DVarSet
freeVarsOf CoreExprWithFVs
scrut2
           DVarSet -> DVarSet -> DVarSet
`unionDVarSet` Type -> DVarSet
tyCoVarsOfTypeDSet Type
ty
          -- Don't need to look at (idType bndr)
          -- because that's redundant with scrut
        , CoreExprWithFVs
-> Var -> Type -> [AnnAlt Var DVarSet] -> AnnExpr' Var DVarSet
forall bndr annot.
AnnExpr bndr annot
-> bndr -> Type -> [AnnAlt bndr annot] -> AnnExpr' bndr annot
AnnCase CoreExprWithFVs
scrut2 Var
bndr Type
ty [AnnAlt Var DVarSet]
alts2 )
      where
        scrut2 :: CoreExprWithFVs
scrut2 = CoreExpr -> CoreExprWithFVs
go CoreExpr
scrut

        ([DVarSet]
alts_fvs_s, [AnnAlt Var DVarSet]
alts2) = (Alt Var -> (DVarSet, AnnAlt Var DVarSet))
-> [Alt Var] -> ([DVarSet], [AnnAlt Var DVarSet])
forall a b c. (a -> (b, c)) -> [a] -> ([b], [c])
mapAndUnzip Alt Var -> (DVarSet, AnnAlt Var DVarSet)
fv_alt [Alt Var]
alts
        alts_fvs :: DVarSet
alts_fvs            = [DVarSet] -> DVarSet
unionDVarSets [DVarSet]
alts_fvs_s

        fv_alt :: Alt Var -> (DVarSet, AnnAlt Var DVarSet)
fv_alt (Alt AltCon
con [Var]
args CoreExpr
rhs) = ([Var] -> DVarSet -> DVarSet
delBindersFV [Var]
args (CoreExprWithFVs -> DVarSet
freeVarsOf CoreExprWithFVs
rhs2),
                                     (AltCon -> [Var] -> CoreExprWithFVs -> AnnAlt Var DVarSet
forall bndr annot.
AltCon -> [bndr] -> AnnExpr bndr annot -> AnnAlt bndr annot
AnnAlt AltCon
con [Var]
args CoreExprWithFVs
rhs2))
                              where
                                 rhs2 :: CoreExprWithFVs
rhs2 = CoreExpr -> CoreExprWithFVs
go CoreExpr
rhs

    go (Let CoreBind
bind CoreExpr
body)
      = (DVarSet
bind_fvs, CoreBindWithFVs -> CoreExprWithFVs -> AnnExpr' Var DVarSet
forall bndr annot.
AnnBind bndr annot -> AnnExpr bndr annot -> AnnExpr' bndr annot
AnnLet CoreBindWithFVs
bind2 CoreExprWithFVs
body2)
      where
        (CoreBindWithFVs
bind2, DVarSet
bind_fvs) = CoreBind -> DVarSet -> (CoreBindWithFVs, DVarSet)
freeVarsBind CoreBind
bind (CoreExprWithFVs -> DVarSet
freeVarsOf CoreExprWithFVs
body2)
        body2 :: CoreExprWithFVs
body2             = CoreExpr -> CoreExprWithFVs
go CoreExpr
body

    go (Cast CoreExpr
expr Coercion
co)
      = ( CoreExprWithFVs -> DVarSet
freeVarsOf CoreExprWithFVs
expr2 DVarSet -> DVarSet -> DVarSet
`unionDVarSet` DVarSet
cfvs
        , CoreExprWithFVs -> (DVarSet, Coercion) -> AnnExpr' Var DVarSet
forall bndr annot.
AnnExpr bndr annot -> (annot, Coercion) -> AnnExpr' bndr annot
AnnCast CoreExprWithFVs
expr2 (DVarSet
cfvs, Coercion
co) )
      where
        expr2 :: CoreExprWithFVs
expr2 = CoreExpr -> CoreExprWithFVs
go CoreExpr
expr
        cfvs :: DVarSet
cfvs  = Coercion -> DVarSet
tyCoVarsOfCoDSet Coercion
co

    go (Tick CoreTickish
tickish CoreExpr
expr)
      = ( CoreTickish -> DVarSet
forall {pass :: TickishPass}.
(XTickishId pass ~ Var) =>
GenTickish pass -> DVarSet
tickishFVs CoreTickish
tickish DVarSet -> DVarSet -> DVarSet
`unionDVarSet` CoreExprWithFVs -> DVarSet
freeVarsOf CoreExprWithFVs
expr2
        , CoreTickish -> CoreExprWithFVs -> AnnExpr' Var DVarSet
forall bndr annot.
CoreTickish -> AnnExpr bndr annot -> AnnExpr' bndr annot
AnnTick CoreTickish
tickish CoreExprWithFVs
expr2 )
      where
        expr2 :: CoreExprWithFVs
expr2 = CoreExpr -> CoreExprWithFVs
go CoreExpr
expr
        tickishFVs :: GenTickish pass -> DVarSet
tickishFVs (Breakpoint XBreakpoint pass
_ BreakpointId
_ [XTickishId pass]
ids) = [Var] -> DVarSet
mkDVarSet [Var]
[XTickishId pass]
ids
        tickishFVs GenTickish pass
_                    = DVarSet
emptyDVarSet

    go (Type Type
ty)     = (Type -> DVarSet
tyCoVarsOfTypeDSet Type
ty, Type -> AnnExpr' Var DVarSet
forall bndr annot. Type -> AnnExpr' bndr annot
AnnType Type
ty)
    go (Coercion Coercion
co) = (Coercion -> DVarSet
tyCoVarsOfCoDSet Coercion
co, Coercion -> AnnExpr' Var DVarSet
forall bndr annot. Coercion -> AnnExpr' bndr annot
AnnCoercion Coercion
co)