[Git][ghc/ghc][wip/sjakobi/nondetfolds] 2 commits: Use the argument order of the deterministic folds
Simon Jakobi
gitlab at gitlab.haskell.org
Thu Apr 2 00:59:09 UTC 2020
Simon Jakobi pushed to branch wip/sjakobi/nondetfolds at Glasgow Haskell Compiler / GHC
Commits:
286c1dd9 by Simon Jakobi at 2020-04-02T02:50:13+02:00
Use the argument order of the deterministic folds
- - - - -
960b9951 by Simon Jakobi at 2020-04-02T02:58:53+02:00
Use strict folds in GraphOps
- - - - -
18 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/Unify.hs
- compiler/GHC/Rename/Source.hs
- compiler/GHC/Stg/Lift/Analysis.hs
- compiler/GHC/Types/Unique/DFM.hs
- compiler/GHC/Types/Unique/DSet.hs
- compiler/GHC/Types/Unique/FM.hs
- compiler/GHC/Types/Unique/Set.hs
- compiler/GHC/Types/Var/Env.hs
- compiler/GHC/Types/Var/Set.hs
- compiler/typecheck/TcEvidence.hs
- compiler/typecheck/TcSimplify.hs
- compiler/typecheck/TcType.hs
- compiler/utils/GraphOps.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
=====================================
@@ -554,7 +554,7 @@ delAssoc :: (Uniquable a)
delAssoc a m
| Just aSet <- lookupUFM m a
, m1 <- delFromUFM m a
- = nonDetStrictFoldUniqSet (\m x -> delAssoc1 x a m) m1 aSet
+ = nonDetStrictFoldUniqSet (\x m -> 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,7 +378,7 @@ famInstEnvElts fi = [elt | FamIE elts <- eltsUDFM fi, elt <- elts]
-- See Note [FamInstEnv determinism]
famInstEnvSize :: FamInstEnv -> Int
-famInstEnvSize = nonDetStrictFoldUDFM (\sum (FamIE elt) -> sum + length elt) 0
+famInstEnvSize = nonDetStrictFoldUDFM (\(FamIE elt) sum -> sum + length elt) 0
-- It's OK to use nonDetStrictFoldUDFM here since we're just computing the
-- size.
=====================================
compiler/GHC/Core/Op/OccurAnal.hs
=====================================
@@ -2502,7 +2502,7 @@ addOneOcc ud id info
plus_zapped old new = doZapping ud id old `addOccInfo` new
addManyOccsSet :: UsageDetails -> VarSet -> UsageDetails
-addManyOccsSet usage id_set = nonDetStrictFoldUniqSet (flip addManyOccs) usage id_set
+addManyOccsSet usage id_set = nonDetStrictFoldUniqSet addManyOccs usage id_set
-- It's OK to use nonDetStrictFoldUFM here because addManyOccs commutes
-- Add several occurrences, assumed not to be tail calls
=====================================
compiler/GHC/Core/Op/SetLevels.hs
=====================================
@@ -1472,8 +1472,8 @@ countFreeIds :: DVarSet -> Int
countFreeIds = nonDetStrictFoldUDFM add 0 . getUniqDSet
-- It's OK to use nonDetStrictFoldUDFM here because we're just counting things.
where
- add :: Int -> Var -> Int
- add n v | isId v = n+1
+ add :: Var -> Int -> Int
+ add v n | isId v = n+1
| otherwise = n
{-
@@ -1581,12 +1581,12 @@ placeJoinCeiling le@(LE { le_ctxt_lvl = lvl })
maxFvLevel :: (Var -> Bool) -> LevelEnv -> DVarSet -> Level
maxFvLevel max_me env var_set
- = nonDetStrictFoldDVarSet (flip (maxIn max_me env)) tOP_LEVEL var_set
+ = nonDetStrictFoldDVarSet (maxIn max_me env) tOP_LEVEL var_set
maxFvLevel' :: (Var -> Bool) -> LevelEnv -> TyCoVarSet -> Level
-- Same but for TyCoVarSet
maxFvLevel' max_me env var_set
- = nonDetStrictFoldUniqSet (flip (maxIn max_me env)) tOP_LEVEL var_set
+ = nonDetStrictFoldUniqSet (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,7 +2177,7 @@ unionCallInfoSet (CIS f calls1) (CIS _ calls2) =
callDetailsFVs :: CallDetails -> VarSet
callDetailsFVs calls =
- nonDetStrictFoldUDFM (flip (unionVarSet . callInfoFVs)) emptyVarSet calls
+ nonDetStrictFoldUDFM (unionVarSet . callInfoFVs) emptyVarSet calls
-- It's OK to use nonDetStrictFoldUDFM here because we forget the ordering
-- immediately by converting to a nondeterministic set.
=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -658,7 +658,7 @@ 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
- = nonDetStrictFoldUniqSet (flip (unionVarSet . get)) emptyVarSet tvs
+ = nonDetStrictFoldUniqSet (unionVarSet . get) emptyVarSet tvs
-- It's OK to nonDetStrictFoldUFM here because we immediately forget the
-- ordering by creating a set.
where
=====================================
compiler/GHC/Rename/Source.hs
=====================================
@@ -1426,7 +1426,7 @@ toParents rdr_env ns
-- It's OK to use nonDetStrictFoldUFM because we immediately forget the
-- ordering by creating a set
where
- add s n = extendNameSet s (getParent rdr_env n)
+ add n s = extendNameSet s (getParent rdr_env n)
getParent :: GlobalRdrEnv -> Name -> Name
getParent rdr_env n
=====================================
compiler/GHC/Stg/Lift/Analysis.hs
=====================================
@@ -545,7 +545,7 @@ closureGrowth expander sizer group abs_ids = go
-- we lift @f@
newbies = abs_ids `minusDVarSet` clo_fvs'
-- Lifting @f@ removes @f@ from the closure but adds all @newbies@
- cost = nonDetStrictFoldDVarSet (\size id -> sizer id + size) 0 newbies - n_occs
+ cost = nonDetStrictFoldDVarSet (\id size -> sizer id + size) 0 newbies - n_occs
go (RhsSk body_dmd body)
-- The conservative assumption would be that
-- 1. Every RHS with positive growth would be called multiple times,
=====================================
compiler/GHC/Types/Unique/DFM.hs
=====================================
@@ -280,10 +280,10 @@ foldUDFM k z m = foldr k z (eltsUDFM m)
nonDetFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a
nonDetFoldUDFM k z (UDFM m _i) = foldr k z $ map taggedFst $ M.elems m
-nonDetStrictFoldUDFM :: (a -> elt -> a) -> a -> UniqDFM elt -> a
+nonDetStrictFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a
nonDetStrictFoldUDFM k z (UDFM m _i) = foldl' k' z m
where
- k' acc (TaggedVal v _) = k acc v
+ k' acc (TaggedVal v _) = k v acc
eltsUDFM :: UniqDFM elt -> [elt]
eltsUDFM (UDFM m _i) =
=====================================
compiler/GHC/Types/Unique/DSet.hs
=====================================
@@ -101,7 +101,7 @@ uniqDSetIntersectUniqSet xs ys
foldUniqDSet :: (a -> b -> b) -> b -> UniqDSet a -> b
foldUniqDSet c n (UniqDSet s) = foldUDFM c n s
-nonDetStrictFoldUniqDSet :: (b -> a -> b) -> b -> UniqDSet a -> b
+nonDetStrictFoldUniqDSet :: (a -> b -> b) -> b -> UniqDSet a -> b
nonDetStrictFoldUniqDSet f acc (UniqDSet s) = nonDetStrictFoldUDFM f acc s
elementOfUniqDSet :: Uniquable a => a -> UniqDSet a -> Bool
=====================================
compiler/GHC/Types/Unique/FM.hs
=====================================
@@ -321,8 +321,8 @@ 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
+nonDetStrictFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
+nonDetStrictFoldUFM k z (UFM m) = M.foldl' (flip k) z m
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
=====================================
compiler/GHC/Types/Unique/Set.hs
=====================================
@@ -167,7 +167,7 @@ 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 :: (elt -> a -> a) -> a -> UniqSet elt -> a
nonDetStrictFoldUniqSet c n (UniqSet s) = nonDetStrictFoldUFM c n s
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
=====================================
compiler/GHC/Types/Var/Env.hs
=====================================
@@ -583,7 +583,7 @@ lookupDVarEnv = lookupUDFM
foldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b
foldDVarEnv = foldUDFM
-nonDetStrictFoldDVarEnv :: (b -> a -> b) -> b -> DVarEnv a -> b
+nonDetStrictFoldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b
nonDetStrictFoldDVarEnv = nonDetStrictFoldUDFM
mapDVarEnv :: (a -> b) -> DVarEnv a -> DVarEnv b
=====================================
compiler/GHC/Types/Var/Set.hs
=====================================
@@ -295,7 +295,7 @@ dVarSetMinusVarSet = uniqDSetMinusUniqSet
foldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a
foldDVarSet = foldUniqDSet
-nonDetStrictFoldDVarSet :: (a -> Var -> a) -> a -> DVarSet -> a
+nonDetStrictFoldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a
nonDetStrictFoldDVarSet = nonDetStrictFoldUniqDSet
anyDVarSet :: (Var -> Bool) -> DVarSet -> Bool
=====================================
compiler/typecheck/TcEvidence.hs
=====================================
@@ -501,7 +501,7 @@ evBindMapBinds = foldEvBindMap consBag emptyBag
foldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a
foldEvBindMap k z bs = foldDVarEnv k z (ev_bind_varenv bs)
-nonDetStrictFoldEvBindMap :: (a -> EvBind -> a) -> a -> EvBindMap -> a
+nonDetStrictFoldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a
nonDetStrictFoldEvBindMap k z bs = nonDetStrictFoldDVarEnv k z (ev_bind_varenv bs)
filterEvBindMap :: (EvBind -> Bool) -> EvBindMap -> EvBindMap
@@ -866,8 +866,8 @@ findNeededEvVars ev_binds seeds
-- It's OK to use nonDetStrictFoldUFM here because we immediately
-- forget about the ordering by creating a set
- add :: VarSet -> Var -> VarSet
- add needs v
+ add :: Var -> VarSet -> VarSet
+ add v needs
| Just ev_bind <- lookupEvBind ev_binds v
, EvBind { eb_is_given = is_given, eb_rhs = rhs } <- ev_bind
, is_given
=====================================
compiler/typecheck/TcSimplify.hs
=====================================
@@ -1862,7 +1862,7 @@ neededEvVars implic@(Implic { ic_given = givens
; tcvs <- TcS.getTcEvTyCoVars ev_binds_var
; let seeds1 = foldr add_implic_seeds old_needs implics
- seeds2 = nonDetStrictFoldEvBindMap (flip add_wanted) seeds1 ev_binds
+ seeds2 = nonDetStrictFoldEvBindMap add_wanted seeds1 ev_binds
seeds3 = seeds2 `unionVarSet` tcvs
need_inner = findNeededEvVars ev_binds seeds3
live_ev_binds = filterEvBindMap (needed_ev_bind need_inner) ev_binds
=====================================
compiler/typecheck/TcType.hs
=====================================
@@ -707,7 +707,7 @@ tcTypeLevel ty
-- It's safe to use a non-deterministic fold because `maxTcLevel` is
-- commutative.
where
- add lvl v
+ add v lvl
| isTcTyVar v = lvl `maxTcLevel` tcTyVarLevel v
| otherwise = lvl
=====================================
compiler/utils/GraphOps.hs
=====================================
@@ -63,8 +63,8 @@ addNode k node graph
= let
-- add back conflict edges from other nodes to this one
map_conflict =
- nonDetFoldUniqSet -- TODO?
- -- It's OK to use nonDetFoldUFM here because the
+ nonDetStrictFoldUniqSet
+ -- It's OK to use nonDetStrictFoldUFM here because the
-- operation is commutative
(adjustUFM_C (\n -> n { nodeConflicts =
addOneToUniqSet (nodeConflicts n) k}))
@@ -73,8 +73,8 @@ addNode k node graph
-- add back coalesce edges from other nodes to this one
map_coalesce =
- nonDetFoldUniqSet -- TODO?
- -- It's OK to use nonDetFoldUFM here because the
+ nonDetStrictFoldUniqSet
+ -- It's OK to use nonDetStrictFoldUFM here because the
-- operation is commutative
(adjustUFM_C (\n -> n { nodeCoalesce =
addOneToUniqSet (nodeCoalesce n) k}))
@@ -476,8 +476,8 @@ 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 -- TODO?
- -- It's OK to use nonDetFoldUFM here because the operation
+ fm2 = nonDetStrictFoldUniqSet (adjustUFM_C (freezeEdge k)) fm1
+ -- It's OK to use nonDetStrictFoldUFM here because the operation
-- is commutative
$ nodeCoalesce node
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d058ecc3bb567581d6d2a01d9cd8878b22fd9464...960b9951fc20ceafe61798c2a2f5b1f2caa809fe
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d058ecc3bb567581d6d2a01d9cd8878b22fd9464...960b9951fc20ceafe61798c2a2f5b1f2caa809fe
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/20200401/9be2ac12/attachment-0001.html>
More information about the ghc-commits
mailing list