{-
(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 CPP #-}

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

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

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

        expr_fvs,

        -- * Orphan names
        orphNamesOfType, orphNamesOfCo, orphNamesOfAxiom,
        orphNamesOfTypes, orphNamesOfCoCon,
        exprsOrphNames, orphNamesOfFamInst,

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

#include "HsVersions.h"

import GhcPrelude

import CoreSyn
import Id
import IdInfo
import NameSet
import UniqSet
import Unique (Uniquable (..))
import Name
import VarSet
import Var
import Type
import TyCoRep
import TyCoFVs
import TyCon
import CoAxiom
import FamInstEnv
import TysPrim( funTyConName )
import Maybes( orElse )
import Util
import BasicTypes( Activation )
import Outputable
import FV

{-
************************************************************************
*                                                                      *
\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 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

-- | 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 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 obselete 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 ([Var], VarSet)
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 ([Var], VarSet)
acc

addBndrs :: [CoreBndr] -> FV -> FV
addBndrs :: [Var] -> FV -> FV
addBndrs [Var]
bndrs FV
fv = (Var -> FV -> FV) -> FV -> [Var] -> FV
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 ([Var], VarSet)
acc =
  Type -> FV
tyCoFVsOfType Type
ty InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc
expr_fvs (Coercion Coercion
co) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc =
  Coercion -> FV
tyCoFVsOfCo Coercion
co InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc
expr_fvs (Var Var
var) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc = Var -> FV
FV.unitFV Var
var InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc
expr_fvs (Lit Literal
_) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc = FV
emptyFV InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc
expr_fvs (Tick Tickish Var
t CoreExpr
expr) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc =
  (Tickish Var -> FV
tickish_fvs Tickish Var
t FV -> FV -> FV
`unionFV` CoreExpr -> FV
expr_fvs CoreExpr
expr) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc
expr_fvs (App CoreExpr
fun CoreExpr
arg) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc =
  (CoreExpr -> FV
expr_fvs CoreExpr
fun FV -> FV -> FV
`unionFV` CoreExpr -> FV
expr_fvs CoreExpr
arg) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc
expr_fvs (Lam Var
bndr CoreExpr
body) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc =
  Var -> FV -> FV
addBndr Var
bndr (CoreExpr -> FV
expr_fvs CoreExpr
body) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc
expr_fvs (Cast CoreExpr
expr Coercion
co) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc =
  (CoreExpr -> FV
expr_fvs CoreExpr
expr FV -> FV -> FV
`unionFV` Coercion -> FV
tyCoFVsOfCo Coercion
co) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc

expr_fvs (Case CoreExpr
scrut Var
bndr Type
ty [Alt Var]
alts) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
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
forall a. (a, [Var], CoreExpr) -> FV
alt_fvs [Alt Var]
alts)) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
acc
  where
    alt_fvs :: (a, [Var], CoreExpr) -> FV
alt_fvs (a
_, [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 ([Var], VarSet)
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 ([Var], VarSet)
acc

expr_fvs (Let (Rec [(Var, CoreExpr)]
pairs) CoreExpr
body) InterestingVarFun
fv_cand VarSet
in_scope ([Var], VarSet)
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 ([Var], VarSet)
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 :: Tickish Id -> FV
tickish_fvs :: Tickish Var -> FV
tickish_fvs (Breakpoint Int
_ [Var]
ids) = [Var] -> FV
FV.mkFVs [Var]
ids
tickish_fvs Tickish Var
_ = FV
emptyFV

{-
************************************************************************
*                                                                      *
\section{Free names}
*                                                                      *
************************************************************************
-}

-- | Finds the free /external/ names of an expression, notably
-- including the names of type constructors (which of course do not show
-- up in 'exprFreeVars').
exprOrphNames :: CoreExpr -> NameSet
-- There's no need to delete local binders, because they will all
-- be /internal/ names.
exprOrphNames :: CoreExpr -> NameSet
exprOrphNames 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)        = Coercion -> NameSet
orphNamesOfCo Coercion
co
    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 Tickish Var
_ CoreExpr
e)           = CoreExpr -> NameSet
go CoreExpr
e
    go (Cast CoreExpr
e Coercion
co)          = CoreExpr -> NameSet
go CoreExpr
e NameSet -> NameSet -> NameSet
`unionNameSet` Coercion -> NameSet
orphNamesOfCo Coercion
co
    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
exprsOrphNames (((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 (AltCon
_,[Var]
_,CoreExpr
r) = CoreExpr -> NameSet
go CoreExpr
r

-- | Finds the free /external/ names of several expressions: see 'exprOrphNames' for details
exprsOrphNames :: [CoreExpr] -> NameSet
exprsOrphNames :: [CoreExpr] -> NameSet
exprsOrphNames [CoreExpr]
es = (CoreExpr -> NameSet -> NameSet)
-> NameSet -> [CoreExpr] -> NameSet
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
exprOrphNames) NameSet
emptyNameSet [CoreExpr]
es


{- **********************************************************************
%*                                                                      *
                    orphNamesXXX

%*                                                                      *
%********************************************************************* -}

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 (TyConApp TyCon
tycon [Type]
tys) = TyCon -> NameSet
orphNamesOfTyCon TyCon
tycon
                                       NameSet -> NameSet -> NameSet
`unionNameSet` [Type] -> NameSet
orphNamesOfTypes [Type]
tys
orphNamesOfType (ForAllTy TyCoVarBinder
bndr Type
res)  = Type -> NameSet
orphNamesOfType (TyCoVarBinder -> Type
forall argf. VarBndr Var argf -> Type
binderType TyCoVarBinder
bndr)
                                       NameSet -> NameSet -> NameSet
`unionNameSet` Type -> NameSet
orphNamesOfType Type
res
orphNamesOfType (FunTy AnonArgFlag
_ Type
arg Type
res)    = Name -> NameSet
unitNameSet Name
funTyConName    -- NB!  See #8535
                                       NameSet -> NameSet -> NameSet
`unionNameSet` Type -> NameSet
orphNamesOfType Type
arg
                                       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 (CastTy Type
ty Coercion
co)       = Type -> NameSet
orphNamesOfType Type
ty NameSet -> NameSet -> NameSet
`unionNameSet` Coercion -> NameSet
orphNamesOfCo Coercion
co
orphNamesOfType (CoercionTy Coercion
co)      = Coercion -> NameSet
orphNamesOfCo Coercion
co

orphNamesOfThings :: (a -> NameSet) -> [a] -> NameSet
orphNamesOfThings :: (a -> NameSet) -> [a] -> NameSet
orphNamesOfThings a -> NameSet
f = (a -> NameSet -> NameSet) -> NameSet -> [a] -> NameSet
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

orphNamesOfMCo :: MCoercion -> NameSet
orphNamesOfMCo :: MCoercion -> NameSet
orphNamesOfMCo MCoercion
MRefl    = NameSet
emptyNameSet
orphNamesOfMCo (MCo Coercion
co) = Coercion -> NameSet
orphNamesOfCo Coercion
co

orphNamesOfCo :: Coercion -> NameSet
orphNamesOfCo :: Coercion -> NameSet
orphNamesOfCo (Refl Type
ty)             = Type -> NameSet
orphNamesOfType Type
ty
orphNamesOfCo (GRefl Role
_ Type
ty MCoercion
mco)      = Type -> NameSet
orphNamesOfType Type
ty NameSet -> NameSet -> NameSet
`unionNameSet` MCoercion -> NameSet
orphNamesOfMCo MCoercion
mco
orphNamesOfCo (TyConAppCo Role
_ TyCon
tc [Coercion]
cos) = Name -> NameSet
unitNameSet (TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tc) NameSet -> NameSet -> NameSet
`unionNameSet` [Coercion] -> NameSet
orphNamesOfCos [Coercion]
cos
orphNamesOfCo (AppCo Coercion
co1 Coercion
co2)       = Coercion -> NameSet
orphNamesOfCo Coercion
co1 NameSet -> NameSet -> NameSet
`unionNameSet` Coercion -> NameSet
orphNamesOfCo Coercion
co2
orphNamesOfCo (ForAllCo Var
_ Coercion
kind_co Coercion
co)
  = Coercion -> NameSet
orphNamesOfCo Coercion
kind_co NameSet -> NameSet -> NameSet
`unionNameSet` Coercion -> NameSet
orphNamesOfCo Coercion
co
orphNamesOfCo (FunCo Role
_ Coercion
co1 Coercion
co2)     = Coercion -> NameSet
orphNamesOfCo Coercion
co1 NameSet -> NameSet -> NameSet
`unionNameSet` Coercion -> NameSet
orphNamesOfCo Coercion
co2
orphNamesOfCo (CoVarCo Var
_)           = NameSet
emptyNameSet
orphNamesOfCo (AxiomInstCo CoAxiom Branched
con Int
_ [Coercion]
cos) = CoAxiom Branched -> NameSet
forall (br :: BranchFlag). CoAxiom br -> NameSet
orphNamesOfCoCon CoAxiom Branched
con NameSet -> NameSet -> NameSet
`unionNameSet` [Coercion] -> NameSet
orphNamesOfCos [Coercion]
cos
orphNamesOfCo (UnivCo UnivCoProvenance
p Role
_ Type
t1 Type
t2)    = UnivCoProvenance -> NameSet
orphNamesOfProv UnivCoProvenance
p NameSet -> NameSet -> NameSet
`unionNameSet` Type -> NameSet
orphNamesOfType Type
t1 NameSet -> NameSet -> NameSet
`unionNameSet` Type -> NameSet
orphNamesOfType Type
t2
orphNamesOfCo (SymCo Coercion
co)            = Coercion -> NameSet
orphNamesOfCo Coercion
co
orphNamesOfCo (TransCo Coercion
co1 Coercion
co2)     = Coercion -> NameSet
orphNamesOfCo Coercion
co1 NameSet -> NameSet -> NameSet
`unionNameSet` Coercion -> NameSet
orphNamesOfCo Coercion
co2
orphNamesOfCo (NthCo Role
_ Int
_ Coercion
co)        = Coercion -> NameSet
orphNamesOfCo Coercion
co
orphNamesOfCo (LRCo  LeftOrRight
_ Coercion
co)          = Coercion -> NameSet
orphNamesOfCo Coercion
co
orphNamesOfCo (InstCo Coercion
co Coercion
arg)       = Coercion -> NameSet
orphNamesOfCo Coercion
co NameSet -> NameSet -> NameSet
`unionNameSet` Coercion -> NameSet
orphNamesOfCo Coercion
arg
orphNamesOfCo (KindCo Coercion
co)           = Coercion -> NameSet
orphNamesOfCo Coercion
co
orphNamesOfCo (SubCo Coercion
co)            = Coercion -> NameSet
orphNamesOfCo Coercion
co
orphNamesOfCo (AxiomRuleCo CoAxiomRule
_ [Coercion]
cs)    = [Coercion] -> NameSet
orphNamesOfCos [Coercion]
cs
orphNamesOfCo (HoleCo CoercionHole
_)            = NameSet
emptyNameSet

orphNamesOfProv :: UnivCoProvenance -> NameSet
orphNamesOfProv :: UnivCoProvenance -> NameSet
orphNamesOfProv UnivCoProvenance
UnsafeCoerceProv    = NameSet
emptyNameSet
orphNamesOfProv (PhantomProv Coercion
co)    = Coercion -> NameSet
orphNamesOfCo Coercion
co
orphNamesOfProv (ProofIrrelProv Coercion
co) = Coercion -> NameSet
orphNamesOfCo Coercion
co
orphNamesOfProv (PluginProv String
_)      = NameSet
emptyNameSet

orphNamesOfCos :: [Coercion] -> NameSet
orphNamesOfCos :: [Coercion] -> NameSet
orphNamesOfCos = (Coercion -> NameSet) -> [Coercion] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
orphNamesOfThings Coercion -> NameSet
orphNamesOfCo

orphNamesOfCoCon :: CoAxiom br -> NameSet
orphNamesOfCoCon :: CoAxiom br -> NameSet
orphNamesOfCoCon (CoAxiom { co_ax_tc :: forall (br :: BranchFlag). CoAxiom br -> TyCon
co_ax_tc = TyCon
tc, co_ax_branches :: forall (br :: BranchFlag). CoAxiom br -> Branches br
co_ax_branches = Branches br
branches })
  = TyCon -> NameSet
orphNamesOfTyCon TyCon
tc NameSet -> NameSet -> NameSet
`unionNameSet` Branches br -> NameSet
forall (br :: BranchFlag). Branches br -> NameSet
orphNamesOfCoAxBranches Branches br
branches

orphNamesOfAxiom :: CoAxiom br -> NameSet
orphNamesOfAxiom :: CoAxiom br -> NameSet
orphNamesOfAxiom CoAxiom br
axiom
  = [Type] -> NameSet
orphNamesOfTypes ((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)

orphNamesOfCoAxBranches :: Branches br -> NameSet
orphNamesOfCoAxBranches :: Branches br -> NameSet
orphNamesOfCoAxBranches
  = (CoAxBranch -> NameSet -> NameSet)
-> NameSet -> [CoAxBranch] -> NameSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (NameSet -> NameSet -> NameSet
unionNameSet (NameSet -> NameSet -> NameSet)
-> (CoAxBranch -> NameSet) -> CoAxBranch -> NameSet -> NameSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoAxBranch -> NameSet
orphNamesOfCoAxBranch) NameSet
emptyNameSet ([CoAxBranch] -> NameSet)
-> (Branches br -> [CoAxBranch]) -> Branches br -> NameSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branches br -> [CoAxBranch]
forall (br :: BranchFlag). Branches br -> [CoAxBranch]
fromBranches

orphNamesOfCoAxBranch :: CoAxBranch -> NameSet
orphNamesOfCoAxBranch :: CoAxBranch -> NameSet
orphNamesOfCoAxBranch (CoAxBranch { cab_lhs :: CoAxBranch -> [Type]
cab_lhs = [Type]
lhs, cab_rhs :: CoAxBranch -> Type
cab_rhs = Type
rhs })
  = [Type] -> NameSet
orphNamesOfTypes [Type]
lhs NameSet -> NameSet -> NameSet
`unionNameSet` Type -> NameSet
orphNamesOfType Type
rhs

-- | orphNamesOfAxiom 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 in the implementation of ":info" in GHCi.
orphNamesOfFamInst :: FamInst -> NameSet
orphNamesOfFamInst :: FamInst -> NameSet
orphNamesOfFamInst FamInst
fam_inst = CoAxiom Unbranched -> NameSet
forall (br :: BranchFlag). CoAxiom br -> NameSet
orphNamesOfAxiom (FamInst -> CoAxiom Unbranched
famInstAxiom FamInst
fam_inst)

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

-- | Those variables free in the right hand side of a rule returned as a
-- non-deterministic set
ruleRhsFreeVars :: CoreRule -> VarSet
ruleRhsFreeVars :: CoreRule -> VarSet
ruleRhsFreeVars (BuiltinRule {}) = VarSet
noFVs
ruleRhsFreeVars (Rule { ru_fn :: CoreRule -> Name
ru_fn = Name
_, ru_bndrs :: CoreRule -> [Var]
ru_bndrs = [Var]
bndrs, ru_rhs :: CoreRule -> CoreExpr
ru_rhs = CoreExpr
rhs })
  = 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]
bndrs (CoreExpr -> FV
expr_fvs CoreExpr
rhs)
      -- See Note [Rule free var hack]

-- | 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
. CoreRule -> FV
ruleFVs

-- | Those variables free in the both the left right hand sides of a rule
-- returned as FV computation
ruleFVs :: CoreRule -> FV
ruleFVs :: CoreRule -> FV
ruleFVs (BuiltinRule {}) = FV
emptyFV
ruleFVs (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
rhsCoreExpr -> [CoreExpr] -> [CoreExpr]
forall a. a -> [a] -> [a]
:[CoreExpr]
args))

-- | Those variables free in the both the left right hand sides of rules
-- returned as FV computation
rulesFVs :: [CoreRule] -> FV
rulesFVs :: [CoreRule] -> FV
rulesFVs = (CoreRule -> FV) -> [CoreRule] -> FV
forall a. (a -> FV) -> [a] -> FV
mapUnionFV CoreRule -> FV
ruleFVs

-- | 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
$ [CoreRule] -> FV
rulesFVs [CoreRule]
rules

idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet
-- Just the variables free on the *rhs* of a rule
idRuleRhsVars :: (Activation -> Bool) -> Var -> VarSet
idRuleRhsVars Activation -> Bool
is_active Var
id
  = (CoreRule -> VarSet) -> [CoreRule] -> VarSet
forall a. (a -> VarSet) -> [a] -> VarSet
mapUnionVarSet CoreRule -> VarSet
get_fvs (Var -> [CoreRule]
idCoreRules Var
id)
  where
    get_fvs :: CoreRule -> VarSet
get_fvs (Rule { ru_fn :: CoreRule -> Name
ru_fn = Name
fn, ru_bndrs :: CoreRule -> [Var]
ru_bndrs = [Var]
bndrs
                  , ru_rhs :: CoreRule -> CoreExpr
ru_rhs = CoreExpr
rhs, ru_act :: CoreRule -> Activation
ru_act = Activation
act })
      | Activation -> Bool
is_active Activation
act
            -- See Note [Finding rule RHS free vars] in OccAnal.hs
      = VarSet -> Unique -> VarSet
forall a. UniqSet a -> Unique -> UniqSet a
delOneFromUniqSet_Directly VarSet
fvs (Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique Name
fn)
            -- Note [Rule free var hack]
      where
        fvs :: VarSet
fvs = 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]
bndrs (CoreExpr -> FV
expr_fvs CoreExpr
rhs)
    get_fvs CoreRule
_ = VarSet
noFVs

-- | Those variables free in the right hand side of several rules
rulesFreeVars :: [CoreRule] -> VarSet
rulesFreeVars :: [CoreRule] -> VarSet
rulesFreeVars [CoreRule]
rules = (CoreRule -> VarSet) -> [CoreRule] -> VarSet
forall a. (a -> VarSet) -> [a] -> VarSet
mapUnionVarSet CoreRule -> VarSet
ruleFreeVars [CoreRule]
rules

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
. CoreRule -> FV
ruleLhsFVIds

ruleLhsFreeIdsList :: CoreRule -> [Var]
-- ^ This finds all locally-defined free Ids on the left hand side of a rule
-- and returns them as a determinisitcally 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
. CoreRule -> FV
ruleLhsFVIds

ruleLhsFVIds :: CoreRule -> FV
-- ^ This finds all locally-defined free Ids on the left hand side of a rule
-- and returns an FV computation
ruleLhsFVIds :: CoreRule -> FV
ruleLhsFVIds (BuiltinRule {}) = FV
emptyFV
ruleLhsFVIds (Rule { ru_bndrs :: CoreRule -> [Var]
ru_bndrs = [Var]
bndrs, ru_args :: CoreRule -> [CoreExpr]
ru_args = [CoreExpr]
args })
  = InterestingVarFun -> FV -> FV
filterFV InterestingVarFun
isLocalId (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ [Var] -> FV -> FV
addBndrs [Var]
bndrs ([CoreExpr] -> FV
exprs_fvs [CoreExpr]
args)

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

noFVs :: VarSet
noFVs :: VarSet
noFVs = VarSet
emptyVarSet

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 (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
varTypeTyCoFVs :: Var -> FV
varTypeTyCoFVs Var
var = Type -> FV
tyCoFVsOfType (Var -> Type
varType Var
var)

idFreeVars :: Id -> VarSet
idFreeVars :: Var -> VarSet
idFreeVars Var
id = ASSERT( isId id) fvVarSet $ idFVs 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 = ASSERT( isId id)
           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

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 = ASSERT( isId id)
  [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 (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 (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, 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
        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)
forall a.
(a, [Var], CoreExpr) -> (DVarSet, (a, [Var], CoreExprWithFVs))
fv_alt [Alt Var]
alts
        alts_fvs :: DVarSet
alts_fvs            = [DVarSet] -> DVarSet
unionFVss [DVarSet]
alts_fvs_s

        fv_alt :: (a, [Var], CoreExpr) -> (DVarSet, (a, [Var], CoreExprWithFVs))
fv_alt (a
con,[Var]
args,CoreExpr
rhs) = ([Var] -> DVarSet -> DVarSet
delBindersFV [Var]
args (CoreExprWithFVs -> DVarSet
freeVarsOf CoreExprWithFVs
rhs2),
                                 (a
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 Tickish Var
tickish CoreExpr
expr)
      = ( Tickish Var -> DVarSet
tickishFVs Tickish Var
tickish DVarSet -> DVarSet -> DVarSet
`unionFVs` CoreExprWithFVs -> DVarSet
freeVarsOf CoreExprWithFVs
expr2
        , Tickish Var -> CoreExprWithFVs -> AnnExpr' Var DVarSet
forall bndr annot.
Tickish Var -> AnnExpr bndr annot -> AnnExpr' bndr annot
AnnTick Tickish Var
tickish CoreExprWithFVs
expr2 )
      where
        expr2 :: CoreExprWithFVs
expr2 = CoreExpr -> CoreExprWithFVs
go CoreExpr
expr
        tickishFVs :: Tickish Var -> DVarSet
tickishFVs (Breakpoint Int
_ [Var]
ids) = [Var] -> DVarSet
mkDVarSet [Var]
ids
        tickishFVs Tickish Var
_                  = 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)