From 2b71126c521a8420c023a171fe8dfcd08bb0be85 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Tue, 19 Jul 2005 22:53:37 +0000
Subject: [PATCH 1/1] [project @ 2005-07-19 22:53:37 by simonpj] Wibble

---
 ghc/compiler/deSugar/DsBinds.lhs |    9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/ghc/compiler/deSugar/DsBinds.lhs b/ghc/compiler/deSugar/DsBinds.lhs
index fe3276f..87fda8e 100644
--- a/ghc/compiler/deSugar/DsBinds.lhs
+++ b/ghc/compiler/deSugar/DsBinds.lhs
@@ -30,7 +30,7 @@ import OccurAnal	( occurAnalyseExpr )
 import CostCentre	( mkAutoCC, IsCafCC(..) )
 import Id		( Id, idType, idName, isExportedId, mkLocalId, setInlinePragma )
 import Rules		( addIdSpecialisations, mkLocalRule )
-import Var		( Var, isGlobalId )
+import Var		( Var, isGlobalId, setIdNotExported )
 import VarEnv
 import Type		( mkTyVarTy, substTyWith )
 import TysWiredIn	( voidTy )
@@ -183,6 +183,8 @@ dsHsBind auto_scc rest (AbsBinds all_tyvars dicts exports binds)
 --
 -- Spec bind:	f_spec = Let f = /\ab \(d1:Eq a)(d2:Ix b). let binds in f_mono 
 --			 /\b.\(d:Ix b). in f Int b dInt d
+--		The idea is that f occurs just once, so it'll be 
+--		inlined and specialised
 
 dsSpec all_tvs dicts tvs poly_id mono_id mono_bind (InlinePrag {})
   = return Nothing
@@ -200,8 +202,11 @@ dsSpec all_tvs dicts tvs poly_id mono_id mono_bind
 
 	    Just (bndrs', var, args) -> return (Just ((spec_id, spec_rhs), rule))
 		where
+		  local_poly  = setIdNotExported poly_id
+			-- Very important to make the 'f' non-exported,
+			-- else it won't be inlined!
 		  spec_id     = mkLocalId spec_name spec_ty
-		  spec_rhs    = Let (NonRec poly_id poly_f_body) ds_spec_expr
+		  spec_rhs    = Let (NonRec local_poly poly_f_body) ds_spec_expr
 		  poly_f_body = mkLams (tvs ++ dicts) $
 			   	fix_up (Let mono_bind (Var mono_id))
 
-- 
1.7.10.4