From 8d5cf8bf584fd4849917c29d82dcf46ee75dd035 Mon Sep 17 00:00:00 2001 From: Luke Maurer Date: Wed, 1 Feb 2017 11:56:01 -0500 Subject: Join points This major patch implements Join Points, as described in https://ghc.haskell.org/trac/ghc/wiki/SequentCore. You have to read that page, and especially the paper it links to, to understand what's going on; but it is very cool. It's Luke Maurer's work, but done in close collaboration with Simon PJ. This Phab is a squash-merge of wip/join-points branch of http://github.com/lukemaurer/ghc. There are many, many interdependent changes. Reviewers: goldfire, mpickering, bgamari, simonmar, dfeuer, austin Subscribers: simonpj, dfeuer, mpickering, Mikolaj, thomie Differential Revision: https://phabricator.haskell.org/D2853 --- compiler/specialise/Rules.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'compiler/specialise/Rules.hs') diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs index 42cb13e8df..ba44794db4 100644 --- a/compiler/specialise/Rules.hs +++ b/compiler/specialise/Rules.hs @@ -35,7 +35,8 @@ import OccurAnal ( occurAnalyseExpr ) import CoreFVs ( exprFreeVars, exprsFreeVars, bindFreeVars , rulesFreeVarsDSet, exprsOrphNames, exprFreeVarsList ) import CoreUtils ( exprType, eqExpr, mkTick, mkTicks, - stripTicksTopT, stripTicksTopE ) + stripTicksTopT, stripTicksTopE, + isJoinBind ) import PprCore ( pprRules ) import Type ( Type, substTy, mkTCvSubst ) import TcType ( tcSplitTyConApp_maybe ) @@ -728,7 +729,8 @@ match renv subst e1 (Var v2) -- Note [Expanding variables] match renv subst e1 (Let bind e2) | -- pprTrace "match:Let" (vcat [ppr bind, ppr $ okToFloat (rv_lcl renv) (bindFreeVars bind)]) $ - okToFloat (rv_lcl renv) (bindFreeVars bind) -- See Note [Matching lets] + not (isJoinBind bind) -- can't float join point out of argument position + , okToFloat (rv_lcl renv) (bindFreeVars bind) -- See Note [Matching lets] = match (renv { rv_fltR = flt_subst' }) (subst { rs_binds = rs_binds subst . Let bind' , rs_bndrs = extendVarSetList (rs_bndrs subst) new_bndrs }) -- cgit v1.2.1