[Git][ghc/ghc][wip/sjakobi/nondetfolds] Convert some existing non-det folds to be strict
Simon Jakobi
gitlab at gitlab.haskell.org
Tue Mar 31 18:19:51 UTC 2020
Simon Jakobi pushed to branch wip/sjakobi/nondetfolds at Glasgow Haskell Compiler / GHC
Commits:
d058ecc3 by Simon Jakobi at 2020-03-31T20:19:24+02:00
Convert some existing non-det folds to be strict
- - - - -
13 changed files:
- compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Op/OccurAnal.hs
- compiler/GHC/Core/Op/SetLevels.hs
- compiler/GHC/Core/Op/Specialise.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Rename/Source.hs
- compiler/GHC/Types/Unique/FM.hs
- compiler/GHC/Types/Unique/Set.hs
- compiler/typecheck/TcEvidence.hs
- compiler/utils/GraphOps.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
=====================================
@@ -554,8 +554,8 @@ delAssoc :: (Uniquable a)
delAssoc a m
| Just aSet <- lookupUFM m a
, m1 <- delFromUFM m a
- = nonDetFoldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
- -- It's OK to use nonDetFoldUFM here because deletion is commutative
+ = nonDetStrictFoldUniqSet (\m x -> delAssoc1 x a m) m1 aSet
+ -- It's OK to use nonDetStrictFoldUFM here because deletion is commutative
| otherwise = m
=====================================
compiler/GHC/Core/FamInstEnv.hs
=====================================
@@ -378,8 +378,8 @@ famInstEnvElts fi = [elt | FamIE elts <- eltsUDFM fi, elt <- elts]
-- See Note [FamInstEnv determinism]
famInstEnvSize :: FamInstEnv -> Int
-famInstEnvSize = nonDetFoldUDFM (\(FamIE elt) sum -> sum + length elt) 0
- -- It's OK to use nonDetFoldUDFM here since we're just computing the
+famInstEnvSize = nonDetStrictFoldUDFM (\sum (FamIE elt) -> sum + length elt) 0
+ -- It's OK to use nonDetStrictFoldUDFM here since we're just computing the
-- size.
familyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst]
=====================================
compiler/GHC/Core/Op/OccurAnal.hs
=====================================
@@ -2204,8 +2204,8 @@ extendFvs env s
= (s `unionVarSet` extras, extras `subVarSet` s)
where
extras :: VarSet -- env(s)
- extras = nonDetFoldUFM unionVarSet emptyVarSet $
- -- It's OK to use nonDetFoldUFM here because unionVarSet commutes
+ extras = nonDetStrictFoldUFM unionVarSet emptyVarSet $
+ -- It's OK to use nonDetStrictFoldUFM here because unionVarSet commutes
intersectUFM_C (\x _ -> x) env (getUniqSet s)
{-
@@ -2502,8 +2502,8 @@ addOneOcc ud id info
plus_zapped old new = doZapping ud id old `addOccInfo` new
addManyOccsSet :: UsageDetails -> VarSet -> UsageDetails
-addManyOccsSet usage id_set = nonDetFoldUniqSet addManyOccs usage id_set
- -- It's OK to use nonDetFoldUFM here because addManyOccs commutes
+addManyOccsSet usage id_set = nonDetStrictFoldUniqSet (flip addManyOccs) usage id_set
+ -- It's OK to use nonDetStrictFoldUFM here because addManyOccs commutes
-- Add several occurrences, assumed not to be tail calls
addManyOccs :: Var -> UsageDetails -> UsageDetails
=====================================
compiler/GHC/Core/Op/SetLevels.hs
=====================================
@@ -83,7 +83,7 @@ import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Var
import GHC.Types.Var.Set
-import GHC.Types.Unique.Set ( nonDetFoldUniqSet )
+import GHC.Types.Unique.Set ( nonDetStrictFoldUniqSet )
import GHC.Types.Unique.DSet ( getUniqDSet )
import GHC.Types.Var.Env
import GHC.Types.Literal ( litIsTrivial )
@@ -1469,11 +1469,11 @@ isFunction (_, AnnLam b e) | isId b = True
isFunction _ = False
countFreeIds :: DVarSet -> Int
-countFreeIds = nonDetFoldUDFM add 0 . getUniqDSet
- -- It's OK to use nonDetFoldUDFM here because we're just counting things.
+countFreeIds = nonDetStrictFoldUDFM add 0 . getUniqDSet
+ -- It's OK to use nonDetStrictFoldUDFM here because we're just counting things.
where
- add :: Var -> Int -> Int
- add v n | isId v = n+1
+ add :: Int -> Var -> Int
+ add n v | isId v = n+1
| otherwise = n
{-
@@ -1586,7 +1586,7 @@ maxFvLevel max_me env var_set
maxFvLevel' :: (Var -> Bool) -> LevelEnv -> TyCoVarSet -> Level
-- Same but for TyCoVarSet
maxFvLevel' max_me env var_set
- = nonDetFoldUniqSet (maxIn max_me env) tOP_LEVEL var_set
+ = nonDetStrictFoldUniqSet (flip (maxIn max_me env)) tOP_LEVEL var_set
maxIn :: (Var -> Bool) -> LevelEnv -> InVar -> Level -> Level
maxIn max_me (LE { le_lvl_env = lvl_env, le_env = id_env }) in_var lvl
=====================================
compiler/GHC/Core/Op/Specialise.hs
=====================================
@@ -2177,8 +2177,8 @@ unionCallInfoSet (CIS f calls1) (CIS _ calls2) =
callDetailsFVs :: CallDetails -> VarSet
callDetailsFVs calls =
- nonDetFoldUDFM (unionVarSet . callInfoFVs) emptyVarSet calls
- -- It's OK to use nonDetFoldUDFM here because we forget the ordering
+ nonDetStrictFoldUDFM (flip (unionVarSet . callInfoFVs)) emptyVarSet calls
+ -- It's OK to use nonDetStrictFoldUDFM here because we forget the ordering
-- immediately by converting to a nondeterministic set.
callInfoFVs :: CallInfoSet -> VarSet
=====================================
compiler/GHC/Core/TyCo/FVs.hs
=====================================
@@ -441,7 +441,7 @@ deepCoVarFolder = TyCoFolder { tcf_view = noView
closeOverKinds :: TyCoVarSet -> TyCoVarSet
-- For each element of the input set,
-- add the deep free variables of its kind
-closeOverKinds vs = nonDetFoldVarSet do_one vs vs
+closeOverKinds vs = nonDetFoldVarSet do_one vs vs -- TODO?
where
do_one v acc = appEndo (deep_ty (varType v)) acc
=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -658,8 +658,8 @@ niSubstTvSet :: TvSubstEnv -> TyCoVarSet -> TyCoVarSet
-- remembering that the substitution isn't necessarily idempotent
-- This is used in the occurs check, before extending the substitution
niSubstTvSet tsubst tvs
- = nonDetFoldUniqSet (unionVarSet . get) emptyVarSet tvs
- -- It's OK to nonDetFoldUFM here because we immediately forget the
+ = nonDetStrictFoldUniqSet (flip (unionVarSet . get)) emptyVarSet tvs
+ -- It's OK to nonDetStrictFoldUFM here because we immediately forget the
-- ordering by creating a set.
where
get tv
=====================================
compiler/GHC/HsToCore/Usage.hs
=====================================
@@ -260,7 +260,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 = nonDetFoldUniqSet add_mv emptyModuleEnv used_names
+ ent_map = nonDetFoldUniqSet add_mv emptyModuleEnv used_names -- TODO?
-- nonDetFoldUFM is OK here. If you follow the logic, we sort by OccName
-- in ent_hashs
where
=====================================
compiler/GHC/Rename/Source.hs
=====================================
@@ -1422,11 +1422,11 @@ depAnalTyClDecls rdr_env kisig_fv_env ds_w_fvs
toParents :: GlobalRdrEnv -> NameSet -> NameSet
toParents rdr_env ns
- = nonDetFoldUniqSet add emptyNameSet ns
- -- It's OK to use nonDetFoldUFM because we immediately forget the
+ = nonDetStrictFoldUniqSet add emptyNameSet ns
+ -- It's OK to use nonDetStrictFoldUFM because we immediately forget the
-- ordering by creating a set
where
- add n s = extendNameSet s (getParent rdr_env n)
+ add s n = extendNameSet s (getParent rdr_env n)
getParent :: GlobalRdrEnv -> Name -> Name
getParent rdr_env n
=====================================
compiler/GHC/Types/Unique/FM.hs
=====================================
@@ -56,7 +56,7 @@ module GHC.Types.Unique.FM (
intersectUFM_C,
disjointUFM,
equalKeysUFM,
- nonDetFoldUFM, foldUFM, nonDetFoldUFM_Directly,
+ nonDetFoldUFM, nonDetStrictFoldUFM, foldUFM, nonDetFoldUFM_Directly,
anyUFM, allUFM, seqEltsUFM,
mapUFM, mapUFM_Directly,
elemUFM, elemUFM_Directly,
@@ -321,6 +321,9 @@ nonDetKeysUFM (UFM m) = map getUnique $ M.keys m
nonDetFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
nonDetFoldUFM k z (UFM m) = M.foldr k z m
+nonDetStrictFoldUFM :: (a -> elt -> a) -> a -> UniqFM elt -> a
+nonDetStrictFoldUFM k z (UFM m) = M.foldl' k z m
+
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
=====================================
compiler/GHC/Types/Unique/Set.hs
=====================================
@@ -43,6 +43,7 @@ module GHC.Types.Unique.Set (
nonDetEltsUniqSet,
nonDetKeysUniqSet,
nonDetFoldUniqSet,
+ nonDetStrictFoldUniqSet,
nonDetFoldUniqSet_Directly
) where
@@ -166,6 +167,9 @@ nonDetKeysUniqSet = nonDetKeysUFM . getUniqSet'
nonDetFoldUniqSet :: (elt -> a -> a) -> a -> UniqSet elt -> a
nonDetFoldUniqSet c n (UniqSet s) = nonDetFoldUFM c n s
+nonDetStrictFoldUniqSet :: (a -> elt -> a) -> a -> UniqSet elt -> a
+nonDetStrictFoldUniqSet c n (UniqSet s) = nonDetStrictFoldUFM c n s
+
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
=====================================
compiler/typecheck/TcEvidence.hs
=====================================
@@ -862,12 +862,12 @@ findNeededEvVars ev_binds seeds
= transCloVarSet also_needs seeds
where
also_needs :: VarSet -> VarSet
- also_needs needs = nonDetFoldUniqSet add emptyVarSet needs
- -- It's OK to use nonDetFoldUFM here because we immediately
+ also_needs needs = nonDetStrictFoldUniqSet add emptyVarSet needs
+ -- It's OK to use nonDetStrictFoldUFM here because we immediately
-- forget about the ordering by creating a set
- add :: Var -> VarSet -> VarSet
- add v needs
+ add :: VarSet -> Var -> VarSet
+ add needs v
| Just ev_bind <- lookupEvBind ev_binds v
, EvBind { eb_is_given = is_given, eb_rhs = rhs } <- ev_bind
, is_given
=====================================
compiler/utils/GraphOps.hs
=====================================
@@ -63,7 +63,7 @@ addNode k node graph
= let
-- add back conflict edges from other nodes to this one
map_conflict =
- nonDetFoldUniqSet
+ nonDetFoldUniqSet -- TODO?
-- It's OK to use nonDetFoldUFM here because the
-- operation is commutative
(adjustUFM_C (\n -> n { nodeConflicts =
@@ -73,7 +73,7 @@ addNode k node graph
-- add back coalesce edges from other nodes to this one
map_coalesce =
- nonDetFoldUniqSet
+ nonDetFoldUniqSet -- TODO?
-- It's OK to use nonDetFoldUFM here because the
-- operation is commutative
(adjustUFM_C (\n -> n { nodeCoalesce =
@@ -476,7 +476,7 @@ freezeNode k
else node -- panic "GraphOps.freezeNode: edge to freeze wasn't in the coalesce set"
-- If the edge isn't actually in the coelesce set then just ignore it.
- fm2 = nonDetFoldUniqSet (adjustUFM_C (freezeEdge k)) fm1
+ fm2 = nonDetFoldUniqSet (adjustUFM_C (freezeEdge k)) fm1 -- TODO?
-- It's OK to use nonDetFoldUFM here because the operation
-- is commutative
$ nodeCoalesce node
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d058ecc3bb567581d6d2a01d9cd8878b22fd9464
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d058ecc3bb567581d6d2a01d9cd8878b22fd9464
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200331/27ff4a9f/attachment-0001.html>
More information about the ghc-commits
mailing list