content: {-
  (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, exprLocalFVs, addBndrFV, addBndrsFV,
  
          -- * 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 = fvVarSet . exprLocalFVs
  
  -- | 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.
  exprLocalFVs :: CoreExpr -> FV
  exprLocalFVs = filterFV isLocalVar . exprFVs
  
  -- | Find all locally-defined free Ids or type variables in an expression
  -- returning a deterministic set.
  exprFreeVarsDSet :: CoreExpr -> DVarSet
  exprFreeVarsDSet = fvDVarSet . exprLocalFVs
  
  -- | Find all locally-defined free Ids or type variables in an expression
  -- returning a deterministically ordered list.
  exprFreeVarsList :: CoreExpr -> [Var]
  exprFreeVarsList = fvVarList . exprLocalFVs
  
  -- | Find all locally-defined free Ids in an expression
  exprFreeIds :: CoreExpr -> IdSet        -- Find all locally-defined free Ids
  exprFreeIds = exprSomeFreeVars isLocalId
  
  exprsFreeIds :: [CoreExpr] -> IdSet        -- Find all locally-defined free Ids
  exprsFreeIds = exprsSomeFreeVars isLocalId
  
  -- | Find all locally-defined free Ids in an expression
  -- returning a deterministic set.
  exprFreeIdsDSet :: CoreExpr -> DIdSet -- Find all locally-defined free Ids
  exprFreeIdsDSet = exprSomeFreeVarsDSet 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 = exprSomeFreeVarsList isLocalId
  
  -- | Find all locally-defined free Ids in several expressions
  -- returning a deterministic set.
  exprsFreeIdsDSet :: [CoreExpr] -> DIdSet -- Find all locally-defined free Ids
  exprsFreeIdsDSet = exprsSomeFreeVarsDSet 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 = exprsSomeFreeVarsList isLocalId
  
  -- | Find all locally-defined free Ids or type variables in several expressions
  -- returning a non-deterministic set.
  exprsFreeVars :: [CoreExpr] -> VarSet
  exprsFreeVars = fvVarSet . exprsLocalFVs
  
  -- | 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.
  exprsLocalFVs :: [CoreExpr] -> FV
  exprsLocalFVs exprs = mapUnionFV exprLocalFVs exprs
  
  -- | Find all locally-defined free Ids or type variables in several expressions
  -- returning a deterministically ordered list.
  exprsFreeVarsList :: [CoreExpr] -> [Var]
  exprsFreeVarsList = fvVarList . exprsLocalFVs
  
  -- | Find all locally defined free Ids in a binding group
  bindFreeVars :: CoreBind -> VarSet
  bindFreeVars (NonRec b r) = fvVarSet $ filterFV isLocalVar $ rhs_fvs (b,r)
  bindFreeVars (Rec prs)    = fvVarSet $ filterFV isLocalVar $
                                  addBndrsFV (map fst prs)
                                       (mapUnionFV rhs_fvs prs)
  
  -- | Finds free variables in an expression selected by a predicate
  exprSomeFreeVars :: InterestingVarFun   -- ^ Says which 'Var's are interesting
                   -> CoreExpr
                   -> VarSet
  exprSomeFreeVars fv_cand e = fvVarSet $ filterFV fv_cand $ exprFVs 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 fv_cand e = fvVarList $ filterFV fv_cand $ exprFVs 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 fv_cand e = fvDVarSet $ filterFV fv_cand $ exprFVs e
  
  -- | Finds free variables in several expressions selected by a predicate
  exprsSomeFreeVars :: InterestingVarFun  -- Says which 'Var's are interesting
                    -> [CoreExpr]
                    -> VarSet
  exprsSomeFreeVars fv_cand es = fvVarSet $ filterFV fv_cand $ mapUnionFV exprFVs 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 fv_cand es = fvVarList $ filterFV fv_cand $ mapUnionFV exprFVs 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 fv_cand e = fvDVarSet $ filterFV fv_cand $ mapUnionFV exprFVs 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
  
  addBndrFV :: CoreBndr -> FV -> FV
  addBndrFV bndr fv fv_cand in_scope acc
    = (varTypeTyCoFVs bndr `unionFV`
          -- Include type variables in the binder's type
          --      (not just Ids; coercion variables too!)
       FV.delFV bndr fv) fv_cand in_scope acc
  
  addBndrsFV :: [CoreBndr] -> FV -> FV
  addBndrsFV bndrs fv = foldr addBndrFV fv bndrs
  
  exprsFVs :: [CoreExpr] -> FV
  exprsFVs exprs = mapUnionFV exprFVs exprs
  
  exprFVs :: CoreExpr -> FV
  exprFVs (Type ty) fv_cand in_scope acc =
    tyCoFVsOfType ty fv_cand in_scope acc
  exprFVs (Coercion co) fv_cand in_scope acc =
    tyCoFVsOfCo co fv_cand in_scope acc
  exprFVs (Var var) fv_cand in_scope acc = FV.unitFV var fv_cand in_scope acc
  exprFVs (Lit _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc
  exprFVs (Tick t expr) fv_cand in_scope acc =
    (tickish_fvs t `unionFV` exprFVs expr) fv_cand in_scope acc
  exprFVs (App fun arg) fv_cand in_scope acc =
    (exprFVs fun `unionFV` exprFVs arg) fv_cand in_scope acc
  exprFVs (Lam bndr body) fv_cand in_scope acc =
    addBndrFV bndr (exprFVs body) fv_cand in_scope acc
  exprFVs (Cast expr co) fv_cand in_scope acc =
    (exprFVs expr `unionFV` tyCoFVsOfCo co) fv_cand in_scope acc
  
  exprFVs (Case scrut bndr ty alts) fv_cand in_scope acc
    = (exprFVs scrut `unionFV` tyCoFVsOfType ty `unionFV` addBndrFV bndr
        (mapUnionFV alt_fvs alts)) fv_cand in_scope acc
    where
      alt_fvs (Alt _ bndrs rhs) = addBndrsFV bndrs (exprFVs rhs)
  
  exprFVs (Let (NonRec bndr rhs) body) fv_cand in_scope acc
    = (rhs_fvs (bndr, rhs) `unionFV` addBndrFV bndr (exprFVs body))
        fv_cand in_scope acc
  
  exprFVs (Let (Rec pairs) body) fv_cand in_scope acc
    = addBndrsFV (map fst pairs)
                 (mapUnionFV rhs_fvs pairs `unionFV` exprFVs body)
                 fv_cand in_scope acc
  
  ---------
  rhs_fvs :: (Id, CoreExpr) -> FV
  rhs_fvs (bndr, rhs) = exprFVs rhs `unionFV`
                        bndrRuleAndUnfoldingFVs bndr
          -- Treat any RULES as extra RHSs of the binding
  
  ---------
  tickish_fvs :: CoreTickish -> FV
  tickish_fvs (Breakpoint _ _ ids) = FV.mkFVs ids
  tickish_fvs _ = 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 = unitNameSet (getName tycon) `unionNameSet` case tyConClass_maybe tycon of
      Nothing  -> emptyNameSet
      Just cls -> unitNameSet (getName cls)
  
  orphNamesOfType :: Type -> NameSet
  orphNamesOfType ty | Just ty' <- coreView ty = orphNamesOfType ty'
                  -- Look through type synonyms (#4912)
  orphNamesOfType (TyVarTy _)          = emptyNameSet
  orphNamesOfType (LitTy {})           = emptyNameSet
  orphNamesOfType (ForAllTy bndr res)  = orphNamesOfType (binderType bndr)
                                         `unionNameSet` orphNamesOfType res
  orphNamesOfType (AppTy fun arg)      = orphNamesOfType fun `unionNameSet` orphNamesOfType arg
  
  orphNamesOfType (TyConApp tycon tys) = func
                                         `unionNameSet` orphNamesOfTyCon tycon
                                         `unionNameSet` orphNamesOfTypes tys
          where func = case tys of
                         arg:_ | tycon == fUNTyCon -> orph_names_of_fun_ty_con arg
                         _ -> emptyNameSet
  
  orphNamesOfType (FunTy af w arg res) =  func
                                         `unionNameSet` unitNameSet fun_tc
                                         `unionNameSet` orphNamesOfType w
                                         `unionNameSet` orphNamesOfType arg
                                         `unionNameSet` orphNamesOfType res
          where func | isVisibleFunArg af = orph_names_of_fun_ty_con w
                     | otherwise          = emptyNameSet
  
                fun_tc = tyConName (funTyFlagTyCon af)
  
  -- Coercions: see wrinkle (ON1) of Note [Finding orphan names]
  orphNamesOfType (CastTy ty _co)  = orphNamesOfType ty
  orphNamesOfType (CoercionTy _co) = emptyNameSet
  
  orphNamesOfThings :: (a -> NameSet) -> [a] -> NameSet
  orphNamesOfThings f = foldr (unionNameSet . f) emptyNameSet
  
  orphNamesOfTypes :: [Type] -> NameSet
  orphNamesOfTypes = orphNamesOfThings 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 axiom
    = (orphNamesOfTypes $ concatMap coAxBranchLHS $ fromBranches $ coAxiomBranches axiom)
      `extendNameSet` getName (coAxiomTyCon 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 ManyTy = unitNameSet unrestrictedFunTyConName
  orph_names_of_fun_ty_con _      = 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 e
    = go e
    where
      go (Var v)
        | isExternalName n    = unitNameSet n
        | otherwise           = emptyNameSet
        where n = idName v
      go (Lit _)              = emptyNameSet
      go (Type ty)            = orphNamesOfType ty        -- Don't need free tyvars
      go (Coercion _co)       = emptyNameSet -- See wrinkle (ON1) of Note [Finding orphan names]
      go (App e1 e2)          = go e1 `unionNameSet` go e2
      go (Lam v e)            = go e `delFromNameSet` idName v
      go (Tick _ e)           = go e
      go (Cast e _co)         = go e  -- See wrinkle (ON1) of Note [Finding orphan names]
      go (Let (NonRec _ r) e) = go e `unionNameSet` go r
      go (Let (Rec prs) e)    = orphNamesOfExprs (map snd prs) `unionNameSet` go e
      go (Case e _ ty as)     = go e `unionNameSet` orphNamesOfType ty
                                `unionNameSet` unionNameSets (map go_alt as)
  
      go_alt (Alt _ _ r)      = go r
  
  -- | Finds the free /external/ names of several expressions: see 'exprOrphNames' for details
  orphNamesOfExprs :: [CoreExpr] -> NameSet
  orphNamesOfExprs es = foldr (unionNameSet . orphNamesOfExpr) emptyNameSet 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 !_   (BuiltinRule {}) = emptyFV
  ruleFVs from (Rule { ru_fn = _do_not_include
                       -- See Note [Rule free var hack]
                     , ru_bndrs = bndrs
                     , ru_rhs = rhs, ru_args = args })
    = filterFV isLocalVar $ addBndrsFV bndrs (exprsFVs exprs)
    where
      exprs = case from of
        LhsOnly   -> args
        RhsOnly   -> [rhs]
        BothSides -> rhs: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 from = mapUnionFV (ruleFVs from)
  
  -- | Those variables free in the right hand side of a rule returned as a
  -- non-deterministic set
  ruleRhsFreeVars :: CoreRule -> VarSet
  ruleRhsFreeVars = fvVarSet . ruleFVs 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 = fvVarSet . filterFV isLocalId . rulesFVs 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 = fvVarSet . filterFV isLocalId . ruleFVs 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 = fvVarList . filterFV isLocalId . ruleFVs 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 = fvVarSet . ruleFVs BothSides
  
  -- | Those variables free in the both the left right hand sides of rules
  -- returned as a deterministic set
  rulesFreeVarsDSet :: [CoreRule] -> DVarSet
  rulesFreeVarsDSet rules = fvDVarSet $ rulesFVs BothSides rules
  
  -- | Those variables free in both the left right hand sides of several rules
  rulesFreeVars :: [CoreRule] -> VarSet
  rulesFreeVars rules = fvVarSet $ rulesFVs BothSides rules
  
  -- | Make a 'RuleInfo' containing a number of 'CoreRule's, suitable
  -- for putting into an 'IdInfo'
  mkRuleInfo :: [CoreRule] -> RuleInfo
  mkRuleInfo rules = RuleInfo rules (rulesFreeVarsDSet 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 (fvs, _) = fvs
  
  -- | Extract the vars reported in a FVAnn
  freeVarsOfAnn :: FVAnn -> DIdSet
  freeVarsOfAnn fvs = fvs
  
  aFreeVar :: Var -> DVarSet
  aFreeVar = unitDVarSet
  
  unionFVs :: DVarSet -> DVarSet -> DVarSet
  unionFVs = unionDVarSet
  
  unionFVss :: [DVarSet] -> DVarSet
  unionFVss = unionDVarSets
  
  delBindersFV :: [Var] -> DVarSet -> DVarSet
  delBindersFV bs fvs = foldr delBinderFV fvs 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 b s = (s `delDVarSet` b) `unionFVs` dVarTypeTyCoVars b
          -- Include coercion variables too!
  
  varTypeTyCoVars :: Var -> TyCoVarSet
  -- Find the type/kind variables free in the type of the id/tyvar
  varTypeTyCoVars var = fvVarSet $ varTypeTyCoFVs var
  
  dVarTypeTyCoVars :: Var -> DTyCoVarSet
  -- Find the type/kind/coercion variables free in the type of the id/tyvar
  dVarTypeTyCoVars var = fvDVarSet $ varTypeTyCoFVs var
  
  varTypeTyCoFVs :: Var -> FV
  -- Find the free variables of a binder.
  -- In the case of ids, don't forget the multiplicity field!
  varTypeTyCoFVs var
    = tyCoFVsOfType (varType var) `unionFV` mult_fvs
    where
      mult_fvs = case varMultMaybe var of
                   Just mult -> tyCoFVsOfType mult
                   Nothing   -> emptyFV
  
  idFreeVars :: Id -> VarSet
  idFreeVars id = assert (isId id) $ fvVarSet $ idFVs id
  
  dIdFreeVars :: Id -> DVarSet
  dIdFreeVars id = fvDVarSet $ idFVs id
  
  idFVs :: Id -> FV
  -- Type variables, rule variables, and inline variables
  idFVs id = assert (isId id) $
             varTypeTyCoFVs id `unionFV`
             bndrRuleAndUnfoldingFVs id
  
  bndrRuleAndUnfoldingVarsDSet :: Id -> DVarSet
  bndrRuleAndUnfoldingVarsDSet id = fvDVarSet $ bndrRuleAndUnfoldingFVs id
  
  bndrRuleAndUnfoldingIds :: Id -> IdSet
  bndrRuleAndUnfoldingIds id = fvVarSet $ filterFV isId $ bndrRuleAndUnfoldingFVs id
  
  bndrRuleAndUnfoldingFVs :: Id -> FV
  bndrRuleAndUnfoldingFVs id
    | isId id   = idRuleFVs id `unionFV` idUnfoldingFVs id
    | otherwise = emptyFV
  
  idRuleVars ::Id -> VarSet  -- Does *not* include CoreUnfolding vars
  idRuleVars id = fvVarSet $ idRuleFVs id
  
  idRuleFVs :: Id -> FV
  idRuleFVs id = assert (isId id) $
    FV.mkFVs (dVarSetElems $ ruleInfoFreeVars (idSpecialisation 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 id = fvVarSet $ idUnfoldingFVs id
  
  idUnfoldingFVs :: Id -> FV
  idUnfoldingFVs id = stableUnfoldingFVs (realIdUnfolding id) `orElse` emptyFV
  
  stableUnfoldingVars :: Unfolding -> Maybe VarSet
  stableUnfoldingVars unf = fvVarSet `fmap` stableUnfoldingFVs unf
  
  stableUnfoldingFVs :: Unfolding -> Maybe FV
  stableUnfoldingFVs unf
    = case unf of
        CoreUnfolding { uf_tmpl = rhs, uf_src = src }
           | isStableSource src
           -> Just (exprLocalFVs rhs)
        DFunUnfolding { df_bndrs = bndrs, df_args = args }
           -> Just (filterFV isLocalVar $ FV.delFVs (mkVarSet bndrs) $ exprsFVs args)
              -- DFuns are top level, so no fvs from types of bndrs
        _other -> Nothing
  
  
  {-
  ************************************************************************
  *                                                                      *
  \subsection{Free variables (and types)}
  *                                                                      *
  ************************************************************************
  -}
  
  freeVarsBind :: CoreBind
               -> DVarSet                     -- Free vars of scope of binding
               -> (CoreBindWithFVs, DVarSet)  -- Return free vars of binding + scope
  freeVarsBind (NonRec binder rhs) body_fvs
    = ( AnnNonRec binder rhs2
      , freeVarsOf rhs2 `unionFVs` body_fvs2
                        `unionFVs` bndrRuleAndUnfoldingVarsDSet binder )
      where
        rhs2      = freeVars rhs
        body_fvs2 = binder `delBinderFV` body_fvs
  
  freeVarsBind (Rec binds) body_fvs
    = ( AnnRec (binders `zip` rhss2)
      , delBindersFV binders all_fvs )
    where
      (binders, rhss) = unzip binds
      rhss2        = map freeVars rhss
      rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2
      binders_fvs  = fvDVarSet $ mapUnionFV bndrRuleAndUnfoldingFVs binders
                     -- See Note [The FVAnn invariant]
      all_fvs      = rhs_body_fvs `unionFVs` 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 = go
    where
      go :: CoreExpr -> CoreExprWithFVs
      go (Var v)
        | isLocalVar v = (aFreeVar v `unionFVs` ty_fvs `unionFVs` mult_vars, AnnVar v)
        | otherwise    = (emptyDVarSet,                 AnnVar v)
        where
          mult_vars = tyCoVarsOfTypeDSet (idMult v)
          ty_fvs = dVarTypeTyCoVars v
                   -- See Note [The FVAnn invariant]
  
      go (Lit lit) = (emptyDVarSet, AnnLit lit)
      go (Lam b body)
        = ( b_fvs `unionFVs` (b `delBinderFV` body_fvs)
          , AnnLam b body' )
        where
          body'@(body_fvs, _) = go body
          b_ty  = idType b
          b_fvs = tyCoVarsOfTypeDSet b_ty
                  -- See Note [The FVAnn invariant]
  
      go (App fun arg)
        = ( freeVarsOf fun' `unionFVs` freeVarsOf arg'
          , AnnApp fun' arg' )
        where
          fun'   = go fun
          arg'   = go arg
  
      go (Case scrut bndr ty alts)
        = ( (bndr `delBinderFV` alts_fvs)
             `unionFVs` freeVarsOf scrut2
             `unionFVs` tyCoVarsOfTypeDSet ty
            -- Don't need to look at (idType bndr)
            -- because that's redundant with scrut
          , AnnCase scrut2 bndr ty alts2 )
        where
          scrut2 = go scrut
  
          (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
          alts_fvs            = unionFVss alts_fvs_s
  
          fv_alt (Alt con args rhs) = (delBindersFV args (freeVarsOf rhs2),
                                       (AnnAlt con args rhs2))
                                where
                                   rhs2 = go rhs
  
      go (Let bind body)
        = (bind_fvs, AnnLet bind2 body2)
        where
          (bind2, bind_fvs) = freeVarsBind bind (freeVarsOf body2)
          body2             = go body
  
      go (Cast expr co)
        = ( freeVarsOf expr2 `unionFVs` cfvs
          , AnnCast expr2 (cfvs, co) )
        where
          expr2 = go expr
          cfvs  = tyCoVarsOfCoDSet co
  
      go (Tick tickish expr)
        = ( tickishFVs tickish `unionFVs` freeVarsOf expr2
          , AnnTick tickish expr2 )
        where
          expr2 = go expr
          tickishFVs (Breakpoint _ _ ids) = mkDVarSet ids
          tickishFVs _                    = emptyDVarSet
  
      go (Type ty)     = (tyCoVarsOfTypeDSet ty, AnnType ty)
      go (Coercion co) = (tyCoVarsOfCoDSet co, AnnCoercion co)
  