Make 'SPECIALISE instance' work again

This is a long-standing regression (Trac #7797), which meant that in
particular the Eq [Char] instance does not get specialised.
(The *methods* do, but the dictionary itself doesn't.)  So when you
call a function
     f :: Eq a => blah
on a string type (ie a=[Char]), 7.6 passes a dictionary of un-specialised
methods.

This only matters when calling an overloaded function from a
specialised context, but that does matter in some programs.  I
remember (though I cannot find the details) that Nick Frisby discovered
this to be the source of some pretty solid performanc regresisons.

Anyway it works now. The key change is that a DFunUnfolding now takes
a form that is both simpler than before (the DFunArg type is eliminated)
and more general:

data Unfolding
  = ...
  | DFunUnfolding {     -- The Unfolding of a DFunId
    			-- See Note [DFun unfoldings]
      		  	--     df = /\a1..am. \d1..dn. MkD t1 .. tk
                        --                                 (op1 a1..am d1..dn)
     		      	--     	    	      	       	   (op2 a1..am d1..dn)
        df_bndrs :: [Var],      -- The bound variables [a1..m],[d1..dn]
        df_con   :: DataCon,    -- The dictionary data constructor (never a newtype datacon)
        df_args  :: [CoreExpr]  -- Args of the data con: types, superclasses and methods,
    }                           -- in positional order

That in turn allowed me to re-enable the DFunUnfolding specialisation in
DsBinds.  Lots of details here in TcInstDcls:
	  Note [SPECIALISE instance pragmas]

I also did some refactoring, in particular to pass the InScopeSet to
exprIsConApp_maybe (which in turn means it has to go to a RuleFun).

NB: Interface file format has changed!

4 files changed, 15 insertions, 23 deletions

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 5a751f7243..9390ee4377 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -24,7 +24,6 @@ import TyCon
 import DataCon    (dataConName, dataConWorkId, dataConTyCon)
 import PrelInfo   (wiredInThings, basicKnownKeyNames)
 import Id         (idName, isDataConWorkId_maybe)
-import CoreSyn    (DFunArg(..))
 import Coercion   (LeftOrRight(..))
 import TysWiredIn
 import IfaceEnv
@@ -1110,14 +1109,6 @@ instance Binary IfaceIdDetails where
             1 -> do { a <- get bh; b <- get bh; return (IfRecSelId a b) }
             _ -> do { n <- get bh; return (IfDFunId n) }
 
-instance Binary (DFunArg IfaceExpr) where
-    put_ bh (DFunPolyArg  e) = putByte bh 0 >> put_ bh e
-    put_ bh (DFunLamArg i)   = putByte bh 1 >> put_ bh i
-    get bh = do { h <- getByte bh
-                ; case h of
-                    0 -> do { a <- get bh; return (DFunPolyArg a) }
-                    _ -> do { a <- get bh; return (DFunLamArg a) } }
-
 instance Binary IfaceIdInfo where
     put_ bh NoInfo      = putByte bh 0
     put_ bh (HasInfo i) = putByte bh 1 >> lazyPut bh i -- NB lazyPut
@@ -1164,9 +1155,10 @@ instance Binary IfaceUnfolding where
         putByte bh 3
         put_ bh a
         put_ bh n
-    put_ bh (IfDFunUnfold as) = do
+    put_ bh (IfDFunUnfold as bs) = do
         putByte bh 4
         put_ bh as
+        put_ bh bs
     put_ bh (IfCompulsory e) = do
         putByte bh 5
         put_ bh e
@@ -1188,7 +1180,8 @@ instance Binary IfaceUnfolding where
                     n <- get bh
                     return (IfExtWrapper a n)
             4 -> do as <- get bh
-                    return (IfDFunUnfold as)
+                    bs <- get bh
+                    return (IfDFunUnfold as bs)
             _ -> do e <- get bh
                     return (IfCompulsory e)
 
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index e20269b35a..7632b38d81 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -38,7 +38,6 @@ module IfaceSyn (
 
 import TyCon( SynTyConRhs(..) )
 import IfaceType
-import CoreSyn( DFunArg, dfunArgExprs )
 import PprCore()            -- Printing DFunArgs
 import Demand
 import Annotations
@@ -255,7 +254,7 @@ data IfaceUnfolding
   | IfLclWrapper Arity IfLclName  --     because the worker can simplify to a function in
                                   --     another module.
 
-  | IfDFunUnfold [DFunArg IfaceExpr]
+  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
 
 --------------------------------
 data IfaceExpr
@@ -769,8 +768,8 @@ instance Outputable IfaceUnfolding where
                              <+> parens (ptext (sLit "arity") <+> int a)
   ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext):") <+> ppr wkr
                              <+> parens (ptext (sLit "arity") <+> int a)
-  ppr (IfDFunUnfold ns)    = ptext (sLit "DFun:")
-                             <+> brackets (pprWithCommas ppr ns)
+  ppr (IfDFunUnfold bs es) = hang (ptext (sLit "DFun:") <+> sep (map ppr bs) <> dot)
+                                2 (sep (map pprParendIfaceExpr es))
 
 -- -----------------------------------------------------------------------------
 -- | Finding the Names in IfaceSyn
@@ -899,7 +898,7 @@ freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
 freeNamesIfUnfold (IfExtWrapper _ v)     = unitNameSet v
 freeNamesIfUnfold (IfLclWrapper {})      = emptyNameSet
-freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr (dfunArgExprs vs)
+freeNamesIfUnfold (IfDFunUnfold bs es)   = fnList freeNamesIfBndr bs &&& fnList freeNamesIfExpr es
 
 freeNamesIfExpr :: IfaceExpr -> NameSet
 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index e9676aca7f..13b64cdb25 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1746,8 +1746,8 @@ toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
   where
     if_rhs = toIfaceExpr rhs
 
-toIfUnfolding lb (DFunUnfolding _ar _con ops)
-  = Just (HsUnfold lb (IfDFunUnfold (map (fmap toIfaceExpr) ops)))
+toIfUnfolding lb (DFunUnfolding { df_bndrs = bndrs, df_args = args })
+  = Just (HsUnfold lb (IfDFunUnfold (map toIfaceBndr bndrs) (map toIfaceExpr args)))
       -- No need to serialise the data constructor; 
       -- we can recover it from the type of the dfun
 
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 7f0ad075a3..89d9807a37 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -1244,15 +1244,15 @@ tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
                                                  (UnfWhen unsat_ok boring_ok))
     }
 
-tcUnfolding name dfun_ty _ (IfDFunUnfold ops)
-  = do { mb_ops1 <- forkM_maybe doc $ mapM tc_arg ops
+tcUnfolding name dfun_ty _ (IfDFunUnfold bs ops)
+  = bindIfaceBndrs bs $ \ bs' ->
+    do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops
        ; return (case mb_ops1 of
                     Nothing   -> noUnfolding
-                    Just ops1 -> mkDFunUnfolding dfun_ty ops1) }
+                    Just ops1 -> mkDFunUnfolding bs' (classDataCon cls) ops1) }
   where
     doc = text "Class ops for dfun" <+> ppr name
-    tc_arg (DFunPolyArg  e) = do { e' <- tcIfaceExpr e; return (DFunPolyArg e') }
-    tc_arg (DFunLamArg i)   = return (DFunLamArg i)
+    (_, _, cls, _) = tcSplitDFunTy dfun_ty
 
 tcUnfolding name ty info (IfExtWrapper arity wkr)
   = tcIfaceWrapper name ty info arity (tcIfaceExtId wkr)