diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2014-08-29 10:14:45 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2014-08-29 10:21:37 +0100 |
| commit | dfc9d309a5202d65032c80f5b74df17035a61b8c (patch) | |
| tree | 18fb696fbf94a3c923f4c585ade76f6954b778d7 /compiler/simplCore | |
| parent | 2da63c60d0edfc8b3ae9c31f2179fee0dc026edd (diff) | |
| download | haskell-dfc9d309a5202d65032c80f5b74df17035a61b8c.tar.gz | |
Define mapUnionVarSet, and use it
Call sites are much easier to understand than before
Diffstat (limited to 'compiler/simplCore')
| -rw-r--r-- | compiler/simplCore/CoreMonad.lhs | 2 | ||||
| -rw-r--r-- | compiler/simplCore/FloatIn.lhs | 4 | ||||
| -rw-r--r-- | compiler/simplCore/OccurAnal.lhs | 10 |
3 files changed, 8 insertions, 8 deletions
diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs index faec02e9c6..ad4a0e1a1b 100644 --- a/compiler/simplCore/CoreMonad.lhs +++ b/compiler/simplCore/CoreMonad.lhs @@ -274,7 +274,7 @@ interactiveInScope hsc_env te1 = mkTypeEnvWithImplicits (ic_tythings ictxt) te = extendTypeEnvWithIds te1 (map instanceDFunId cls_insts) ids = typeEnvIds te - tyvars = foldr (unionVarSet . tyVarsOfType . idType) emptyVarSet ids + tyvars = mapUnionVarSet (tyVarsOfType . idType) ids -- Why the type variables? How can the top level envt have free tyvars? -- I think it's because of the GHCi debugger, which can bind variables -- f :: [t] -> [t] diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs index f00768a9f5..a90d59cf77 100644 --- a/compiler/simplCore/FloatIn.lhs +++ b/compiler/simplCore/FloatIn.lhs @@ -344,7 +344,7 @@ fiExpr dflags to_drop (_,AnnLet (AnnRec bindings) body) body_fvs = freeVarsOf body -- See Note [extra_fvs (1,2)] - rule_fvs = foldr (unionVarSet . idRuleAndUnfoldingVars) emptyVarSet ids + rule_fvs = mapUnionVarSet idRuleAndUnfoldingVars ids extra_fvs = rule_fvs `unionVarSet` unionVarSets [ fvs | (fvs, rhs) <- rhss , noFloatIntoExpr rhs ] @@ -552,7 +552,7 @@ sepBindsByDropPoint dflags is_case drop_pts floaters floatedBindsFVs :: FloatInBinds -> FreeVarSet -floatedBindsFVs binds = foldr (unionVarSet . fbFVs) emptyVarSet binds +floatedBindsFVs binds = mapUnionVarSet fbFVs binds fbFVs :: FloatInBind -> VarSet fbFVs (FB _ fvs _) = fvs diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs index 2ce32a1e9a..6456eccd49 100644 --- a/compiler/simplCore/OccurAnal.lhs +++ b/compiler/simplCore/OccurAnal.lhs @@ -684,10 +684,10 @@ makeNode env imp_rules_edges bndr_set (bndr, rhs) , let fvs = exprFreeVars (ru_rhs rule) `delVarSetList` ru_bndrs rule , not (isEmptyVarSet fvs) ] - all_rule_fvs = foldr (unionVarSet . snd) rule_lhs_fvs rules_w_fvs - rule_lhs_fvs = foldr (unionVarSet . (\ru -> exprsFreeVars (ru_args ru) - `delVarSetList` ru_bndrs ru)) - emptyVarSet rules + all_rule_fvs = rule_lhs_fvs `unionVarSet` rule_rhs_fvs + rule_rhs_fvs = mapUnionVarSet snd rules_w_fvs + rule_lhs_fvs = mapUnionVarSet (\ru -> exprsFreeVars (ru_args ru) + `delVarSetList` ru_bndrs ru) rules active_rule_fvs = unionVarSets [fvs | (a,fvs) <- rules_w_fvs, is_active a] -- Finding the free variables of the INLINE pragma (if any) @@ -757,7 +757,7 @@ occAnalRec (CyclicSCC nodes) (body_uds, binds) -- a fresh SCC computation that will yield a single CyclicSCC result. weak_fvs :: VarSet - weak_fvs = foldr (unionVarSet . nd_weak . fstOf3) emptyVarSet nodes + weak_fvs = mapUnionVarSet (nd_weak . fstOf3) nodes -- See Note [Choosing loop breakers] for loop_breaker_edges loop_breaker_edges = map mk_node tagged_nodes |