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!

3 files changed, 14 insertions, 12 deletions

diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs
index 2c27070166..42dd672844 100644
--- a/compiler/simplCore/OccurAnal.lhs
+++ b/compiler/simplCore/OccurAnal.lhs
@@ -692,7 +692,7 @@ makeNode env imp_rules_edges bndr_set (bndr, rhs)
 
     -- Finding the free variables of the INLINE pragma (if any)
     unf        = realIdUnfolding bndr     -- Ignore any current loop-breaker flag
-    mb_unf_fvs = stableUnfoldingVars isLocalId unf
+    mb_unf_fvs = stableUnfoldingVars unf
 
     -- Find the "nd_inl" free vars; for the loop-breaker phase
     inl_fvs = case mb_unf_fvs of
diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 7bc10de43f..17da9be32e 100644
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -641,19 +641,21 @@ activeUnfolding env
   where
     mode = getMode env
 
-getUnfoldingInRuleMatch :: SimplEnv -> IdUnfoldingFun
+getUnfoldingInRuleMatch :: SimplEnv -> InScopeEnv
 -- When matching in RULE, we want to "look through" an unfolding
 -- (to see a constructor) if *rules* are on, even if *inlinings*
 -- are not.  A notable example is DFuns, which really we want to
 -- match in rules like (op dfun) in gentle mode. Another example
 -- is 'otherwise' which we want exprIsConApp_maybe to be able to
 -- see very early on
-getUnfoldingInRuleMatch env id
-  | unf_is_active = idUnfolding id
-  | otherwise     = NoUnfolding
+getUnfoldingInRuleMatch env
+  = (in_scope, id_unf)
   where
+    in_scope = seInScope env
     mode = getMode env
-    unf_is_active
+    id_unf id | unf_is_active id = idUnfolding id
+              | otherwise        = NoUnfolding
+    unf_is_active id
      | not (sm_rules mode) = active_unfolding_minimal id
      | otherwise           = isActive (sm_phase mode) (idInlineActivation id)
 
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index d30e826f93..0bc05f3985 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -723,10 +723,10 @@ simplUnfolding :: SimplEnv-> TopLevelFlag
                -> OutExpr
                -> Unfolding -> SimplM Unfolding
 -- Note [Setting the new unfolding]
-simplUnfolding env _ _ _ (DFunUnfolding ar con ops)
-  = return (DFunUnfolding ar con ops')
-  where
-    ops' = map (fmap (substExpr (text "simplUnfolding") env)) ops
+simplUnfolding env _ _ _ df@(DFunUnfolding { df_bndrs = bndrs, df_args = args })
+  = do { (env', bndrs') <- simplBinders env bndrs
+       ; args' <- mapM (simplExpr env') args
+       ; return (df { df_bndrs = bndrs', df_args  = args' }) }
 
 simplUnfolding env top_lvl id _
     (CoreUnfolding { uf_tmpl = expr, uf_arity = arity
@@ -1559,8 +1559,8 @@ tryRules env rules fn args call_cont
   = return Nothing
   | otherwise
   = do { dflags <- getDynFlags
-       ; case lookupRule dflags (activeRule env) (getUnfoldingInRuleMatch env)
-                         (getInScope env) fn args rules of {
+       ; case lookupRule dflags (getUnfoldingInRuleMatch env) (activeRule env) 
+                         fn args rules of {
            Nothing               -> return Nothing ;   -- No rule matches
            Just (rule, rule_rhs) ->