Create a deterministic version of tyVarsOfType

I've run into situations where I need deterministic `tyVarsOfType` and
this implementation achieves that and also brings an algorithmic
improvement.  Union of two `VarSet`s takes linear time the size of the
sets and in the worst case we can have `n` unions of sets of sizes
`(n-1, 1), (n-2, 1)...` making it quadratic.

One reason why we need deterministic `tyVarsOfType` is in `abstractVars`
in `SetLevels`. When we abstract type variables when floating we want
them to be abstracted in deterministic order.

Test Plan: harbormaster

Reviewers: simonpj, goldfire, austin, hvr, simonmar, bgamari

Reviewed By: simonmar

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1468

GHC Trac Issues: #4012

3 files changed, 150 insertions, 119 deletions

diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs
index 0e5027768a..39a159958e 100644
--- a/compiler/coreSyn/CoreFVs.hs
+++ b/compiler/coreSyn/CoreFVs.hs
@@ -11,6 +11,7 @@ Taken quite directly from the Peyton Jones/Lester paper.
 module CoreFVs (
         -- * Free variables of expressions and binding groups
         exprFreeVars,   -- CoreExpr   -> VarSet -- Find all locally-defined free Ids or tyvars
+        exprFreeDVars,  -- CoreExpr   -> DVarSet -- Find all locally-defined free Ids or tyvars
         exprFreeIds,    -- CoreExpr   -> IdSet  -- Find all locally-defined free Ids
         exprsFreeVars,  -- [CoreExpr] -> VarSet
         bindFreeVars,   -- CoreBind   -> VarSet
@@ -22,16 +23,20 @@ module CoreFVs (
         -- * Free variables of Rules, Vars and Ids
         varTypeTyVars,
         idUnfoldingVars, idFreeVars, idRuleAndUnfoldingVars,
+        idFreeVarsAcc,
         idRuleVars, idRuleRhsVars, stableUnfoldingVars,
         ruleRhsFreeVars, ruleFreeVars, rulesFreeVars,
+        rulesFreeDVars,
         ruleLhsFreeIds, exprsOrphNames,
         vectsFreeVars,
 
+        expr_fvs,
+
         -- * Core syntax tree annotation with free variables
-        CoreExprWithFVs,        -- = AnnExpr Id VarSet
-        CoreBindWithFVs,        -- = AnnBind Id VarSet
+        CoreExprWithFVs,        -- = AnnExpr Id DVarSet
+        CoreBindWithFVs,        -- = AnnBind Id DVarSet
         freeVars,               -- CoreExpr -> CoreExprWithFVs
-        freeVarsOf              -- CoreExprWithFVs -> IdSet
+        freeVarsOf              -- CoreExprWithFVs -> DIdSet
     ) where
 
 #include "HsVersions.h"
@@ -45,11 +50,13 @@ import Name
 import VarSet
 import Var
 import TcType
+import TypeRep
 import Coercion
 import Maybes( orElse )
 import Util
 import BasicTypes( Activation )
 import Outputable
+import FV
 
 {-
 ************************************************************************
@@ -69,7 +76,11 @@ but not those that are free in the type of variable occurrence.
 
 -- | Find all locally-defined free Ids or type variables in an expression
 exprFreeVars :: CoreExpr -> VarSet
-exprFreeVars = exprSomeFreeVars isLocalVar
+exprFreeVars = runFVSet . filterFV isLocalVar . expr_fvs
+
+exprFreeDVars :: CoreExpr -> DVarSet
+exprFreeDVars = runFVDSet . filterFV isLocalVar . expr_fvs
+
 
 -- | Find all locally-defined free Ids in an expression
 exprFreeIds :: CoreExpr -> IdSet        -- Find all locally-defined free Ids
@@ -81,44 +92,23 @@ exprsFreeVars = mapUnionVarSet exprFreeVars
 
 -- | Find all locally defined free Ids in a binding group
 bindFreeVars :: CoreBind -> VarSet
-bindFreeVars (NonRec b r) = rhs_fvs (b,r) isLocalVar emptyVarSet
-bindFreeVars (Rec prs)    = addBndrs (map fst prs)
-                                     (foldr (union . rhs_fvs) noVars prs)
-                                     isLocalVar emptyVarSet
+bindFreeVars (NonRec b r) = runFVSet $ filterFV isLocalVar $ rhs_fvs (b,r)
+bindFreeVars (Rec prs)    = runFVSet $ filterFV isLocalVar $
+                                addBndrs (map fst prs)
+                                     (foldr (unionFV . rhs_fvs) noVars 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 = expr_fvs e fv_cand emptyVarSet
+exprSomeFreeVars fv_cand e = runFVSet $ filterFV fv_cand $ expr_fvs e
 
 -- | Finds free variables in several expressions selected by a predicate
 exprsSomeFreeVars :: InterestingVarFun  -- Says which 'Var's are interesting
                   -> [CoreExpr]
                   -> VarSet
-exprsSomeFreeVars fv_cand = mapUnionVarSet (exprSomeFreeVars fv_cand)
-
--- | Predicate on possible free variables: returns @True@ iff the variable is interesting
-type InterestingVarFun = Var -> Bool
-
-type FV = InterestingVarFun
-        -> VarSet               -- Locally bound
-        -> VarSet               -- Free vars
- -- Return the vars that are both (a) interesting
- --                           and (b) not locally bound
- -- See function keep_it
-
-keep_it :: InterestingVarFun -> VarSet -> Var -> Bool
-keep_it fv_cand in_scope var
-  | var `elemVarSet` in_scope = False
-  | fv_cand var               = True
-  | otherwise                 = False
-
-union :: FV -> FV -> FV
-union fv1 fv2 fv_cand in_scope = fv1 fv_cand in_scope `unionVarSet` fv2 fv_cand in_scope
-
-noVars :: FV
-noVars _ _ = emptyVarSet
+exprsSomeFreeVars fv_cand es =
+  runFVSet $ filterFV fv_cand $ foldr (unionFV . expr_fvs) noVars es
 
 --      Comment about obselete code
 -- We used to gather the free variables the RULES at a variable occurrence
@@ -148,63 +138,65 @@ noVars _ _ = emptyVarSet
 --                          | otherwise                    = set
 --      SLPJ Feb06
 
-oneVar :: Id -> FV
-oneVar var fv_cand in_scope
-  = ASSERT( isId var )
-    if keep_it fv_cand in_scope var
-    then unitVarSet var
-    else emptyVarSet
+-- XXX move to FV
+someVars :: [Var] -> FV
+someVars vars = foldr (unionFV . oneVar) noVars vars
 
-someVars :: VarSet -> FV
-someVars vars fv_cand in_scope
-  = filterVarSet (keep_it fv_cand in_scope) vars
 
 addBndr :: CoreBndr -> FV -> FV
-addBndr bndr fv fv_cand in_scope
-  = someVars (varTypeTyVars bndr) fv_cand in_scope
+addBndr bndr fv fv_cand in_scope acc
+  = (varTypeTyVarsAcc bndr `unionFV`
         -- Include type varibles in the binder's type
         --      (not just Ids; coercion variables too!)
-    `unionVarSet`  fv fv_cand (in_scope `extendVarSet` bndr)
+     FV.delFV bndr fv) fv_cand in_scope acc
 
 addBndrs :: [CoreBndr] -> FV -> FV
 addBndrs bndrs fv = foldr addBndr fv bndrs
 
 expr_fvs :: CoreExpr -> FV
 
-expr_fvs (Type ty)       = someVars (tyVarsOfType ty)
-expr_fvs (Coercion co)   = someVars (tyCoVarsOfCo co)
-expr_fvs (Var var)       = oneVar var
-expr_fvs (Lit _)         = noVars
-expr_fvs (Tick t expr)   = tickish_fvs t `union` expr_fvs expr
-expr_fvs (App fun arg)   = expr_fvs fun `union` expr_fvs arg
-expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
-expr_fvs (Cast expr co)  = expr_fvs expr `union` someVars (tyCoVarsOfCo co)
-
-expr_fvs (Case scrut bndr ty alts)
-  = expr_fvs scrut `union` someVars (tyVarsOfType ty) `union` addBndr bndr
-      (foldr (union . alt_fvs) noVars alts)
+expr_fvs (Type ty) fv_cand in_scope acc =
+  tyVarsOfTypeAcc ty fv_cand in_scope acc
+expr_fvs (Coercion co) fv_cand in_scope acc =
+  tyCoVarsOfCoAcc co fv_cand in_scope acc
+expr_fvs (Var var) fv_cand in_scope acc = oneVar var fv_cand in_scope acc
+expr_fvs (Lit _) fv_cand in_scope acc = noVars fv_cand in_scope acc
+expr_fvs (Tick t expr) fv_cand in_scope acc =
+  (tickish_fvs t `unionFV` expr_fvs expr) fv_cand in_scope acc
+expr_fvs (App fun arg) fv_cand in_scope acc =
+  (expr_fvs fun `unionFV` expr_fvs arg) fv_cand in_scope acc
+expr_fvs (Lam bndr body) fv_cand in_scope acc =
+  addBndr bndr (expr_fvs body) fv_cand in_scope acc
+expr_fvs (Cast expr co) fv_cand in_scope acc =
+  (expr_fvs expr `unionFV` tyCoVarsOfCoAcc co) fv_cand in_scope acc
+
+expr_fvs (Case scrut bndr ty alts) fv_cand in_scope acc
+  = (expr_fvs scrut `unionFV` tyVarsOfTypeAcc ty `unionFV` addBndr bndr
+      (foldr (unionFV . alt_fvs) noVars alts)) fv_cand in_scope acc
   where
     alt_fvs (_, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
 
-expr_fvs (Let (NonRec bndr rhs) body)
-  = rhs_fvs (bndr, rhs) `union` addBndr bndr (expr_fvs body)
+expr_fvs (Let (NonRec bndr rhs) body) fv_cand in_scope acc
+  = (rhs_fvs (bndr, rhs) `unionFV` addBndr bndr (expr_fvs body))
+      fv_cand in_scope acc
 
-expr_fvs (Let (Rec pairs) body)
+expr_fvs (Let (Rec pairs) body) fv_cand in_scope acc
   = addBndrs (map fst pairs)
-             (foldr (union . rhs_fvs) (expr_fvs body) pairs)
+             (foldr (unionFV . rhs_fvs) (expr_fvs body) pairs)
+               fv_cand in_scope acc
 
 ---------
-rhs_fvs :: (Id,CoreExpr) -> FV
-rhs_fvs (bndr, rhs) = expr_fvs rhs `union`
-                      someVars (bndrRuleAndUnfoldingVars bndr)
+rhs_fvs :: (Id, CoreExpr) -> FV
+rhs_fvs (bndr, rhs) = expr_fvs rhs `unionFV`
+                      bndrRuleAndUnfoldingVarsAcc bndr -- XXX: FIXME
         -- Treat any RULES as extra RHSs of the binding
 
 ---------
 exprs_fvs :: [CoreExpr] -> FV
-exprs_fvs exprs = foldr (union . expr_fvs) noVars exprs
+exprs_fvs exprs = foldr (unionFV . expr_fvs) noVars exprs
 
 tickish_fvs :: Tickish Id -> FV
-tickish_fvs (Breakpoint _ ids) = someVars (mkVarSet ids)
+tickish_fvs (Breakpoint _ ids) = someVars ids
 tickish_fvs _ = noVars
 
 {-
@@ -258,7 +250,7 @@ exprsOrphNames es = foldr (unionNameSet . exprOrphNames) emptyNameSet es
 ruleRhsFreeVars :: CoreRule -> VarSet
 ruleRhsFreeVars (BuiltinRule {}) = noFVs
 ruleRhsFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs })
-  = addBndrs bndrs (expr_fvs rhs) isLocalVar emptyVarSet
+  = runFVSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs)
       -- See Note [Rule free var hack]
 
 -- | Those variables free in the both the left right hand sides of a rule
@@ -267,7 +259,22 @@ ruleFreeVars (BuiltinRule {}) = noFVs
 ruleFreeVars (Rule { ru_fn = _do_not_include  -- See Note [Rule free var hack]
                    , ru_bndrs = bndrs
                    , ru_rhs = rhs, ru_args = args })
-  = addBndrs bndrs (exprs_fvs (rhs:args)) isLocalVar emptyVarSet
+  = runFVSet $ filterFV isLocalVar $ addBndrs bndrs (exprs_fvs (rhs:args))
+
+ruleFreeVarsAcc :: CoreRule -> FV
+ruleFreeVarsAcc (BuiltinRule {}) =
+  noVars
+ruleFreeVarsAcc (Rule { ru_fn = _do_not_include  -- See Note [Rule free var hack]
+                      , ru_bndrs = bndrs
+                      , ru_rhs = rhs, ru_args = args })
+  = addBndrs bndrs (exprs_fvs (rhs:args))
+
+rulesFreeVarsAcc :: [CoreRule] -> FV
+rulesFreeVarsAcc (rule:rules) = ruleFreeVarsAcc rule `unionFV` rulesFreeVarsAcc rules
+rulesFreeVarsAcc [] = noVars
+
+rulesFreeDVars :: [CoreRule] -> DVarSet
+rulesFreeDVars rules = runFVDSet $ filterFV isLocalVar $ rulesFreeVarsAcc rules
 
 
 idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet
@@ -281,7 +288,7 @@ idRuleRhsVars is_active id
             -- See Note [Finding rule RHS free vars] in OccAnal.hs
       = delFromUFM fvs fn        -- Note [Rule free var hack]
       where
-        fvs = addBndrs bndrs (expr_fvs rhs) isLocalVar emptyVarSet
+        fvs = runFVSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs)
     get_fvs _ = noFVs
 
 -- | Those variables free in the right hand side of several rules
@@ -292,7 +299,7 @@ ruleLhsFreeIds :: CoreRule -> VarSet
 -- ^ This finds all locally-defined free Ids on the left hand side of a rule
 ruleLhsFreeIds (BuiltinRule {}) = noFVs
 ruleLhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args })
-  = addBndrs bndrs (exprs_fvs args) isLocalId emptyVarSet
+  = runFVSet $ filterFV isLocalId $ addBndrs bndrs (exprs_fvs args)
 
 {-
 Note [Rule free var hack]  (Not a hack any more)
@@ -311,7 +318,7 @@ breaker, which is perfectly inlinable.
 vectsFreeVars :: [CoreVect] -> VarSet
 vectsFreeVars = mapUnionVarSet vectFreeVars
   where
-    vectFreeVars (Vect   _ rhs)   = expr_fvs rhs isLocalId emptyVarSet
+    vectFreeVars (Vect   _ rhs)   = runFVSet $ filterFV isLocalId $ expr_fvs rhs
     vectFreeVars (NoVect _)       = noFVs
     vectFreeVars (VectType _ _ _) = noFVs
     vectFreeVars (VectClass _)    = noFVs
@@ -331,28 +338,28 @@ NON-GLOBAL free variables and type variables.
 
 -- | Every node in a binding group annotated with its
 -- (non-global) free variables, both Ids and TyVars
-type CoreBindWithFVs = AnnBind Id VarSet
+type CoreBindWithFVs = AnnBind Id DVarSet
 -- | Every node in an expression annotated with its
 -- (non-global) free variables, both Ids and TyVars
-type CoreExprWithFVs = AnnExpr Id VarSet
+type CoreExprWithFVs = AnnExpr Id DVarSet
 
-freeVarsOf :: CoreExprWithFVs -> IdSet
+freeVarsOf :: CoreExprWithFVs -> DIdSet
 -- ^ Inverse function to 'freeVars'
 freeVarsOf (free_vars, _) = free_vars
 
 noFVs :: VarSet
-noFVs    = emptyVarSet
+noFVs = emptyVarSet
 
-aFreeVar :: Var -> VarSet
-aFreeVar = unitVarSet
+aFreeVar :: Var -> DVarSet
+aFreeVar = unitDVarSet
 
-unionFVs :: VarSet -> VarSet -> VarSet
-unionFVs = unionVarSet
+unionFVs :: DVarSet -> DVarSet -> DVarSet
+unionFVs = unionDVarSet
 
-delBindersFV :: [Var] -> VarSet -> VarSet
+delBindersFV :: [Var] -> DVarSet -> DVarSet
 delBindersFV bs fvs = foldr delBinderFV fvs bs
 
-delBinderFV :: Var -> VarSet -> VarSet
+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,
@@ -383,32 +390,47 @@ delBinderFV :: Var -> VarSet -> VarSet
 --                        where
 --                          bottom = bottom -- Never evaluated
 
-delBinderFV b s = (s `delVarSet` b) `unionFVs` varTypeTyVars b
+delBinderFV b s = (s `delDVarSet` b) `unionFVs` dVarTypeTyVars b
         -- Include coercion variables too!
 
 varTypeTyVars :: Var -> TyVarSet
 -- Find the type/kind variables free in the type of the id/tyvar
-varTypeTyVars var = tyVarsOfType (varType var)
+varTypeTyVars var = runFVSet $ varTypeTyVarsAcc var
+
+dVarTypeTyVars :: Var -> DTyVarSet
+-- Find the type/kind variables free in the type of the id/tyvar
+dVarTypeTyVars var = runFVDSet $ varTypeTyVarsAcc var
+
+varTypeTyVarsAcc :: Var -> FV
+varTypeTyVarsAcc var = tyVarsOfTypeAcc (varType var)
 
 idFreeVars :: Id -> VarSet
+idFreeVars id = ASSERT( isId id) runFVSet $ idFreeVarsAcc id
+
+idFreeVarsAcc :: Id -> FV
 -- Type variables, rule variables, and inline variables
-idFreeVars id = ASSERT( isId id)
-                varTypeTyVars id `unionVarSet`
-                idRuleAndUnfoldingVars id
+idFreeVarsAcc id = ASSERT( isId id)
+                   varTypeTyVarsAcc id `unionFV`
+                   idRuleAndUnfoldingVarsAcc id
 
-bndrRuleAndUnfoldingVars ::Var -> VarSet
--- A 'let' can bind a type variable, and idRuleVars assumes
--- it's seeing an Id. This function tests first.
-bndrRuleAndUnfoldingVars v | isTyVar v = emptyVarSet
-                           | otherwise = idRuleAndUnfoldingVars v
+bndrRuleAndUnfoldingVarsAcc :: Var -> FV
+bndrRuleAndUnfoldingVarsAcc v | isTyVar v = noVars
+                              | otherwise = idRuleAndUnfoldingVarsAcc v
 
 idRuleAndUnfoldingVars :: Id -> VarSet
-idRuleAndUnfoldingVars id = ASSERT( isId id)
-                            idRuleVars id    `unionVarSet`
-                            idUnfoldingVars id
+idRuleAndUnfoldingVars id = runFVSet $ idRuleAndUnfoldingVarsAcc id
+
+idRuleAndUnfoldingVarsAcc :: Id -> FV
+idRuleAndUnfoldingVarsAcc id = ASSERT( isId id)
+                               idRuleVarsAcc id `unionFV` idUnfoldingVarsAcc id
+
 
 idRuleVars ::Id -> VarSet  -- Does *not* include CoreUnfolding vars
-idRuleVars id = ASSERT( isId id) ruleInfoFreeVars (idSpecialisation id)
+idRuleVars id = runFVSet $ idRuleVarsAcc id
+
+idRuleVarsAcc :: Id -> FV
+idRuleVarsAcc id = ASSERT( isId id)
+  someVars (dVarSetElems $ ruleInfoFreeVars (idSpecialisation id))
 
 idUnfoldingVars :: Id -> VarSet
 -- Produce free vars for an unfolding, but NOT for an ordinary
@@ -416,19 +438,26 @@ idUnfoldingVars :: Id -> VarSet
 -- 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 = stableUnfoldingVars (realIdUnfolding id) `orElse` emptyVarSet
+idUnfoldingVars id = runFVSet $ idUnfoldingVarsAcc id
+
+idUnfoldingVarsAcc :: Id -> FV
+idUnfoldingVarsAcc id = stableUnfoldingVarsAcc (realIdUnfolding id) `orElse` noVars
 
 stableUnfoldingVars :: Unfolding -> Maybe VarSet
-stableUnfoldingVars unf
+stableUnfoldingVars unf = runFVSet `fmap` stableUnfoldingVarsAcc unf
+
+stableUnfoldingVarsAcc :: Unfolding -> Maybe FV
+stableUnfoldingVarsAcc unf
   = case unf of
       CoreUnfolding { uf_tmpl = rhs, uf_src = src }
          | isStableSource src
-         -> Just (exprFreeVars rhs)
+         -> Just (filterFV isLocalVar $ expr_fvs rhs)
       DFunUnfolding { df_bndrs = bndrs, df_args = args }
-         -> Just (exprs_fvs args isLocalVar (mkVarSet bndrs))
+         -> Just (filterFV isLocalVar $ FV.delFVs (mkVarSet bndrs) $ exprs_fvs args)
             -- DFuns are top level, so no fvs from types of bndrs
       _other -> Nothing
 
+
 {-
 ************************************************************************
 *                                                                      *
@@ -448,9 +477,9 @@ freeVars (Var v)
         -- fvs = fvs_v `unionVarSet` idSpecVars v
 
     fvs | isLocalVar v = aFreeVar v
-        | otherwise    = noFVs
+        | otherwise    = emptyDVarSet
 
-freeVars (Lit lit) = (noFVs, AnnLit lit)
+freeVars (Lit lit) = (emptyDVarSet, AnnLit lit)
 freeVars (Lam b body)
   = (b `delBinderFV` freeVarsOf body', AnnLam b body')
   where
@@ -463,13 +492,13 @@ freeVars (App fun arg)
     arg2 = freeVars arg
 
 freeVars (Case scrut bndr ty alts)
-  = ((bndr `delBinderFV` alts_fvs) `unionFVs` freeVarsOf scrut2 `unionFVs` tyVarsOfType ty,
+  = ((bndr `delBinderFV` alts_fvs) `unionFVs` freeVarsOf scrut2 `unionFVs` runFVDSet (tyVarsOfTypeAcc ty),
      AnnCase scrut2 bndr ty alts2)
   where
     scrut2 = freeVars scrut
 
     (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
-    alts_fvs            = foldr unionFVs noFVs alts_fvs_s
+    alts_fvs            = foldr unionFVs emptyDVarSet alts_fvs_s
 
     fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),
                              (con, args, rhs2))
@@ -479,7 +508,7 @@ freeVars (Case scrut bndr ty alts)
 freeVars (Let (NonRec binder rhs) body)
   = (freeVarsOf rhs2
        `unionFVs` body_fvs
-       `unionFVs` bndrRuleAndUnfoldingVars binder,
+       `unionFVs` runFVDSet (bndrRuleAndUnfoldingVarsAcc binder),
                 -- Remember any rules; cf rhs_fvs above
      AnnLet (AnnNonRec binder rhs2) body2)
   where
@@ -495,7 +524,8 @@ freeVars (Let (Rec binds) body)
 
     rhss2     = map freeVars rhss
     rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2
-    all_fvs      = foldr (unionFVs . idRuleAndUnfoldingVars) rhs_body_fvs binders
+    binders_fvs = runFVDSet $ foldr (unionFV . idRuleAndUnfoldingVarsAcc) noVars binders
+    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
 
@@ -506,15 +536,15 @@ freeVars (Cast expr co)
   = (freeVarsOf expr2 `unionFVs` cfvs, AnnCast expr2 (cfvs, co))
   where
     expr2 = freeVars expr
-    cfvs  = tyCoVarsOfCo co
+    cfvs  = runFVDSet $ tyCoVarsOfCoAcc co
 
 freeVars (Tick tickish expr)
   = (tickishFVs tickish `unionFVs` freeVarsOf expr2, AnnTick tickish expr2)
   where
     expr2 = freeVars expr
-    tickishFVs (Breakpoint _ ids) = mkVarSet ids
-    tickishFVs _                  = emptyVarSet
+    tickishFVs (Breakpoint _ ids) = mkDVarSet ids
+    tickishFVs _                  = emptyDVarSet
 
-freeVars (Type ty) = (tyVarsOfType ty, AnnType ty)
+freeVars (Type ty) = (runFVDSet $ tyVarsOfTypeAcc ty, AnnType ty)
 
-freeVars (Coercion co) = (tyCoVarsOfCo co, AnnCoercion co)
+freeVars (Coercion co) = (runFVDSet $ tyCoVarsOfCoAcc co, AnnCoercion co)
diff --git a/compiler/coreSyn/CoreSeq.hs b/compiler/coreSyn/CoreSeq.hs
index e3c7844f2e..d426bd3581 100644
--- a/compiler/coreSyn/CoreSeq.hs
+++ b/compiler/coreSyn/CoreSeq.hs
@@ -14,7 +14,7 @@ import CoreSyn
 import IdInfo
 import Demand( seqDemand, seqStrictSig )
 import BasicTypes( seqOccInfo )
-import VarSet( seqVarSet )
+import VarSet( seqDVarSet )
 import Var( varType, tyVarKind )
 import Type( seqType, isTyVar )
 import Coercion( seqCo )
@@ -40,7 +40,7 @@ seqOneShot :: OneShotInfo -> ()
 seqOneShot l = l `seq` ()
 
 seqRuleInfo :: RuleInfo -> ()
-seqRuleInfo (RuleInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
+seqRuleInfo (RuleInfo rules fvs) = seqRules rules `seq` seqDVarSet fvs
 
 seqCaf :: CafInfo -> ()
 seqCaf c = c `seq` ()
diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs
index c1de2051ee..697ce4b6db 100644
--- a/compiler/coreSyn/CoreSubst.hs
+++ b/compiler/coreSyn/CoreSubst.hs
@@ -17,7 +17,7 @@ module CoreSubst (
         substTy, substCo, substExpr, substExprSC, substBind, substBindSC,
         substUnfolding, substUnfoldingSC,
         lookupIdSubst, lookupTvSubst, lookupCvSubst, substIdOcc,
-        substTickish, substVarSet,
+        substTickish, substDVarSet,
 
         -- ** Operations on substitutions
         emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst,
@@ -53,6 +53,7 @@ import qualified Coercion
         -- We are defining local versions
 import Type     hiding ( substTy, extendTvSubst, extendTvSubstList
                        , isInScope, substTyVarBndr, cloneTyVarBndr )
+import TypeRep (tyVarsOfTypeAcc)
 import Coercion hiding ( substTy, substCo, extendTvSubst, substTyVarBndr, substCoVarBndr )
 
 import TyCon       ( tyConArity )
@@ -674,7 +675,7 @@ substSpec subst new_id (RuleInfo rules rhs_fvs)
   where
     subst_ru_fn = const (idName new_id)
     new_spec = RuleInfo (map (substRule subst subst_ru_fn) rules)
-                        (substVarSet subst rhs_fvs)
+                        (substDVarSet subst rhs_fvs)
 
 ------------------
 substRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule]
@@ -721,13 +722,13 @@ substVect _subst vd@(VectClass _)    = vd
 substVect _subst vd@(VectInst _)     = vd
 
 ------------------
-substVarSet :: Subst -> VarSet -> VarSet
-substVarSet subst fvs
-  = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
+substDVarSet :: Subst -> DVarSet -> DVarSet
+substDVarSet subst fvs
+  = mkDVarSet $ fst $ foldr (subst_fv subst) ([], emptyVarSet) $ dVarSetElems fvs
   where
-    subst_fv subst fv
-        | isId fv   = exprFreeVars (lookupIdSubst (text "substVarSet") subst fv)
-        | otherwise = Type.tyVarsOfType (lookupTvSubst subst fv)
+  subst_fv subst fv acc
+     | isId fv = expr_fvs (lookupIdSubst (text "substDVarSet") subst fv) isLocalVar emptyVarSet $! acc
+     | otherwise = tyVarsOfTypeAcc (lookupTvSubst subst fv) (const True) emptyVarSet $! acc
 
 ------------------
 substTickish :: Subst -> Tickish Id -> Tickish Id