GitLab

Simon Peyton Jones pushed to branch wip/T26868 at Glasgow Haskell Compiler / GHC

Commits:

d3f56f61

by Simon Peyton Jones at 2026-02-21T22:55:58+00:00

Major refactor of free-variable functions

For some time we have had two free-variable mechanims for types:

* The "FV" mechanism, embodied in GHC.Utils.FV, which worked OK, but
  was fragile where eta-expansion was concerned.

* The TyCoFolder mechanism, using a one-shot EndoOS accumulator

I finally got tired of this and refactored the whole thing.   Now we have

* GHC.Types.Var.FV, which has a composable free-variable result type,
  very much in the spirit of the old `FV`, but much more robust.
  (It uses the "one shot trick".)

* GHC.Core.TyCo.FVs now has just one technology for free variables.

All this led to a lot of renaming.

18 changed files:

compiler/GHC/Core/Coercion.hs
compiler/GHC/Core/FVs.hs
compiler/GHC/Core/Opt/SetLevels.hs
compiler/GHC/Core/Opt/Specialise.hs
compiler/GHC/Core/Subst.hs
compiler/GHC/Core/TyCo/FVs.hs
compiler/GHC/Core/Type.hs
compiler/GHC/Iface/Ext/Ast.hs
compiler/GHC/Tc/Gen/App.hs
compiler/GHC/Tc/Types/Constraint.hs
compiler/GHC/Tc/Types/Evidence.hs
compiler/GHC/Tc/Utils/TcMType.hs
compiler/GHC/Tc/Utils/TcType.hs
compiler/GHC/Tc/Utils/Unify.hs
compiler/GHC/Utils/EndoOS.hs
− compiler/GHC/Utils/FV.hs
compiler/ghc.cabal.in
utils/haddock/haddock-api/src/Haddock/GhcUtils.hs

Changes:

compiler/GHC/Core/Coercion.hs

@@ -78,7 +78,6 @@ module GHC.Core.Coercion (
          -- ** Free variables
          tyCoVarsOfCo, tyCoVarsOfCos, coVarsOfCo,
 -        tyCoFVsOfCo, tyCoVarsOfCoDSet,
          coercionSize, anyFreeVarsOfCo,
          -- ** Substitution

compiler/GHC/Core/FVs.hs

@@ -35,7 +35,7 @@ module GHC.Core.FVs (
          ruleLhsFreeIds, ruleLhsFreeIdsList,
          ruleRhsFreeVars, rulesRhsFreeIds,
 -        exprFVs, addBndrFV, addBndrsFV, unitFV,
 +        exprFVs, addCoreBndrFV, addCoreBndrsFV, unitFV,
          -- * Orphan names
          orphNamesOfType, orphNamesOfTypes, orphNamesOfAxiomLHS,
@@ -61,8 +61,9 @@ 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.Types.Var.Set
 +import GHC.Types.Var.FV
  import GHC.Core.Type
  import GHC.Core.TyCo.Rep
  import GHC.Core.TyCo.FVs
@@ -154,10 +155,10 @@ exprsFreeIdsList = dVarSetElems . exprsFreeIdsDSet
  bindFreeVars :: CoreBind -> VarSet
  bindFreeVars = runFVSelectiveSet isLocalVar . bind_fvs
 -bind_fvs :: CoreBind -> SelectiveFVRes
 +bind_fvs :: CoreBind -> SelectiveFV
  bind_fvs (NonRec b r) = rhs_fvs (b,r)
 -bind_fvs (Rec prs)    = addBndrsSelectiveFVRes (map fst prs) $
 -                        mapUnionFVRes rhs_fvs prs
 +bind_fvs (Rec prs)    = addBndrsSelectiveFV (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
@@ -199,20 +200,20 @@ exprsSomeFreeVarsDSet :: InterestingVarFun -- ^ Says which 'Var's are interestin
                        -> DVarSet
  exprsSomeFreeVarsDSet fv_cand = runFVSelective fv_cand . exprsFVs
 -addBndrFV :: CoreBndr -> SelectiveFVRes -> SelectiveFVRes
 -addBndrFV bndr fvr
 +addCoreBndrFV :: CoreBndr -> SelectiveFV -> SelectiveFV
 +addCoreBndrFV bndr fvr
    = bndrTypeTyCoFVs bndr `mappend`
          -- Include type variables in the binder's type
          --      (not just Ids; coercion variables too!)
 -    addBndrSelectiveFVRes bndr fvr
 +    addBndrSelectiveFV bndr fvr
 -addBndrsFV :: [CoreBndr] -> SelectiveFVRes -> SelectiveFVRes
 -addBndrsFV bndrs fv = foldr addBndrFV fv bndrs
 +addCoreBndrsFV :: [CoreBndr] -> SelectiveFV -> SelectiveFV
 +addCoreBndrsFV bndrs fv = foldr addCoreBndrFV fv bndrs
 -unitFV :: Var -> SelectiveFVRes
 +unitFV :: Var -> SelectiveFV
  -- Deals with an occurrence
  -- Shallow: does not look at the kind
 -unitFV v = FVRes (\bvs -> EndoOS (do_it bvs))
 +unitFV v = MkFV (\bvs -> EndoOS (do_it bvs))
    where
      do_it (is_interesting,bvs) acc
        | not (is_interesting v) = acc  -- The "selective" bit
@@ -220,49 +221,49 @@ unitFV v = FVRes (\bvs -> EndoOS (do_it bvs))
        | v `elemDVarSet` acc    = acc
        | otherwise              = acc `extendDVarSet` v
 -exprsFVs :: [CoreExpr] -> SelectiveFVRes
 -exprsFVs = mapUnionFVRes exprFVs
 +exprsFVs :: [CoreExpr] -> SelectiveFV
 +exprsFVs = mapUnionFV exprFVs
 -exprFVs :: CoreExpr -> SelectiveFVRes
 -exprFVs (Type ty)       = tyCoFVsOfType ty
 -exprFVs (Coercion co)   = tyCoFVsOfCo co
 +exprFVs :: CoreExpr -> SelectiveFV
 +exprFVs (Type ty)       = shallowSelTypeFV ty
 +exprFVs (Coercion co)   = shallowSelCoFV co
  exprFVs (Var var)       = unitFV var
  exprFVs (Lit _)         = mempty
  exprFVs (Tick t expr)   = tickish_fvs t `mappend` exprFVs expr
  exprFVs (App fun arg)   = exprFVs fun `mappend` exprFVs arg
 -exprFVs (Lam bndr body) = addBndrFV bndr (exprFVs body)
 -exprFVs (Cast expr co)  = exprFVs expr `mappend` tyCoFVsOfCo co
 +exprFVs (Lam bndr body) = addCoreBndrFV bndr (exprFVs body)
 +exprFVs (Cast expr co)  = exprFVs expr `mappend` shallowSelCoFV co
  exprFVs (Case scrut bndr ty alts)
 -  = exprFVs scrut `mappend` tyCoFVsOfType ty `mappend`
 -    addBndrFV bndr (mapUnionFVRes alt_fvs alts)
 +  = exprFVs scrut `mappend` shallowSelTypeFV ty `mappend`
 +    addCoreBndrFV bndr (mapUnionFV alt_fvs alts)
    where
 -    alt_fvs (Alt _ bndrs rhs) = addBndrsFV bndrs (exprFVs rhs)
 +    alt_fvs (Alt _ bndrs rhs) = addCoreBndrsFV bndrs (exprFVs rhs)
  exprFVs (Let (NonRec bndr rhs) body)
 -  = rhs_fvs (bndr, rhs) `mappend` addBndrFV bndr (exprFVs body)
 +  = rhs_fvs (bndr, rhs) `mappend` addCoreBndrFV bndr (exprFVs body)
  exprFVs (Let (Rec pairs) body)
 -  = addBndrsFV (map fst pairs) $
 -    mapUnionFVRes rhs_fvs pairs `mappend` exprFVs body
 +  = addCoreBndrsFV (map fst pairs) $
 +    mapUnionFV rhs_fvs pairs `mappend` exprFVs body
  ---------
 -rhs_fvs :: (Id, CoreExpr) -> SelectiveFVRes
 +rhs_fvs :: (Id, CoreExpr) -> SelectiveFV
  rhs_fvs (bndr, rhs) = exprFVs rhs `mappend`
                        bndrRuleAndUnfoldingFVs bndr
          -- Treat any RULES as extra RHSs of the binding
  ---------
 -tickish_fvs :: CoreTickish -> SelectiveFVRes
 -tickish_fvs (Breakpoint _ _ ids) = mapUnionFVRes unitFV ids
 +tickish_fvs :: CoreTickish -> SelectiveFV
 +tickish_fvs (Breakpoint _ _ ids) = mapUnionFV unitFV ids
  tickish_fvs _ = mempty
  ---------
 -bndrTypeTyCoFVs :: Var -> SelectiveFVRes
 +bndrTypeTyCoFVs :: Var -> SelectiveFV
  -- Find the free variables of a binder.
  -- In the case of ids, don't forget the multiplicity field!
  bndrTypeTyCoFVs var
 -  = tyCoFVsOfType (varType var) `mappend` mult_fvs
 +  = shallowSelTypeFV (varType var) `mappend` mult_fvs
    where
      mult_fvs = case varMultMaybe var of
 -                 Just mult -> tyCoFVsOfType mult
 +                 Just mult -> shallowSelTypeFV mult
                   Nothing   -> mempty
  dBndrTypeTyCoVars :: Var -> DTyCoVarSet
@@ -278,7 +279,7 @@ dBndrFreeVars :: Id -> DVarSet
  -- Shallow free vars
  dBndrFreeVars id = runFVSelective isLocalVar $ bndrFVs id
 -bndrFVs :: Id -> SelectiveFVRes
 +bndrFVs :: Id -> SelectiveFV
  -- Shallow free vars of types, rules, and inlining
  bndrFVs id = assert (isId id) $
               bndrTypeTyCoFVs id `mappend`
@@ -290,7 +291,7 @@ bndrRuleAndUnfoldingVarsDSet = runFVSelective isLocalVar . bndrRuleAndUnfoldingF
  bndrRuleAndUnfoldingVars :: Id -> VarSet
  bndrRuleAndUnfoldingVars = dVarSetToVarSet . bndrRuleAndUnfoldingVarsDSet
 -bndrRuleAndUnfoldingFVs :: Id -> SelectiveFVRes
 +bndrRuleAndUnfoldingFVs :: Id -> SelectiveFV
  bndrRuleAndUnfoldingFVs id
    | isId id   = idRuleFVs id `mappend` idUnfoldingFVs id
    | otherwise = mempty
@@ -298,7 +299,7 @@ bndrRuleAndUnfoldingFVs id
  idRuleVars :: Id -> VarSet  -- Does *not* include CoreUnfolding vars
  idRuleVars = dVarSetToVarSet . ruleInfoFreeVars . idSpecialisation
 -idRuleFVs :: Id -> SelectiveFVRes
 +idRuleFVs :: Id -> SelectiveFV
  idRuleFVs id = assert (isId id) $
                 strictFoldDVarSet (mappend . unitFV) mempty $
                 ruleInfoFreeVars (idSpecialisation id)
@@ -311,21 +312,21 @@ idUnfoldingVars :: Id -> VarSet
  -- we might get out-of-scope variables
  idUnfoldingVars = runFVSelectiveSet isLocalVar . idUnfoldingFVs
 -idUnfoldingFVs :: Id -> SelectiveFVRes
 +idUnfoldingFVs :: Id -> SelectiveFV
  idUnfoldingFVs id = stableUnfoldingFVs (realIdUnfolding id) `orElse` mempty
  stableUnfoldingVars :: Unfolding -> Maybe VarSet
  stableUnfoldingVars unf = fmap (runFVSelectiveSet isLocalVar) $
                            stableUnfoldingFVs unf
 -stableUnfoldingFVs :: Unfolding -> Maybe SelectiveFVRes
 +stableUnfoldingFVs :: Unfolding -> Maybe SelectiveFV
  stableUnfoldingFVs unf
    = case unf of
        CoreUnfolding { uf_tmpl = rhs, uf_src = src }
           | isStableSource src
           -> Just (exprFVs rhs)
        DFunUnfolding { df_bndrs = bndrs, df_args = args }
 -         -> Just (addBndrsFV bndrs (exprsFVs args))
 +         -> Just (addCoreBndrsFV bndrs (exprsFVs args))
              -- DFuns are top level, so no fvs from types of bndrs
        _other -> Nothing
@@ -497,13 +498,13 @@ data RuleFVsFrom
  -- | Those locally-defined variables free in the left and/or right hand sides
  -- of the rule, depending on the first argument.
 -ruleFVs :: RuleFVsFrom -> CoreRule -> SelectiveFVRes
 +ruleFVs :: RuleFVsFrom -> CoreRule -> SelectiveFV
  ruleFVs !_   (BuiltinRule {}) = mempty
  ruleFVs from (Rule { ru_fn = _do_not_include
                       -- See Note [Rule free var hack]
                     , ru_bndrs = bndrs
                     , ru_rhs = rhs, ru_args = args })
 -  = addBndrsFV bndrs (exprsFVs exprs)
 +  = addCoreBndrsFV bndrs (exprsFVs exprs)
    where
      exprs = case from of
        LhsOnly   -> args
@@ -512,8 +513,8 @@ ruleFVs from (Rule { ru_fn = _do_not_include
  -- | Those locally-defined variables free in the left and/or right hand sides
  -- from several rules, depending on the first argument.
 -rulesFVs :: RuleFVsFrom -> [CoreRule] -> SelectiveFVRes
 -rulesFVs from = mapUnionFVRes (ruleFVs from)
 +rulesFVs :: RuleFVsFrom -> [CoreRule] -> SelectiveFV
 +rulesFVs from = mapUnionFV (ruleFVs from)
  -- | Those variables free in the right hand side of a rule returned as a
  -- non-deterministic set
@@ -666,7 +667,7 @@ freeVarsBind (Rec binds) body_fvs
      (binders, rhss) = unzip binds
      rhss2        = map freeVars rhss
      rhs_body_fvs = foldr (unionDVarSet . freeVarsOf) body_fvs rhss2
 -    binders_fvs  = runFVSelective isLocalVar $ mapUnionFVRes bndrRuleAndUnfoldingFVs binders
 +    binders_fvs  = runFVSelective isLocalVar $ mapUnionFV bndrRuleAndUnfoldingFVs binders
                     -- See Note [The FVAnn invariant]
      all_fvs      = rhs_body_fvs `unionDVarSet` binders_fvs
              -- The "delBinderFV" happens after adding the idSpecVars,

compiler/GHC/Core/Opt/SetLevels.hs

@@ -101,6 +101,7 @@ import GHC.Types.Id
  import GHC.Types.Id.Info
  import GHC.Types.Var
  import GHC.Types.Var.Set
 +import GHC.Types.Var.FV
  import GHC.Types.Unique.Set   ( nonDetStrictFoldUniqSet )
  import GHC.Types.Unique.DSet  ( getUniqDSet )
  import GHC.Types.Var.Env
@@ -1380,7 +1381,7 @@ lvlBind env (AnnRec pairs)
      bind_fvs = ((unionDVarSets [ freeVarsOf rhs | (_, rhs) <- pairs])
                  `unionDVarSet`
                  (runFVSelective isLocalVar $
 -                 mapUnionFVRes (\(bndr,_) -> bndrFVs bndr) pairs))
 +                 mapUnionFV (\(bndr,_) -> bndrFVs bndr) pairs))
                 `delDVarSetList`
                  bndrs

compiler/GHC/Core/Opt/Specialise.hs

@@ -54,6 +54,7 @@ import GHC.Types.Id.Make  ( voidArgId, voidPrimId )
  import GHC.Types.Var
  import GHC.Types.Var.Set
  import GHC.Types.Var.Env
 +import GHC.Types.Var.FV
  import GHC.Types.Id
  import GHC.Types.Id.Info
  import GHC.Types.InlinePragma
@@ -2512,10 +2513,10 @@ specArgsFVs :: InterestingVarFun -> [SpecArg] -> VarSet
  -- Find the shallow deep free vars of the SpecArgs that are not already in scope
  specArgsFVs interesting args
    = runFVSelectiveSet interesting $
 -    mapUnionFVRes get args
 +    mapUnionFV get args
    where
 -    get :: SpecArg -> SelectiveFVRes
 -    get (SpecType ty)   = tyCoFVsOfType ty
 +    get :: SpecArg -> SelectiveFV
 +    get (SpecType ty)   = shallowSelTypeFV ty
      get (SpecDict dx)   = exprFVs dx
      get UnspecType      = mempty
      get UnspecArg       = mempty

compiler/GHC/Core/Subst.hs

@@ -48,6 +48,7 @@ import GHC.Core.Coercion( mkCoVarCo, substCoVarBndr )
  import GHC.Core.TyCo.FVs
  import GHC.Types.Var.Set
 +import GHC.Types.Var.FV
  import GHC.Types.Var.Env as InScopeSet
  import GHC.Types.Id
  import GHC.Types.Name     ( Name )
@@ -594,10 +595,10 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs
    = runFVSelective isLocalVar $
      strictFoldDVarSet (mappend . do_one) mempty fvs
    where
 -  do_one :: Var -> SelectiveFVRes
 +  do_one :: Var -> SelectiveFV
    do_one fv
 -     | isTyVar fv = tyCoFVsOfType (lookupVarEnv tv_env fv `orElse` mkTyVarTy fv)
 -     | isCoVar fv = tyCoFVsOfCo   (lookupVarEnv cv_env fv `orElse` mkCoVarCo fv)
 +     | isTyVar fv = shallowSelTypeFV (lookupVarEnv tv_env fv `orElse` mkTyVarTy fv)
 +     | isCoVar fv = shallowSelCoFV   (lookupVarEnv cv_env fv `orElse` mkCoVarCo fv)
       | otherwise  = exprFVs (lookupIdSubst subst fv)
  ------------------

compiler/GHC/Core/TyCo/FVs.hs

 -{-# LANGUAGE MultiWayIf, PatternSynonyms #-}
 +{-# LANGUAGE MultiWayIf #-}
  module GHC.Core.TyCo.FVs
 -  (     -- FVRes and friends
 -        FVRes( runFV, FVRes ),
 -        addBndrFVRes, addBndrsFVRes, addBndrSelectiveFVRes, addBndrsSelectiveFVRes,
 -        mapUnionFVRes, shallowUnitFVRes, deepUnitFVRes,
 -        BoundVars, VarSetFVRes, DVarSetFVRes, SelectiveFVRes,
 -        TyCoFVRes, DTyCoFVRes,
 -        runFVTop, runFVAcc, runTyCoVars, runTyCoVarsDSet,
 -        runFVSelective, runFVSelectiveList, runFVSelectiveSet,
 -        InterestingVarFun,
+-
 -        -- Shallow
 +  (     -- Shallow
          shallowTyCoVarsOfType, shallowTyCoVarsOfTypes,
          shallowTyCoVarsOfCo, shallowTyCoVarsOfCos,
          shallowTyCoVarsOfTyVarEnv, shallowTyCoVarsOfCoVarEnv,
@@ -20,13 +10,13 @@ module GHC.Core.TyCo.FVs
          tyCoVarsOfType, tyCoVarsOfTypes, tyCoVarsOfTypesList,
          tyCoVarsOfThings,
          tyCoVarsOfCo, tyCoVarsOfCos, tyCoVarsOfMCo,
 -        deepTcvFolder, deepTypeFV, deepCoFV,
 +        deepTcvFolder, deepTypeFV, deepTypesFV, deepCoFV,
          -- Deep, deterministic
          tyCoVarsOfTypeDSet, tyCoVarsOfTypesDSet, tyCoVarsOfTypeList,
          tyCoVarsOfCoDSet, tyCoVarsOfCoList,
          tyCoVarsOfThingsDSet,
 -        detTyCoVarsOfType, detTyCoVarsOfTypes, detTyCoVarsOfCo,
 +        deepDetTypeFV, deepDetTypesFV, deepDetCoFV,
          -- Selective
          someTyCoVarsOfType, someTyCoVarsOfTypes,
@@ -37,7 +27,7 @@ module GHC.Core.TyCo.FVs
          coVarsOfCoDSet, coVarsOfCosDSet,
          -- Shallow, deterministic, composable
 -        tyCoFVsOfType, tyCoFVsOfCo,
 +        shallowSelTypeFV, shallowSelCoFV,
          -- Almost devoid
          almostDevoidCoVarOfCo,
@@ -76,6 +66,7 @@ import GHC.Core.TyCon
  import GHC.Core.Coercion.Axiom( CoAxiomRule(..), BuiltInFamRewrite(..), coAxiomTyCon )
  import GHC.Types.Var
 +import GHC.Types.Var.FV
  import GHC.Types.Unique.FM
  import GHC.Types.Unique.Set
@@ -86,7 +77,6 @@ import GHC.Utils.Misc
  import GHC.Utils.EndoOS
  import GHC.Data.Pair
 -import GHC.Exts (oneShot)
  import Data.Semigroup
@@ -120,97 +110,42 @@ Examples:
    (a : (k:Type))           {a}        {a,k}
    forall (a:(k:Type)). a   {k}        {k}
    (a:k->Type) (b:k)        {a,b}      {a,b,k}
 --}
+-
+-
 -{- Note [Free variables of types]
 -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -The family of functions tyCoVarsOfType, tyCoVarsOfTypes etc, returns
 -a VarSet that is closed over the types of its variables.  More precisely,
 -  if    S = tyCoVarsOfType( t )
 -  and   (a:k) is in S
 -  then  tyCoVarsOftype( k ) is a subset of S
+-
 -Example: The tyCoVars of this ((a:* -> k) Int) is {a, k}.
+-
 -We could /not/ close over the kinds of the variable occurrences, and
 -instead do so at call sites, but it seems that we always want to do
 -so, so it's easiest to do it here.
+-
 -It turns out that getting the free variables of types is performance critical,
 -so we profiled several versions, exploring different implementation strategies.
+-
 -1. Baseline version: uses FV naively. Essentially:
+-
 -   tyCoVarsOfType ty = fvVarSet $ tyCoFVsOfType ty
+-
 -   This is not nice, because FV introduces some overhead to implement
 -   determinism, and through its "interesting var" function, neither of which
 -   we need here, so they are a complete waste.
 -2. UnionVarSet version: instead of reusing the FV-based code, we simply used
 -   VarSets directly, trying to avoid the overhead of FV. E.g.:
 -   -- FV version:
 -   tyCoFVsOfType (AppTy fun arg)    a b c = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) a b c
 +Note [Computing deep free variables]
 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 +tyCoVarsOfType computes the /deep/ free variables of a type; that is, if
 +`a::k` is in the result, then so are the free vars of `k`.  We say that the
 +resulting set is "closed over kinds".
 -   -- UnionVarSet version:
 -   tyCoVarsOfType (AppTy fun arg)    = (tyCoVarsOfType fun `unionVarSet` tyCoVarsOfType arg)
 +But we must take care (see #14880):
 -   This looks deceptively similar, but while FV internally builds a list- and
 -   set-generating function, the VarSet functions manipulate sets directly, and
 -   the latter performs a lot worse than the naive FV version.
 +1. Efficiency. If we have Proxy (a::ki) -> Proxy (a::ki) -> Proxy (a::ki), then
 +   we don't want to have to traverse ki more than once.
 -3. Accumulator-style VarSet version: this is what we use now. We do use VarSet
 -   as our data structure, but delegate the actual work to a new
 -   ty_co_vars_of_...  family of functions, which use accumulator style and the
 -   "in-scope set" filter found in the internals of FV, but without the
 -   determinism overhead.
+-
 -See #14880.
+-
 -Note [Closing over free variable kinds]
 -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -tyCoVarsOfType and tyCoFVsOfType, while traversing a type, will also close over
 -free variable kinds. In previous GHC versions, this happened naively: whenever
 -we would encounter an occurrence of a free type variable, we would close over
 -its kind. This, however is wrong for two reasons (see #14880):
+-
 -1. Efficiency. If we have Proxy (a::k) -> Proxy (a::k) -> Proxy (a::k), then
 -   we don't want to have to traverse k more than once.
+-
 -2. Correctness. Imagine we have forall k. b -> k, where b has
 -   kind k, for some k bound in an outer scope. If we look at b's kind inside
 +2. Correctness. Imagine we have forall k. (b::k) -> k, where b has
 +   kind k, for some k bound in an /outer/ scope. If we look at b's kind inside
     the forall, we'll collect that k is free and then remove k from the set of
     free variables. This is plain wrong. We must instead compute that b is free
     and then conclude that b's kind is free.
 -An obvious first approach is to move the closing-over-kinds from the
 -occurrences of a type variable to after finding the free vars - however, this
 -turns out to introduce performance regressions, and isn't even entirely
 -correct.
+-
 -In fact, it isn't even important *when* we close over kinds; what matters is
 -that we handle each type var exactly once, and that we do it in the right
 -context.
 +An obvious first approach is to compute the /shallow/ free variables of the type,
 +and /then/ close over kinds.   But that turns out not to be very efficient.
 +Fortunately, there is a simpler way, which works with the accumulating
 +free-var story described in (FV1) of Note [Finding free variables] in
 +GHC.Types.Var.FV.  At an occurrence of a variable (a::k)
 -So the next approach we tried was to use the "in-scope set" part of FV or the
 -equivalent argument in the accumulator-style `ty_co_vars_of_type` function, to
 -say "don't bother with variables we have already closed over". This should work
 -fine in theory, but the code is complicated and doesn't perform well.
 +* Check if `a` is a locally-bound var; if so, ignore it.
 -But there is a simpler way, which is implemented here. Consider the two points
 -above:
 +* Check if `a` is already in the accumulator; if so, ignore it because we have
 +  deal with its kind already. Also pre-checking set membership before inserting
 +  ends up not only being faster,
 -1. Efficiency: we now have an accumulator, so the second time we encounter 'a',
 -   we'll ignore it, certainly not looking at its kind - this is why
 -   pre-checking set membership before inserting ends up not only being faster,
 -   but also being correct.
 +* Otherwise add `a` to the accumulator,
 +  AND add on the free vars of its kind `k`.
 +  BUT in this latter step, start with an empty BoundVars set.
 -2. Correctness: we have an "in-scope set" (I think we should call it it a
 -  "bound-var set"), specifying variables that are bound by a forall in the type
 -  we are traversing; we simply ignore these variables, certainly not looking at
 -  their kind.
 +This twist is implemented in `deepUnitFV`
  So now consider:
@@ -222,22 +157,6 @@ this is our first encounter with b; we want the free vars of its kind. But we
  want to behave as if we took the free vars of its kind at the end; that is,
  with no bound vars in scope.
 -So the solution is easy. The old code was this:
+-
 -  ty_co_vars_of_type (TyVarTy v) is acc
 -    | v `elemVarSet` is  = acc
 -    | v `elemVarSet` acc = acc
 -    | otherwise          = ty_co_vars_of_type (tyVarKind v) is (extendVarSet acc v)
+-
 -Now all we need to do is take the free vars of tyVarKind v *with an empty
 -bound-var set*, thus:
+-
 -ty_co_vars_of_type (TyVarTy v) is acc
 -  | v `elemVarSet` is  = acc
 -  | v `elemVarSet` acc = acc
 -  | otherwise          = ty_co_vars_of_type (tyVarKind v) emptyVarSet (extendVarSet acc v)
 -                                                          ^^^^^^^^^^^
+-
  And that's it. This works because a variable is either bound or free. If it is bound,
  then we won't look at it at all. If it is free, then all the variables free in its
  kind are free -- regardless of whether some local variable has the same Unique.
@@ -266,147 +185,6 @@ The sole reason is in Note [Emitting the residual implication in simplifyInfer]
  in GHC.Tc.Solver.  Yuk.  This is not pretty.
  -}
 -{- *********************************************************************
 -*                                                                      *
 -          Endo for free variables
 -*                                                                      *
 -********************************************************************* -}
+-
 -{- Note [Accumulating parameter free variables]
 -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -We can use foldType to build an accumulating-parameter version of a
 -free-var finder, thus:
+-
 -    fvs :: Type -> TyCoVarSet
 -    fvs ty = appEndo (foldType folder ty) emptyVarSet
+-
 -Recall that
 -    foldType :: TyCoFolder env a -> env -> Type -> a
+-
 -    newtype Endo a = Endo (a -> a)   -- In Data.Monoid
 -    instance Monoid a => Monoid (Endo a) where
 -       (Endo f) `mappend` (Endo g) = Endo (f.g)
+-
 -    appEndo :: Endo a -> a -> a
 -    appEndo (Endo f) x = f x
+-
 -So `mappend` for Endos is just function composition.
+-
 -It's very important that, after optimisation, we end up with
 -* an arity-three function
 -* that is strict in the accumulator
+-
 -   fvs env (TyVarTy v) acc
 -      | v `elemVarSet` env = acc
 -      | v `elemVarSet` acc = acc
 -      | otherwise          = acc `extendVarSet` v
 -   fvs env (AppTy t1 t2)   = fvs env t1 (fvs env t2 acc)
 -   ...
+-
 -The "strict in the accumulator" part is to ensure that in the
 -AppTy equation we don't build a thunk for (fvs env t2 acc).
+-
 -The optimiser does do all this, but not very robustly. It depends
 -critically on the basic arity-2 function not being exported, so that
 -all its calls are visibly to three arguments. This analysis is
 -done by the Call Arity pass.
+-
 -TL;DR: check this regularly!
 --}
+-
+-
 -{- *********************************************************************
 -*                                                                      *
 -          Free-var result type
 -*                                                                      *
 -********************************************************************* -}
+-
 -type InterestingVarFun = Var -> Bool
+-
 -newtype FVRes env acc = FVRes' { runFV :: env -> acc }
 -  -- Caries an environment (typically empty, or a set of in-scope variables)
 -  -- and a composable accumulator
+-
 -pattern FVRes :: (env -> acc) -> FVRes env acc
 -pattern FVRes f <- FVRes' f
 -      where
 -        FVRes f = FVRes' (oneShot f)
 -         -- oneShot: this is the core of the one-shot trick!
 -         -- Note [The one-shot state monad trick] in  GHC.Utils.Monad.
+-
 -instance Semigroup a => Semigroup (FVRes env a) where
 -  f1 <>  f2 = FVRes (\env -> runFV f1 env <> runFV f2 env)
+-
 -instance Monoid a => Monoid (FVRes env a) where
 -  mempty  = FVRes (\_ -> mempty)
+-
 -addBndrFV :: (env -> env) -> FVRes env a -> FVRes env a
 -{-# INLINE addBndrFV #-}
 -addBndrFV upd f = FVRes (\bvs -> runFV f $! upd bvs)
 -    -- Strict application to avoid making a thunk
+-
 -addBndrFVRes :: TyCoVar -> FVRes BoundVars a -> FVRes BoundVars a
 -addBndrFVRes tcv = addBndrFV (\bvs -> extendVarSet bvs tcv)
+-
 -addBndrsFVRes :: [Var] -> FVRes BoundVars a -> FVRes BoundVars a
 -addBndrsFVRes tcvs = addBndrFV (\bvs -> extendVarSetList bvs tcvs)
+-
 -addBndrSelectiveFVRes :: TyCoVar -> FVRes (f, BoundVars) a -> FVRes (f, BoundVars) a
 -addBndrSelectiveFVRes tcv
 -  = addBndrFV (\(f,bvs) -> let !bvs' = extendVarSet bvs tcv
 -                               -- Strict let to avoid thunks
 -                           in (f,bvs'))
 -addBndrsSelectiveFVRes :: [Var] -> FVRes (f, BoundVars) a -> FVRes (f, BoundVars) a
 -addBndrsSelectiveFVRes bs
 -  = addBndrFV (\(f,bvs) -> let !bvs' = extendVarSetList bvs bs
 -                               -- Strict let to avoid thunks
 -                           in (f,bvs'))
+-
 -mapUnionFVRes :: (Foldable t, Monoid acc)
 -          => (a -> FVRes env acc) -> t a -> FVRes env acc
 -{-# INLINE mapUnionFVRes #-}
 -mapUnionFVRes f xs = foldr (mappend . f) mempty xs
+-
+-
 -type BoundVars = TyCoVarSet
+-
+-
 -type VarSetFVRes    = FVRes BoundVars (EndoOS TyCoVarSet)
 -type DVarSetFVRes   = FVRes BoundVars (EndoOS DTyCoVarSet)
 -type SelectiveFVRes = FVRes (InterestingVarFun, BoundVars) (EndoOS DVarSet)
 --- VarSetFVRes:    collects a VarSet
 --- DVarSetFVRes:   collects a DVarSet (deterministic)
 --- SelectiveFVRes: selectively collects a DVarSet
+-
 -type TyCoFVRes  = VarSetFVRes
 -type DTyCoFVRes = DVarSetFVRes
+-
 -runFVTop :: FVRes BoundVars a -> a
 -{-# INLINE runFVTop #-}
 -runFVTop f = runFV f emptyVarSet
+-
 -runFVAcc :: FVRes BoundVars (EndoOS a) -> a -> a
 -{-# INLINE runFVAcc #-}
 -runFVAcc f = runEndoOS (runFVTop f)
+-
 -runTyCoVars :: TyCoFVRes -> TyCoVarSet
 -{-# INLINE runTyCoVars #-}
 -runTyCoVars f = runFVAcc f emptyVarSet
+-
 -runTyCoVarsDSet :: DTyCoFVRes -> DTyCoVarSet
 -{-# INLINE runTyCoVarsDSet #-}
 -runTyCoVarsDSet f = runFVAcc f emptyDVarSet
+-
 -runFVSelective :: InterestingVarFun -> SelectiveFVRes -> DVarSet
 -runFVSelective interesting f
 -  = runEndoOS (runFV f (interesting, emptyVarSet)) emptyDVarSet
+-
 -runFVSelectiveList :: InterestingVarFun -> SelectiveFVRes -> [Var]
 -runFVSelectiveList interesting f = dVarSetElems (runFVSelective interesting f)
+-
 -runFVSelectiveSet :: InterestingVarFun -> SelectiveFVRes -> VarSet
 -runFVSelectiveSet interesting f = dVarSetToVarSet (runFVSelective interesting f)
+-
  {- *********************************************************************
  *                                                                      *
@@ -429,7 +207,7 @@ tyCoVarsOfTypes tys = runTyCoVars (deepTypesFV tys)
  tyCoVarsOfCo :: Coercion -> TyCoVarSet
  -- The "deep" TyCoVars of the the coercion
 --- See Note [Free variables of types]
 +-- See Note [Computing deep free variables]
  tyCoVarsOfCo co = runTyCoVars (deepCoFV co)
  tyCoVarsOfMCo :: MCoercion -> TyCoVarSet
@@ -441,17 +219,17 @@ tyCoVarsOfCos cos = runTyCoVars (deepCosFV cos)
  tyCoVarsOfThings :: Foldable t => (a -> Type) -> t a -> TyCoVarSet
  -- Works over a collection of things from which we can extract a type
 --- See Note [Free variables of types]
 +-- See Note [Computing deep free variables]
  tyCoVarsOfThings get_ty things
 -  = runTyCoVars $ mapUnionFVRes (deepTypeFV . get_ty) things
 +  = runTyCoVars $ mapUnionFV (deepTypeFV . get_ty) things
 -deepTypeFV  :: Type       -> TyCoFVRes
 -deepTypesFV :: [Type]     -> TyCoFVRes
 -deepCoFV    :: Coercion   -> TyCoFVRes
 -deepCosFV   :: [Coercion] -> TyCoFVRes
 +deepTypeFV  :: Type       -> TyCoFV
 +deepTypesFV :: [Type]     -> TyCoFV
 +deepCoFV    :: Coercion   -> TyCoFV
 +deepCosFV   :: [Coercion] -> TyCoFV
  (deepTypeFV, deepTypesFV, deepCoFV, deepCosFV) = foldTyCo deepTcvFolder
 -deepTcvFolder :: TyCoFolder TyCoFVRes
 +deepTcvFolder :: TyCoFolder TyCoFV
  -- It's important that we use a one-shot EndoOS, to ensure that all
  -- the free-variable finders are eta-expanded.  Lacking the one-shot-ness
  -- led to some big slow downs.  See Note [The one-shot state monad trick]
@@ -459,22 +237,23 @@ deepTcvFolder :: TyCoFolder TyCoFVRes
  deepTcvFolder = TyCoFolder { tcf_view = noView  -- See Note [Free vars and synonyms]
                             , tcf_tyvar = do_tcv, tcf_covar = do_tcv
                             , tcf_hole  = do_hole
 -                           , tcf_tycobinder = addBndrFVRes }
 +                           , tcf_tycobinder = addBndrFV }
    where
 -    do_tcv :: TyVar -> TyCoFVRes
 -    do_tcv = deepUnitFVRes deepTypeFV
 +    do_tcv :: TyVar -> TyCoFV
 +    do_tcv = deepUnitFV deepTypeFV
 -    do_hole :: CoercionHole -> TyCoFVRes
 +    do_hole :: CoercionHole -> TyCoFV
      do_hole hole = deepTypeFV (varType (coHoleCoVar hole))
                       -- We don't collect the CoercionHole itself, but we /do/
                       -- need to collect the free variables of its /kind/
                       -- See Note [CoercionHoles and coercion free variables]
 -deepUnitFVRes :: (Type -> TyCoFVRes) -> TyCoVar -> TyCoFVRes
 +deepUnitFV :: (Type -> TyCoFV) -> TyCoVar -> TyCoFV
  -- Deal with a single TyCoVar
  -- Takes a function to find free vars of the kind
 -deepUnitFVRes fvs_of_kind v
 -  = FVRes (\bvs -> EndoOS (do_it bvs))
 +-- See Note [Computing deep free variables]
 +deepUnitFV fvs_of_kind v
 +  = MkFV (\bvs -> EndoOS (do_it bvs))
    where
      do_it :: BoundVars -> TyCoVarSet -> TyCoVarSet
      do_it bvs acc | v `elemVarSet` bvs = acc
@@ -490,23 +269,23 @@ deepUnitFVRes fvs_of_kind v
  ********************************************************************* -}
  shallowTyCoVarsOfType :: Type -> TyCoVarSet
 --- See Note [Free variables of types]
 -shallowTyCoVarsOfType ty = runTyCoVars (shallow_ty ty)
 +-- See Note [Shallow and deep free variables]
 +shallowTyCoVarsOfType ty = runTyCoVars (shallowTypeFV ty)
  shallowTyCoVarsOfTypes :: [Type] -> TyCoVarSet
 -shallowTyCoVarsOfTypes tys = runTyCoVars (shallow_tys tys)
 +shallowTyCoVarsOfTypes tys = runTyCoVars (shallowTypesFV tys)
  shallowTyCoVarsOfCo :: Coercion -> TyCoVarSet
 -shallowTyCoVarsOfCo co = runTyCoVars (shallow_co co)
 +shallowTyCoVarsOfCo co = runTyCoVars (shallowCoFV co)
  shallowTyCoVarsOfCos :: [Coercion] -> TyCoVarSet
 -shallowTyCoVarsOfCos cos = runTyCoVars (shallow_cos cos)
 +shallowTyCoVarsOfCos cos = runTyCoVars (shallowCosFV cos)
  -- | Returns free variables of types, including kind variables as
  -- a non-deterministic set. For type synonyms it does /not/ expand the
  -- synonym.
  shallowTyCoVarsOfTyVarEnv :: TyVarEnv Type -> TyCoVarSet
 --- See Note [Free variables of types]
 +-- See Note [Shallow and deep free variables]of types]
  shallowTyCoVarsOfTyVarEnv tys = shallowTyCoVarsOfTypes (nonDetEltsUFM tys)
    -- It's OK to use nonDetEltsUFM here because we immediately
    -- forget the ordering by returning a set
@@ -516,25 +295,25 @@ shallowTyCoVarsOfCoVarEnv cos = shallowTyCoVarsOfCos (nonDetEltsUFM cos)
    -- It's OK to use nonDetEltsUFM here because we immediately
    -- forget the ordering by returning a set
 -shallow_ty  :: Type       -> TyCoFVRes
 -shallow_tys :: [Type]     -> TyCoFVRes
 -shallow_co  :: Coercion   -> TyCoFVRes
 -shallow_cos :: [Coercion] -> TyCoFVRes
 -(shallow_ty, shallow_tys, shallow_co, shallow_cos)
 +shallowTypeFV  :: Type       -> TyCoFV
 +shallowTypesFV :: [Type]     -> TyCoFV
 +shallowCoFV    :: Coercion   -> TyCoFV
 +shallowCosFV   :: [Coercion] -> TyCoFV
 +(shallowTypeFV, shallowTypesFV, shallowCoFV, shallowCosFV)
     = foldTyCo shallowTcvFolder
 -shallowTcvFolder :: TyCoFolder TyCoFVRes
 +shallowTcvFolder :: TyCoFolder TyCoFV
  shallowTcvFolder = TyCoFolder { tcf_view = noView  -- See Note [Free vars and synonyms]
                                , tcf_tyvar = do_tcv, tcf_covar = do_tcv
                                , tcf_hole  = do_hole
 -                              , tcf_tycobinder = addBndrFVRes }
 +                              , tcf_tycobinder = addBndrFV }
    where
 -    do_tcv = shallowUnitFVRes
 +    do_tcv = shallowUnitFV
      do_hole _  = mempty   -- Ignore coercion holes
 -shallowUnitFVRes :: TyCoVar -> TyCoFVRes
 -shallowUnitFVRes v
 -  = FVRes (\bvs -> EndoOS (do_it bvs))
 +shallowUnitFV :: TyCoVar -> TyCoFV
 +shallowUnitFV v
 +  = MkFV (\bvs -> EndoOS (do_it bvs))
    where
      do_it bvs acc | v `elemVarSet` bvs = acc
                    | v `elemVarSet` acc = acc
@@ -547,71 +326,71 @@ shallowUnitFVRes v
  *                                                                      *
  ********************************************************************* -}
 --- | `tyCoVarsOfTypeDSet` that returns free variables of a type in a deterministic
 --- set. For explanation of why using `VarSet` is not deterministic see
 --- Note [Deterministic FV] in "GHC.Utils.FV".
 +-- | `tyCoVarsOfTypeDSet` that returns deep free variables of a type in a
 +-- deterministic-- set. For explanation of why using `VarSet` is not deterministic
 +-- see Note [Deterministic FV] in "GHC.TYpes.Var.FV".
  tyCoVarsOfTypeDSet :: Type -> DTyCoVarSet
 --- See Note [Free variables of types]
 -tyCoVarsOfTypeDSet ty = runTyCoVarsDSet (detTyCoVarsOfType ty)
 +-- See Note [Computing deep free variables]
 +tyCoVarsOfTypeDSet ty = runTyCoVarsDSet (deepDetTypeFV ty)
  -- | Returns free variables of types, including kind variables as
  -- a deterministic set. For type synonyms it does /not/ expand the
  -- synonym.
  tyCoVarsOfTypesDSet :: [Type] -> DTyCoVarSet
 --- See Note [Free variables of types]
 -tyCoVarsOfTypesDSet tys = runTyCoVarsDSet (detTyCoVarsOfTypes tys)
 +-- See Note [Computing deep free variables]
 +tyCoVarsOfTypesDSet tys = runTyCoVarsDSet (deepDetTypesFV tys)
  tyCoVarsOfThingsDSet :: Foldable t => (a -> Type) -> t a -> DTyCoVarSet
  -- Works over a collection of things from which we can extract a type
 --- See Note [Free variables of types]
 +-- See Note [Computing deep free variables]
  tyCoVarsOfThingsDSet get_ty things
 -  = runTyCoVarsDSet (mapUnionFVRes (detTyCoVarsOfType . get_ty) things)
 +  = runTyCoVarsDSet (mapUnionFV (deepDetTypeFV . get_ty) things)
  -- | `tyCoVarsOfTypeList` returns free variables of a type in deterministic
  -- order. For explanation of why using `VarSet` is not deterministic see
 --- Note [Deterministic FV] in "GHC.Utils.FV".
 +-- Note [Deterministic FV] in "GHC.Types.Var.FV".
  tyCoVarsOfTypeList :: Type -> [TyCoVar]
 --- See Note [Free variables of types]
 +-- See Note [Computing deep free variables]
  tyCoVarsOfTypeList ty = dVarSetElems $ tyCoVarsOfTypeDSet ty
  tyCoVarsOfCoDSet :: Coercion -> DTyCoVarSet
 --- See Note [Free variables of types]
 -tyCoVarsOfCoDSet ty = runTyCoVarsDSet (detTyCoVarsOfCo ty)
 +-- See Note [Computing deep free variables]
 +tyCoVarsOfCoDSet ty = runTyCoVarsDSet (deepDetCoFV ty)
  tyCoVarsOfCoList :: Coercion -> [TyCoVar]
 --- See Note [Free variables of types]
 +-- See Note [Computing deep free variables]
  tyCoVarsOfCoList ty = dVarSetElems $ tyCoVarsOfCoDSet ty
  -- | Returns free variables of types, including kind variables as
  -- a deterministically ordered list. For type synonyms it does /not/ expand the
  -- synonym.
  tyCoVarsOfTypesList :: [Type] -> [TyCoVar]
 --- See Note [Free variables of types]
 +-- See Note [Computing deep free variables]
  tyCoVarsOfTypesList tys = dVarSetElems $ tyCoVarsOfTypesDSet tys
 -detTyCoVarsOfType  :: Type   -> DTyCoFVRes
 -detTyCoVarsOfTypes :: [Type] -> DTyCoFVRes
 -detTyCoVarsOfCo    :: Coercion -> DTyCoFVRes
 -(detTyCoVarsOfType, detTyCoVarsOfTypes, detTyCoVarsOfCo, _)
 -  = foldTyCo deepDetTcvFolder
 +deepDetTypeFV  :: Type   -> DTyCoFV
 +deepDetTypesFV :: [Type] -> DTyCoFV
 +deepDetCoFV    :: Coercion -> DTyCoFV
 +(deepDetTypeFV, deepDetTypesFV, deepDetCoFV, _) = foldTyCo deepDetTcvFolder
 -deepDetTcvFolder :: TyCoFolder DTyCoFVRes
 +deepDetTcvFolder :: TyCoFolder DTyCoFV
  -- This one returns a /deterministic/ list
  -- See `deepTcvFolder` for the general pattern
  deepDetTcvFolder
    = TyCoFolder { tcf_view = noView
                 , tcf_tyvar = do_tcv, tcf_covar = do_tcv
                 , tcf_hole  = do_hole
 -               , tcf_tycobinder = addBndrFVRes }
 +               , tcf_tycobinder = addBndrFV }
    where
 -    do_tcv = deepDetUnitFVRes detTyCoVarsOfType
 -    do_hole hole = detTyCoVarsOfType (varType (coHoleCoVar hole))
 +    do_tcv = deepDetUnitFV deepDetTypeFV
 +    do_hole hole = deepDetTypeFV (varType (coHoleCoVar hole))
 -deepDetUnitFVRes :: (Type -> DTyCoFVRes) -> TyCoVar -> DTyCoFVRes
 +deepDetUnitFV :: (Type -> DTyCoFV) -> TyCoVar -> DTyCoFV
  -- Deal with a single TyCoVar
  -- Takes a function to find free vars of the kind
 -deepDetUnitFVRes fvs_of_kind v
 -  = FVRes (\bvs -> EndoOS (do_it bvs))
 +-- See Note [Computing deep free variables]
 +deepDetUnitFV fvs_of_kind v
 +  = MkFV (\bvs -> EndoOS (do_it bvs))
    where
      do_it :: BoundVars -> DTyCoVarSet -> DTyCoVarSet
      do_it bvs acc | v `elemVarSet` bvs  = acc
@@ -627,28 +406,28 @@ deepDetUnitFVRes fvs_of_kind v
  someTyCoVarsOfType :: (TyCoVar -> Bool) -> Type -> [TyCoVar]
  someTyCoVarsOfType interesting
 -  = runFVSelectiveList interesting . tyCoFVsOfType
 +  = runFVSelectiveList interesting . shallowSelTypeFV
  someTyCoVarsOfTypes :: (TyCoVar -> Bool) -> [Type] -> [TyCoVar]
  someTyCoVarsOfTypes interesting
 -  = runFVSelectiveList interesting . mapUnionFVRes tyCoFVsOfType
 +  = runFVSelectiveList interesting . mapUnionFV shallowSelTypeFV
 -tyCoFVsOfType :: Type -> SelectiveFVRes
 -tyCoFVsOfCo   :: Coercion -> SelectiveFVRes
 +shallowSelTypeFV :: Type -> SelectiveFV
 +shallowSelCoFV   :: Coercion -> SelectiveFV
  -- Returns shallow free vars
 --- See Note [Free variables of types]
 -(tyCoFVsOfType, _, tyCoFVsOfCo, _) = foldTyCo selectiveTcvFolder
 +-- See Note [Shallow and deep free variables]
 +(shallowSelTypeFV, _, shallowSelCoFV, _) = foldTyCo selectiveTcvFolder
 -selectiveTcvFolder :: TyCoFolder SelectiveFVRes
 +selectiveTcvFolder :: TyCoFolder SelectiveFV
  -- This one takes an `InterestingVarFun`, and returns shallow free vars
  -- See `shallowTcvFolder` for the general pattern
  selectiveTcvFolder
    = TyCoFolder { tcf_view  = noView  -- See Note [Free vars and synonyms]
                 , tcf_tyvar = do_tcv, tcf_covar = do_tcv
                 , tcf_hole  = do_hole
 -               , tcf_tycobinder = addBndrSelectiveFVRes }
 +               , tcf_tycobinder = addBndrSelectiveFV }
    where
 -    do_tcv v = FVRes (\bvs -> EndoOS (do_it bvs))
 +    do_tcv v = MkFV (\bvs -> EndoOS (do_it bvs))
        where
          do_it (is_interesting,bvs) acc
            | not (is_interesting v) = acc  -- The "selective" bit
@@ -656,7 +435,7 @@ selectiveTcvFolder
            | v `elemDVarSet` acc    = acc
            | otherwise              = acc `extendDVarSet` v
 -    do_hole hole = tyCoFVsOfType (varType (coHoleCoVar hole))
 +    do_hole hole = shallowSelTypeFV (varType (coHoleCoVar hole))
  {- *********************************************************************
@@ -686,24 +465,24 @@ coVarsOfTypes :: [Type]     -> CoVarSet
  coVarsOfCo    :: Coercion   -> CoVarSet
  coVarsOfCos   :: [Coercion] -> CoVarSet
 -coVarsOfType  ty  = runTyCoVars (deep_cv_ty ty)
 -coVarsOfTypes tys = runTyCoVars (deep_cv_tys tys)
 -coVarsOfCo    co  = runTyCoVars (deep_cv_co co)
 -coVarsOfCos   cos = runTyCoVars (deep_cv_cos cos)
 +coVarsOfType  ty  = runTyCoVars (deepCoVarTypeFV ty)
 +coVarsOfTypes tys = runTyCoVars (deepCoVarTypesFV tys)
 +coVarsOfCo    co  = runTyCoVars (deepCoVarCoFV co)
 +coVarsOfCos   cos = runTyCoVars (deepCoVarCosFV cos)
 -type CoVarFVRes  = FVRes BoundVars (EndoOS CoVarSet)
 +type CoVarFV  = FV BoundVars (EndoOS CoVarSet)
 -deep_cv_ty  :: Type       -> CoVarFVRes
 -deep_cv_tys :: [Type]     -> CoVarFVRes
 -deep_cv_co  :: Coercion   -> CoVarFVRes
 -deep_cv_cos :: [Coercion] -> CoVarFVRes
 -(deep_cv_ty, deep_cv_tys, deep_cv_co, deep_cv_cos) = foldTyCo deepCoVarFolder
 +deepCoVarTypeFV  :: Type       -> CoVarFV
 +deepCoVarTypesFV :: [Type]     -> CoVarFV
 +deepCoVarCoFV  :: Coercion   -> CoVarFV
 +deepCoVarCosFV :: [Coercion] -> CoVarFV
 +(deepCoVarTypeFV, deepCoVarTypesFV, deepCoVarCoFV, deepCoVarCosFV) = foldTyCo deepCoVarFolder
 -deepCoVarFolder :: TyCoFolder CoVarFVRes
 +deepCoVarFolder :: TyCoFolder CoVarFV
  deepCoVarFolder = TyCoFolder { tcf_view = noView
                               , tcf_tyvar = do_tyvar, tcf_covar = do_covar
                               , tcf_hole  = do_hole
 -                             , tcf_tycobinder = addBndrFVRes }
 +                             , tcf_tycobinder = addBndrFV }
    where
      do_tyvar _  = mempty
        -- This do_tyvar means we won't see any CoVars in this
@@ -712,14 +491,14 @@ deepCoVarFolder = TyCoFolder { tcf_view = noView
        -- the tyvar won't end up in the accumulator, so
        -- we'd look repeatedly.  Blargh.
 -    do_covar = deepUnitFVRes deep_cv_ty
 +    do_covar = deepUnitFV deepCoVarTypeFV
      do_hole hole  = do_covar (coHoleCoVar hole)
        -- We /do/ treat a CoercionHole as a free variable
        -- See Note [CoercionHoles and coercion free variables]
  -------------- Deterministic versions ------------------
 -type DCoVarFVRes  = FVRes BoundVars (EndoOS DCoVarSet)
 +type DCoVarFV  = FV BoundVars (EndoOS DCoVarSet)
  coVarsOfCoDSet :: Coercion -> DCoVarSet
  coVarsOfCoDSet co = runTyCoVarsDSet (det_co co)
@@ -727,23 +506,23 @@ coVarsOfCoDSet co = runTyCoVarsDSet (det_co co)
  coVarsOfCosDSet :: [Coercion] -> DCoVarSet
  coVarsOfCosDSet cos = runTyCoVarsDSet (det_cos cos)
 -det_ty  :: Type       -> DCoVarFVRes
 -det_co  :: Coercion   -> DCoVarFVRes
 -det_cos :: [Coercion] -> DCoVarFVRes
 +det_ty  :: Type       -> DCoVarFV
 +det_co  :: Coercion   -> DCoVarFV
 +det_cos :: [Coercion] -> DCoVarFV
  (det_ty, _, det_co, det_cos) = foldTyCo deepDetCoVarFolder
 -deepDetCoVarFolder :: TyCoFolder DCoVarFVRes
 +deepDetCoVarFolder :: TyCoFolder DCoVarFV
  -- Follows deepCoVarFolders, but returns a /deterministic/ set
  deepDetCoVarFolder = TyCoFolder { tcf_view = noView
                                  , tcf_tyvar = do_tyvar
                                  , tcf_covar = do_covar
                                  , tcf_hole  = do_hole
 -                                , tcf_tycobinder = addBndrFVRes }
 +                                , tcf_tycobinder = addBndrFV }
    where
      do_tyvar _  = mempty
 -    do_covar :: CoVar -> DCoVarFVRes
 -    do_covar = deepDetUnitFVRes det_ty
 +    do_covar :: CoVar -> DCoVarFV
 +    do_covar = deepDetUnitFV det_ty
      do_hole hole  = do_covar (coHoleCoVar hole)
@@ -768,7 +547,7 @@ closeOverKinds vs = nonDetStrictFoldVarSet do_one vs vs
  closeOverKindsDSet :: DTyVarSet -> DTyVarSet
  closeOverKindsDSet vs = nonDetStrictFoldDVarSet do_one vs vs
    where
 -    do_one v = runFVAcc (detTyCoVarsOfType (varType v))
 +    do_one v = runFVAcc (deepDetTypeFV (varType v))
  {- --------------- Alternative version 1 (using FV) ------------
  closeOverKinds = fvVarSet . closeOverKindsFV . nonDetEltsUniqSet
@@ -1033,18 +812,18 @@ injectiveVarsOfTypes :: Bool -- ^ look under injective type families?
                               -- in "GHC.Tc.Instance.Family".
                       -> [Type] -> VarSet
  injectiveVarsOfTypes look_under_tfs tys
 -  = runTyCoVars $ mapUnionFVRes (inj_vars_of_type look_under_tfs) tys
 +  = runTyCoVars $ mapUnionFV (inj_vars_of_type look_under_tfs) tys
 -inj_vars_of_type :: Bool -> Type -> TyCoFVRes
 +inj_vars_of_type :: Bool -> Type -> TyCoFV
  inj_vars_of_type look_under_tfs = go
    where
      go ty | Just ty' <- rewriterView ty = go ty'
 -    go (TyVarTy v)                      = deepUnitFVRes go v
 +    go (TyVarTy v)                      = deepUnitFV go v
      go (AppTy f a)                      = go f `mappend` go a
      go (FunTy _ w ty1 ty2)              = go w `mappend` go ty1 `mappend` go ty2
      go (TyConApp tc tys)                = go_tc tc tys
      go (ForAllTy (Bndr tv _) ty)        = go (tyVarKind tv) `mappend`
 -                                          addBndrFVRes tv (go ty)
 +                                          addBndrFV tv (go ty)
      go LitTy{}                          = mempty
      go (CastTy ty _)                    = go ty
      go CoercionTy{}                     = mempty
@@ -1053,7 +832,7 @@ inj_vars_of_type look_under_tfs = go
        | isTypeFamilyTyCon tc
        = if | look_under_tfs
             , Injective flags <- tyConInjectivityInfo tc
 -           -> mapUnionFVRes go $
 +           -> mapUnionFV go $
                filterByList (flags ++ repeat True) tys
                           -- Oversaturated arguments to a tycon are
                           -- always injective, hence the repeat True
@@ -1061,7 +840,7 @@ inj_vars_of_type look_under_tfs = go
             -> mempty
        | otherwise        -- Data type, injective in all positions
 -      = mapUnionFVRes go tys
 +      = mapUnionFV go tys
@@ -1110,15 +889,15 @@ invisibleVarsOfTypes = foldr (unionVarSet . invisibleVarsOfType) emptyVarSet
  ********************************************************************* -}
  {-# INLINE afvFolder #-}   -- so that specialization to (const True) works
 -afvFolder :: (TyCoVar -> Bool) -> TyCoFolder (FVRes TyCoVarSet DM.Any)
 +afvFolder :: (TyCoVar -> Bool) -> TyCoFolder (FV TyCoVarSet DM.Any)
  -- 'afvFolder' is short for "any-free-var folder", good for checking
  -- if any free var of a type satisfies a predicate `check_fv`
  afvFolder check_fv = TyCoFolder { tcf_view = noView  -- See Note [Free vars and synonyms]
                                  , tcf_tyvar = do_tcv, tcf_covar = do_tcv
                                  , tcf_hole = do_hole
 -                                , tcf_tycobinder = addBndrFVRes }
 +                                , tcf_tycobinder = addBndrFV }
    where
 -    do_tcv tv = FVRes $ \ bvs ->
 +    do_tcv tv = MkFV $ \ bvs ->
                  Any (not (tv `elemVarSet` bvs) && check_fv tv)
      do_hole _ = mempty    -- I'm unsure; probably never happens

compiler/GHC/Core/Type.hs

@@ -159,11 +159,8 @@ module GHC.Core.Type (
          liftedTypeKind, unliftedTypeKind,
          -- * Type free variables
 -        tyCoFVsOfType,
 -        tyCoVarsOfType, tyCoVarsOfTypes,
 -        tyCoVarsOfTypeDSet,
 -        coVarsOfType,
 -        coVarsOfTypes,
 +        tyCoVarsOfType, tyCoVarsOfTypes, tyCoVarsOfTypeDSet,
 +        coVarsOfType, coVarsOfTypes,
          anyFreeVarsOfType, anyFreeVarsOfTypes,
          noFreeVarsOfType,

compiler/GHC/Iface/Ext/Ast.hs

@@ -23,7 +23,6 @@ import GHC.Core.DataCon           ( dataConWrapperType )
  import GHC.Core.Type              ( Type, ForAllTyFlag(..) )
  import GHC.Core.TyCon             ( TyCon, tyConClass_maybe )
  import GHC.Core.InstEnv
 -import GHC.Core.TyCo.FVs
  import GHC.Core.Predicate         ( isEvId )
  import GHC.Hs
@@ -40,6 +39,7 @@ import GHC.Types.Name.Reader      ( RecFieldInfo(..), WithUserRdr(..) )
  import GHC.Types.SrcLoc
  import GHC.Types.Var              ( Id, Var, EvId, varName, varType, varUnique )
  import GHC.Types.Var.Env
 +import GHC.Types.Var.FV
  import GHC.Tc.Types
  import GHC.Tc.Types.Evidence

compiler/GHC/Tc/Gen/App.hs

@@ -37,7 +37,6 @@ import GHC.Core.DataCon ( dataConConcreteTyVars, isNewDataCon, dataConOrigArgTys
  import GHC.Core.TyCon
  import GHC.Core.TyCo.Rep
  import GHC.Core.TyCo.Ppr
 -import GHC.Core.TyCo.FVs
  import GHC.Core.TyCo.Subst ( substTyWithInScope )
  import GHC.Core.Type
  import GHC.Core.Coercion
@@ -47,6 +46,7 @@ import GHC.Builtin.PrimOps( tagToEnumKey )
  import GHC.Builtin.Names
  import GHC.Types.Var
 +import GHC.Types.Var.FV
  import GHC.Types.Name
  import GHC.Types.Name.Env
  import GHC.Types.Name.Reader
@@ -2082,7 +2082,7 @@ foldQLInstVars check_tv ty
    where
      (do_ty, _, _, _) = foldTyCo folder
 -    folder :: TyCoFolder (FVRes () a)
 +    folder :: TyCoFolder (FV () a)
      folder = TyCoFolder { tcf_view = noView  -- See Note [Free vars and synonyms]
                                               -- in GHC.Core.TyCo.FVs
                          , tcf_tyvar = do_tv, tcf_covar = mempty
@@ -2093,8 +2093,8 @@ foldQLInstVars check_tv ty
      do_hole hole = do_ty (coVarKind (coHoleCoVar hole))
                       -- See (MIV2) in Note [Monomorphise instantiation variables]
 -    do_tv :: TcTyVar -> FVRes () a
 -    do_tv tv | isQLInstTyVar tv = FVRes $ \_ -> check_tv tv
 +    do_tv :: TcTyVar -> FV () a
 +    do_tv tv | isQLInstTyVar tv = MkFV $ \_ -> check_tv tv
               | otherwise        = mempty
  {- *********************************************************************

compiler/GHC/Tc/Types/Constraint.hs

@@ -117,6 +117,7 @@ import GHC.Core.TyCo.FVs
  import GHC.Types.Name
  import GHC.Types.Var
 +import GHC.Types.Var.FV
  import GHC.Tc.Utils.TcType
  import GHC.Tc.Types.Evidence
@@ -809,7 +810,7 @@ tyCoVarsOfCtList :: Ct -> [TcTyCoVar]
  tyCoVarsOfCtList = tyCoVarsOfTypeList . ctPred
  -- | Returns free variables of constraints as a deterministically ordered
 --- list. See Note [Deterministic FV] in GHC.Utils.FV.
 +-- list. See Note [Deterministic FV] in GHC.Types.Var.FV.
  tyCoVarsOfCtEvList :: CtEvidence -> [TcTyCoVar]
  tyCoVarsOfCtEvList = tyCoVarsOfTypeList . ctEvPred
@@ -819,49 +820,49 @@ tyCoVarsOfCts :: Cts -> TcTyCoVarSet
  tyCoVarsOfCts = dVarSetToVarSet . runTyCoVarsDSet . tcvs_of_cts
  -- | Returns free variables of a bag of constraints as a deterministically
 --- ordered list. See Note [Deterministic FV] in "GHC.Utils.FV".
 +-- ordered list. See Note [Deterministic FV] in "GHC.Types.Var.FV".
  tyCoVarsOfCtsList :: Cts -> [TcTyCoVar]
  tyCoVarsOfCtsList = dVarSetElems . tyCoVarsOfThingsDSet ctPred
  -- | Returns free variables of a bag of constraints as a deterministically
 --- ordered list. See Note [Deterministic FV] in GHC.Utils.FV.
 +-- ordered list. See Note [Deterministic FV] in GHC.Types.Var.FV.
  tyCoVarsOfCtEvsList :: [CtEvidence] -> [TcTyCoVar]
  tyCoVarsOfCtEvsList = dVarSetElems . runTyCoVarsDSet
 -                      . mapUnionFVRes (detTyCoVarsOfType . ctEvPred)
 +                      . mapUnionFV (deepDetTypeFV . ctEvPred)
  -- | Returns free variables of WantedConstraints as a non-deterministic
 --- set. See Note [Deterministic FV] in "GHC.Utils.FV".
 +-- set. See Note [Deterministic FV] in "GHC.Types.Var.FV".
  tyCoVarsOfWC :: WantedConstraints -> TyCoVarSet
  -- Only called on *zonked* things
  tyCoVarsOfWC = dVarSetToVarSet . tyCoVarsOfWcDSet
  -- | Returns free variables of WantedConstraints as a deterministically
 --- ordered list. See Note [Deterministic FV] in "GHC.Utils.FV".
 +-- ordered list. See Note [Deterministic FV] in "GHC.Types.Var.FV".
  tyCoVarsOfWCList :: WantedConstraints -> [TyCoVar]
  -- Only called on *zonked* things
  tyCoVarsOfWCList = dVarSetElems . tyCoVarsOfWcDSet
  -- | Returns free variables of WantedConstraints as a composable FV
 --- computation. See Note [Deterministic FV] in "GHC.Utils.FV".
 +-- computation. See Note [Deterministic FV] in "GHC.Types.Var.FV".
  tyCoVarsOfWcDSet :: WantedConstraints -> DTyCoVarSet
  -- Only called on *zonked* things
  tyCoVarsOfWcDSet = runTyCoVarsDSet . tcvs_of_wc
 -tcvs_of_wc :: WantedConstraints -> DTyCoFVRes
 +tcvs_of_wc :: WantedConstraints -> DTyCoFV
  tcvs_of_wc (WC { wc_simple = simple, wc_impl = implics, wc_errors = errors })
    = tcvs_of_cts simple               `mappend`
 -    mapUnionFVRes tcvs_of_implic implics `mappend`
 -    mapUnionFVRes tcvs_of_errs errors
 +    mapUnionFV tcvs_of_implic implics `mappend`
 +    mapUnionFV tcvs_of_errs errors
 -tcvs_of_cts :: Cts -> DTyCoFVRes
 -tcvs_of_cts = mapUnionFVRes tcvs_of_ct
 +tcvs_of_cts :: Cts -> DTyCoFV
 +tcvs_of_cts = mapUnionFV tcvs_of_ct
 -tcvs_of_ct :: Ct -> DTyCoFVRes
 -tcvs_of_ct ct = detTyCoVarsOfType (ctPred ct)
 +tcvs_of_ct :: Ct -> DTyCoFV
 +tcvs_of_ct ct = deepDetTypeFV (ctPred ct)
  -- | Returns free variables of Implication as a composable FV computation.
 --- See Note [Deterministic FV] in "GHC.Utils.FV".
 -tcvs_of_implic :: Implication -> DTyCoFVRes
 +-- See Note [Deterministic FV] in "GHC.Types.Var.FV".
 +tcvs_of_implic :: Implication -> DTyCoFV
  -- Only called on *zonked* things
  tcvs_of_implic (Implic { ic_skols = skols
                         , ic_given = givens
@@ -869,17 +870,17 @@ tcvs_of_implic (Implic { ic_skols = skols
    | isEmptyWC wanted
    = mempty
    | otherwise
 -  = addBndrsFVRes skols  $
 -    addBndrsFVRes givens $
 +  = addBndrsFV skols  $
 +    addBndrsFV givens $
      tcvs_of_wc wanted
 -tcvs_of_errs :: DelayedError -> DTyCoFVRes
 +tcvs_of_errs :: DelayedError -> DTyCoFV
  tcvs_of_errs (DE_Hole hole)         = tcvs_of_hole hole
  tcvs_of_errs (DE_NotConcrete {})    = mempty
 -tcvs_of_errs (DE_Multiplicity co _) = detTyCoVarsOfCo co
 +tcvs_of_errs (DE_Multiplicity co _) = deepDetCoFV co
 -tcvs_of_hole :: Hole -> DTyCoFVRes
 -tcvs_of_hole (Hole { hole_ty = ty }) = detTyCoVarsOfType ty
 +tcvs_of_hole :: Hole -> DTyCoFV
 +tcvs_of_hole (Hole { hole_ty = ty }) = deepDetTypeFV ty
  {-
  ************************************************************************

compiler/GHC/Tc/Types/Evidence.hs

@@ -64,7 +64,6 @@ import GHC.Core.Ppr ()   -- Instance OutputableBndr TyVar
  import GHC.Core.Predicate
  import GHC.Core.Type
  import GHC.Core.TyCo.Rep (UnivCoProvenance(..))
 -import GHC.Core.TyCo.FVs
  import GHC.Core.TyCon
  import GHC.Core.Make    ( mkWildCase, mkRuntimeErrorApp, tYPE_ERROR_ID )
  import GHC.Core.Class   ( classTyCon )
@@ -80,6 +79,7 @@ import GHC.Types.Var
  import GHC.Types.Id( idType )
  import GHC.Types.Var.Env
  import GHC.Types.Var.Set
 +import GHC.Types.Var.FV
  import GHC.Types.Basic
  import GHC.Builtin.Names
@@ -1318,25 +1318,25 @@ nestedEvIdsOfTerm :: EvTerm -> VarSet
  -- Returns only EvIds satisfying relevantEvId
  nestedEvIdsOfTerm = runFVSelectiveSet isNestedEvId . evTermFVs
 -evTermFVs :: EvTerm -> SelectiveFVRes
 +evTermFVs :: EvTerm -> SelectiveFV
  evTermFVs (EvExpr e)         = exprFVs e
  evTermFVs (EvTypeable _ ev)  = evFVsOfTypeable ev
  evTermFVs (EvFun { et_tvs = tvs, et_given = given
                   , et_binds = tc_ev_binds, et_body = v })
    = case tc_ev_binds of
        TcEvBinds {}  -> mempty  -- See Note [Free vars of EvFun]
 -      EvBinds binds -> addBndrsFV bndrs fvs
 +      EvBinds binds -> addBndrsSelectiveFV bndrs fvs
          where
            fvs = foldr (mappend . evTermFVs . eb_rhs) (unitFV v) binds
            bndrs = foldr ((:) . eb_lhs) (tvs ++ given) binds
 -evTermFVss :: [EvTerm] -> SelectiveFVRes
 -evTermFVss = mapUnionFVRes evTermFVs
 +evTermFVss :: [EvTerm] -> SelectiveFV
 +evTermFVss = mapUnionFV evTermFVs
 -evFVsOfTypeable :: EvTypeable -> SelectiveFVRes
 +evFVsOfTypeable :: EvTypeable -> SelectiveFV
  evFVsOfTypeable ev =
    case ev of
 -    EvTypeableTyCon _ e      -> mapUnionFVRes evTermFVs e
 +    EvTypeableTyCon _ e      -> mapUnionFV evTermFVs e
      EvTypeableTyApp e1 e2    -> evTermFVss [e1,e2]
      EvTypeableTrFun em e1 e2 -> evTermFVss [em,e1,e2]
      EvTypeableTyLit e        -> evTermFVs e

compiler/GHC/Tc/Utils/TcMType.hs

@@ -1565,7 +1565,7 @@ against any specification -- just suboptimal and confounding to users.
  Note [Recurring into kinds for candidateQTyVars]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -First, read Note [Closing over free variable kinds] in GHC.Core.TyCo.FVs, paying
 +First, read Note [Computing deep free variables] in GHC.Core.TyCo.FVs, paying
  attention to the end of the Note about using an empty bound set when
  traversing a variable's kind.
@@ -1582,7 +1582,7 @@ type inference, which is seeded by the renamer and its insistence to
  use different Uniques for different variables. (In contrast, the Core
  functions work on the output of optimizations, which may introduce
  shadowing.) Without shadowing, the problem studied by
 -Note [Closing over free variable kinds] in GHC.Core.TyCo.FVs cannot happen.
 +Note [Computing deep free variables] in GHC.Core.TyCo.FVs cannot happen.
  Why it is necessary:
  Wiping the bound set would be just plain wrong here. Consider
@@ -1593,7 +1593,7 @@ We really don't want to think k1 and k2 are free here. (It's true that we'll
  never be able to fill in `hole`, but we don't want to go off the rails just
  because we have an insoluble coercion hole.) So: why is it wrong to wipe
  the bound variables here but right in Core? Because the final statement
 -in Note [Closing over free variable kinds] in GHC.Core.TyCo.FVs is wrong: not
 +in Note [Computing deep free variables] in GHC.Core.TyCo.FVs is wrong: not
  every variable is either free or bound. A variable can be a hole, too!
  The reasoning in that Note then breaks down.

compiler/GHC/Tc/Utils/TcType.hs

@@ -219,16 +219,17 @@ import {-# SOURCE #-} GHC.Tc.Types.Origin
    ( SkolemInfo, unkSkol
    , FixedRuntimeRepOrigin, FixedRuntimeRepContext )
 --- others:
 +import GHC.Types.Var.FV
  import GHC.Types.Name as Name
              -- We use this to make dictionaries for type literals.
              -- Perhaps there's a better way to do this?
  import GHC.Types.Name.Env
  import GHC.Types.Name.Set
 +import GHC.Types.Basic
++
  import GHC.Builtin.Names
  import GHC.Builtin.Types ( coercibleClass, eqClass, heqClass, unitTyConKey
                           , listTyCon, constraintKind )
 -import GHC.Types.Basic
  import GHC.Data.Maybe
  import GHC.Data.List.SetOps ( getNth, findDupsEq )
@@ -1178,11 +1179,11 @@ exactTyCoVarsOfTypes :: [Type] -> TyCoVarSet
  exactTyCoVarsOfType  ty  = runTyCoVars (exact_ty ty)
  exactTyCoVarsOfTypes tys = runTyCoVars (exact_tys tys)
 -exact_ty  :: Type       -> TyCoFVRes
 -exact_tys :: [Type]     -> TyCoFVRes
 +exact_ty  :: Type       -> TyCoFV
 +exact_tys :: [Type]     -> TyCoFV
  (exact_ty, exact_tys, _, _) = foldTyCo exactTcvFolder
 -exactTcvFolder :: TyCoFolder TyCoFVRes
 +exactTcvFolder :: TyCoFolder TyCoFV
  exactTcvFolder = deepTcvFolder { tcf_view = coreView }
                   -- This is the key line

compiler/GHC/Tc/Utils/Unify.hs

@@ -101,6 +101,7 @@ import GHC.Types.Id( idType )
  import GHC.Types.Var as Var
  import GHC.Types.Var.Set
  import GHC.Types.Var.Env
 +import GHC.Types.Var.FV
  import GHC.Types.Basic
  import GHC.Types.Unique.Set (nonDetEltsUniqSet)
@@ -3572,20 +3573,20 @@ mkOccFolders :: Name -> (TcType -> Bool, TcCoercion -> Bool)
  mkOccFolders lhs_tv = ( getAny . runFVTop . check_ty
                        , getAny . runFVTop . check_co)
    where
 -    check_ty :: Type -> FVRes BoundVars Any
 +    check_ty :: Type -> FV BoundVars Any
      !(check_ty, _, check_co, _) = foldTyCo occ_folder
 -    occ_folder :: TyCoFolder (FVRes BoundVars Any)
 +    occ_folder :: TyCoFolder (FV BoundVars Any)
      occ_folder = TyCoFolder { tcf_view  = noView  -- Don't expand synonyms
                              , tcf_tyvar = do_tcv, tcf_covar = do_tcv
                              , tcf_hole  = do_hole
 -                            , tcf_tycobinder = addBndrFVRes }
 +                            , tcf_tycobinder = addBndrFV }
 -    do_tcv v = (FVRes $ \ bvs ->
 +    do_tcv v = (MkFV $ \ bvs ->
                  Any (not (v `elemVarSet` bvs) && tyVarName v == lhs_tv))
                 `mappend` check_ty (varType v)
 -    do_hole _hole = FVRes $ \ _bvs -> DM.Any True  -- Reject coercion holes
 +    do_hole _hole = MkFV $ \ _bvs -> DM.Any True  -- Reject coercion holes
  {- *********************************************************************
  *                                                                      *

compiler/GHC/Utils/EndoOS.hs

  {-# LANGUAGE PatternSynonyms #-}
  -- | One-shot endomorphisms
 ---   Mostly for backwards compatibility.
  -- One-shot endomorphisms
  -- Like GHC.Internal.Data.Semigroup.Internal.Endo, but using
  -- the one-shot trick from
  --    Note [The one-shot state monad trick] in  GHC.Utils.Monad.
 +--
 +-- It is also strict: see the (<>) method in he Semigroup instance
  module GHC.Utils.EndoOS( EndoOS(EndoOS, runEndoOS ), foldEndoOS ) where
@@ -19,13 +20,21 @@ newtype EndoOS a = EndoOS' { runEndoOS :: a -> a }
  instance Semigroup (EndoOS a) where
 -  f <> g = EndoOS (\x -> runEndoOS f $! (runEndoOS g x))
 -           -- Strict application, to avoid thunk creation
 +  EndoOS' f <> EndoOS' g = EndoOS (\x -> g $! f x)
 +     -- NB1: Strict application, to avoid thunk creation
 +     --      See (FV3) in Note [Finding free variables]
 +     --      in GHC.Types.Var.FV
 +     -- NB2: We apply `f` to the acccumulator first, then `g`
 +     --      So if we traverse a type left-to-right, the insertion
 +     --      order for (say) free type variables is left-to-right
 +     --      See (FV4) in Note [Finding free variables]
 +     --      in GHC.Types.Var.FV
  instance Monoid (EndoOS a) where
     mempty  = EndoOS id
  pattern EndoOS :: (a->a) -> EndoOS a
 +{-# COMPLETE EndoOS #-}
  pattern EndoOS f <- EndoOS' f
        where
          EndoOS f = EndoOS' (oneShot f)

compiler/GHC/Utils/FV.hs deleted

 -{-
 -(c) Bartosz Nitka, Facebook 2015
+-
 --}
+-
 --- | Utilities for efficiently and deterministically computing free variables.
 -module GHC.Utils.FV (
 -        -- * Deterministic free vars computations
 -        FV, InterestingVarFun,
+-
 -        -- * Running the computations
 -        fvVarList, fvVarSet, fvDVarSet,
+-
 -        -- ** Manipulating those computations
 -        unitFV,
 -        emptyFV,
 -        mkFVs,
 -        unionFV,
 -        unionsFV,
 -        delFV,
 -        delFVs,
 -        filterFV,
 -        mapUnionFV,
 -        fvDVarSetSome,
 -    ) where
+-
 -import GHC.Prelude
+-
 -import GHC.Types.Var
 -import GHC.Types.Var.Set
+-
 --- | Predicate on possible free variables: returns @True@ iff the variable is
 --- interesting
 -type InterestingVarFun = Var -> Bool
+-
 --- Note [Deterministic FV]
 --- ~~~~~~~~~~~~~~~~~~~~~~~
 --- When computing free variables, the order in which you get them affects
 --- the results of floating and specialization. If you use UniqFM to collect
 --- them and then turn that into a list, you get them in nondeterministic
 --- order as described in Note [Deterministic UniqFM] in GHC.Types.Unique.DFM.
+-
 --- A naive algorithm for free variables relies on merging sets of variables.
 --- Merging costs O(n+m) for UniqFM and for UniqDFM there's an additional log
 --- factor. It's cheaper to incrementally add to a list and use a set to check
 --- for duplicates.
 -type FV = InterestingVarFun -- Used for filtering sets as we build them
 -        -> VarSet           -- Locally bound variables
 -        -> VarAcc           -- Accumulator
 -        -> VarAcc
+-
 -type VarAcc = ([Var], VarSet)  -- List to preserve ordering and set to check for membership,
 -                               -- so that the list doesn't have duplicates
 -                               -- For explanation of why using `VarSet` is not deterministic see
 -                               -- Note [Deterministic UniqFM] in GHC.Types.Unique.DFM.
+-
 --- Note [FV naming conventions]
 --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --- To get the performance and determinism that FV provides, FV computations
 --- need to built up from smaller FV computations and then evaluated with
 --- one of `fvVarList`, `fvDVarSet` That means the functions
 --- returning FV need to be exported.
 ---
 --- The conventions are:
 ---
 --- a) non-deterministic functions:
 ---   * a function that returns VarSet
 ---       e.g. `tyVarsOfType`
 --- b) deterministic functions:
 ---   * a worker that returns FV
 ---       e.g. `tyFVsOfType`
 ---   * a function that returns [Var]
 ---       e.g. `tyVarsOfTypeList`
 ---   * a function that returns DVarSet
 ---       e.g. `tyVarsOfTypeDSet`
 ---
 --- Where tyVarsOfType, tyVarsOfTypeList, tyVarsOfTypeDSet are implemented
 --- in terms of the worker evaluated with fvVarSet, fvVarList, fvDVarSet
 --- respectively.
+-
 --- | Run a free variable computation, returning a list of distinct free
 --- variables in deterministic order and a non-deterministic set containing
 --- those variables.
 -fvVarAcc :: FV ->  ([Var], VarSet)
 -fvVarAcc fv = fv (const True) emptyVarSet ([], emptyVarSet)
+-
 --- | Run a free variable computation, returning a list of distinct free
 --- variables in deterministic order.
 -fvVarList :: FV -> [Var]
 -fvVarList = fst . fvVarAcc
+-
 --- | Run a free variable computation, returning a deterministic set of free
 --- variables. Note that this is just a wrapper around the version that
 --- returns a deterministic list. If you need a list you should use
 --- `fvVarList`.
 -fvDVarSet :: FV -> DVarSet
 -fvDVarSet = mkDVarSet . fvVarList
+-
 --- | Run a free variable computation, returning a non-deterministic set of
 --- free variables. Don't use if the set will be later converted to a list
 --- and the order of that list will impact the generated code.
 -fvVarSet :: FV -> VarSet
 -fvVarSet = snd . fvVarAcc
+-
 --- Note [FV eta expansion]
 --- ~~~~~~~~~~~~~~~~~~~~~~~
 --- Let's consider an eta-reduced implementation of freeVarsOf using FV:
 ---
 --- freeVarsOf (App a b) = freeVarsOf a `unionFV` freeVarsOf b
 ---
 --- If GHC doesn't eta-expand it, after inlining unionFV we end up with
 ---
 --- freeVarsOf = \x ->
 ---   case x of
 ---     App a b -> \fv_cand in_scope acc ->
 ---       freeVarsOf a fv_cand in_scope $! freeVarsOf b fv_cand in_scope $! acc
 ---
 --- which has to create a thunk, resulting in more allocations.
 ---
 --- On the other hand if it is eta-expanded:
 ---
 --- freeVarsOf (App a b) fv_cand in_scope acc =
 ---   (freeVarsOf a `unionFV` freeVarsOf b) fv_cand in_scope acc
 ---
 --- after inlining unionFV we have:
 ---
 --- freeVarsOf = \x fv_cand in_scope acc ->
 ---   case x of
 ---     App a b ->
 ---       freeVarsOf a fv_cand in_scope $! freeVarsOf b fv_cand in_scope $! acc
 ---
 --- which saves allocations.
 ---
 --- GHC when presented with knowledge about all the call sites, correctly
 --- eta-expands in this case. Unfortunately due to the fact that freeVarsOf gets
 --- exported to be composed with other functions, GHC doesn't have that
 --- information and has to be more conservative here.
 ---
 --- Hence functions that get exported and return FV need to be manually
 --- eta-expanded. See also #11146.
+-
 --- | Add a variable - when free, to the returned free variables.
 --- Ignores duplicates and respects the filtering function.
 -unitFV :: Id -> FV
 -unitFV var fv_cand in_scope acc@(have, haveSet)
 -  | var `elemVarSet` in_scope = acc
 -  | var `elemVarSet` haveSet = acc
 -  | fv_cand var = (var:have, extendVarSet haveSet var)
 -  | otherwise = acc
 -{-# INLINE unitFV #-}
+-
 --- | Return no free variables.
 -emptyFV :: FV
 -emptyFV _ _ acc = acc
 -{-# INLINE emptyFV #-}
+-
 --- | Union two free variable computations.
 -unionFV :: FV -> FV -> FV
 -unionFV fv1 fv2 fv_cand in_scope acc =
 -  fv1 fv_cand in_scope $! fv2 fv_cand in_scope $! acc
 -{-# INLINE unionFV #-}
+-
 --- | Mark the variable as not free by putting it in scope.
 -delFV :: Var -> FV -> FV
 -delFV var fv fv_cand !in_scope acc =
 -  fv fv_cand (extendVarSet in_scope var) acc
 -{-# INLINE delFV #-}
+-
 --- | Mark many free variables as not free.
 -delFVs :: VarSet -> FV -> FV
 -delFVs vars fv fv_cand !in_scope acc =
 -  fv fv_cand (in_scope `unionVarSet` vars) acc
 -{-# INLINE delFVs #-}
+-
 --- | Filter a free variable computation.
 -filterFV :: InterestingVarFun -> FV -> FV
 -filterFV fv_cand2 fv fv_cand1 in_scope acc =
 -  fv (\v -> fv_cand1 v && fv_cand2 v) in_scope acc
 -{-# INLINE filterFV #-}
+-
 --- | Map a free variable computation over a list and union the results.
 -mapUnionFV :: (a -> FV) -> [a] -> FV
 -mapUnionFV _f [] _fv_cand _in_scope acc = acc
 -mapUnionFV f (a:as) fv_cand in_scope acc =
 -  mapUnionFV f as fv_cand in_scope $! f a fv_cand in_scope $! acc
 -{-# INLINABLE mapUnionFV #-}
+-
 --- | Union many free variable computations.
 -unionsFV :: [FV] -> FV
 -unionsFV fvs fv_cand in_scope acc = mapUnionFV id fvs fv_cand in_scope acc
 -{-# INLINE unionsFV #-}
+-
 --- | Add multiple variables - when free, to the returned free variables.
 --- Ignores duplicates and respects the filtering function.
 -mkFVs :: [Var] -> FV
 -mkFVs vars fv_cand in_scope acc =
 -  mapUnionFV unitFV vars fv_cand in_scope acc
 -{-# INLINE mkFVs #-}
+-
 -fvDVarSetSome :: InterestingVarFun -> FV -> DVarSet
 -fvDVarSetSome interesting_var fv =
 -  mkDVarSet $ fst $ fv interesting_var emptyVarSet ([], emptyVarSet)

compiler/ghc.cabal.in

@@ -951,6 +951,7 @@ Library
          GHC.Types.Var
          GHC.Types.Var.Env
          GHC.Types.Var.Set
 +        GHC.Types.Var.FV
          GHC.Unit
          GHC.Unit.Env
          GHC.Unit.External
@@ -992,7 +993,6 @@ Library
          GHC.Utils.EndoOS
          GHC.Utils.Exception
          GHC.Utils.Fingerprint
 -        GHC.Utils.FV
          GHC.Utils.GlobalVars
          GHC.Utils.IO.Unsafe
          GHC.Utils.Json

utils/haddock/haddock-api/src/Haddock/GhcUtils.hs

@@ -43,7 +43,8 @@ import qualified Data.Set as Set
  import GHC hiding (HsTypeGhcPsExt (..))
  import GHC.Builtin.Types (liftedRepTy)
  import GHC.Core.TyCo.Rep (Type (..))
 -import GHC.Core.Type (binderVar, isRuntimeRepVar)
 +import GHC.Core.TyCo.FVs ( deepDetTypesFV )
 +import GHC.Core.Type (isRuntimeRepVar)
  import GHC.Data.StringBuffer (StringBuffer)
  import qualified GHC.Data.StringBuffer as S
  import GHC.Driver.Session
@@ -52,17 +53,11 @@ import GHC.Types.Name
  import GHC.Types.SrcLoc (advanceSrcLoc)
  import GHC.Types.SourceText (SourceText(..))
  import GHC.Types.Var
 -  ( Specificity
 -  , TyVarBinder
 -  , VarBndr (..)
 -  , isInvisibleForAllTyFlag
 -  , tyVarKind
 -  , updateTyVarKind
 -  )
 -import GHC.Types.Var.Env (TyVarEnv, elemVarEnv, emptyVarEnv, extendVarEnv)
 -import GHC.Types.Var.Set (VarSet, emptyVarSet)
 -import GHC.Utils.FV as FV
 +import GHC.Types.Var.Env
 +import GHC.Types.Var.Set
 +import GHC.Types.Var.FV
  import GHC.Utils.Outputable (Outputable, SDocContext, ppr)
 +import GHC.Utils.EndoOS
  import qualified GHC.Utils.Outputable as Outputable
  import GHC.Utils.Panic (panic)
@@ -86,6 +81,7 @@ filterSigNames p orig@(SpecSig _ n _ _) = ifTrueJust (p $ unLoc n) orig
  filterSigNames p orig@(InlineSig _ n _) = ifTrueJust (p $ unLoc n) orig
  filterSigNames p (FixSig _ (FixitySig ns_spec ns ty)) =
    case filter (p . unLoc) ns of
++
      [] -> Nothing
      filtered -> Just (FixSig noAnn (FixitySig ns_spec filtered ty))
  filterSigNames _ orig@(MinimalSig _ _) = Just orig
@@ -817,66 +813,14 @@ isTypeHidden expInfo = typeHidden
  -- | Get free type variables in a 'Type' in their order of appearance.
  -- See [Ordering of implicit variables].
  orderedFVs
 -  :: VarSet
 -  -- ^ free variables to ignore
 -  -> [Type]
 -  -- ^ types to traverse (in order) looking for free variables
 -  -> [TyVar]
 -  -- ^ free type variables, in the order they appear in
 -orderedFVs vs tys =
 -  reverse . fst $ tyCoFVsOfTypes' tys (const True) vs ([], emptyVarSet)
+-
 --- See the "Free variables of types and coercions" section in 'TyCoRep', or
 --- check out Note [Free variables of types]. The functions in this section
 --- don't output type variables in the order they first appear in in the 'Type'.
 ---
 --- For example, 'tyCoVarsOfTypeList' reports an incorrect order for the type
 --- of 'const :: a -> b -> a':
 ---
 --- >>> import GHC.Types.Name
 --- >>> import TyCoRep
 --- >>> import GHC.Builtin.Types.Prim
 --- >>> import GHC.Types.Var
 --- >>> a = TyVarTy alphaTyVar
 --- >>> b = TyVarTy betaTyVar
 --- >>> constTy = mkFunTys [a, b] a
 --- >>> map (getOccString . tyVarName) (tyCoVarsOfTypeList constTy)
 --- ["b","a"]
 ---
 --- However, we want to reuse the very optimized traversal machinery there, so
 --- so we make our own `tyCoFVsOfType'`, `tyCoFVsBndr'`, and `tyCoVarsOfTypes'`.
 --- All these do differently is traverse in a different order and ignore
 --- coercion variables.
+-
 --- | Just like 'tyCoFVsOfType', but traverses type variables in reverse order
 --- of  appearance.
 -tyCoFVsOfType' :: Type -> FV
 -tyCoFVsOfType' (TyVarTy v) a b c = (FV.unitFV v `unionFV` tyCoFVsOfType' (tyVarKind v)) a b c
 -tyCoFVsOfType' (TyConApp _ tys) a b c = tyCoFVsOfTypes' tys a b c
 -tyCoFVsOfType' (LitTy{}) a b c = emptyFV a b c
 -tyCoFVsOfType' (AppTy fun arg) a b c = (tyCoFVsOfType' arg `unionFV` tyCoFVsOfType' fun) a b c
 -tyCoFVsOfType' (FunTy _ w arg res) a b c =
 -  ( tyCoFVsOfType' res
 -      `unionFV` tyCoFVsOfType' w
 -      `unionFV` tyCoFVsOfType' arg
 -  )
 -    a
 -    b
 -    c
 -tyCoFVsOfType' (ForAllTy bndr ty) a b c = tyCoFVsBndr' bndr (tyCoFVsOfType' ty) a b c
 -tyCoFVsOfType' (CastTy ty _) a b c = (tyCoFVsOfType' ty) a b c
 -tyCoFVsOfType' (CoercionTy _) a b c = emptyFV a b c
+-
 --- | Just like 'tyCoFVsOfTypes', but traverses type variables in reverse order
 --- of appearance.
 -tyCoFVsOfTypes' :: [Type] -> FV
 -tyCoFVsOfTypes' (ty : tys) fv_cand in_scope acc = (tyCoFVsOfTypes' tys `unionFV` tyCoFVsOfType' ty) fv_cand in_scope acc
 -tyCoFVsOfTypes' [] fv_cand in_scope acc = emptyFV fv_cand in_scope acc
+-
 --- | Just like 'tyCoFVsBndr', but traverses type variables in reverse order of
 --- appearance.
 -tyCoFVsBndr' :: TyVarBinder -> FV -> FV
 -tyCoFVsBndr' (Bndr tv _) fvs = FV.delFV tv fvs `unionFV` tyCoFVsOfType' (tyVarKind tv)
 +  :: VarSet  -- ^ Free variables to ignore
 +  -> [Type]  -- ^ Types to traverse (in order) looking for free variables
 +  -> [TyVar] -- ^ Free type variables, /in the order in which they appear/
 +orderedFVs ignore_tvs tys
 +  = dVarSetElems (runEndoOS (runFV get_fvs ignore_tvs) emptyDVarSet)
 +  where
 +    get_fvs :: DVarSetFV
 +    get_fvs = deepDetTypesFV tys
  -------------------------------------------------------------------------------