+emptyFVInfo :: FreeVarsInfo
+emptyFVInfo = emptyVarEnv
+
+singletonFVInfo :: Id -> HowBound -> StgBinderInfo -> FreeVarsInfo
+-- Don't record non-CAF imports at all, to keep free-var sets small
+singletonFVInfo id ImportBound info
+ | mayHaveCafRefs (idCafInfo id) = unitVarEnv id (id, ImportBound, info)
+ | otherwise = emptyVarEnv
+singletonFVInfo id how_bound info = unitVarEnv id (id, how_bound, info)
+
+tyvarFVInfo :: TyVarSet -> FreeVarsInfo
+tyvarFVInfo tvs = foldVarSet add emptyFVInfo tvs
+ where
+ add tv fvs = extendVarEnv fvs tv (tv, LambdaBound, noBinderInfo)
+ -- Type variables must be lambda-bound
+
+unionFVInfo :: FreeVarsInfo -> FreeVarsInfo -> FreeVarsInfo
+unionFVInfo fv1 fv2 = plusVarEnv_C plusFVInfo fv1 fv2
+
+unionFVInfos :: [FreeVarsInfo] -> FreeVarsInfo
+unionFVInfos fvs = foldr unionFVInfo emptyFVInfo fvs
+
+minusFVBinders :: [Id] -> FreeVarsInfo -> FreeVarsInfo
+minusFVBinders vs fv = foldr minusFVBinder fv vs
+
+minusFVBinder :: Id -> FreeVarsInfo -> FreeVarsInfo
+minusFVBinder v fv | isId v && opt_RuntimeTypes
+ = (fv `delVarEnv` v) `unionFVInfo`
+ tyvarFVInfo (tyVarsOfType (idType v))
+ | otherwise = fv `delVarEnv` v
+ -- When removing a binder, remember to add its type variables
+ -- c.f. CoreFVs.delBinderFV
+
+elementOfFVInfo :: Id -> FreeVarsInfo -> Bool
+elementOfFVInfo id fvs = maybeToBool (lookupVarEnv fvs id)
+
+lookupFVInfo :: FreeVarsInfo -> Id -> StgBinderInfo
+-- Find how the given Id is used.
+-- Externally visible things may be used any old how
+lookupFVInfo fvs id
+ | isExternalName (idName id) = noBinderInfo
+ | otherwise = case lookupVarEnv fvs id of
+ Nothing -> noBinderInfo
+ Just (_,_,info) -> info
+
+allFreeIds :: FreeVarsInfo -> [(Id,HowBound)] -- Both top level and non-top-level Ids
+allFreeIds fvs = [(id,how_bound) | (id,how_bound,_) <- rngVarEnv fvs, isId id]
+
+-- Non-top-level things only, both type variables and ids
+-- (type variables only if opt_RuntimeTypes)
+getFVs :: FreeVarsInfo -> [Var]
+getFVs fvs = [id | (id, how_bound, _) <- rngVarEnv fvs,
+ not (topLevelBound how_bound) ]
+
+getFVSet :: FreeVarsInfo -> VarSet
+getFVSet fvs = mkVarSet (getFVs fvs)
+
+plusFVInfo (id1,hb1,info1) (id2,hb2,info2)
+ = ASSERT (id1 == id2 && hb1 `check_eq_how_bound` hb2)
+ (id1, hb1, combineStgBinderInfo info1 info2)
+
+#ifdef DEBUG
+-- The HowBound info for a variable in the FVInfo should be consistent
+check_eq_how_bound ImportBound ImportBound = True
+check_eq_how_bound LambdaBound LambdaBound = True
+check_eq_how_bound (LetBound li1 ar1) (LetBound li2 ar2) = ar1 == ar2 && check_eq_li li1 li2
+check_eq_how_bound hb1 hb2 = False
+
+check_eq_li (NestedLet _) (NestedLet _) = True
+check_eq_li TopLet TopLet = True
+check_eq_li li1 li2 = False
+#endif