From 99f41975ae61fc919638aa389199b32742332eff Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Wed, 6 Jan 2010 16:52:51 +0000
Subject: [PATCH] SpecConstr: Remove -fspec-inline-join-points, and add
 let-binding specialisation

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]
---
 compiler/main/StaticFlags.hs       |    4 ---
 compiler/specialise/SpecConstr.lhs |   62 +++++++++++++++++++-----------------
 2 files changed, 32 insertions(+), 34 deletions(-)

diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 56242b7..8de8611 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -41,7 +41,6 @@ module StaticFlags (
 	opt_DsMultiTyVar,
 	opt_NoStateHack,
         opt_SimpleListLiterals,
-	opt_SpecInlineJoinPoints,
 	opt_CprOff,
 	opt_SimplNoPreInlining,
 	opt_SimplExcessPrecision,
@@ -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")
 
diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index ade88d9..b811f40 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -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 )
@@ -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)
@@ -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
-- 
1.7.10.4