Skip to content

Commit

Permalink
SpecConstr: Remove -fspec-inline-join-points, and add let-binding spe…
Browse files Browse the repository at this point in the history
…cialisation

The -fspec-inline-join-point thing was a gross hack intended to help
Roman play around, but he's not using it and it was a terribly blunt
instrument so I've nuked it.  

Instead I've re-instated the let-binding specialiser. 
See Note [Local let bindings]
  • Loading branch information
simonpj@microsoft.com committed Jan 6, 2010
1 parent f766da1 commit 99f4197
Show file tree
Hide file tree
Showing 2 changed files with 32 additions and 34 deletions.
4 changes: 0 additions & 4 deletions compiler/main/StaticFlags.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,6 @@ module StaticFlags (
opt_DsMultiTyVar,
opt_NoStateHack,
opt_SimpleListLiterals,
opt_SpecInlineJoinPoints,
opt_CprOff,
opt_SimplNoPreInlining,
opt_SimplExcessPrecision,
Expand Down Expand Up @@ -218,9 +217,6 @@ opt_DsMultiTyVar :: Bool
opt_DsMultiTyVar = not (lookUp (fsLit "-fno-ds-multi-tyvar"))
-- On by default

opt_SpecInlineJoinPoints :: Bool
opt_SpecInlineJoinPoints = lookUp (fsLit "-fspec-inline-join-points")

opt_SimpleListLiterals :: Bool
opt_SimpleListLiterals = lookUp (fsLit "-fsimple-list-literals")

Expand Down
62 changes: 32 additions & 30 deletions compiler/specialise/SpecConstr.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,6 @@ import VarSet
import Name
import DynFlags ( DynFlags(..) )
import StaticFlags ( opt_PprStyle_Debug )
import StaticFlags ( opt_SpecInlineJoinPoints )
import Maybes ( orElse, catMaybes, isJust, isNothing )
import Demand
import DmdAnal ( both )
Expand Down Expand Up @@ -878,38 +877,23 @@ scExpr' env (Case scrut b ty alts)
scExpr' env (Let (NonRec bndr rhs) body)
| isTyVar bndr -- Type-lets may be created by doBeta
= scExpr' (extendScSubst env bndr rhs) body
| otherwise
= do { let (body_env, bndr') = extendBndr env bndr
; (rhs_usg, (_, args', rhs_body', _)) <- scRecRhs env (bndr',rhs)
; let rhs' = mkLams args' rhs_body'
; if not opt_SpecInlineJoinPoints || null args' || isEmptyVarEnv (scu_calls rhs_usg) then do
do { -- Vanilla case
let body_env2 = extendValEnv body_env bndr' (isValue (sc_vals env) rhs')
-- Record if the RHS is a value
; (body_usg, body') <- scExpr body_env2 body
; return (body_usg `combineUsage` rhs_usg, Let (NonRec bndr' rhs') body') }
else -- For now, just brutally inline the join point
do { let body_env2 = extendScSubst env bndr rhs'
; scExpr body_env2 body } }
{- Old code
do { -- Join-point case
let body_env2 = extendHowBound body_env [bndr'] RecFun
-- If the RHS of this 'let' contains calls
-- to recursive functions that we're trying
-- to specialise, then treat this let too
-- as one to specialise
; (body_usg, body') <- scExpr body_env2 body
; (spec_usg, _, specs) <- specialise env (scu_calls body_usg) ([], rhs_info)
; return (body_usg { scu_calls = scu_calls body_usg `delVarEnv` bndr' }
| otherwise -- Note [Local let bindings]
= do { let (body_env, bndr') = extendBndr env bndr
; (rhs_usg, rhs_info) <- scRecRhs env (bndr',rhs)
; let force_spec = False
; let body_env2 = extendHowBound body_env [bndr'] RecFun
; (body_usg, body') <- scExpr body_env2 body
; (spec_usg, specs) <- specialise env force_spec
(scu_calls body_usg)
rhs_info
(SI [] 0 Nothing)
; return (body_usg { scu_calls = scu_calls body_usg `delVarEnv` bndr' }
`combineUsage` rhs_usg `combineUsage` spec_usg,
mkLets [NonRec b r | (b,r) <- specInfoBinds rhs_info specs] body')
}
-}
-- A *local* recursive group: see Note [Local recursive groups]
scExpr' env (Let (Rec prs) body)
Expand All @@ -931,8 +915,26 @@ scExpr' env (Let (Rec prs) body)
; return (all_usg { scu_calls = scu_calls all_usg `delVarEnvList` bndrs' },
Let bind' body') }
\end{code}
Note [Local let bindings]
~~~~~~~~~~~~~~~~~~~~~~~~~
It is not uncommon to find this
let $j = \x. <blah> in ...$j True...$j True...
Here $j is an arbitrary let-bound function, but it often comes up for
join points. We might like to specialise $j for its call patterns.
Notice the difference from a letrec, where we look for call patterns
in the *RHS* of the function. Here we look for call patterns in the
*body* of the let.
-----------------------------------
At one point I predicated this on the RHS mentioning the outer
recursive function, but that's not essential and might even be
harmful. I'm not sure.
\begin{code}
scApp :: ScEnv -> (InExpr, [InExpr]) -> UniqSM (ScUsage, CoreExpr)
scApp env (Var fn, args) -- Function is a variable
Expand Down

0 comments on commit 99f4197

Please sign in to comment.