diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2014-08-01 21:26:51 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2014-08-01 21:27:18 +0100 |
| commit | 02975c90c0a587122797930e824a4d45ada26b6a (patch) | |
| tree | cc46566d0a6a4d49b8783729079634cb874a613e /compiler/deSugar/DsBinds.lhs | |
| parent | 033658892bb2e7c172ca75b94b54258b93f715e4 (diff) | |
| download | haskell-02975c90c0a587122797930e824a4d45ada26b6a.tar.gz | |
Fix-up to d4d4bef2 'Improve the desugaring of RULES'
I'd forgotten the possiblity that desugaring could generate
dead dictionary bindings; easily fixed by calling occurAnalyseExpr
Diffstat (limited to 'compiler/deSugar/DsBinds.lhs')
| -rw-r--r-- | compiler/deSugar/DsBinds.lhs | 10 |
1 files changed, 8 insertions, 2 deletions
diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs index 92970645d0..172d19b9ac 100644 --- a/compiler/deSugar/DsBinds.lhs +++ b/compiler/deSugar/DsBinds.lhs @@ -35,6 +35,7 @@ import HsSyn -- lots of things import CoreSyn -- lots of things import Literal ( Literal(MachStr) ) import CoreSubst +import OccurAnal ( occurAnalyseExpr ) import MkCore import CoreUtils import CoreArity ( etaExpand ) @@ -627,7 +628,9 @@ decomposeRuleLhs orig_bndrs orig_lhs , text "Orig lhs:" <+> ppr orig_lhs]) dead_msg bndr = hang (sep [ ptext (sLit "Forall'd") <+> pp_bndr bndr , ptext (sLit "is not bound in RULE lhs")]) - 2 (ppr lhs2) + 2 (vcat [ text "Orig bndrs:" <+> ppr orig_bndrs + , text "Orig lhs:" <+> ppr orig_lhs + , text "optimised lhs:" <+> ppr lhs2 ]) pp_bndr bndr | isTyVar bndr = ptext (sLit "type variable") <+> quotes (ppr bndr) | Just pred <- evVarPred_maybe bndr = ptext (sLit "constraint") <+> quotes (ppr pred) @@ -637,8 +640,11 @@ decomposeRuleLhs orig_bndrs orig_lhs drop_dicts e = wrap_lets needed bnds body where - (bnds, body) = split_lets e needed = orig_bndr_set `minusVarSet` exprFreeVars body + (bnds, body) = split_lets (occurAnalyseExpr e) + -- The occurAnalyseExpr drops dead bindings which is + -- crucial to ensure that every binding is used later; + -- which in turn makes wrap_lets work right split_lets :: CoreExpr -> ([(DictId,CoreExpr)], CoreExpr) split_lets e |