X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fspecialise%2FSpecialise.lhs;h=bdef3523f6cddc9b93fcbd06edaf9964d5d46b73;hb=12e6a9a58473f8b24e831c2171bf62d256da8a85;hp=6fbc5b9a5669c4d8d7ac1757a305d525f566b28c;hpb=f53c4074ff7554ceedaa6b7a5edb2bca7a2d3886;p=ghc-hetmet.git

diff --git a/ghc/compiler/specialise/Specialise.lhs b/ghc/compiler/specialise/Specialise.lhs
index 6fbc5b9..bdef352 100644
--- a/ghc/compiler/specialise/Specialise.lhs
+++ b/ghc/compiler/specialise/Specialise.lhs
@@ -34,7 +34,7 @@ import PprCore		( pprCoreRules )
 import Rules		( addIdSpecialisations, lookupRule )
 
 import UniqSupply	( UniqSupply,
-			  UniqSM, initUs_, thenUs, thenUs_, returnUs, getUniqueUs, 
+			  UniqSM, initUs_, thenUs, thenUs, returnUs, getUniqueUs, 
 			  withUs, mapUs
 			)
 import Name		( nameOccName, mkSpecOcc, getSrcLoc )
@@ -800,9 +800,9 @@ specDefn subst calls (fn, rhs)
       -- Make a specialised version for each call in calls_for_me
     mapSM spec_call calls_for_me		`thenSM` \ stuff ->
     let
-	(spec_defns, spec_uds, spec_env_stuff) = unzip3 stuff
+	(spec_defns, spec_uds, spec_rules) = unzip3 stuff
 
-	fn' = addIdSpecialisations zapped_fn spec_env_stuff
+	fn' = addIdSpecialisations zapped_fn spec_rules
     in
     returnSM ((fn',rhs'), 
 	      spec_defns, 
@@ -835,10 +835,10 @@ specDefn subst calls (fn, rhs)
 
     ----------------------------------------------------------
 	-- Specialise to one particular call pattern
-    spec_call :: ([Maybe Type], ([DictExpr], VarSet))		-- Call instance
-              -> SpecM ((Id,CoreExpr),				-- Specialised definition
-	                UsageDetails, 				-- Usage details from specialised body
-                	([CoreBndr], [CoreExpr], CoreExpr))	-- Info for the Id's SpecEnv
+    spec_call :: ([Maybe Type], ([DictExpr], VarSet))	-- Call instance
+              -> SpecM ((Id,CoreExpr),			-- Specialised definition
+	                UsageDetails, 			-- Usage details from specialised body
+                	CoreRule)			-- Info for the Id's SpecEnv
     spec_call (call_ts, (call_ds, call_fvs))
       = ASSERT( length call_ts == n_tyvars && length call_ds == n_dicts )
 		-- Calls are only recorded for properly-saturated applications
@@ -880,9 +880,10 @@ specDefn subst calls (fn, rhs)
 	let
 		-- The rule to put in the function's specialisation is:
 		--	forall b,d, d1',d2'.  f t1 b t3 d d1' d2' = f1 b d  
-           spec_env_rule = (poly_tyvars ++ rhs_dicts',
-			    inst_args, 
-			    mkTyApps (Var spec_f) (map mkTyVarTy poly_tyvars))
+           spec_env_rule = Rule (_PK_ ("SPEC " ++ showSDoc (ppr fn)))
+			        (poly_tyvars ++ rhs_dicts')
+				inst_args 
+				(mkTyApps (Var spec_f) (map mkTyVarTy poly_tyvars))
 
 		-- Add the { d1' = dx1; d2' = dx2 } usage stuff
 	   final_uds = foldr addDictBind rhs_uds (my_zipEqual "spec_call" rhs_dicts' call_ds)