{-
(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 free variables of expressions
        InterestingVarFun,
        exprSomeFreeVars, exprsSomeFreeVars,
        exprSomeFreeVarsList, exprsSomeFreeVarsList,

        -- * Free variables of Rules, Vars and Ids
        varTypeTyCoVars,
        varTypeTyCoFVs,
        idUnfoldingVars, idFreeVars, dIdFreeVars,
        bndrRuleAndUnfoldingVarsDSet,
        bndrRuleAndUnfoldingIds,
        idFVs,
        idRuleVars, stableUnfoldingVars,
        ruleFreeVars, rulesFreeVars,
        rulesFreeVarsDSet, mkRuleInfo,
        ruleLhsFreeIds, ruleLhsFreeIdsList,
        ruleRhsFreeVars, rulesRhsFreeIds,

        exprFVs,

        -- * 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.Set
import GHC.Types.Var
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.FV as FV
import GHC.Utils.Misc
import GHC.Utils.Panic.Plain

{-
************************************************************************
*                                                                      *
\section{Finding the free variables of an expression}
*                                                                      *
************************************************************************

This function simply finds the 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 occurrence.
-}

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

-- | Find all locally-defined free Ids or type variables in an expression
-- returning a composable FV computation. See Note [FV naming conventions] in "GHC.Utils.FV"
-- for why export it.
exprFVs :: CoreExpr -> FV
exprFVs :: CoreExpr -> FV
exprFVs = InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
isLocalVar (FV -> FV) -> (CoreExpr -> FV) -> CoreExpr -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> FV
expr_fvs

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

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

-- | Find all locally-defined free Ids in an expression
exprFreeIds :: CoreExpr -> IdSet        -- Find all locally-defined free Ids
exprFreeIds :: CoreExpr -> VarSet
exprFreeIds = InterestingVarFun -> CoreExpr -> VarSet
exprSomeFreeVars InterestingVarFun
isLocalId

exprsFreeIds :: [CoreExpr] -> IdSet        -- Find all locally-defined free Ids
exprsFreeIds :: [CoreExpr] -> VarSet
exprsFreeIds = InterestingVarFun -> [CoreExpr] -> VarSet
exprsSomeFreeVars InterestingVarFun
isLocalId

-- | 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 -> CoreExpr -> DVarSet
exprSomeFreeVarsDSet InterestingVarFun
isLocalId

-- | 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 = InterestingVarFun -> CoreExpr -> [Var]
exprSomeFreeVarsList InterestingVarFun
isLocalId

-- | 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 -> [CoreExpr] -> DVarSet
exprsSomeFreeVarsDSet InterestingVarFun
isLocalId

-- | 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 = InterestingVarFun -> [CoreExpr] -> [Var]
exprsSomeFreeVarsList InterestingVarFun
isLocalId

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

-- | Find all locally-defined free Ids or type variables in several expressions
-- returning a composable FV computation. See Note [FV naming conventions] in "GHC.Utils.FV"
-- for why export it.
exprsFVs :: [CoreExpr] -> FV
exprsFVs :: [CoreExpr] -> FV
exprsFVs [CoreExpr]
exprs = (CoreExpr -> FV) -> [CoreExpr] -> FV
forall a. (a -> FV) -> [a] -> FV
mapUnionFV CoreExpr -> FV
exprFVs [CoreExpr]
exprs

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

-- | Find all locally defined free Ids in a binding group
bindFreeVars :: CoreBind -> VarSet
bindFreeVars :: CoreBind -> VarSet
bindFreeVars (NonRec Var
b CoreExpr
r) = FV -> VarSet
fvVarSet (FV -> VarSet) -> FV -> VarSet
forall a b. (a -> b) -> a -> b
$ InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
isLocalVar (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ (Var, CoreExpr) -> FV
rhs_fvs (Var
b,CoreExpr
r)
bindFreeVars (Rec [(Var, CoreExpr)]
prs)    = FV -> VarSet
fvVarSet (FV -> VarSet) -> FV -> VarSet
forall a b. (a -> b) -> a -> b
$ InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
isLocalVar (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$
                                [Var] -> FV -> FV
addBndrs (((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)
                                     (((Var, CoreExpr) -> FV) -> [(Var, CoreExpr)] -> FV
forall a. (a -> FV) -> [a] -> FV
mapUnionFV (Var, CoreExpr) -> FV
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 CoreExpr
e = FV -> VarSet
fvVarSet (FV -> VarSet) -> FV -> VarSet
forall a b. (a -> b) -> a -> b
$ InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
fv_cand (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ CoreExpr -> FV
expr_fvs CoreExpr
e

-- | 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 CoreExpr
e = FV -> [Var]
fvVarList (FV -> [Var]) -> FV -> [Var]
forall a b. (a -> b) -> a -> b
$ InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
fv_cand (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ CoreExpr -> FV
expr_fvs CoreExpr
e

-- | 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 CoreExpr
e = FV -> DVarSet
fvDVarSet (FV -> DVarSet) -> FV -> DVarSet
forall a b. (a -> b) -> a -> b
$ InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
fv_cand (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ CoreExpr -> FV
expr_fvs CoreExpr
e

-- | 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 [CoreExpr]
es =
  FV -> VarSet
fvVarSet (FV -> VarSet) -> FV -> VarSet
forall a b. (a -> b) -> a -> b
$ InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
fv_cand (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ (CoreExpr -> FV) -> [CoreExpr] -> FV
forall a. (a -> FV) -> [a] -> FV
mapUnionFV CoreExpr -> FV
expr_fvs [CoreExpr]
es

-- | 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 [CoreExpr]
es =
  FV -> [Var]
fvVarList (FV -> [Var]) -> FV -> [Var]
forall a b. (a -> b) -> a -> b
$ InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
fv_cand (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ (CoreExpr -> FV) -> [CoreExpr] -> FV
forall a. (a -> FV) -> [a] -> FV
mapUnionFV CoreExpr -> FV
expr_fvs [CoreExpr]
es

-- | 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 [CoreExpr]
e =
  FV -> DVarSet
fvDVarSet (FV -> DVarSet) -> FV -> DVarSet
forall a b. (a -> b) -> a -> b
$ InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
fv_cand (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ (CoreExpr -> FV) -> [CoreExpr] -> FV
forall a. (a -> FV) -> [a] -> FV
mapUnionFV CoreExpr -> FV
expr_fvs [CoreExpr]
e

--      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

addBndr :: CoreBndr -> FV -> FV
addBndr :: Var -> FV -> FV
addBndr Var
bndr FV
fv InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc
  = (Var -> FV
varTypeTyCoFVs Var
bndr FV -> FV -> FV
`unionFV`
        -- Include type variables in the binder's type
        --      (not just Ids; coercion variables too!)
     Var -> FV -> FV
FV.delFV Var
bndr FV
fv) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc

addBndrs :: [CoreBndr] -> FV -> FV
addBndrs :: [Var] -> FV -> FV
addBndrs [Var]
bndrs FV
fv = (Var -> FV -> FV) -> FV -> [Var] -> FV
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Var -> FV -> FV
addBndr FV
fv [Var]
bndrs

expr_fvs :: CoreExpr -> FV
expr_fvs :: CoreExpr -> FV
expr_fvs (Type Type
ty) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc =
  Type -> FV
tyCoFVsOfType Type
ty InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc
expr_fvs (Coercion Coercion
co) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc =
  Coercion -> FV
tyCoFVsOfCo Coercion
co InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc
expr_fvs (Var Var
var) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc = Var -> FV
FV.unitFV Var
var InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc
expr_fvs (Lit Literal
_) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc = FV
emptyFV InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc
expr_fvs (Tick CoreTickish
t CoreExpr
expr) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc =
  (CoreTickish -> FV
tickish_fvs CoreTickish
t FV -> FV -> FV
`unionFV` CoreExpr -> FV
expr_fvs CoreExpr
expr) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc
expr_fvs (App CoreExpr
fun CoreExpr
arg) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc =
  (CoreExpr -> FV
expr_fvs CoreExpr
fun FV -> FV -> FV
`unionFV` CoreExpr -> FV
expr_fvs CoreExpr
arg) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc
expr_fvs (Lam Var
bndr CoreExpr
body) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc =
  Var -> FV -> FV
addBndr Var
bndr (CoreExpr -> FV
expr_fvs CoreExpr
body) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc
expr_fvs (Cast CoreExpr
expr Coercion
co) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc =
  (CoreExpr -> FV
expr_fvs CoreExpr
expr FV -> FV -> FV
`unionFV` Coercion -> FV
tyCoFVsOfCo Coercion
co) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc

expr_fvs (Case CoreExpr
scrut Var
bndr Type
ty [Alt Var]
alts) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc
  = (CoreExpr -> FV
expr_fvs CoreExpr
scrut FV -> FV -> FV
`unionFV` Type -> FV
tyCoFVsOfType Type
ty FV -> FV -> FV
`unionFV` Var -> FV -> FV
addBndr Var
bndr
      ((Alt Var -> FV) -> [Alt Var] -> FV
forall a. (a -> FV) -> [a] -> FV
mapUnionFV Alt Var -> FV
alt_fvs [Alt Var]
alts)) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc
  where
    alt_fvs :: Alt Var -> FV
alt_fvs (Alt AltCon
_ [Var]
bndrs CoreExpr
rhs) = [Var] -> FV -> FV
addBndrs [Var]
bndrs (CoreExpr -> FV
expr_fvs CoreExpr
rhs)

expr_fvs (Let (NonRec Var
bndr CoreExpr
rhs) CoreExpr
body) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc
  = ((Var, CoreExpr) -> FV
rhs_fvs (Var
bndr, CoreExpr
rhs) FV -> FV -> FV
`unionFV` Var -> FV -> FV
addBndr Var
bndr (CoreExpr -> FV
expr_fvs CoreExpr
body))
      InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc

expr_fvs (Let (Rec [(Var, CoreExpr)]
pairs) CoreExpr
body) InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc
  = [Var] -> FV -> FV
addBndrs (((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)
             (((Var, CoreExpr) -> FV) -> [(Var, CoreExpr)] -> FV
forall a. (a -> FV) -> [a] -> FV
mapUnionFV (Var, CoreExpr) -> FV
rhs_fvs [(Var, CoreExpr)]
pairs FV -> FV -> FV
`unionFV` CoreExpr -> FV
expr_fvs CoreExpr
body)
               InterestingVarFun
fv_cand VarSet
in_scope VarAcc
acc

---------
rhs_fvs :: (Id, CoreExpr) -> FV
rhs_fvs :: (Var, CoreExpr) -> FV
rhs_fvs (Var
bndr, CoreExpr
rhs) = CoreExpr -> FV
expr_fvs CoreExpr
rhs FV -> FV -> FV
`unionFV`
                      Var -> FV
bndrRuleAndUnfoldingFVs Var
bndr
        -- Treat any RULES as extra RHSs of the binding

---------
exprs_fvs :: [CoreExpr] -> FV
exprs_fvs :: [CoreExpr] -> FV
exprs_fvs [CoreExpr]
exprs = (CoreExpr -> FV) -> [CoreExpr] -> FV
forall a. (a -> FV) -> [a] -> FV
mapUnionFV CoreExpr -> FV
expr_fvs [CoreExpr]
exprs

tickish_fvs :: CoreTickish -> FV
tickish_fvs :: CoreTickish -> FV
tickish_fvs (Breakpoint XBreakpoint 'TickishPassCore
_ Int
_ [XTickishId 'TickishPassCore]
ids Module
_) = [Var] -> FV
FV.mkFVs [Var]
[XTickishId 'TickishPassCore]
ids
tickish_fvs CoreTickish
_ = FV
emptyFV

{- **********************************************************************
%*                                                                      *
                    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. Returns an 'FV' computation.
ruleFVs :: RuleFVsFrom -> CoreRule -> FV
ruleFVs :: RuleFVsFrom -> CoreRule -> FV
ruleFVs !RuleFVsFrom
_   (BuiltinRule {}) = FV
emptyFV
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 })
  = InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
isLocalVar (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ [Var] -> FV -> FV
addBndrs [Var]
bndrs ([CoreExpr] -> FV
exprs_fvs [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.
-- Returns an 'FV' computation.
rulesFVs :: RuleFVsFrom -> [CoreRule] -> FV
rulesFVs :: RuleFVsFrom -> [CoreRule] -> FV
rulesFVs RuleFVsFrom
from = (CoreRule -> FV) -> [CoreRule] -> FV
forall a. (a -> FV) -> [a] -> FV
mapUnionFV (RuleFVsFrom -> CoreRule -> FV
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 = FV -> VarSet
fvVarSet (FV -> VarSet) -> (CoreRule -> FV) -> CoreRule -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleFVsFrom -> CoreRule -> FV
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 = FV -> VarSet
fvVarSet (FV -> VarSet) -> ([CoreRule] -> FV) -> [CoreRule] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
isLocalId (FV -> FV) -> ([CoreRule] -> FV) -> [CoreRule] -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleFVsFrom -> [CoreRule] -> FV
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 = FV -> VarSet
fvVarSet (FV -> VarSet) -> (CoreRule -> FV) -> CoreRule -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
isLocalId (FV -> FV) -> (CoreRule -> FV) -> CoreRule -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleFVsFrom -> CoreRule -> FV
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 = FV -> [Var]
fvVarList (FV -> [Var]) -> (CoreRule -> FV) -> CoreRule -> [Var]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
isLocalId (FV -> FV) -> (CoreRule -> FV) -> CoreRule -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleFVsFrom -> CoreRule -> FV
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 = FV -> VarSet
fvVarSet (FV -> VarSet) -> (CoreRule -> FV) -> CoreRule -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleFVsFrom -> CoreRule -> FV
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 [CoreRule]
rules = FV -> DVarSet
fvDVarSet (FV -> DVarSet) -> FV -> DVarSet
forall a b. (a -> b) -> a -> b
$ RuleFVsFrom -> [CoreRule] -> FV
rulesFVs RuleFVsFrom
BothSides [CoreRule]
rules

-- | Those variables free in both the left right hand sides of several rules
rulesFreeVars :: [CoreRule] -> VarSet
rulesFreeVars :: [CoreRule] -> VarSet
rulesFreeVars [CoreRule]
rules = FV -> VarSet
fvVarSet (FV -> VarSet) -> FV -> VarSet
forall a b. (a -> b) -> a -> b
$ RuleFVsFrom -> [CoreRule] -> FV
rulesFVs RuleFVsFrom
BothSides [CoreRule]
rules

-- | 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.
-}

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

The free variable pass annotates every node in the expression with its
NON-GLOBAL free variables and type variables.
-}

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

{- 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
-}

-- | 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

unionFVs :: DVarSet -> DVarSet -> DVarSet
unionFVs :: DVarSet -> DVarSet -> DVarSet
unionFVs = DVarSet -> DVarSet -> DVarSet
unionDVarSet

unionFVss :: [DVarSet] -> DVarSet
unionFVss :: [DVarSet] -> DVarSet
unionFVss = [DVarSet] -> DVarSet
unionDVarSets

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
`unionFVs` Var -> DVarSet
dVarTypeTyCoVars Var
b
        -- Include coercion variables too!

varTypeTyCoVars :: Var -> TyCoVarSet
-- Find the type/kind variables free in the type of the id/tyvar
varTypeTyCoVars :: Var -> VarSet
varTypeTyCoVars Var
var = FV -> VarSet
fvVarSet (FV -> VarSet) -> FV -> VarSet
forall a b. (a -> b) -> a -> b
$ Var -> FV
varTypeTyCoFVs Var
var

dVarTypeTyCoVars :: Var -> DTyCoVarSet
-- Find the type/kind/coercion variables free in the type of the id/tyvar
dVarTypeTyCoVars :: Var -> DVarSet
dVarTypeTyCoVars Var
var = FV -> DVarSet
fvDVarSet (FV -> DVarSet) -> FV -> DVarSet
forall a b. (a -> b) -> a -> b
$ Var -> FV
varTypeTyCoFVs Var
var

varTypeTyCoFVs :: Var -> FV
-- Find the free variables of a binder.
-- In the case of ids, don't forget the multiplicity field!
varTypeTyCoFVs :: Var -> FV
varTypeTyCoFVs Var
var
  = Type -> FV
tyCoFVsOfType (Var -> Type
varType Var
var) FV -> FV -> FV
`unionFV` FV
mult_fvs
  where
    mult_fvs :: FV
mult_fvs = case Var -> Maybe Type
varMultMaybe Var
var of
                 Just Type
mult -> Type -> FV
tyCoFVsOfType Type
mult
                 Maybe Type
Nothing   -> FV
emptyFV

idFreeVars :: Id -> VarSet
idFreeVars :: Var -> VarSet
idFreeVars 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
$ FV -> VarSet
fvVarSet (FV -> VarSet) -> FV -> VarSet
forall a b. (a -> b) -> a -> b
$ Var -> FV
idFVs Var
id

dIdFreeVars :: Id -> DVarSet
dIdFreeVars :: Var -> DVarSet
dIdFreeVars Var
id = FV -> DVarSet
fvDVarSet (FV -> DVarSet) -> FV -> DVarSet
forall a b. (a -> b) -> a -> b
$ Var -> FV
idFVs Var
id

idFVs :: Id -> FV
-- Type variables, rule variables, and inline variables
idFVs :: Var -> FV
idFVs Var
id = Bool -> FV -> FV
forall a. HasCallStack => Bool -> a -> a
assert (InterestingVarFun
isId Var
id) (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$
           Var -> FV
varTypeTyCoFVs Var
id FV -> FV -> FV
`unionFV`
           Var -> FV
bndrRuleAndUnfoldingFVs Var
id

bndrRuleAndUnfoldingVarsDSet :: Id -> DVarSet
bndrRuleAndUnfoldingVarsDSet :: Var -> DVarSet
bndrRuleAndUnfoldingVarsDSet Var
id = FV -> DVarSet
fvDVarSet (FV -> DVarSet) -> FV -> DVarSet
forall a b. (a -> b) -> a -> b
$ Var -> FV
bndrRuleAndUnfoldingFVs Var
id

bndrRuleAndUnfoldingIds :: Id -> IdSet
bndrRuleAndUnfoldingIds :: Var -> VarSet
bndrRuleAndUnfoldingIds Var
id = FV -> VarSet
fvVarSet (FV -> VarSet) -> FV -> VarSet
forall a b. (a -> b) -> a -> b
$ InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
isId (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ Var -> FV
bndrRuleAndUnfoldingFVs Var
id

bndrRuleAndUnfoldingFVs :: Id -> FV
bndrRuleAndUnfoldingFVs :: Var -> FV
bndrRuleAndUnfoldingFVs Var
id
  | InterestingVarFun
isId Var
id   = Var -> FV
idRuleFVs Var
id FV -> FV -> FV
`unionFV` Var -> FV
idUnfoldingFVs Var
id
  | Bool
otherwise = FV
emptyFV

idRuleVars ::Id -> VarSet  -- Does *not* include CoreUnfolding vars
idRuleVars :: Var -> VarSet
idRuleVars Var
id = FV -> VarSet
fvVarSet (FV -> VarSet) -> FV -> VarSet
forall a b. (a -> b) -> a -> b
$ Var -> FV
idRuleFVs Var
id

idRuleFVs :: Id -> FV
idRuleFVs :: Var -> FV
idRuleFVs Var
id = Bool -> FV -> FV
forall a. HasCallStack => Bool -> a -> a
assert (InterestingVarFun
isId Var
id) (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$
  [Var] -> FV
FV.mkFVs (DVarSet -> [Var]
dVarSetElems (DVarSet -> [Var]) -> DVarSet -> [Var]
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 Var
id = FV -> VarSet
fvVarSet (FV -> VarSet) -> FV -> VarSet
forall a b. (a -> b) -> a -> b
$ Var -> FV
idUnfoldingFVs Var
id

idUnfoldingFVs :: Id -> FV
idUnfoldingFVs :: Var -> FV
idUnfoldingFVs Var
id = Unfolding -> Maybe FV
stableUnfoldingFVs (Var -> Unfolding
realIdUnfolding Var
id) Maybe FV -> FV -> FV
forall a. Maybe a -> a -> a
`orElse` FV
emptyFV

stableUnfoldingVars :: Unfolding -> Maybe VarSet
stableUnfoldingVars :: Unfolding -> Maybe VarSet
stableUnfoldingVars Unfolding
unf = FV -> VarSet
fvVarSet (FV -> VarSet) -> Maybe FV -> Maybe VarSet
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Unfolding -> Maybe FV
stableUnfoldingFVs Unfolding
unf

stableUnfoldingFVs :: Unfolding -> Maybe FV
stableUnfoldingFVs :: Unfolding -> Maybe FV
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
         -> FV -> Maybe FV
forall a. a -> Maybe a
Just (InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
isLocalVar (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ CoreExpr -> FV
expr_fvs CoreExpr
rhs)
      DFunUnfolding { df_bndrs :: Unfolding -> [Var]
df_bndrs = [Var]
bndrs, df_args :: Unfolding -> [CoreExpr]
df_args = [CoreExpr]
args }
         -> FV -> Maybe FV
forall a. a -> Maybe a
Just (InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
isLocalVar (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ VarSet -> FV -> FV
FV.delFVs ([Var] -> VarSet
mkVarSet [Var]
bndrs) (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ [CoreExpr] -> FV
exprs_fvs [CoreExpr]
args)
            -- DFuns are top level, so no fvs from types of bndrs
      Unfolding
_other -> Maybe FV
forall a. Maybe a
Nothing


{-
************************************************************************
*                                                                      *
\subsection{Free variables (and types)}
*                                                                      *
************************************************************************
-}

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
`unionFVs` DVarSet
body_fvs2
                      DVarSet -> DVarSet -> DVarSet
`unionFVs` 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 a b. [(a, b)] -> ([a], [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
unionFVs (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  = FV -> DVarSet
fvDVarSet (FV -> DVarSet) -> FV -> DVarSet
forall a b. (a -> b) -> a -> b
$ (Var -> FV) -> [Var] -> FV
forall a. (a -> FV) -> [a] -> FV
mapUnionFV Var -> FV
bndrRuleAndUnfoldingFVs [Var]
binders
                   -- See Note [The FVAnn invariant]
    all_fvs :: DVarSet
all_fvs      = DVarSet
rhs_body_fvs DVarSet -> DVarSet -> DVarSet
`unionFVs` 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
`unionFVs` DVarSet
ty_fvs DVarSet -> DVarSet -> DVarSet
`unionFVs` 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
dVarTypeTyCoVars 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
`unionFVs` (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
`unionFVs` 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
`unionFVs` CoreExprWithFVs -> DVarSet
freeVarsOf CoreExprWithFVs
scrut2
           DVarSet -> DVarSet -> DVarSet
`unionFVs` 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
unionFVss [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
`unionFVs` 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
`unionFVs` 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
_ Int
_ [XTickishId pass]
ids Module
_) = [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)