Implement more deterministic operations and document them

I will need them for the future determinism fixes.

Test Plan: ./validate

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

Reviewed By: simonpj, simonmar

Subscribers: osa1, thomie

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

GHC Trac Issues: #4012

11 files changed, 380 insertions, 90 deletions

diff --git a/compiler/basicTypes/VarSet.hs b/compiler/basicTypes/VarSet.hs
index e340117893..ce6aea68ab 100644
--- a/compiler/basicTypes/VarSet.hs
+++ b/compiler/basicTypes/VarSet.hs
@@ -26,13 +26,15 @@ module VarSet (
 
         -- ** Manipulating these sets
         emptyDVarSet, unitDVarSet, mkDVarSet,
-        extendDVarSet,
+        extendDVarSet, extendDVarSetList,
         elemDVarSet, dVarSetElems, subDVarSet,
         unionDVarSet, unionDVarSets, mapUnionDVarSet,
-        intersectDVarSet,
-        isEmptyDVarSet, delDVarSet,
+        intersectDVarSet, intersectsDVarSet, disjointDVarSet,
+        isEmptyDVarSet, delDVarSet, delDVarSetList,
         minusDVarSet, foldDVarSet, filterDVarSet,
+        transCloDVarSet,
         sizeDVarSet, seqDVarSet,
+        partitionDVarSet,
     ) where
 
 #include "HsVersions.h"
@@ -42,15 +44,13 @@ import Unique
 import UniqSet
 import UniqDSet
 import UniqFM( disjointUFM )
+import UniqDFM( disjointUDFM )
 
-{-
-************************************************************************
-*                                                                      *
-\subsection{@VarSet@s}
-*                                                                      *
-************************************************************************
--}
-
+-- | A non-deterministic set of variables.
+-- See Note [Deterministic UniqFM] in UniqDFM for explanation why it's not
+-- deterministic and why it matters. Use DVarSet if the set eventually
+-- gets converted into a list or folded over in a way where the order
+-- changes the generated code, for example when abstracting variables.
 type VarSet       = UniqSet Var
 type IdSet        = UniqSet Id
 type TyVarSet     = UniqSet TyVar
@@ -206,6 +206,14 @@ mapUnionDVarSet get_set xs = foldr (unionDVarSet . get_set) emptyDVarSet xs
 intersectDVarSet :: DVarSet -> DVarSet -> DVarSet
 intersectDVarSet = intersectUniqDSets
 
+-- | True if empty intersection
+disjointDVarSet :: DVarSet -> DVarSet -> Bool
+disjointDVarSet s1 s2 = disjointUDFM s1 s2
+
+-- | True if non-empty intersection
+intersectsDVarSet :: DVarSet -> DVarSet -> Bool
+intersectsDVarSet s1 s2 = not (s1 `disjointDVarSet` s2)
+
 isEmptyDVarSet :: DVarSet -> Bool
 isEmptyDVarSet = isEmptyUniqDSet
 
@@ -224,5 +232,43 @@ filterDVarSet = filterUniqDSet
 sizeDVarSet :: DVarSet -> Int
 sizeDVarSet = sizeUniqDSet
 
+-- | Partition DVarSet according to the predicate given
+partitionDVarSet :: (Var -> Bool) -> DVarSet -> (DVarSet, DVarSet)
+partitionDVarSet = partitionUniqDSet
+
+-- | Delete a list of variables from DVarSet
+delDVarSetList :: DVarSet -> [Var] -> DVarSet
+delDVarSetList = delListFromUniqDSet
+
 seqDVarSet :: DVarSet -> ()
 seqDVarSet s = sizeDVarSet s `seq` ()
+
+-- | Add a list of variables to DVarSet
+extendDVarSetList :: DVarSet -> [Var] -> DVarSet
+extendDVarSetList = addListToUniqDSet
+
+-- | transCloVarSet for DVarSet
+transCloDVarSet :: (DVarSet -> DVarSet)
+                  -- Map some variables in the set to
+                  -- extra variables that should be in it
+                -> DVarSet -> DVarSet
+-- (transCloDVarSet f s) repeatedly applies f to new candidates, adding any
+-- new variables to s that it finds thereby, until it reaches a fixed point.
+--
+-- The function fn could be (Var -> DVarSet), but we use (DVarSet -> DVarSet)
+-- for efficiency, so that the test can be batched up.
+-- It's essential that fn will work fine if given new candidates
+-- one at at time; ie  fn {v1,v2} = fn v1 `union` fn v2
+transCloDVarSet fn seeds
+  = go seeds seeds
+  where
+    go :: DVarSet  -- Accumulating result
+       -> DVarSet  -- Work-list; un-processed subset of accumulating result
+       -> DVarSet
+    -- Specification: go acc vs = acc `union` transClo fn vs
+
+    go acc candidates
+       | isEmptyDVarSet new_vs = acc
+       | otherwise            = go (acc `unionDVarSet` new_vs) new_vs
+       where
+         new_vs = fn candidates `minusDVarSet` acc
diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs
index 0533038d9f..398f6bee39 100644
--- a/compiler/coreSyn/CoreFVs.hs
+++ b/compiler/coreSyn/CoreFVs.hs
@@ -10,11 +10,12 @@ Taken quite directly from the Peyton Jones/Lester paper.
 -- | A module concerned with finding the free variables of an expression.
 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
+        exprFreeVars,
+        exprFreeVarsDSet,
+        exprFreeIds,
+        exprsFreeVars,
+        exprsFreeVarsList,
+        bindFreeVars,
 
         -- * Selective free variables of expressions
         InterestingVarFun,
@@ -27,7 +28,7 @@ module CoreFVs (
         idFreeVarsAcc,
         idRuleVars, idRuleRhsVars, stableUnfoldingVars,
         ruleRhsFreeVars, ruleFreeVars, rulesFreeVars,
-        rulesFreeDVars,
+        rulesFreeVarsDSet,
         ruleLhsFreeIds, exprsOrphNames,
         vectsFreeVars,
 
@@ -51,7 +52,6 @@ import Name
 import VarSet
 import Var
 import TcType
-import TypeRep
 import Coercion
 import Maybes( orElse )
 import Util
@@ -76,27 +76,47 @@ but not those that are free in the type of variable occurrence.
 -}
 
 -- | Find all locally-defined free Ids or type variables in an expression
+-- returning a non-deterministic set.
 exprFreeVars :: CoreExpr -> VarSet
-exprFreeVars = runFVSet . filterFV isLocalVar . expr_fvs
+exprFreeVars = runFVSet . exprFreeVarsAcc
 
-exprFreeDVars :: CoreExpr -> DVarSet
-exprFreeDVars = runFVDSet . filterFV isLocalVar . expr_fvs
+-- | Find all locally-defined free Ids or type variables in an expression
+-- returning a composable FV computation. See Note [FV naming coventions] in FV
+-- for why export it.
+exprFreeVarsAcc :: CoreExpr -> FV
+exprFreeVarsAcc = filterFV isLocalVar . expr_fvs
 
+-- | Find all locally-defined free Ids or type variables in an expression
+-- returning a deterministic set.
+exprFreeVarsDSet :: CoreExpr -> DVarSet
+exprFreeVarsDSet = runFVDSet . exprFreeVarsAcc
 
 -- | Find all locally-defined free Ids in an expression
 exprFreeIds :: CoreExpr -> IdSet        -- Find all locally-defined free Ids
 exprFreeIds = exprSomeFreeVars isLocalId
 
 -- | Find all locally-defined free Ids or type variables in several expressions
+-- returning a non-deterministic set.
 exprsFreeVars :: [CoreExpr] -> VarSet
-exprsFreeVars = mapUnionVarSet exprFreeVars
+exprsFreeVars = runFVSet . exprsFreeVarsAcc
+
+-- | Find all locally-defined free Ids or type variables in several expressions
+-- returning a composable FV computation. See Note [FV naming coventions] in FV
+-- for why export it.
+exprsFreeVarsAcc :: [CoreExpr] -> FV
+exprsFreeVarsAcc exprs = mapUnionFV exprFreeVarsAcc exprs
+
+-- | Find all locally-defined free Ids or type variables in several expressions
+-- returning a deterministically ordered list.
+exprsFreeVarsList :: [CoreExpr] -> [Var]
+exprsFreeVarsList = runFVList . exprsFreeVarsAcc
 
 -- | Find all locally defined free Ids in a binding group
 bindFreeVars :: CoreBind -> VarSet
 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)
+                                     (mapUnionFV rhs_fvs prs)
 
 -- | Finds free variables in an expression selected by a predicate
 exprSomeFreeVars :: InterestingVarFun   -- ^ Says which 'Var's are interesting
@@ -109,7 +129,7 @@ exprsSomeFreeVars :: InterestingVarFun  -- Says which 'Var's are interesting
                   -> [CoreExpr]
                   -> VarSet
 exprsSomeFreeVars fv_cand es =
-  runFVSet $ filterFV fv_cand $ foldr (unionFV . expr_fvs) noVars es
+  runFVSet $ filterFV fv_cand $ mapUnionFV expr_fvs es
 
 --      Comment about obselete code
 -- We used to gather the free variables the RULES at a variable occurrence
@@ -139,11 +159,6 @@ exprsSomeFreeVars fv_cand es =
 --                          | otherwise                    = set
 --      SLPJ Feb06
 
--- XXX move to FV
-someVars :: [Var] -> FV
-someVars vars = foldr (unionFV . oneVar) noVars vars
-
-
 addBndr :: CoreBndr -> FV -> FV
 addBndr bndr fv fv_cand in_scope acc
   = (varTypeTyVarsAcc bndr `unionFV`
@@ -155,7 +170,6 @@ addBndrs :: [CoreBndr] -> FV -> FV
 addBndrs bndrs fv = foldr addBndr fv bndrs
 
 expr_fvs :: CoreExpr -> FV
-
 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 =
@@ -173,7 +187,7 @@ expr_fvs (Cast expr 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
+      (mapUnionFV alt_fvs alts)) fv_cand in_scope acc
   where
     alt_fvs (_, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
 
@@ -183,18 +197,18 @@ expr_fvs (Let (NonRec bndr rhs) body) fv_cand in_scope acc
 
 expr_fvs (Let (Rec pairs) body) fv_cand in_scope acc
   = addBndrs (map fst pairs)
-             (foldr (unionFV . rhs_fvs) (expr_fvs body) pairs)
+             (mapUnionFV rhs_fvs pairs `unionFV` expr_fvs body)
                fv_cand in_scope acc
 
 ---------
 rhs_fvs :: (Id, CoreExpr) -> FV
 rhs_fvs (bndr, rhs) = expr_fvs rhs `unionFV`
-                      bndrRuleAndUnfoldingVarsAcc bndr -- XXX: FIXME
+                      bndrRuleAndUnfoldingVarsAcc bndr
         -- Treat any RULES as extra RHSs of the binding
 
 ---------
 exprs_fvs :: [CoreExpr] -> FV
-exprs_fvs exprs = foldr (unionFV . expr_fvs) noVars exprs
+exprs_fvs exprs = mapUnionFV expr_fvs exprs
 
 tickish_fvs :: Tickish Id -> FV
 tickish_fvs (Breakpoint _ ids) = someVars ids
@@ -247,7 +261,8 @@ exprsOrphNames es = foldr (unionNameSet . exprOrphNames) emptyNameSet es
 ************************************************************************
 -}
 
--- | Those variables free in the right hand side of a rule
+-- | Those variables free in the right hand side of a rule returned as a
+-- non-deterministic set
 ruleRhsFreeVars :: CoreRule -> VarSet
 ruleRhsFreeVars (BuiltinRule {}) = noFVs
 ruleRhsFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs })
@@ -255,28 +270,29 @@ ruleRhsFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs })
       -- See Note [Rule free var hack]
 
 -- | Those variables free in the both the left right hand sides of a rule
+-- returned as a non-deterministic set
 ruleFreeVars :: CoreRule -> VarSet
-ruleFreeVars (BuiltinRule {}) = noFVs
-ruleFreeVars (Rule { ru_fn = _do_not_include  -- See Note [Rule free var hack]
-                   , ru_bndrs = bndrs
-                   , ru_rhs = rhs, ru_args = args })
-  = runFVSet $ filterFV isLocalVar $ addBndrs bndrs (exprs_fvs (rhs:args))
+ruleFreeVars = runFVSet . ruleFreeVarsAcc
 
+-- | Those variables free in the both the left right hand sides of a rule
+-- returned as FV computation
 ruleFreeVarsAcc :: CoreRule -> FV
-ruleFreeVarsAcc (BuiltinRule {}) =
-  noVars
-ruleFreeVarsAcc (Rule { ru_fn = _do_not_include  -- See Note [Rule free var hack]
+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))
+  = filterFV isLocalVar $ addBndrs bndrs (exprs_fvs (rhs:args))
 
+-- | Those variables free in the both the left right hand sides of rules
+-- returned as FV computation
 rulesFreeVarsAcc :: [CoreRule] -> FV
-rulesFreeVarsAcc (rule:rules) = ruleFreeVarsAcc rule `unionFV` rulesFreeVarsAcc rules
-rulesFreeVarsAcc [] = noVars
-
-rulesFreeDVars :: [CoreRule] -> DVarSet
-rulesFreeDVars rules = runFVDSet $ filterFV isLocalVar $ rulesFreeVarsAcc rules
+rulesFreeVarsAcc = mapUnionFV ruleFreeVarsAcc
 
+-- | Those variables free in the both the left right hand sides of rules
+-- returned as a deterministic set
+rulesFreeVarsDSet :: [CoreRule] -> DVarSet
+rulesFreeVarsDSet rules = runFVDSet $ rulesFreeVarsAcc rules
 
 idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet
 -- Just the variables free on the *rhs* of a rule
@@ -525,7 +541,7 @@ freeVars (Let (Rec binds) body)
 
     rhss2     = map freeVars rhss
     rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2
-    binders_fvs = runFVDSet $ foldr (unionFV . idRuleAndUnfoldingVarsAcc) noVars binders
+    binders_fvs = runFVDSet $ mapUnionFV idRuleAndUnfoldingVarsAcc 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
diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs
index 83b8028c19..3091a453cd 100644
--- a/compiler/ghci/ByteCodeGen.hs
+++ b/compiler/ghci/ByteCodeGen.hs
@@ -479,7 +479,7 @@ schemeE d s p exp@(AnnTick (Breakpoint _id _fvs) _rhs)
           let letExp = AnnLet (AnnNonRec id (fvs, exp)) (emptyDVarSet, AnnVar id)
           schemeE d s p letExp
    where exp' = deAnnotate' exp
-         fvs  = exprFreeDVars exp'
+         fvs  = exprFreeVarsDSet exp'
          ty   = exprType exp'
 
 -- ignore other kinds of tick
diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs
index 2f98007fe7..65a36c3b46 100644
--- a/compiler/simplCore/SetLevels.hs
+++ b/compiler/simplCore/SetLevels.hs
@@ -771,10 +771,10 @@ lvlBind env (AnnRec pairs)
         -- Finding the free vars of the binding group is annoying
     bind_fvs = ((unionDVarSets [ rhs_fvs | (_, (rhs_fvs,_)) <- pairs])
                 `unionDVarSet`
-                (runFVDSet $ foldr unionFV noVars [ idFreeVarsAcc bndr
-                                                  | (bndr, (_,_)) <- pairs]))
-               `minusDVarSet`
-                mkDVarSet bndrs -- XXX: it's a waste to create a set here
+                (runFVDSet $ unionsFV [ idFreeVarsAcc bndr
+                                      | (bndr, (_,_)) <- pairs]))
+               `delDVarSetList`
+                bndrs
 
     dest_lvl = destLevel env bind_fvs (all isFunction rhss) False
     abs_vars = abstractVars dest_lvl env bind_fvs
diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs
index 1aa472b92a..f7a67ea8bd 100644
--- a/compiler/specialise/Rules.hs
+++ b/compiler/specialise/Rules.hs
@@ -33,7 +33,7 @@ import Module           ( Module, ModuleSet, elemModuleSet )
 import CoreSubst
 import OccurAnal        ( occurAnalyseExpr )
 import CoreFVs          ( exprFreeVars, exprsFreeVars, bindFreeVars
-                        , rulesFreeDVars, exprsOrphNames )
+                        , rulesFreeVarsDSet, exprsOrphNames )
 import CoreUtils        ( exprType, eqExpr, mkTick, mkTicks,
                           stripTicksTopT, stripTicksTopE )
 import PprCore          ( pprRules )
@@ -275,11 +275,11 @@ pprRulesForUser rules
 -- | Make a 'RuleInfo' containing a number of 'CoreRule's, suitable
 -- for putting into an 'IdInfo'
 mkRuleInfo :: [CoreRule] -> RuleInfo
-mkRuleInfo rules = RuleInfo rules (rulesFreeDVars rules)
+mkRuleInfo rules = RuleInfo rules (rulesFreeVarsDSet rules)
 
 extendRuleInfo :: RuleInfo -> [CoreRule] -> RuleInfo
 extendRuleInfo (RuleInfo rs1 fvs1) rs2
-  = RuleInfo (rs2 ++ rs1) (rulesFreeDVars rs2 `unionDVarSet` fvs1)
+  = RuleInfo (rs2 ++ rs1) (rulesFreeVarsDSet rs2 `unionDVarSet` fvs1)
 
 addRuleInfo :: RuleInfo -> RuleInfo -> RuleInfo
 addRuleInfo (RuleInfo rs1 fvs1) (RuleInfo rs2 fvs2)
diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs
index 05a9208d92..6e918edf2f 100644
--- a/compiler/typecheck/Inst.hs
+++ b/compiler/typecheck/Inst.hs
@@ -9,7 +9,7 @@ The @Inst@ type: dictionaries or method instances
 {-# LANGUAGE CPP #-}
 
 module Inst (
-       deeplySkolemise, deeplyInstantiate, 
+       deeplySkolemise, deeplyInstantiate,
        instCall, instDFunType, instStupidTheta,
        newWanted, newWanteds,
        emitWanted, emitWanteds,
@@ -25,6 +25,7 @@ module Inst (
        -- Simple functions over evidence variables
        tyVarsOfWC, tyVarsOfBag,
        tyVarsOfCt, tyVarsOfCts,
+       tyVarsOfCtList, tyVarsOfCtsList,
     ) where
 
 #include "HsVersions.h"
@@ -60,6 +61,7 @@ import Util
 import Outputable
 import Control.Monad( unless )
 import Data.Maybe( isJust )
+import FV
 
 {-
 ************************************************************************
@@ -623,16 +625,43 @@ addClsInstsErr herald ispecs
 -}
 
 ---------------- Getting free tyvars -------------------------
-tyVarsOfCt :: Ct -> TcTyVarSet
-tyVarsOfCt (CTyEqCan { cc_tyvar = tv, cc_rhs = xi })     = extendVarSet (tyVarsOfType xi) tv
-tyVarsOfCt (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk }) = extendVarSet (tyVarsOfTypes tys) fsk
-tyVarsOfCt (CDictCan { cc_tyargs = tys })                = tyVarsOfTypes tys
-tyVarsOfCt (CIrredEvCan { cc_ev = ev })                  = tyVarsOfType (ctEvPred ev)
-tyVarsOfCt (CHoleCan { cc_ev = ev })                     = tyVarsOfType (ctEvPred ev)
-tyVarsOfCt (CNonCanonical { cc_ev = ev })                = tyVarsOfType (ctEvPred ev)
 
+-- | Returns free variables of constraints as a non-deterministic set
+tyVarsOfCt :: Ct -> TcTyVarSet
+tyVarsOfCt = runFVSet . tyVarsOfCtAcc
+
+-- | Returns free variables of constraints as a deterministically ordered.
+-- list. See Note [Deterministic FV] in FV.
+tyVarsOfCtList :: Ct -> [TcTyVar]
+tyVarsOfCtList = runFVList . tyVarsOfCtAcc
+
+-- | Returns free variables of constraints as a composable FV computation.
+-- See Note [Deterministic FV] in FV.
+tyVarsOfCtAcc :: Ct -> FV
+tyVarsOfCtAcc (CTyEqCan { cc_tyvar = tv, cc_rhs = xi })
+  = tyVarsOfTypeAcc xi `unionFV` oneVar tv
+tyVarsOfCtAcc (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk })
+  = tyVarsOfTypesAcc tys `unionFV` oneVar fsk
+tyVarsOfCtAcc (CDictCan { cc_tyargs = tys }) = tyVarsOfTypesAcc tys
+tyVarsOfCtAcc (CIrredEvCan { cc_ev = ev }) = tyVarsOfTypeAcc (ctEvPred ev)
+tyVarsOfCtAcc (CHoleCan { cc_ev = ev }) = tyVarsOfTypeAcc (ctEvPred ev)
+tyVarsOfCtAcc (CNonCanonical { cc_ev = ev }) = tyVarsOfTypeAcc (ctEvPred ev)
+
+-- | Returns free variables of a bag of constraints as a non-deterministic
+-- set. See Note [Deterministic FV] in FV.
 tyVarsOfCts :: Cts -> TcTyVarSet
-tyVarsOfCts = foldrBag (unionVarSet . tyVarsOfCt) emptyVarSet
+tyVarsOfCts = runFVSet . tyVarsOfCtsAcc
+
+-- | Returns free variables of a bag of constraints as a deterministically
+-- odered list. See Note [Deterministic FV] in FV.
+tyVarsOfCtsList :: Cts -> [TcTyVar]
+tyVarsOfCtsList = runFVList . tyVarsOfCtsAcc
+
+-- | Returns free variables of a bag of constraints as a composable FV
+-- computation. See Note [Deterministic FV] in FV.
+tyVarsOfCtsAcc :: Cts -> FV
+tyVarsOfCtsAcc = foldrBag (unionFV . tyVarsOfCtAcc) noVars
+
 
 tyVarsOfWC :: WantedConstraints -> TyVarSet
 -- Only called on *zonked* things, hence no need to worry about flatten-skolems
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index 48de69988a..4e48d9f65e 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -21,7 +21,7 @@ module TcType (
   --------------------------------
   -- Types
   TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,
-  TcTyVar, TcTyVarSet, TcKind, TcCoVar,
+  TcTyVar, TcTyVarSet, TcDTyVarSet, TcKind, TcCoVar,
 
   -- TcLevel
   TcLevel(..), topTcLevel, pushTcLevel,
@@ -144,6 +144,8 @@ module TcType (
 
   tyVarsOfType, tyVarsOfTypes, closeOverKinds,
   tyVarsOfTypeList, tyVarsOfTypesList,
+  tyVarsOfTypeAcc, tyVarsOfTypesAcc,
+  tyVarsOfTypeDSet, tyVarsOfTypesDSet, closeOverKindsDSet,
   tcTyVarsOfType, tcTyVarsOfTypes,
 
   pprKind, pprParendKind, pprSigmaType,
@@ -244,6 +246,7 @@ type TcRhoType      = TcType  -- Note [TcRhoType]
 type TcTauType      = TcType
 type TcKind         = Kind
 type TcTyVarSet     = TyVarSet
+type TcDTyVarSet    = DTyVarSet
 
 {-
 Note [TcRhoType]
diff --git a/compiler/types/TypeRep.hs b/compiler/types/TypeRep.hs
index 3eac8b5e7a..384f1ef47a 100644
--- a/compiler/types/TypeRep.hs
+++ b/compiler/types/TypeRep.hs
@@ -44,6 +44,8 @@ module TypeRep (
         -- Free variables
         tyVarsOfType, tyVarsOfTypes, closeOverKinds, varSetElemsKvsFirst,
         tyVarsOfTypeAcc, tyVarsOfTypeList, tyVarsOfTypesAcc, tyVarsOfTypesList,
+        tyVarsOfTypeDSet, tyVarsOfTypesDSet,
+        closeOverKindsDSet, closeOverKindsAcc,
 
         -- * Tidying type related things up for printing
         tidyType,      tidyTypes,
@@ -308,29 +310,49 @@ isKindVar v = isTKVar v && isSuperKind (varType v)
 ************************************************************************
 -}
 
+-- | Returns free variables of a type, including kind variables as
+-- a non-deterministic set. For type synonyms it does /not/ expand the
+-- synonym.
 tyVarsOfType :: Type -> VarSet
--- ^ NB: for type synonyms tyVarsOfType does /not/ expand the synonym
--- tyVarsOfType returns free variables of a type, including kind variables.
 tyVarsOfType ty = runFVSet $ tyVarsOfTypeAcc ty
 
 -- | `tyVarsOfType` that returns free variables of a type in deterministic
 -- order. For explanation of why using `VarSet` is not deterministic see
--- Note [Deterministic UniqFM] in UniqDFM.
-tyVarsOfTypeList :: Type -> [Var]
+-- Note [Deterministic FV] in FV.
+tyVarsOfTypeList :: Type -> [TyVar]
 tyVarsOfTypeList ty = runFVList $ tyVarsOfTypeAcc ty
 
+-- | `tyVarsOfType` 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 FV.
+tyVarsOfTypeDSet :: Type -> DTyVarSet
+tyVarsOfTypeDSet ty = runFVDSet $ tyVarsOfTypeAcc ty
+
+-- | Returns free variables of types, including kind variables as
+-- a non-deterministic set. For type synonyms it does /not/ expand the
+-- synonym.
 tyVarsOfTypes :: [Type] -> TyVarSet
 tyVarsOfTypes tys = runFVSet $ tyVarsOfTypesAcc tys
 
-tyVarsOfTypesList :: [Type] -> [Var]
+-- | Returns free variables of types, including kind variables as
+-- a deterministically ordered list. For type synonyms it does /not/ expand the
+-- synonym.
+tyVarsOfTypesList :: [Type] -> [TyVar]
 tyVarsOfTypesList tys = runFVList $ tyVarsOfTypesAcc tys
 
+-- | Returns free variables of types, including kind variables as
+-- a deterministic set. For type synonyms it does /not/ expand the
+-- synonym.
+tyVarsOfTypesDSet :: [Type] -> DTyVarSet
+tyVarsOfTypesDSet tys = runFVDSet $ tyVarsOfTypesAcc tys
+
 
 -- | The worker for `tyVarsOfType` and `tyVarsOfTypeList`.
 -- The previous implementation used `unionVarSet` which is O(n+m) and can
 -- make the function quadratic.
 -- It's exported, so that it can be composed with other functions that compute
 -- free variables.
+-- See Note [FV naming conventions] in FV.
 tyVarsOfTypeAcc :: Type -> FV
 tyVarsOfTypeAcc (TyVarTy v) fv_cand in_scope acc = oneVar v fv_cand in_scope acc
 tyVarsOfTypeAcc (TyConApp _ tys) fv_cand in_scope acc =
@@ -349,12 +371,22 @@ tyVarsOfTypesAcc (ty:tys) fv_cand in_scope acc =
   (tyVarsOfTypeAcc ty `unionFV` tyVarsOfTypesAcc tys) fv_cand in_scope acc
 tyVarsOfTypesAcc [] fv_cand in_scope acc = noVars fv_cand in_scope acc
 
+-- | Add the kind variables free in the kinds of the tyvars in the given set.
+-- Returns a non-deterministic set.
 closeOverKinds :: TyVarSet -> TyVarSet
--- Add the kind variables free in the kinds
--- of the tyvars in the given set
-closeOverKinds tvs
-  = foldVarSet (\tv ktvs -> tyVarsOfType (tyVarKind tv) `unionVarSet` ktvs)
-               tvs tvs
+closeOverKinds = runFVSet . closeOverKindsAcc . varSetElems
+
+-- | Given a list of tyvars returns a deterministic FV computation that
+-- returns the given tyvars with the kind variables free in the kinds of the
+-- given tyvars.
+closeOverKindsAcc :: [TyVar] -> FV
+closeOverKindsAcc tvs =
+  mapUnionFV (tyVarsOfTypeAcc . tyVarKind) tvs `unionFV` someVars tvs
+
+-- | Add the kind variables free in the kinds of the tyvars in the given set.
+-- Returns a deterministic set.
+closeOverKindsDSet :: DTyVarSet -> DTyVarSet
+closeOverKindsDSet = runFVDSet . closeOverKindsAcc . dVarSetElems
 
 varSetElemsKvsFirst :: VarSet -> [TyVar]
 -- {k1,a,k2,b} --> [k1,k2,a,b]
diff --git a/compiler/utils/FV.hs b/compiler/utils/FV.hs
index 907a20f9ca..9ff273024c 100644
--- a/compiler/utils/FV.hs
+++ b/compiler/utils/FV.hs
@@ -17,10 +17,13 @@ module FV (
         -- ** Manipulating those computations
         oneVar,
         noVars,
+        someVars,
         unionFV,
+        unionsFV,
         delFV,
         delFVs,
         filterFV,
+        mapUnionFV,
     ) where
 
 import Var
@@ -30,7 +33,19 @@ import VarSet
 -- 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 UniqDFM.
+
+-- 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
           -> ([Var], VarSet)
@@ -40,48 +55,144 @@ type FV = InterestingVarFun
              -- Note [Deterministic UniqFM] in UniqDFM.
           -> ([Var], VarSet)
 
+-- 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 `runFVList`, `runFVDSet`, `runFV`. That means the functions
+-- returning FV need to be exported.
+--
+-- The conventions are:
+--
+-- a) non-deterministic functions:
+--   * x - a function that returns VarSet
+--         e.g. `tyVarsOfType`
+-- b) deterministic functions:
+--   * xAcc - a worker that returns FV
+--            e.g. `tyVarsOfTypeAcc`
+--   * xList - a function that returns [Var]
+--             e.g. `tyVarsOfTypeList`
+--   * xDSet - a function that returns DVarSet
+--             e.g. `tyVarsOfTypeDSet`
+--
+-- Where x, xList, xDSet are implemented in terms of the worker evaluated with
+-- runFVSet, runFVList, runFVDSet respectively.
+
+-- | Run a free variable computation, returning a list of distinct free
+-- variables in deterministic order and a non-deterministic set containing
+-- those variables.
 runFV :: FV ->  ([Var], VarSet)
 runFV fv = fv (const True) emptyVarSet ([], emptyVarSet)
 
+-- | Run a free variable computation, returning a list of distinct free
+-- variables in deterministic order.
 runFVList :: FV -> [Var]
 runFVList = fst . runFV
 
+-- | 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
+-- `runFVList`.
 runFVDSet :: FV -> DVarSet
 runFVDSet = mkDVarSet . fst . runFV
 
+-- | 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.
 runFVSet :: FV -> VarSet
 runFVSet = snd . runFV
 
-{-# INLINE oneVar #-}
+-- 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.
 oneVar :: Id -> FV
 oneVar var fv_cand in_scope acc@(have, haveSet)
-  = {- ASSERT( isId var ) probably not going to work -} fvs
-  where
-  fvs | var `elemVarSet` in_scope = acc
-      | var `elemVarSet` haveSet = acc
-      | fv_cand var = (var:have, extendVarSet haveSet var)
-      | otherwise = acc
+  | var `elemVarSet` in_scope = acc
+  | var `elemVarSet` haveSet = acc
+  | fv_cand var = (var:have, extendVarSet haveSet var)
+  | otherwise = acc
+{-# INLINE oneVar #-}
 
-{-# INLINE noVars #-}
+-- | Return no free variables.
 noVars :: FV
 noVars _ _ acc = acc
+{-# INLINE noVars #-}
 
-{-# INLINE unionFV #-}
+-- | 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 #-}
 
-{-# INLINE delFV #-}
+-- | 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 #-}
 
-{-# INLINE delFVs #-}
+-- | 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 #-}
 
-{-# INLINE filterFV #-}
+-- | 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
+{-# INLINE 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.
+someVars :: [Var] -> FV
+someVars vars fv_cand in_scope acc =
+  mapUnionFV oneVar vars fv_cand in_scope acc
+{-# INLINE someVars #-}
diff --git a/compiler/utils/UniqDFM.hs b/compiler/utils/UniqDFM.hs
index 3f2830ab1f..aeb5b34116 100644
--- a/compiler/utils/UniqDFM.hs
+++ b/compiler/utils/UniqDFM.hs
@@ -28,6 +28,10 @@ module UniqDFM (
         unitUDFM,
         addToUDFM,
         delFromUDFM,
+        delListFromUDFM,
+        adjustUDFM,
+        alterUDFM,
+        mapUDFM,
         plusUDFM,
         lookupUDFM,
         elemUDFM,
@@ -37,7 +41,9 @@ module UniqDFM (
         isNullUDFM,
         sizeUDFM,
         intersectUDFM,
+        disjointUDFM,
         minusUDFM,
+        partitionUDFM,
 
         udfmToList,
         udfmToUfm,
@@ -222,11 +228,24 @@ intersectUDFM (UDFM x i) (UDFM y _j) = UDFM (M.intersection x y) i
   -- M.intersection is left biased, that means the result will only have
   -- a subset of elements from the left set, so `i` is a good upper bound.
 
+disjointUDFM :: UniqDFM elt -> UniqDFM elt -> Bool
+disjointUDFM (UDFM x _i) (UDFM y _j) = M.null (M.intersection x y)
+
 minusUDFM :: UniqDFM elt1 -> UniqDFM elt2 -> UniqDFM elt1
 minusUDFM (UDFM x i) (UDFM y _j) = UDFM (M.difference x y) i
   -- M.difference returns a subset of a left set, so `i` is a good upper
   -- bound.
 
+-- | Partition UniqDFM into two UniqDFMs according to the predicate
+partitionUDFM :: (elt -> Bool) -> UniqDFM elt -> (UniqDFM elt, UniqDFM elt)
+partitionUDFM p (UDFM m i) =
+  case M.partition (p . taggedFst) m of
+    (left, right) -> (UDFM left i, UDFM right i)
+
+-- | Delete a list of elements from a UniqDFM
+delListFromUDFM  :: Uniquable key => UniqDFM elt -> [key] -> UniqDFM elt
+delListFromUDFM = foldl delFromUDFM
+
 -- | This allows for lossy conversion from UniqDFM to UniqFM
 udfmToUfm :: UniqDFM elt -> UniqFM elt
 udfmToUfm (UDFM m _i) =
@@ -235,6 +254,32 @@ udfmToUfm (UDFM m _i) =
 listToUDFM_Directly :: [(Unique, elt)] -> UniqDFM elt
 listToUDFM_Directly = foldl (\m (u, v) -> addToUDFM_Directly m u v) emptyUDFM
 
+-- | Apply a function to a particular element
+adjustUDFM :: Uniquable key => (elt -> elt) -> UniqDFM elt -> key -> UniqDFM elt
+adjustUDFM f (UDFM m i) k = UDFM (M.adjust (fmap f) (getKey $ getUnique k) m) i
+
+-- | The expression (alterUDFM f k map) alters value x at k, or absence
+-- thereof. alterUDFM can be used to insert, delete, or update a value in
+-- UniqDFM. Use addToUDFM, delFromUDFM or adjustUDFM when possible, they are
+-- more efficient.
+alterUDFM
+  :: Uniquable key
+  => (Maybe elt -> Maybe elt)  -- How to adjust
+  -> UniqDFM elt               -- old
+  -> key                       -- new
+  -> UniqDFM elt               -- result
+alterUDFM f (UDFM m i) k =
+  UDFM (M.alter alterf (getKey $ getUnique k) m) (i + 1)
+  where
+  alterf Nothing = inject $ f Nothing
+  alterf (Just (TaggedVal v _)) = inject $ f (Just v)
+  inject Nothing = Nothing
+  inject (Just v) = Just $ TaggedVal v i
+
+-- | Map a function over every value in a UniqDFM
+mapUDFM :: (elt1 -> elt2) -> UniqDFM elt1 -> UniqDFM elt2
+mapUDFM f (UDFM m i) = UDFM (M.map (fmap f) m) i
+
 -- This should not be used in commited code, provided for convenience to
 -- make ad-hoc conversions when developing
 alwaysUnsafeUfmToUdfm :: UniqFM elt -> UniqDFM elt
diff --git a/compiler/utils/UniqDSet.hs b/compiler/utils/UniqDSet.hs
index bf9f7a301c..85c5126e57 100644
--- a/compiler/utils/UniqDSet.hs
+++ b/compiler/utils/UniqDSet.hs
@@ -28,6 +28,8 @@ module UniqDSet (
         isEmptyUniqDSet,
         lookupUniqDSet,
         uniqDSetToList,
+        partitionUniqDSet,
+        delListFromUniqDSet,
     ) where
 
 import UniqDFM
@@ -86,3 +88,9 @@ lookupUniqDSet = lookupUDFM
 
 uniqDSetToList :: UniqDSet a -> [a]
 uniqDSetToList = eltsUDFM
+
+partitionUniqDSet :: (a -> Bool) -> UniqDSet a -> (UniqDSet a, UniqDSet a)
+partitionUniqDSet = partitionUDFM
+
+delListFromUniqDSet :: Uniquable a => UniqDSet a -> [a] -> UniqDSet a
+delListFromUniqDSet = delListFromUDFM