X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsBinds.lhs;fp=ghc%2Fcompiler%2FdeSugar%2FDsBinds.lhs;h=87fda8eb18e298330e41acffcf226b7e8163f070;hb=2b71126c521a8420c023a171fe8dfcd08bb0be85;hp=fe3276fd23a8d5e22a5cd731358424b87dedb9d6;hpb=a7ecdf96844404b7bc8273d4ff6d85759278427c;p=ghc-hetmet.git

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))