From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Mon, 13 Jun 2011 14:03:38 +0000 (+0100)
Subject: Don't allow specialisation of class methods (fixes Trac #5001)
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=777b8c4bd6f8a76f2fd365aa43451b7af098e9ef

Don't allow specialisation of class methods (fixes Trac #5001)

It doesn't make sense to specialise class methods -- their
code is simply a record selector.  Moreover, such methods
don't (currently) have an inl_sat field in their InlinePragma
which made DsBinds.makeCoreArity bleat.

This patch just ignores such pragmas, with a warning.
---

diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index 65cb815..39e7e29 100644
--- a/compiler/deSugar/DsBinds.lhs
+++ b/compiler/deSugar/DsBinds.lhs
@@ -493,6 +493,15 @@ dsSpec :: Maybe CoreExpr  	-- Just rhs => RULE is for a local binding
        -> Located TcSpecPrag
        -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule))
 dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
+  | isJust (isClassOpId_maybe poly_id)
+  = putSrcSpanDs loc $ 
+    do { warnDs (ptext (sLit "Ignoring useless SPECIALISE pragma for class method selector") 
+                 <+> quotes (ppr poly_id))
+       ; return Nothing  }  -- There is no point in trying to specialise a class op
+       	 		    -- Moreover, classops don't (currently) have an inl_sat arity set
+			    -- (it would be Just 0) and that in turn makes makeCorePair bleat
+
+  | otherwise
   = putSrcSpanDs loc $ 
     do { let poly_name = idName poly_id
        ; spec_name <- newLocalName poly_name