Commit cbe569a5 authored by David Feuer's avatar David Feuer Committed by David Feuer

Upgrade UniqSet to a newtype

The fundamental problem with `type UniqSet = UniqFM` is that `UniqSet`
has a key invariant `UniqFM` does not. For example, `fmap` over
`UniqSet` will generally produce nonsense.

* Upgrade `UniqSet` from a type synonym to a newtype.

* Remove unused and shady `extendVarSet_C` and `addOneToUniqSet_C`.

* Use cached unique in `tyConsOfType` by replacing
  `unitNameEnv (tyConName tc) tc` with `unitUniqSet tc`.

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

Reviewed By: niteria

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3146
parent 701256df
......@@ -79,7 +79,6 @@ import FastString
import Module
import Binary
import UniqSet
import UniqFM
import Unique( mkAlphaTyVarUnique )
import qualified Data.Data as Data
......@@ -1202,7 +1201,7 @@ isLegacyPromotableDataCon dc
= null (dataConEqSpec dc) -- no GADTs
&& null (dataConTheta dc) -- no context
&& not (isFamInstTyCon (dataConTyCon dc)) -- no data instance constructors
&& allUFM isLegacyPromotableTyCon (tyConsOfType (dataConUserType dc))
&& uniqSetAll isLegacyPromotableTyCon (tyConsOfType (dataConUserType dc))
-- | Was this tycon promotable before GHC 8.0? That is, is it promotable
-- without -XTypeInType
......
......@@ -35,7 +35,6 @@ module NameSet (
import Name
import UniqSet
import UniqFM
import Data.List (sortBy)
{-
......@@ -96,8 +95,8 @@ nameSetAll = uniqSetAll
-- See Note [Deterministic UniqFM] to learn about nondeterminism
nameSetElemsStable :: NameSet -> [Name]
nameSetElemsStable ns =
sortBy stableNameCmp $ nonDetEltsUFM ns
-- It's OK to use nonDetEltsUFM here because we immediately sort
sortBy stableNameCmp $ nonDetEltsUniqSet ns
-- It's OK to use nonDetEltsUniqSet here because we immediately sort
-- with stableNameCmp
{-
......
......@@ -77,6 +77,7 @@ import FieldLabel
import Outputable
import Unique
import UniqFM
import UniqSet
import Util
import NameEnv
......@@ -346,7 +347,7 @@ instance Outputable LocalRdrEnv where
= hang (text "LocalRdrEnv {")
2 (vcat [ text "env =" <+> pprOccEnv ppr_elt env
, text "in_scope ="
<+> pprUFM ns (braces . pprWithCommas ppr)
<+> pprUFM (getUniqSet ns) (braces . pprWithCommas ppr)
] <+> char '}')
where
ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name
......
......@@ -9,7 +9,7 @@ module VarEnv (
-- ** Manipulating these environments
emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly,
elemVarEnv,
elemVarEnv, disjointVarEnv,
extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnv_Directly,
extendVarEnvList,
plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C,
......@@ -76,6 +76,7 @@ module VarEnv (
import OccName
import Var
import VarSet
import UniqSet
import UniqFM
import UniqDFM
import Unique
......@@ -94,26 +95,21 @@ import Outputable
-- | A set of variables that are in scope at some point
-- "Secrets of the Glasgow Haskell Compiler inliner" Section 3.2 provides
-- the motivation for this abstraction.
data InScopeSet = InScope (VarEnv Var) {-# UNPACK #-} !Int
-- The (VarEnv Var) is just a VarSet. But we write it like
-- this to remind ourselves that you can look up a Var in
-- the InScopeSet. Typically the InScopeSet contains the
data InScopeSet = InScope VarSet {-# UNPACK #-} !Int
-- We store a VarSet here, but we use this for lookups rather than
-- just membership tests. Typically the InScopeSet contains the
-- canonical version of the variable (e.g. with an informative
-- unfolding), so this lookup is useful.
--
-- INVARIANT: the VarEnv maps (the Unique of) a variable to
-- a variable with the same Unique. (This was not
-- the case in the past, when we had a grevious hack
-- mapping var1 to var2.
--
-- The Int is a kind of hash-value used by uniqAway
-- For example, it might be the size of the set
-- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
instance Outputable InScopeSet where
ppr (InScope s _) =
text "InScope" <+> braces (fsep (map (ppr . Var.varName) (nonDetEltsUFM s)))
-- It's OK to use nonDetEltsUFM here because it's
text "InScope" <+>
braces (fsep (map (ppr . Var.varName) (nonDetEltsUniqSet s)))
-- It's OK to use nonDetEltsUniqSet here because it's
-- only for pretty printing
-- In-scope sets get big, and with -dppr-debug
-- the output is overwhelming
......@@ -121,42 +117,43 @@ instance Outputable InScopeSet where
emptyInScopeSet :: InScopeSet
emptyInScopeSet = InScope emptyVarSet 1
getInScopeVars :: InScopeSet -> VarEnv Var
getInScopeVars :: InScopeSet -> VarSet
getInScopeVars (InScope vs _) = vs
mkInScopeSet :: VarEnv Var -> InScopeSet
mkInScopeSet :: VarSet -> InScopeSet
mkInScopeSet in_scope = InScope in_scope 1
extendInScopeSet :: InScopeSet -> Var -> InScopeSet
extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n + 1)
extendInScopeSet (InScope in_scope n) v
= InScope (extendVarSet in_scope v) (n + 1)
extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
extendInScopeSetList (InScope in_scope n) vs
= InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
= InScope (foldl (\s v -> extendVarSet s v) in_scope vs)
(n + length vs)
extendInScopeSetSet :: InScopeSet -> VarEnv Var -> InScopeSet
extendInScopeSetSet :: InScopeSet -> VarSet -> InScopeSet
extendInScopeSetSet (InScope in_scope n) vs
= InScope (in_scope `plusVarEnv` vs) (n + sizeUFM vs)
= InScope (in_scope `unionVarSet` vs) (n + sizeUniqSet vs)
delInScopeSet :: InScopeSet -> Var -> InScopeSet
delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarSet` v) n
elemInScopeSet :: Var -> InScopeSet -> Bool
elemInScopeSet v (InScope in_scope _) = v `elemVarEnv` in_scope
elemInScopeSet v (InScope in_scope _) = v `elemVarSet` in_scope
-- | Look up a variable the 'InScopeSet'. This lets you map from
-- the variable's identity (unique) to its full value.
lookupInScope :: InScopeSet -> Var -> Maybe Var
lookupInScope (InScope in_scope _) v = lookupVarEnv in_scope v
lookupInScope (InScope in_scope _) v = lookupVarSet in_scope v
lookupInScope_Directly :: InScopeSet -> Unique -> Maybe Var
lookupInScope_Directly (InScope in_scope _) uniq
= lookupVarEnv_Directly in_scope uniq
= lookupVarSet_Directly in_scope uniq
unionInScope :: InScopeSet -> InScopeSet -> InScopeSet
unionInScope (InScope s1 _) (InScope s2 n2)
= InScope (s1 `plusVarEnv` s2) n2
= InScope (s1 `unionVarSet` s2) n2
varSetInScope :: VarSet -> InScopeSet -> Bool
varSetInScope vars (InScope s1 _) = vars `subVarSet` s1
......@@ -240,9 +237,9 @@ mkRnEnv2 vars = RV2 { envL = emptyVarEnv
, envR = emptyVarEnv
, in_scope = vars }
addRnInScopeSet :: RnEnv2 -> VarEnv Var -> RnEnv2
addRnInScopeSet :: RnEnv2 -> VarSet -> RnEnv2
addRnInScopeSet env vs
| isEmptyVarEnv vs = env
| isEmptyVarSet vs = env
| otherwise = env { in_scope = extendInScopeSetSet (in_scope env) vs }
rnInScope :: Var -> RnEnv2 -> Bool
......@@ -462,9 +459,11 @@ lookupVarEnv_NF :: VarEnv a -> Var -> a
lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
elemVarEnv :: Var -> VarEnv a -> Bool
elemVarEnvByKey :: Unique -> VarEnv a -> Bool
disjointVarEnv :: VarEnv a -> VarEnv a -> Bool
elemVarEnv = elemUFM
elemVarEnvByKey = elemUFM_Directly
disjointVarEnv = disjointUFM
alterVarEnv = alterUFM
extendVarEnv = addToUFM
extendVarEnv_C = addToUFM_C
......
......@@ -11,7 +11,7 @@ module VarSet (
-- ** Manipulating these sets
emptyVarSet, unitVarSet, mkVarSet,
extendVarSet, extendVarSetList, extendVarSet_C,
extendVarSet, extendVarSetList,
elemVarSet, subVarSet,
unionVarSet, unionVarSets, mapUnionVarSet,
intersectVarSet, intersectsVarSet, disjointVarSet,
......@@ -19,7 +19,7 @@ module VarSet (
minusVarSet, filterVarSet,
anyVarSet, allVarSet,
transCloVarSet, fixVarSet,
lookupVarSet, lookupVarSetByName,
lookupVarSet_Directly, lookupVarSet, lookupVarSetByName,
sizeVarSet, seqVarSet,
elemVarSetByKey, partitionVarSet,
pluralVarSet, pprVarSet,
......@@ -91,13 +91,13 @@ delVarSetList :: VarSet -> [Var] -> VarSet
minusVarSet :: VarSet -> VarSet -> VarSet
isEmptyVarSet :: VarSet -> Bool
mkVarSet :: [Var] -> VarSet
lookupVarSet_Directly :: VarSet -> Unique -> Maybe Var
lookupVarSet :: VarSet -> Var -> Maybe Var
-- Returns the set element, which may be
-- (==) to the argument, but not the same as
lookupVarSetByName :: VarSet -> Name -> Maybe Var
sizeVarSet :: VarSet -> Int
filterVarSet :: (Var -> Bool) -> VarSet -> VarSet
extendVarSet_C :: (Var->Var->Var) -> VarSet -> Var -> VarSet
delVarSetByKey :: VarSet -> Unique -> VarSet
elemVarSetByKey :: Unique -> VarSet -> Bool
......@@ -123,11 +123,11 @@ delVarSet = delOneFromUniqSet
delVarSetList = delListFromUniqSet
isEmptyVarSet = isEmptyUniqSet
mkVarSet = mkUniqSet
lookupVarSet_Directly = lookupUniqSet_Directly
lookupVarSet = lookupUniqSet
lookupVarSetByName = lookupUniqSet
sizeVarSet = sizeUniqSet
filterVarSet = filterUniqSet
extendVarSet_C = addOneToUniqSet_C
delVarSetByKey = delOneFromUniqSet_Directly
elemVarSetByKey = elemUniqSet_Directly
partitionVarSet = partitionUniqSet
......@@ -136,7 +136,7 @@ mapUnionVarSet get_set xs = foldr (unionVarSet . get_set) emptyVarSet xs
-- See comments with type signatures
intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)
disjointVarSet s1 s2 = disjointUFM s1 s2
disjointVarSet s1 s2 = disjointUFM (getUniqSet s1) (getUniqSet s2)
subVarSet s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)
anyVarSet :: (Var -> Bool) -> VarSet -> Bool
......@@ -190,7 +190,7 @@ seqVarSet s = sizeVarSet s `seq` ()
-- | Determines the pluralisation suffix appropriate for the length of a set
-- in the same way that plural from Outputable does for lists.
pluralVarSet :: VarSet -> SDoc
pluralVarSet = pluralUFM
pluralVarSet = pluralUFM . getUniqSet
-- | Pretty-print a non-deterministic set.
-- The order of variables is non-deterministic and for pretty-printing that
......@@ -207,7 +207,7 @@ pprVarSet :: VarSet -- ^ The things to be pretty printed
-- elements
-> SDoc -- ^ 'SDoc' where the things have been pretty
-- printed
pprVarSet = pprUFM
pprVarSet = pprUFM . getUniqSet
-- Deterministic VarSet
-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need
......@@ -311,7 +311,7 @@ extendDVarSetList = addListToUniqDSet
-- | Convert a DVarSet to a VarSet by forgeting the order of insertion
dVarSetToVarSet :: DVarSet -> VarSet
dVarSetToVarSet = udfmToUfm
dVarSetToVarSet = unsafeUFMToUniqSet . udfmToUfm
-- | transCloVarSet for DVarSet
transCloDVarSet :: (DVarSet -> DVarSet)
......
......@@ -985,7 +985,7 @@ is_cishCC JavaScriptCallConv = False
--
pprTempAndExternDecls :: [CmmBlock] -> (SDoc{-temps-}, SDoc{-externs-})
pprTempAndExternDecls stmts
= (pprUFM temps (vcat . map pprTempDecl),
= (pprUFM (getUniqSet temps) (vcat . map pprTempDecl),
vcat (map (pprExternDecl False{-ToDo-}) (Map.keys lbls)))
where (temps, lbls) = runTE (mapM_ te_BB stmts)
......
......@@ -66,7 +66,8 @@ import CoreSyn
import Id
import IdInfo
import NameSet
import UniqFM
import UniqSet
import Unique (Uniquable (..))
import Literal ( literalType )
import Name
import VarSet
......@@ -476,7 +477,8 @@ idRuleRhsVars is_active id
, ru_rhs = rhs, ru_act = act })
| is_active act
-- See Note [Finding rule RHS free vars] in OccAnal.hs
= delFromUFM fvs fn -- Note [Rule free var hack]
= delOneFromUniqSet_Directly fvs (getUnique fn)
-- Note [Rule free var hack]
where
fvs = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs)
get_fvs _ = noFVs
......
......@@ -876,7 +876,7 @@ simpleOptPgm dflags this_mod binds rules vects
; return (reverse binds', rules', vects') }
where
occ_anald_binds = occurAnalysePgm this_mod (\_ -> False) {- No rules active -}
rules vects emptyVarEnv binds
rules vects emptyVarSet binds
(final_env, binds') = foldl do_one (emptyEnv, []) occ_anald_binds
final_subst = soe_subst final_env
......
......@@ -114,7 +114,7 @@ import BasicTypes
import DynFlags
import Outputable
import Util
import UniqFM
import UniqSet
import SrcLoc ( RealSrcSpan, containsSpan )
import Binary
......@@ -1038,7 +1038,7 @@ chooseOrphanAnchor local_names
| isEmptyNameSet local_names = IsOrphan
| otherwise = NotOrphan (minimum occs)
where
occs = map nameOccName $ nonDetEltsUFM local_names
occs = map nameOccName $ nonDetEltsUniqSet local_names
-- It's OK to use nonDetEltsUFM here, see comments above
instance Binary IsOrphan where
......
......@@ -51,6 +51,7 @@ import ListSetOps( assocMaybe )
import Data.List
import Util
import UniqDFM
import UniqSet
data DsCmdEnv = DsCmdEnv {
arr_id, compose_id, first_id, app_id, choice_id, loop_id :: CoreExpr
......@@ -375,7 +376,7 @@ dsCmd ids local_vars stack_ty res_ty
res_ty
core_make_arg
core_arrow,
exprFreeIdsDSet core_arg `udfmIntersectUFM` local_vars)
exprFreeIdsDSet core_arg `udfmIntersectUFM` (getUniqSet local_vars))
-- D, xs |- fun :: a t1 t2
-- D, xs |- arg :: t1
......@@ -404,7 +405,7 @@ dsCmd ids local_vars stack_ty res_ty
core_make_pair
(do_app ids arg_ty res_ty),
(exprsFreeIdsDSet [core_arrow, core_arg])
`udfmIntersectUFM` local_vars)
`udfmIntersectUFM` getUniqSet local_vars)
-- D; ys |-a cmd : (t,stk) --> t'
-- D, xs |- exp :: t
......@@ -437,7 +438,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdApp cmd arg) env_ids = do
core_map
core_cmd,
free_vars `unionDVarSet`
(exprFreeIdsDSet core_arg `udfmIntersectUFM` local_vars))
(exprFreeIdsDSet core_arg `udfmIntersectUFM` getUniqSet local_vars))
-- D; ys |-a cmd : stk t'
-- -----------------------------------------------
......@@ -474,7 +475,7 @@ dsCmd ids local_vars stack_ty res_ty
-- match the old environment and stack against the input
select_code <- matchEnvStack env_ids stack_id param_code
return (do_premap ids in_ty in_ty' res_ty select_code core_body,
free_vars `udfmMinusUFM` pat_vars)
free_vars `udfmMinusUFM` getUniqSet pat_vars)
dsCmd ids local_vars stack_ty res_ty (HsCmdPar cmd) env_ids
= dsLCmd ids local_vars stack_ty res_ty cmd env_ids
......@@ -506,7 +507,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdIf mb_fun cond then_cmd else_cmd)
then_ty = envStackType then_ids stack_ty
else_ty = envStackType else_ids stack_ty
sum_ty = mkTyConApp either_con [then_ty, else_ty]
fvs_cond = exprFreeIdsDSet core_cond `udfmIntersectUFM` local_vars
fvs_cond = exprFreeIdsDSet core_cond `udfmIntersectUFM` getUniqSet local_vars
core_left = mk_left_expr then_ty else_ty (buildEnvStack then_ids stack_id)
core_right = mk_right_expr then_ty else_ty (buildEnvStack else_ids stack_id)
......@@ -602,7 +603,7 @@ dsCmd ids local_vars stack_ty res_ty
core_matches <- matchEnvStack env_ids stack_id core_body
return (do_premap ids in_ty sum_ty res_ty core_matches core_choices,
exprFreeIdsDSet core_body `udfmIntersectUFM` local_vars)
exprFreeIdsDSet core_body `udfmIntersectUFM` getUniqSet local_vars)
-- D; ys |-a cmd : stk --> t
-- ----------------------------------
......@@ -627,7 +628,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdLet lbinds@(L _ binds) body) env_ids
res_ty
core_map
core_body,
exprFreeIdsDSet core_binds `udfmIntersectUFM` local_vars)
exprFreeIdsDSet core_binds `udfmIntersectUFM` getUniqSet local_vars)
-- D; xs |-a ss : t
-- ----------------------------------
......@@ -879,7 +880,7 @@ dsCmdStmt ids local_vars out_ids (BindStmt pat cmd _ _ _) env_ids = do
do_compose ids before_c_ty after_c_ty out_ty
(do_first ids in_ty1 pat_ty in_ty2 core_cmd) $
do_arr ids after_c_ty out_ty proj_expr,
fv_cmd `unionDVarSet` (mkDVarSet out_ids `udfmMinusUFM` pat_vars))
fv_cmd `unionDVarSet` (mkDVarSet out_ids `udfmMinusUFM` getUniqSet pat_vars))
-- D; xs' |-a do { ss } : t
-- --------------------------------------
......@@ -896,7 +897,7 @@ dsCmdStmt ids local_vars out_ids (LetStmt binds) env_ids = do
(mkBigCoreVarTupTy env_ids)
(mkBigCoreVarTupTy out_ids)
core_map,
exprFreeIdsDSet core_binds `udfmIntersectUFM` local_vars)
exprFreeIdsDSet core_binds `udfmIntersectUFM` getUniqSet local_vars)
-- D; ys |-a do { ss; returnA -< ((xs1), (ys2)) } : ...
-- D; xs' |-a do { ss' } : t
......@@ -1015,7 +1016,7 @@ dsRecCmd ids local_vars stmts later_ids later_rets rec_ids rec_rets = do
rec_id <- newSysLocalDs rec_ty
let
env1_id_set = fv_stmts `udfmMinusUFM` rec_id_set
env1_id_set = fv_stmts `udfmMinusUFM` getUniqSet rec_id_set
env1_ids = dVarSetElems env1_id_set
env1_ty = mkBigCoreVarTupTy env1_ids
in_pair_ty = mkCorePairTy env1_ty rec_ty
......
......@@ -15,7 +15,7 @@ import NameSet
import Module
import Outputable
import Util
import UniqFM
import UniqSet
import UniqDFM
import ListSetOps
import Fingerprint
......@@ -108,7 +108,7 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
-- ent_map groups together all the things imported and used
-- from a particular module
ent_map :: ModuleEnv [OccName]
ent_map = nonDetFoldUFM add_mv emptyModuleEnv used_names
ent_map = nonDetFoldUniqSet add_mv emptyModuleEnv used_names
-- nonDetFoldUFM is OK here. If you follow the logic, we sort by OccName
-- in ent_hashs
where
......
......@@ -27,7 +27,7 @@ import IfaceEnv( newInteractiveBinder )
import Name
import Var hiding ( varName )
import VarSet
import UniqFM
import UniqSet
import Type
import GHC
import Outputable
......@@ -100,11 +100,11 @@ pprintClosureCommand bindThings force str = do
my_tvs = termTyCoVars t
tvs = env_tvs `minusVarSet` my_tvs
tyvarOccName = nameOccName . tyVarName
tidyEnv = (initTidyOccEnv (map tyvarOccName (nonDetEltsUFM tvs))
-- It's OK to use nonDetEltsUFM here because initTidyOccEnv
tidyEnv = (initTidyOccEnv (map tyvarOccName (nonDetEltsUniqSet tvs))
-- It's OK to use nonDetEltsUniqSet here because initTidyOccEnv
-- forgets the ordering immediately by creating an env
, env_tvs `intersectVarSet` my_tvs)
return$ mapTermType (snd . tidyOpenType tidyEnv) t
, getUniqSet $ env_tvs `intersectVarSet` my_tvs)
return $ mapTermType (snd . tidyOpenType tidyEnv) t
-- | Give names, and bind in the interactive environment, to all the suspensions
-- included (inductively) in a term
......
......@@ -46,7 +46,6 @@ import TcEnv
import TyCon
import Name
import VarEnv
import Util
import VarSet
import BasicTypes ( Boxity(..) )
......@@ -307,12 +306,12 @@ mapTermTypeM f = foldTermM TermFoldM {
termTyCoVars :: Term -> TyCoVarSet
termTyCoVars = foldTerm TermFold {
fTerm = \ty _ _ tt ->
tyCoVarsOfType ty `plusVarEnv` concatVarEnv tt,
tyCoVarsOfType ty `unionVarSet` concatVarEnv tt,
fSuspension = \_ ty _ _ -> tyCoVarsOfType ty,
fPrim = \ _ _ -> emptyVarEnv,
fNewtypeWrap= \ty _ t -> tyCoVarsOfType ty `plusVarEnv` t,
fRefWrap = \ty t -> tyCoVarsOfType ty `plusVarEnv` t}
where concatVarEnv = foldr plusVarEnv emptyVarEnv
fPrim = \ _ _ -> emptyVarSet,
fNewtypeWrap= \ty _ t -> tyCoVarsOfType ty `unionVarSet` t,
fRefWrap = \ty t -> tyCoVarsOfType ty `unionVarSet` t}
where concatVarEnv = foldr unionVarSet emptyVarSet
----------------------------------
-- Pretty printing of terms
......
......@@ -104,7 +104,7 @@ import Maybes
import Binary
import Fingerprint
import Exception
import UniqFM
import UniqSet
import UniqDFM
import Packages
......@@ -453,7 +453,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
-- filtering must be on the semantic module!
-- See Note [Identity versus semantic module]
. filter ((== semantic_mod) . name_module)
. nonDetEltsUFM
. nonDetEltsUniqSet
-- It's OK to use nonDetEltsUFM as localOccs is only
-- used to construct the edges and
-- stronglyConnCompFromEdgedVertices is deterministic
......
......@@ -447,7 +447,7 @@ getGlobalPtr llvmLbl = do
-- will be generated anymore!
generateExternDecls :: LlvmM ([LMGlobal], [LlvmType])
generateExternDecls = do
delayed <- fmap nonDetEltsUFM $ getEnv envAliases
delayed <- fmap nonDetEltsUniqSet $ getEnv envAliases
-- This is non-deterministic but we do not
-- currently support deterministic code-generation.
-- See Note [Unique Determinism and code generation]
......
......@@ -89,7 +89,7 @@ worst :: (RegClass -> UniqSet Reg)
worst regsOfClass regAlias neighbors classN classC
= let regAliasS regs = unionManyUniqSets
$ map regAlias
$ nonDetEltsUFM regs
$ nonDetEltsUniqSet regs
-- This is non-deterministic but we do not
-- currently support deterministic code-generation.
-- See Note [Unique Determinism and code generation]
......@@ -126,7 +126,7 @@ bound regsOfClass regAlias classN classesC
regsC_aliases
= unionManyUniqSets
$ map (regAliasS . regsOfClass) classesC
$ map (regAliasS . getUniqSet . regsOfClass) classesC
overlap = intersectUniqSets (regsOfClass classN) regsC_aliases
......@@ -155,5 +155,5 @@ powersetL = map concat . mapM (\x -> [[],[x]])
-- | powersetLS (list of sets)
powersetLS :: Uniquable a => UniqSet a -> [UniqSet a]
powersetLS s = map mkUniqSet $ powersetL $ nonDetEltsUFM s
powersetLS s = map mkUniqSet $ powersetL $ nonDetEltsUniqSet s
-- See Note [Unique Determinism and code generation]
......@@ -111,7 +111,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code
( text "It looks like the register allocator is stuck in an infinite loop."
$$ text "max cycles = " <> int maxSpinCount
$$ text "regsFree = " <> (hcat $ punctuate space $ map ppr
$ nonDetEltsUFM $ unionManyUniqSets
$ nonDetEltsUniqSet $ unionManyUniqSets
$ nonDetEltsUFM regsFree)
-- This is non-deterministic but we do not
-- currently support deterministic code-generation.
......@@ -316,15 +316,15 @@ graphAddConflictSet
graphAddConflictSet set graph
= let virtuals = mkUniqSet
[ vr | RegVirtual vr <- nonDetEltsUFM set ]
[ vr | RegVirtual vr <- nonDetEltsUniqSet set ]
graph1 = Color.addConflicts virtuals classOfVirtualReg graph
graph2 = foldr (\(r1, r2) -> Color.addExclusion r1 classOfVirtualReg r2)
graph1
[ (vr, rr)
| RegVirtual vr <- nonDetEltsUFM set
, RegReal rr <- nonDetEltsUFM set]
| RegVirtual vr <- nonDetEltsUniqSet set
, RegReal rr <- nonDetEltsUniqSet set]
-- See Note [Unique Determinism and code generation]
in graph2
......@@ -419,11 +419,11 @@ seqNode node
= seqVirtualReg (Color.nodeId node)
`seq` seqRegClass (Color.nodeClass node)
`seq` seqMaybeRealReg (Color.nodeColor node)
`seq` (seqVirtualRegList (nonDetEltsUFM (Color.nodeConflicts node)))
`seq` (seqRealRegList (nonDetEltsUFM (Color.nodeExclusions node)))
`seq` (seqVirtualRegList (nonDetEltsUniqSet (Color.nodeConflicts node)))
`seq` (seqRealRegList (nonDetEltsUniqSet (Color.nodeExclusions node)))
`seq` (seqRealRegList (Color.nodePreference node))
`seq` (seqVirtualRegList (nonDetEltsUFM (Color.nodeCoalesce node)))
-- It's OK to use nonDetEltsUFM for seq
`seq` (seqVirtualRegList (nonDetEltsUniqSet (Color.nodeCoalesce node)))
-- It's OK to use nonDetEltsUniqSet for seq
seqVirtualReg :: VirtualReg -> ()
seqVirtualReg reg = reg `seq` ()
......
......@@ -61,9 +61,9 @@ regSpill platform code slotsFree regs
| otherwise
= do
-- Allocate a slot for each of the spilled regs.
let slots = take (sizeUniqSet regs) $ nonDetEltsUFM slotsFree
let slots = take (sizeUniqSet regs) $ nonDetEltsUniqSet slotsFree
let regSlotMap = listToUFM
$ zip (nonDetEltsUFM regs) slots
$ zip (nonDetEltsUniqSet regs) slots
-- This is non-deterministic but we do not
-- currently support deterministic code-generation.
-- See Note [Unique Determinism and code generation]
......@@ -141,7 +141,7 @@ regSpill_top platform regSlotMap cmm
moreSlotsLive = IntSet.fromList
$ catMaybes
$ map (lookupUFM regSlotMap)
$ nonDetEltsUFM regsLive
$ nonDetEltsUniqSet regsLive
-- See Note [Unique Determinism and code generation]
slotMap'
......
......@@ -413,7 +413,7 @@ intersects assocs = foldl1' intersectAssoc assocs
findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
findRegOfSlot assoc slot
| close <- closeAssoc (SSlot slot) assoc
, Just (SReg reg) <- find isStoreReg $ nonDetEltsUFM close
, Just (SReg reg) <- find isStoreReg $ nonDetEltsUniqSet close
-- See Note [Unique Determinism and code generation]
= Just reg
......@@ -549,7 +549,7 @@ delAssoc :: (Uniquable a)
delAssoc a m
| Just aSet <- lookupUFM m a
, m1 <- delFromUFM m a
= nonDetFoldUFM (\x m -> delAssoc1 x a m) m1 aSet
= nonDetFoldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
-- It's OK to use nonDetFoldUFM here because deletion is commutative
| otherwise = m
......@@ -582,7 +582,7 @@ closeAssoc a assoc
= closeAssoc' assoc emptyUniqSet (unitUniqSet a)
where
closeAssoc' assoc visited toVisit
= case nonDetEltsUFM toVisit of
= case nonDetEltsUniqSet toVisit of
-- See Note [Unique Determinism and code generation]
-- nothing else to visit, we're done
......
......@@ -108,7 +108,7 @@ slurpSpillCostInfo platform cmm
countLIs rsLiveEntry (LiveInstr instr (Just live) : lis)
= do
-- Increment the lifetime counts for regs live on entry to this instr.
mapM_ incLifetime $ nonDetEltsUFM rsLiveEntry
mapM_ incLifetime $ nonDetEltsUniqSet rsLiveEntry
-- This is non-deterministic but we do not
-- currently support deterministic code-generation.
-- See Note [Unique Determinism and code generation]
......@@ -140,7 +140,7 @@ slurpSpillCostInfo platform cmm
-- | Take all the virtual registers from this set.
takeVirtuals :: UniqSet Reg -> UniqSet VirtualReg
takeVirtuals set = mkUniqSet
[ vr | RegVirtual vr <- nonDetEltsUFM set ]
[ vr | RegVirtual vr <- nonDetEltsUniqSet set ]
-- See Note [Unique Determinism and code generation]
......@@ -260,7 +260,7 @@ nodeDegree classOfVirtualReg graph reg
, virtConflicts
<- length
$ filter (\r -> classOfVirtualReg r == classOfVirtualReg reg)
$ nonDetEltsUFM
$ nonDetEltsUniqSet
-- See Note [Unique Determinism and code generation]
$ nodeConflicts node
......
......@@ -13,7 +13,7 @@ import Reg
import GraphBase
import UniqFM
import UniqSet
import Platform
import Panic
......@@ -56,10 +56,10 @@ accSqueeze
:: Int
-> Int
-> (reg -> Int)
-> UniqFM reg
-> UniqSet reg
-> Int
accSqueeze count maxCount squeeze ufm = acc count (nonDetEltsUFM ufm)
accSqueeze count maxCount squeeze us = acc count (nonDetEltsUniqSet us)
-- See Note [Unique Determinism and code generation]
where acc count [] = count
acc count _ | count >= maxCount = count
......
......@@ -352,7 +352,7 @@ initBlock id block_live
setFreeRegsR (frInitFreeRegs platform)
Just live ->
setFreeRegsR $ foldl' (flip $ frAllocateReg platform) (frInitFreeRegs platform)
[ r | RegReal r <- nonDetEltsUFM live ]
[ r | RegReal r <- nonDetEltsUniqSet live ]
-- See Note [Unique Determinism and code generation]
setAssigR emptyRegMap
......@@ -446,8 +446,8 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
return (new_instrs, [])
_ -> genRaInsn block_live new_instrs id instr
(nonDetEltsUFM $ liveDieRead live)
(nonDetEltsUFM $ liveDieWrite live)
(nonDetEltsUniqSet $ liveDieRead live)
(nonDetEltsUniqSet $ liveDieWrite live)
-- See Note [Unique Determinism and code generation]
raInsn _ _ _ instr
......