diff options
| author | Bartosz Nitka <niteria@gmail.com> | 2016-05-11 07:47:15 -0700 |
|---|---|---|
| committer | Bartosz Nitka <niteria@gmail.com> | 2016-05-11 07:47:18 -0700 |
| commit | 0e719885f53e20f2e14a94b32d858b47b516a8fc (patch) | |
| tree | 9c05055463bdd6fdcbfbb9d5b2e75a2f5244d38d /compiler/deSugar/DsArrows.hs | |
| parent | 9363f04d0ff22f3d898af35bb5432c4287e6dc9a (diff) | |
| download | haskell-0e719885f53e20f2e14a94b32d858b47b516a8fc.tar.gz | |
Remove some varSetElems in dsCmdStmt
varSetElems introduces unnecessary determinism and it's easy to
preserve determinism here.
Test Plan: ./validate
Reviewers: goldfire, simonmar, austin, bgamari, simonpj
Reviewed By: simonpj
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2195
GHC Trac Issues: #4012
Diffstat (limited to 'compiler/deSugar/DsArrows.hs')
| -rw-r--r-- | compiler/deSugar/DsArrows.hs | 8 |
1 files changed, 5 insertions, 3 deletions
diff --git a/compiler/deSugar/DsArrows.hs b/compiler/deSugar/DsArrows.hs index ea10b7424e..cdf839a47d 100644 --- a/compiler/deSugar/DsArrows.hs +++ b/compiler/deSugar/DsArrows.hs @@ -48,6 +48,7 @@ import VarSet import SrcLoc import ListSetOps( assocDefault ) import Data.List +import Util data DsCmdEnv = DsCmdEnv { arr_id, compose_id, first_id, app_id, choice_id, loop_id :: CoreExpr @@ -786,7 +787,7 @@ dsCmdStmt ids local_vars out_ids (BindStmt pat cmd _ _ _) env_ids = do (core_cmd, fv_cmd, env_ids1) <- dsfixCmd ids local_vars unitTy pat_ty cmd let pat_vars = mkVarSet (collectPatBinders pat) let - env_ids2 = varSetElems (mkVarSet out_ids `minusVarSet` pat_vars) + env_ids2 = filterOut (`elemVarSet` pat_vars) out_ids env_ty2 = mkBigCoreVarTupTy env_ids2 -- multiplexing function @@ -863,8 +864,9 @@ dsCmdStmt ids local_vars out_ids , recS_later_rets = later_rets, recS_rec_rets = rec_rets }) env_ids = do let - env2_id_set = mkVarSet out_ids `minusVarSet` mkVarSet later_ids - env2_ids = varSetElems env2_id_set + later_ids_set = mkVarSet later_ids + env2_ids = filterOut (`elemVarSet` later_ids_set) out_ids + env2_id_set = mkVarSet env2_ids env2_ty = mkBigCoreVarTupTy env2_ids -- post_loop_fn = \((later_ids),(env2_ids)) -> (out_ids) |