Commit 7460dafa authored by Simon Peyton Jones's avatar Simon Peyton Jones

Rename some of the functions in NameSet, to make the uniform with VarSet etc

For ages NameSet has used different names,
  eg.   addOneToNameSet   rather than    extendNameSet
        nameSetToList     rather than    nameSetElems

etc.  Other set-like modules use uniform naming conventions.
This patch makes NameSet follow suit.

No change in behaviour; this is just renaming.

I'm doing this just before the fork so that merging is easier.
parent 171101be
......@@ -56,7 +56,7 @@ stableAvailCmp (AvailTC {}) (Avail {}) = GT
availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet avails = foldr add emptyNameSet avails
where add avail set = addListToNameSet set (availNames avail)
where add avail set = extendNameSetList set (availNames avail)
availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv avails = foldr add emptyNameEnv avails
......
......@@ -713,7 +713,7 @@ isUnpackableType fam_envs ty
= not (tc_name `elemNameSet` tcs)
&& case tyConSingleAlgDataCon_maybe tc of
Just con | isVanillaDataCon con
-> ok_con_args (tcs `addOneToNameSet` getName tc) con
-> ok_con_args (tcs `extendNameSet` getName tc) con
_ -> True
| otherwise
= True
......
......@@ -10,8 +10,8 @@ module NameSet (
NameSet,
-- ** Manipulating these sets
emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets,
minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet,
emptyNameSet, unitNameSet, mkNameSet, unionNameSet, unionNameSets,
minusNameSet, elemNameSet, nameSetElems, extendNameSet, extendNameSetList,
delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
intersectsNameSet, intersectNameSet,
......@@ -47,14 +47,14 @@ type NameSet = UniqSet Name
emptyNameSet :: NameSet
unitNameSet :: Name -> NameSet
addListToNameSet :: NameSet -> [Name] -> NameSet
addOneToNameSet :: NameSet -> Name -> NameSet
extendNameSetList :: NameSet -> [Name] -> NameSet
extendNameSet :: NameSet -> Name -> NameSet
mkNameSet :: [Name] -> NameSet
unionNameSets :: NameSet -> NameSet -> NameSet
unionManyNameSets :: [NameSet] -> NameSet
unionNameSet :: NameSet -> NameSet -> NameSet
unionNameSets :: [NameSet] -> NameSet
minusNameSet :: NameSet -> NameSet -> NameSet
elemNameSet :: Name -> NameSet -> Bool
nameSetToList :: NameSet -> [Name]
nameSetElems :: NameSet -> [Name]
isEmptyNameSet :: NameSet -> Bool
delFromNameSet :: NameSet -> Name -> NameSet
delListFromNameSet :: NameSet -> [Name] -> NameSet
......@@ -69,13 +69,13 @@ isEmptyNameSet = isEmptyUniqSet
emptyNameSet = emptyUniqSet
unitNameSet = unitUniqSet
mkNameSet = mkUniqSet
addListToNameSet = addListToUniqSet
addOneToNameSet = addOneToUniqSet
unionNameSets = unionUniqSets
unionManyNameSets = unionManyUniqSets
extendNameSetList = addListToUniqSet
extendNameSet = addOneToUniqSet
unionNameSet = unionUniqSets
unionNameSets = unionManyUniqSets
minusNameSet = minusUniqSet
elemNameSet = elementOfUniqSet
nameSetToList = uniqSetToList
nameSetElems = uniqSetToList
delFromNameSet = delOneFromUniqSet
foldNameSet = foldUniqSet
filterNameSet = filterUniqSet
......@@ -110,10 +110,10 @@ delFVs :: [Name] -> FreeVars -> FreeVars
isEmptyFVs :: NameSet -> Bool
isEmptyFVs = isEmptyNameSet
emptyFVs = emptyNameSet
plusFVs = unionManyNameSets
plusFV = unionNameSets
plusFVs = unionNameSets
plusFV = unionNameSet
mkFVs = mkNameSet
addOneFV = addOneToNameSet
addOneFV = extendNameSet
unitFV = unitNameSet
delFV n s = delFromNameSet s n
delFVs ns s = delListFromNameSet s ns
......@@ -162,21 +162,21 @@ duDefs :: DefUses -> Defs
duDefs dus = foldr get emptyNameSet dus
where
get (Nothing, _u1) d2 = d2
get (Just d1, _u1) d2 = d1 `unionNameSets` d2
get (Just d1, _u1) d2 = d1 `unionNameSet` d2
allUses :: DefUses -> Uses
-- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned
allUses dus = foldr get emptyNameSet dus
where
get (_d1, u1) u2 = u1 `unionNameSets` u2
get (_d1, u1) u2 = u1 `unionNameSet` u2
duUses :: DefUses -> Uses
-- ^ Collect all 'Uses', regardless of whether the group is itself used,
-- but remove 'Defs' on the way
duUses dus = foldr get emptyNameSet dus
where
get (Nothing, rhs_uses) uses = rhs_uses `unionNameSets` uses
get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSets` uses)
get (Nothing, rhs_uses) uses = rhs_uses `unionNameSet` uses
get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSet` uses)
`minusNameSet` defs
findUses :: DefUses -> Uses -> Uses
......@@ -187,13 +187,13 @@ findUses dus uses
= foldr get uses dus
where
get (Nothing, rhs_uses) uses
= rhs_uses `unionNameSets` uses
= rhs_uses `unionNameSet` uses
get (Just defs, rhs_uses) uses
| defs `intersectsNameSet` uses -- Used
|| any (startsWithUnderscore . nameOccName) (nameSetToList defs)
|| any (startsWithUnderscore . nameOccName) (nameSetElems defs)
-- At least one starts with an "_",
-- so treat the group as used
= rhs_uses `unionNameSets` uses
= rhs_uses `unionNameSet` uses
| otherwise -- No def is used
= uses
\end{code}
......@@ -343,7 +343,7 @@ instance Outputable LocalRdrEnv where
ppr (LRE {lre_env = env, lre_in_scope = ns})
= hang (ptext (sLit "LocalRdrEnv {"))
2 (vcat [ ptext (sLit "env =") <+> pprOccEnv ppr_elt env
, ptext (sLit "in_scope =") <+> braces (pprWithCommas ppr (nameSetToList ns))
, ptext (sLit "in_scope =") <+> braces (pprWithCommas ppr (nameSetElems ns))
] <+> char '}')
where
ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name
......@@ -357,13 +357,13 @@ extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
extendLocalRdrEnv (LRE { lre_env = env, lre_in_scope = ns }) name
= WARN( isExternalName name, ppr name )
LRE { lre_env = extendOccEnv env (nameOccName name) name
, lre_in_scope = addOneToNameSet ns name }
, lre_in_scope = extendNameSet ns name }
extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
extendLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) names
= WARN( any isExternalName names, ppr names )
LRE { lre_env = extendOccEnvList env [(nameOccName n, n) | n <- names]
, lre_in_scope = addListToNameSet ns names }
, lre_in_scope = extendNameSetList ns names }
lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
lookupLocalRdrEnv (LRE { lre_env = env }) (Unqual occ) = lookupOccEnv env occ
......
......@@ -234,7 +234,7 @@ tickish_fvs _ = noVars
ruleLhsOrphNames :: CoreRule -> NameSet
ruleLhsOrphNames (BuiltinRule { ru_fn = fn }) = unitNameSet fn
ruleLhsOrphNames (Rule { ru_fn = fn, ru_args = tpl_args })
= addOneToNameSet (exprsOrphNames tpl_args) fn
= extendNameSet (exprsOrphNames tpl_args) fn
-- No need to delete bndrs, because
-- exprsOrphNames finds only External names
......@@ -254,20 +254,20 @@ exprOrphNames e
go (Lit _) = emptyNameSet
go (Type ty) = orphNamesOfType ty -- Don't need free tyvars
go (Coercion co) = orphNamesOfCo co
go (App e1 e2) = go e1 `unionNameSets` go e2
go (App e1 e2) = go e1 `unionNameSet` go e2
go (Lam v e) = go e `delFromNameSet` idName v
go (Tick _ e) = go e
go (Cast e co) = go e `unionNameSets` orphNamesOfCo co
go (Let (NonRec _ r) e) = go e `unionNameSets` go r
go (Let (Rec prs) e) = exprsOrphNames (map snd prs) `unionNameSets` go e
go (Case e _ ty as) = go e `unionNameSets` orphNamesOfType ty
`unionNameSets` unionManyNameSets (map go_alt as)
go (Cast e co) = go e `unionNameSet` orphNamesOfCo co
go (Let (NonRec _ r) e) = go e `unionNameSet` go r
go (Let (Rec prs) e) = exprsOrphNames (map snd prs) `unionNameSet` go e
go (Case e _ ty as) = go e `unionNameSet` orphNamesOfType ty
`unionNameSet` unionNameSets (map go_alt as)
go_alt (_,_,r) = go r
-- | Finds the free /external/ names of several expressions: see 'exprOrphNames' for details
exprsOrphNames :: [CoreExpr] -> NameSet
exprsOrphNames es = foldr (unionNameSets . exprOrphNames) emptyNameSet es
exprsOrphNames es = foldr (unionNameSet . exprOrphNames) emptyNameSet es
\end{code}
%************************************************************************
......
......@@ -247,7 +247,7 @@ addTickLHsBind (L pos bind@(AbsBinds { abs_binds = binds,
-- to add the local Ids to the set of exported Names so that we know to
-- tick the right bindings.
add_exports env =
env{ exports = exports env `addListToNameSet`
env{ exports = exports env `extendNameSetList`
[ idName mid
| ABE{ abe_poly = pid, abe_mono = mid } <- abs_exports
, idName pid `elemNameSet` (exports env) ] }
......
......@@ -99,7 +99,7 @@ bcoFreeNames bco
= bco_refs bco `minusNameSet` mkNameSet [unlinkedBCOName bco]
where
bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs)
= unionManyNameSets (
= unionNameSets (
mkNameSet [ n | BCOPtrName n <- ssElts ptrs ] :
mkNameSet [ n | BCONPtrItbl n <- ssElts nonptrs ] :
map bco_refs [ bco | BCOPtrBCO bco <- ssElts ptrs ]
......
......@@ -473,7 +473,7 @@ linkExpr hsc_env span root_ul_bco
; return (pls, root_hval)
}}}
where
free_names = nameSetToList (bcoFreeNames root_ul_bco)
free_names = nameSetElems (bcoFreeNames root_ul_bco)
needed_mods :: [Module]
needed_mods = [ nameModule n | n <- free_names,
......@@ -688,7 +688,7 @@ linkDecls hsc_env span (ByteCode unlinkedBCOs itblEnv) = do
itbl_env = ie }
return (pls2, ()) --hvals)
where
free_names = concatMap (nameSetToList . bcoFreeNames) unlinkedBCOs
free_names = concatMap (nameSetElems . bcoFreeNames) unlinkedBCOs
needed_mods :: [Module]
needed_mods = [ nameModule n | n <- free_names,
......
......@@ -844,7 +844,7 @@ lStmtsImplicits :: [LStmtLR Name idR (Located (body idR))] -> NameSet
lStmtsImplicits = hs_lstmts
where
hs_lstmts :: [LStmtLR Name idR (Located (body idR))] -> NameSet
hs_lstmts = foldr (\stmt rest -> unionNameSets (hs_stmt (unLoc stmt)) rest) emptyNameSet
hs_lstmts = foldr (\stmt rest -> unionNameSet (hs_stmt (unLoc stmt)) rest) emptyNameSet
hs_stmt (BindStmt pat _ _ _) = lPatImplicits pat
hs_stmt (LetStmt binds) = hs_local_binds binds
......@@ -860,12 +860,12 @@ lStmtsImplicits = hs_lstmts
hsValBindsImplicits :: HsValBindsLR Name idR -> NameSet
hsValBindsImplicits (ValBindsOut binds _)
= foldr (unionNameSets . lhsBindsImplicits . snd) emptyNameSet binds
= foldr (unionNameSet . lhsBindsImplicits . snd) emptyNameSet binds
hsValBindsImplicits (ValBindsIn binds _)
= lhsBindsImplicits binds
lhsBindsImplicits :: LHsBindsLR Name idR -> NameSet
lhsBindsImplicits = foldBag unionNameSets (lhs_bind . unLoc) emptyNameSet
lhsBindsImplicits = foldBag unionNameSet (lhs_bind . unLoc) emptyNameSet
where
lhs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat
lhs_bind _ = emptyNameSet
......@@ -875,7 +875,7 @@ lPatImplicits = hs_lpat
where
hs_lpat (L _ pat) = hs_pat pat
hs_lpats = foldr (\pat rest -> hs_lpat pat `unionNameSets` rest) emptyNameSet
hs_lpats = foldr (\pat rest -> hs_lpat pat `unionNameSet` rest) emptyNameSet
hs_pat (LazyPat pat) = hs_lpat pat
hs_pat (BangPat pat) = hs_lpat pat
......@@ -896,11 +896,11 @@ lPatImplicits = hs_lpat
hs_pat _ = emptyNameSet
details (PrefixCon ps) = hs_lpats ps
details (RecCon fs) = hs_lpats explicit `unionNameSets` mkNameSet (collectPatsBinders implicit)
details (RecCon fs) = hs_lpats explicit `unionNameSet` mkNameSet (collectPatsBinders implicit)
where (explicit, implicit) = partitionEithers [if pat_explicit then Left pat else Right pat
| (i, fld) <- [0..] `zip` rec_flds fs
, let pat = hsRecFieldArg
(unLoc fld)
pat_explicit = maybe True (i<) (rec_dotdot fs)]
details (InfixCon p1 p2) = hs_lpat p1 `unionNameSets` hs_lpat p2
details (InfixCon p1 p2) = hs_lpat p1 `unionNameSet` hs_lpat p2
\end{code}
......@@ -1335,7 +1335,7 @@ freeNamesIfaceTyConParent (IfDataInstance ax tc tys)
-- helpers
(&&&) :: NameSet -> NameSet -> NameSet
(&&&) = unionNameSets
(&&&) = unionNameSet
fnList :: (a -> NameSet) -> [a] -> NameSet
fnList f = foldr (&&&) emptyNameSet . map f
......
......@@ -395,7 +395,7 @@ mkIface_ hsc_env maybe_old_fingerprint
, ifaceVectInfoTyCon = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t /= t_v]
, ifaceVectInfoTyConReuse = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t == t_v]
, ifaceVectInfoParallelVars = [Var.varName v | v <- varSetElems vParallelVars]
, ifaceVectInfoParallelTyCons = nameSetToList vParallelTyCons
, ifaceVectInfoParallelTyCons = nameSetElems vParallelTyCons
}
-----------------------------
......@@ -464,7 +464,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
localOccs = map (getUnique . getParent . getOccName)
. filter ((== this_mod) . name_module)
. nameSetToList
. nameSetElems
where getParent occ = lookupOccEnv parent_map occ `orElse` occ
-- maps OccNames to their parents in the current module.
......@@ -783,15 +783,15 @@ cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
freeNamesDeclABI :: IfaceDeclABI -> NameSet
freeNamesDeclABI (_mod, decl, extras) =
freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
freeNamesIfDecl decl `unionNameSet` freeNamesDeclExtras extras
freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
freeNamesDeclExtras (IfaceIdExtras id_extras)
= freeNamesIdExtras id_extras
freeNamesDeclExtras (IfaceDataExtras _ insts _ subs)
= unionManyNameSets (mkNameSet insts : map freeNamesIdExtras subs)
= unionNameSets (mkNameSet insts : map freeNamesIdExtras subs)
freeNamesDeclExtras (IfaceClassExtras _ insts _ subs)
= unionManyNameSets (mkNameSet insts : map freeNamesIdExtras subs)
= unionNameSets (mkNameSet insts : map freeNamesIdExtras subs)
freeNamesDeclExtras (IfaceSynonymExtras _ _)
= emptyNameSet
freeNamesDeclExtras (IfaceFamilyExtras _ insts _)
......@@ -800,7 +800,7 @@ freeNamesDeclExtras IfaceOtherDeclExtras
= emptyNameSet
freeNamesIdExtras :: IfaceIdExtras -> NameSet
freeNamesIdExtras (IdExtras _ rules _) = unionManyNameSets (map freeNamesIfRule rules)
freeNamesIdExtras (IdExtras _ rules _) = unionNameSets (map freeNamesIfRule rules)
instance Outputable IfaceDeclExtras where
ppr IfaceOtherDeclExtras = Outputable.empty
......@@ -1829,7 +1829,7 @@ instanceToIfaceInst (ClsInst { is_dfun = dfun_id, is_flag = oflag
, not (tv `elem` rtvs)]
choose_one :: [NameSet] -> Maybe OccName
choose_one nss = case nameSetToList (unionManyNameSets nss) of
choose_one nss = case nameSetElems (unionNameSets nss) of
[] -> Nothing
(n : _) -> Just (nameOccName n)
......@@ -1857,7 +1857,7 @@ famInstToIfaceFamInst (FamInst { fi_axiom = axiom,
= Just (nameOccName fam_decl)
| not (isEmptyNameSet lhs_names)
= Just (nameOccName (head (nameSetToList lhs_names)))
= Just (nameOccName (head (nameSetElems lhs_names)))
| otherwise
......@@ -1973,7 +1973,7 @@ coreRuleToIfaceRule mod rule@(Rule { ru_name = name, ru_fn = fn,
-- Compute orphanhood. See Note [Orphans] in IfaceSyn
-- A rule is an orphan only if none of the variables
-- mentioned on its left-hand side are locally defined
lhs_names = nameSetToList (ruleLhsOrphNames rule)
lhs_names = nameSetElems (ruleLhsOrphNames rule)
orph = case filter (nameIsLocalOrFrom mod) lhs_names of
(n : _) -> Just (nameOccName n)
......
......@@ -1115,7 +1115,7 @@ modInfoTopLevelScope minf
= fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
modInfoExports :: ModuleInfo -> [Name]
modInfoExports minf = nameSetToList $! minf_exports minf
modInfoExports minf = nameSetElems $! minf_exports minf
-- | Returns the instances defined by the specified module.
-- Warning: currently unimplemented for package modules.
......
......@@ -2494,7 +2494,7 @@ plusVectInfo vi1 vi2 =
(vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2)
(vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
(vectInfoParallelVars vi1 `unionVarSet` vectInfoParallelVars vi2)
(vectInfoParallelTyCons vi1 `unionNameSets` vectInfoParallelTyCons vi2)
(vectInfoParallelTyCons vi1 `unionNameSet` vectInfoParallelTyCons vi2)
concatVectInfo :: [VectInfo] -> VectInfo
concatVectInfo = foldr plusVectInfo noVectInfo
......
......@@ -912,7 +912,7 @@ getInfo allInfo name
plausible rdr_env names
-- Dfun involving only names that are in ic_rn_glb_env
= allInfo
|| all ok (nameSetToList names)
|| all ok (nameSetElems names)
where -- A name is ok if it's in the rdr_env,
-- whether qualified or not
ok n | n == name = True -- The one we looked for in the first place!
......
......@@ -348,7 +348,7 @@ rnLocalValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
-- wildcards (#4404)
implicit_uses = hsValBindsImplicits binds'
; warnUnusedLocalBinds bound_names
(real_uses `unionNameSets` implicit_uses)
(real_uses `unionNameSet` implicit_uses)
; let
-- The variables "used" in the val binds are:
......@@ -637,7 +637,7 @@ depAnalBinds binds_w_dus
= (map get_binds sccs, map get_du sccs)
where
sccs = depAnal (\(_, defs, _) -> defs)
(\(_, _, uses) -> nameSetToList uses)
(\(_, _, uses) -> nameSetElems uses)
(bagToList binds_w_dus)
get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)
......@@ -647,7 +647,7 @@ depAnalBinds binds_w_dus
get_du (CyclicSCC binds_w_dus) = (Just defs, uses)
where
defs = mkNameSet [b | (_,bs,_) <- binds_w_dus, b <- bs]
uses = unionManyNameSets [u | (_,_,u) <- binds_w_dus]
uses = unionNameSets [u | (_,_,u) <- binds_w_dus]
---------------------
-- Bind the top-level forall'd type variables in the sigs.
......
......@@ -394,7 +394,7 @@ rnCmdTop = wrapLocFstM rnCmdTop'
rnCmdTop' (HsCmdTop cmd _ _ _)
= do { (cmd', fvCmd) <- rnLCmd cmd
; let cmd_names = [arrAName, composeAName, firstAName] ++
nameSetToList (methodNamesCmd (unLoc cmd'))
nameSetElems (methodNamesCmd (unLoc cmd'))
-- Generate the rebindable syntax for the monad
; (cmd_names', cmd_fvs) <- lookupSyntaxNames cmd_names
......@@ -686,7 +686,7 @@ rnStmt ctxt rnBody (L _ (RecStmt { recS_stmts = rec_stmts })) thing_inside
-- (This set may not be empty, because we're in a recursive
-- context.)
; rnRecStmtsAndThen rnBody rec_stmts $ \ segs -> do
{ let bndrs = nameSetToList $ foldr (unionNameSets . (\(ds,_,_,_) -> ds))
{ let bndrs = nameSetElems $ foldr (unionNameSet . (\(ds,_,_,_) -> ds))
emptyNameSet segs
; (thing, fvs_later) <- thing_inside bndrs
; let (rec_stmts', fvs) = segmentRecStmts ctxt empty_rec_stmt segs fvs_later
......@@ -850,7 +850,7 @@ rnRecStmtsAndThen rnBody s cont
-- (C) do the right-hand-sides and thing-inside
{ segs <- rn_rec_stmts rnBody bound_names new_lhs_and_fv
; (res, fvs) <- cont segs
; warnUnusedLocalBinds bound_names (fvs `unionNameSets` implicit_uses)
; warnUnusedLocalBinds bound_names (fvs `unionNameSet` implicit_uses)
; return (res, fvs) }}
-- get all the fixity decls in any Let stmt
......@@ -1001,8 +1001,8 @@ segmentRecStmts ctxt empty_rec_stmt segs fvs_later
| otherwise
= ([ L (getLoc (head ss)) $
empty_rec_stmt { recS_stmts = ss
, recS_later_ids = nameSetToList (defs `intersectNameSet` fvs_later)
, recS_rec_ids = nameSetToList (defs `intersectNameSet` uses) }]
, recS_later_ids = nameSetElems (defs `intersectNameSet` fvs_later)
, recS_rec_ids = nameSetElems (defs `intersectNameSet` uses) }]
, uses `plusFV` fvs_later)
where
......@@ -1034,8 +1034,8 @@ addFwdRefs segs
= (new_seg : segs, all_defs)
where
new_seg = (defs, uses, new_fwds, stmts)
all_defs = later_defs `unionNameSets` defs
new_fwds = fwds `unionNameSets` (uses `intersectNameSet` later_defs)
all_defs = later_defs `unionNameSet` defs
new_fwds = fwds `unionNameSet` (uses `intersectNameSet` later_defs)
-- Add the downstream fwd refs here
\end{code}
......@@ -1125,8 +1125,8 @@ segsToStmts empty_rec_stmt ((defs, uses, fwds, ss) : segs) fvs_later
new_stmt | non_rec = head ss
| otherwise = L (getLoc (head ss)) rec_stmt
rec_stmt = empty_rec_stmt { recS_stmts = ss
, recS_later_ids = nameSetToList used_later
, recS_rec_ids = nameSetToList fwds }
, recS_later_ids = nameSetElems used_later
, recS_rec_ids = nameSetElems fwds }
non_rec = isSingleton ss && isEmptyNameSet fwds
used_later = defs `intersectNameSet` later_uses
-- The ones needed after the RecStmt
......
......@@ -518,7 +518,7 @@ getLocalNonValBinders fixity_env
; val_avails <- mapM new_simple val_bndrs
; let avails = nti_avails ++ val_avails
new_bndrs = availsToNameSet avails `unionNameSets`
new_bndrs = availsToNameSet avails `unionNameSet`
availsToNameSet tc_avails
; traceRn (text "getLocalNonValBinders 2" <+> ppr avails)
; envs <- extendGlobalRdrEnvRn avails fixity_env
......@@ -1390,7 +1390,7 @@ findImportUsage imports rdr_env rdrs
import_usage = foldr (extendImportMap rdr_env) Map.empty rdrs
unused_decl decl@(L loc (ImportDecl { ideclHiding = imps }))
= (decl, nubAvails used_avails, nameSetToList unused_imps)
= (decl, nubAvails used_avails, nameSetElems unused_imps)
where
used_avails = Map.lookup (srcSpanEnd loc) import_usage `orElse` []
-- srcSpanEnd: see Note [The ImportMap]
......@@ -1413,11 +1413,11 @@ findImportUsage imports rdr_env rdrs
add_unused_name n acc
| n `elemNameSet` used_names = acc
| otherwise = acc `addOneToNameSet` n
| otherwise = acc `extendNameSet` n
add_unused_all n acc
| n `elemNameSet` used_names = acc
| n `elemNameSet` used_parents = acc
| otherwise = acc `addOneToNameSet` n
| otherwise = acc `extendNameSet` n
add_unused_with p ns acc
| all (`elemNameSet` acc1) ns = add_unused_name p acc1
| otherwise = acc1
......
......@@ -116,7 +116,7 @@ rnSrcDecls extra_deps group@(HsGroup { hs_valds = val_decls,
new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
-- bind the LHSes (and their fixities) in the global rdr environment
let { val_binders = collectHsValBinders new_lhs ;
all_bndrs = addListToNameSet tc_bndrs val_binders ;
all_bndrs = extendNameSetList tc_bndrs val_binders ;
val_avails = map Avail val_binders } ;
traceRn (text "rnSrcDecls" <+> ppr val_avails) ;
(tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
......@@ -188,7 +188,7 @@ rnSrcDecls extra_deps group@(HsGroup { hs_valds = val_decls,
tycl_bndrs = hsTyClDeclsBinders rn_tycl_decls rn_inst_decls ;
ford_bndrs = hsForeignDeclsBinders rn_foreign_decls ;
other_def = (Just (mkNameSet tycl_bndrs `unionNameSets` mkNameSet ford_bndrs), emptyNameSet) ;
other_def = (Just (mkNameSet tycl_bndrs `unionNameSet` mkNameSet ford_bndrs), emptyNameSet) ;
other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
src_fvs5, src_fvs6, src_fvs7, src_fvs8,
src_fvs9] ;
......@@ -545,7 +545,7 @@ rnFamInstDecl doc mb_cls tycon pats payload rnPayload
; (payload', rhs_fvs) <- rnPayload doc payload
-- See Note [Renaming associated types]
; let lhs_names = mkNameSet kv_names `unionNameSets` mkNameSet tv_names
; let lhs_names = mkNameSet kv_names `unionNameSet` mkNameSet tv_names
bad_tvs = case mb_cls of
Nothing -> []
Just (_,cls_tkvs) -> filter is_bad cls_tkvs
......@@ -938,7 +938,7 @@ rnTyClDecls extra_deps tycl_ds
; thisPkg <- fmap thisPackage getDynFlags
; let add_boot_deps :: FreeVars -> FreeVars
-- See Note [Extra dependencies from .hs-boot files]
add_boot_deps fvs | any (isInPackage thisPkg) (nameSetToList fvs)
add_boot_deps fvs | any (isInPackage thisPkg) (nameSetElems fvs)
= fvs `plusFV` mkFVs extra_deps
| otherwise
= fvs
......@@ -1213,7 +1213,7 @@ depAnalTyClDecls :: [(LTyClDecl Name, FreeVars)] -> [SCC (LTyClDecl Name)]
depAnalTyClDecls ds_w_fvs
= stronglyConnCompFromEdgedVertices edges
where
edges = [ (d, tcdName (unLoc d), map get_parent (nameSetToList fvs))
edges = [ (d, tcdName (unLoc d), map get_parent (nameSetElems fvs))
| (d, fvs) <- ds_w_fvs ]
-- We also need to consider data constructor names since
......@@ -1435,7 +1435,7 @@ extendRecordFieldEnv tycl_decls inst_decls
; flds' <- mapM lookup (concatMap (cd_fld_names . unLoc) flds)
; let env' = foldl (\e c -> extendNameEnv e c flds') env cons'
fld_set' = addListToNameSet fld_set flds'
fld_set' = extendNameSetList fld_set flds'
; return $ (RecFields env' fld_set') }
get_con _ env = return env
\end{code}
......
......@@ -449,7 +449,7 @@ mkEdges :: TcSigFun -> LHsBinds Name
type BKey = Int -- Just number off the bindings
mkEdges sig_fn binds
= [ (bind, key, [key | n <- nameSetToList (bind_fvs (unLoc bind)),
= [ (bind, key, [key | n <- nameSetElems (bind_fvs (unLoc bind)),
Just key <- [lookupNameEnv key_map n], no_sig n ])
| (bind, key) <- keyd_binds
]
......
......@@ -533,7 +533,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = poly_ty, cid_binds = binds
-- Check for missing associated types and build them
-- from their defaults (if available)
; let defined_ats = mkNameSet (map (tyFamInstDeclName . unLoc) ats)
`unionNameSets`
`unionNameSet`
mkNameSet (map (unLoc . dfid_tycon . unLoc) adts)
; tyfam_insts1 <- mapM (tcATDefault mini_subst defined_ats)
(classATItems clas)
......
......@@ -1190,7 +1190,7 @@ tcTopSrcDecls boot_details
-- Extend the GblEnv with the (as yet un-zonked)
-- bindings, rules, foreign decls
; tcg_env' = tcg_env { tcg_binds = tcg_binds tcg_env `unionBags` all_binds
, tcg_sigs = tcg_sigs tcg_env `unionNameSets` sig_names
, tcg_sigs = tcg_sigs tcg_env `unionNameSet` sig_names
, tcg_rules = tcg_rules tcg_env ++ rules
, tcg_vects = tcg_vects tcg_env ++ vects
, tcg_anns = tcg_anns tcg_env ++ annotations
......
......@@ -1214,7 +1214,7 @@ keepAlive :: Name -> TcRn () -- Record the name in the keep-alive set
keepAlive name
= do { env <- getGblEnv
; traceRn (ptext (sLit "keep alive") <+> ppr name)
; updTcRef (tcg_keep env) (`addOneToNameSet` name) }
; updTcRef (tcg_keep env) (`extendNameSet` name) }
getStage :: TcM ThStage
getStage = do { env <- getLclEnv; return (tcl_th_ctxt env) }
......
......@@ -944,7 +944,7 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
bindName :: RdrName -> TcM ()
bindName (Exact n)
= do { th_topnames_var <- fmap tcg_th_topnames getGblEnv
; updTcRef th_topnames_var (\ns -> addOneToNameSet ns n)
; updTcRef th_topnames_var (\ns -> extendNameSet ns n)
}
bindName name =
......
......@@ -117,7 +117,7 @@ synTyConsOfType ty
\begin{code}
mkSynEdges :: [LTyClDecl Name] -> [(LTyClDecl Name, Name, [Name])]
mkSynEdges syn_decls = [ (ldecl, name, nameSetToList fvs)
mkSynEdges syn_decls = [ (ldecl, name, nameSetElems fvs)
| ldecl@(L _ (SynDecl { tcdLName = L _ name
, tcdFVs = fvs })) <- syn_decls ]
......@@ -383,8 +383,8 @@ calcRecFlags boot_details is_boot mrole_env tyclss
| otherwise = NonRecursive
boot_name_set = availsToNameSet (md_exports boot_details)
rec_names = boot_name_set `unionNameSets`
nt_loop_breakers `unionNameSets`
rec_names = boot_name_set `unionNameSet`
nt_loop_breakers `unionNameSet`
prod_loop_breakers
......
......@@ -1437,7 +1437,7 @@ end of the compiler.
\begin{code}
orphNamesOfTyCon :: TyCon -> NameSet
orphNamesOfTyCon tycon = unitNameSet (getName tycon) `unionNameSets` case tyConClass_maybe tycon of
orphNamesOfTyCon tycon = unitNameSet (getName tycon) `unionNameSet` case tyConClass_maybe tycon of
Nothing -> emptyNameSet
Just cls -> unitNameSet (getName cls)
......@@ -1447,15 +1447,15 @@ orphNamesOfType ty | Just ty' <- tcView ty = orphNamesOfType ty'
orphNamesOfType (TyVarTy _) = emptyNameSet
orphNamesOfType (LitTy {}) = emptyNameSet
orphNamesOfType (TyConApp tycon tys) = orphNamesOfTyCon tycon
`unionNameSets` orphNamesOfTypes tys
`unionNameSet` orphNamesOfTypes tys
orphNamesOfType (FunTy arg res) = orphNamesOfTyCon funTyCon -- NB! See Trac #8535
`unionNameSets` orphNamesOfType arg
`unionNameSets` orphNamesOfType res
orphNamesOfType (AppTy fun arg) = orphNamesOfType fun `unionNameSets` orphNamesOfType arg
`unionNameSet` orphNamesOfType arg
`unionNameSet` orphNamesOfType res
orphNamesOfType (AppTy fun arg) = orphNamesOfType fun `unionNameSet` orphNamesOfType arg
orphNamesOfType (ForAllTy _ ty) = orphNamesOfType ty
orphNamesOfThings :: (a -> NameSet) -> [a] -> NameSet
orphNamesOfThings f = foldr (unionNameSets . f) emptyNameSet
orphNamesOfThings f = foldr (unionNameSet . f) emptyNameSet
orphNamesOfTypes :: [Type] -> NameSet
orphNamesOfTypes = orphNamesOfThings orphNamesOfType
......@@ -1473,19 +1473,19 @@ orphNamesOfDFunHead dfun_ty
orphNamesOfCo :: Coercion -> NameSet
orphNamesOfCo (Refl _ ty) = orphNamesOfType ty
orphNamesOfCo (TyConAppCo _ tc cos) = unitNameSet (getName tc) `unionNameSets` orphNamesOfCos cos
orphNamesOfCo (AppCo co1 co2) = orphNamesOfCo co1 `unionNameSets` orphNamesOfCo co2
orphNamesOfCo (TyConAppCo _ tc cos) = unitNameSet (getName tc) `unionNameSet` orphNamesOfCos cos
orphNamesOfCo (AppCo co1 co2) = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2
orphNamesOfCo (ForAllCo _ co) = orphNamesOfCo co
orphNamesOfCo (CoVarCo _) = emptyNameSet
orphNamesOfCo (AxiomInstCo con _ cos) = orphNamesOfCoCon con `unionNameSets` orphNamesOfCos cos
orphNamesOfCo (UnivCo _ ty1 ty2) = orphNamesOfType ty1 `unionNameSets` orphNamesOfType ty2
orphNamesOfCo (AxiomInstCo con _ cos) = orphNamesOfCoCon con `unionNameSet` orphNamesOfCos cos
orphNamesOfCo (UnivCo _ ty1 ty2) = orphNamesOfType ty1 `unionNameSet` orphNamesOfType ty2
orphNamesOfCo (SymCo co) = orphNamesOfCo co
orphNamesOfCo (TransCo co1 co2) = orphNamesOfCo co1 `unionNameSets` orphNamesOfCo co2
orphNamesOfCo (TransCo co1 co2) = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2
orphNamesOfCo (NthCo _ co) = orphNamesOfCo co
orphNamesOfCo (LRCo _ co) = orphNamesOfCo co
orphNamesOfCo (InstCo co ty) = orphNamesOfCo co `unionNameSets` orphNamesOfType ty
orphNamesOfCo (InstCo co ty) = orphNamesOfCo co `unionNameSet` orphNamesOfType ty
orphNamesOfCo (SubCo co) = orphNamesOfCo co
orphNamesOfCo (AxiomRuleCo _ ts cs) = orphNamesOfTypes ts `unionNameSets`
orphNamesOfCo (AxiomRuleCo _ ts cs) = orphNamesOfTypes ts `unionNameSet`
orphNamesOfCos cs
orphNamesOfCos :: [Coercion] -> NameSet
......@@ -1493,14 +1493,14 @@ orphNamesOfCos = orphNamesOfThings orphNamesOfCo
orphNamesOfCoCon :: CoAxiom br -> NameSet
orphNamesOfCoCon (CoAxiom { co_ax_tc = tc, co_ax_branches = branches })
= orphNamesOfTyCon tc `unionNameSets` orphNamesOfCoAxBranches branches
= orphNamesOfTyCon tc `unionNameSet` orphNamesOfCoAxBranches branches
orphNamesOfCoAxBranches :: BranchList CoAxBranch br -> NameSet
orphNamesOfCoAxBranches = brListFoldr (unionNameSets . orphNamesOfCoAxBranch) emptyNameSet
orphNamesOfCoAxBranches = brListFoldr (unionNameSet . orphNamesOfCoAxBranch) emptyNameSet
orphNamesOfCoAxBranch :: CoAxBranch -> NameSet
orphNamesOfCoAxBranch (CoAxBranch { cab_lhs = lhs, cab_rhs = rhs })
= orphNamesOfTypes lhs `unionNameSets` orphNamesOfType rhs
= orphNamesOfTypes lhs `unionNameSet` orphNamesOfType rhs
\end{code}
......
......@@ -353,7 +353,7 @@ familyInstances (pkg_fie, home_fie) fam
orphNamesOfFamInst :: FamInst -> NameSet
orphNamesOfFamInst fam_inst
= orphNamesOfTypes (concat (brListMap cab_lhs (coAxiomBranches axiom)))
`addOneToNameSet` getName (coAxiomTyCon axiom)
`extendNameSet` getName (coAxiomTyCon axiom)
where
axiom = fi_axiom fam_inst
......
......@@ -1792,7 +1792,7 @@ checkRecTc :: RecTcChecker -> TyCon -> Maybe RecTcChecker
checkRecTc (RC rec_nts) tc
| not (isRecursiveTyCon tc) = Just (RC rec_nts)
| tc_name `elemNameSet` rec_nts = Nothing
| otherwise = Just (RC (addOneToNameSet rec_nts tc_name))
| otherwise = Just (RC (extendNameSet rec_nts tc_name))
where
tc_name = tyConName tc
\end{code}
......@@ -191,5 +191,5 @@ addGlobalParallelTyCon :: TyCon -> VM ()
addGlobalParallelTyCon tycon
= do { traceVt "addGlobalParallelTyCon" (ppr tycon)
; updGEnv $ \env ->
env{global_parallel_tycons = addOneToNameSet (global_parallel_tycons env) (tyConName tycon)}
env{global_parallel_tycons = extendNameSet (global_parallel_tycons env) (tyConName tycon)}
}
......@@ -71,7 +71,7 @@ classifyTyCons convStatus parTyCons tcs = classify [] [] [] [] convStatus parTyC
tcs_par | any ((`elemNameSet` parTyCons) . tyConName) . eltsUFM $ refs = tcs
| otherwise = []
pts' = pts `addListToNameSet` map tyConName tcs_par
pts' = pts `extendNameSetList` map tyConName tcs_par
can_convert = (isNullUFM (filterUniqSet ((`elemNameSet` pts) . tyConName) (refs `minusUFM` cs))
&& all convertable tcs)
......
......@@ -217,7 +217,7 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
-- Furthermore, 'par_tcs' are those type constructors (converted or not) whose
-- definition, directly or indirectly, depends on parallel arrays. Finally, 'drop_tcs'
-- are all type constructors that cannot be vectorised.
; parallelTyCons <- (`addListToNameSet` map (tyConName . fst) vectTyConsWithRHS) <$>
; parallelTyCons <- (`extendNameSetList` map (tyConName . fst) vectTyConsWithRHS) <$>
globalParallelTyCons
; let maybeVectoriseTyCons = filter notVectSpecialTyCon tycons ++ impVectTyCons
(conv_tcs, keep_tcs