Overlapable pragmas for individual instances (#9242)

Programmers may provide a pragma immediately after the `instance` keyword
to control the overlap/incoherence behavior for individual instances.
For example:

    instance {-# OVERLAP #-} C a where ...

I chose this notation, rather than the other two outlined in the ticket
for these reasons:

   1. Having the pragma after the type looks odd, I think.
   2. Having the pragma after there `where` does not work for
       stand-alone derived instances

I have implemented 3 pragams:

   1. NO_OVERLAP
   2. OVERLAP
   3. INCOHERENT

These correspond directly to the internal modes currently supported by
GHC.  If a pragma is specified, it will be used no matter what flags are
turned on.   For example, putting `NO_OVERLAP` on an instance will mark
it as non-overlapping, even if `OVERLAPPIN_INSTANCES` is turned on for the
module.

7 files changed, 82 insertions, 29 deletions

diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index 6862901437..122be81972 100644
--- a/compiler/hsSyn/Convert.lhs
+++ b/compiler/hsSyn/Convert.lhs
@@ -216,7 +216,7 @@ cvtDec (InstanceD ctxt ty decs)
         ; ctxt' <- cvtContext ctxt
         ; L loc ty' <- cvtType ty
         ; let inst_ty' = L loc $ mkImplicitHsForAllTy ctxt' $ L loc ty'
-        ; returnL $ InstD (ClsInstD (ClsInstDecl inst_ty' binds' sigs' ats' adts')) }
+        ; returnL $ InstD (ClsInstD (ClsInstDecl inst_ty' binds' sigs' ats' adts' Nothing)) }
 
 cvtDec (ForeignD ford)
   = do { ford' <- cvtForD ford
diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index c4174db776..d35a7e5c5e 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -941,6 +941,7 @@ data ClsInstDecl name
       , cid_sigs  :: [LSig name]                -- User-supplied pragmatic info
       , cid_tyfam_insts :: [LTyFamInstDecl name]  -- type family instances
       , cid_datafam_insts :: [LDataFamInstDecl name] -- data family instances
+      , cid_overlap_mode :: Maybe OverlapMode
       }
   deriving (Data, Typeable)
 
@@ -1013,6 +1014,7 @@ pprDataFamInstFlavour (DataFamInstDecl { dfid_defn = (HsDataDefn { dd_ND = nd })
 instance (OutputableBndr name) => Outputable (ClsInstDecl name) where
     ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds
                      , cid_sigs = sigs, cid_tyfam_insts = ats
+                     , cid_overlap_mode = mbOverlap
                      , cid_datafam_insts = adts })
       | null sigs, null ats, null adts, isEmptyBag binds  -- No "where" part
       = top_matter
@@ -1024,7 +1026,19 @@ instance (OutputableBndr name) => Outputable (ClsInstDecl name) where
                map (pprDataFamInstDecl NotTopLevel . unLoc) adts ++
                pprLHsBindsForUser binds sigs ]
       where
-        top_matter = ptext (sLit "instance") <+> ppr inst_ty
+        top_matter = ptext (sLit "instance") <+> ppOveralapPragma mbOverlap
+                                             <+> ppr inst_ty
+
+ppOveralapPragma :: Maybe OverlapMode -> SDoc
+ppOveralapPragma mb =
+  case mb of
+    Nothing          -> empty
+    Just NoOverlap   -> ptext (sLit "{-# NO_OVERLAP #-}")
+    Just OverlapOk   -> ptext (sLit "{-# OVERLAP #-}")
+    Just Incoherent  -> ptext (sLit "{-# INCOHERENT #-}")
+
+
+
 
 instance (OutputableBndr name) => Outputable (InstDecl name) where
     ppr (ClsInstD     { cid_inst  = decl }) = ppr decl
@@ -1052,12 +1066,14 @@ instDeclDataFamInsts inst_decls
 \begin{code}
 type LDerivDecl name = Located (DerivDecl name)
 
-data DerivDecl name = DerivDecl { deriv_type :: LHsType name }
+data DerivDecl name = DerivDecl { deriv_type :: LHsType name
+                                , deriv_overlap_mode :: Maybe OverlapMode
+                                }
   deriving (Data, Typeable)
 
 instance (OutputableBndr name) => Outputable (DerivDecl name) where
-    ppr (DerivDecl ty) 
-        = hsep [ptext (sLit "deriving instance"), ppr ty]
+    ppr (DerivDecl ty o)
+        = hsep [ptext (sLit "deriving instance"), ppOveralapPragma o, ppr ty]
 \end{code}
 
 %************************************************************************
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 78c39c75db..fe3d6a5d2b 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -527,6 +527,9 @@ data Token
   | ITvect_scalar_prag
   | ITnovect_prag
   | ITminimal_prag
+  | ITno_overlap_prag           -- instance overlap mode
+  | IToverlap_prag              -- instance overlap mode
+  | ITincoherent_prag           -- instance overlap mode
   | ITctype
 
   | ITdotdot                    -- reserved symbols
@@ -2428,6 +2431,9 @@ oneWordPrags = Map.fromList([("rules", rulePrag),
                            ("vectorize", token ITvect_prag),
                            ("novectorize", token ITnovect_prag),
                            ("minimal", token ITminimal_prag),
+                           ("no_overlap", token ITno_overlap_prag),
+                           ("overlap", token IToverlap_prag),
+                           ("incoherent", token ITincoherent_prag),
                            ("ctype", token ITctype)])
 
 twoWordPrags = Map.fromList([("inline conlike", token (ITinline_prag Inline ConLike)),
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 4f4ec0b123..a3c68c3e59 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -269,6 +269,9 @@ incorrect.
  '{-# NOVECTORISE'        { L _ ITnovect_prag }
  '{-# MINIMAL'            { L _ ITminimal_prag }
  '{-# CTYPE'              { L _ ITctype }
+ '{-# NO_OVERLAP'         { L _ ITno_overlap_prag }
+ '{-# OVERLAP'            { L _ IToverlap_prag }
+ '{-# INCOHERENT'         { L _ ITincoherent_prag }
  '#-}'                                          { L _ ITclose_prag }
 
  '..'           { L _ ITdotdot }                        -- reserved symbols
@@ -654,12 +657,13 @@ ty_decl :: { LTyClDecl RdrName }
                 {% mkFamDecl (comb3 $1 $2 $4) DataFamily $3 (unLoc $4) }
 
 inst_decl :: { LInstDecl RdrName }
-        : 'instance' inst_type where_inst
-                 { let (binds, sigs, _, ats, adts, _) = cvBindsAndSigs (unLoc $3) in
-                   let cid = ClsInstDecl { cid_poly_ty = $2, cid_binds = binds
+        : 'instance' overlap_pragma inst_type where_inst
+                 { let (binds, sigs, _, ats, adts, _) = cvBindsAndSigs (unLoc $4) in
+                   let cid = ClsInstDecl { cid_poly_ty = $3, cid_binds = binds
                                          , cid_sigs = sigs, cid_tyfam_insts = ats
+                                         , cid_overlap_mode = $2
                                          , cid_datafam_insts = adts }
-                   in L (comb3 $1 $2 $3) (ClsInstD { cid_inst = cid }) }
+                   in L (comb3 $1 $3 $4) (ClsInstD { cid_inst = cid }) }
 
            -- type instance declarations
         | 'type' 'instance' ty_fam_inst_eqn
@@ -677,6 +681,13 @@ inst_decl :: { LInstDecl RdrName }
                 {% mkDataFamInst (comb4 $1 $4 $6 $7) (unLoc $1) $3 $4
                                      (unLoc $5) (unLoc $6) (unLoc $7) }
 
+overlap_pragma :: { Maybe OverlapMode }
+  : '{-# OVERLAP'    '#-}'    { Just OverlapOk  }
+  | '{-# INCOHERENT' '#-}'    { Just Incoherent }
+  | '{-# NO_OVERLAP' '#-}'    { Just NoOverlap  }
+  | {- empty -}               { Nothing }
+
+
 -- Closed type families
 
 where_type_family :: { Located (FamilyInfo RdrName) }
@@ -783,7 +794,7 @@ capi_ctype : '{-# CTYPE' STRING STRING '#-}' { Just (CType (Just (Header (getSTR
 
 -- Glasgow extension: stand-alone deriving declarations
 stand_alone_deriving :: { LDerivDecl RdrName }
-        : 'deriving' 'instance' inst_type { LL (DerivDecl $3) }
+  : 'deriving' 'instance' overlap_pragma inst_type { LL (DerivDecl $4 $3) }
 
 -----------------------------------------------------------------------------
 -- Role annotations
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 2618792e82..c6646ad563 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -445,12 +445,14 @@ rnSrcInstDecl (ClsInstD { cid_inst = cid })
 rnClsInstDecl :: ClsInstDecl RdrName -> RnM (ClsInstDecl Name, FreeVars)
 rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
                            , cid_sigs = uprags, cid_tyfam_insts = ats
+                           , cid_overlap_mode = oflag
                            , cid_datafam_insts = adts })
         -- Used for both source and interface file decls
   = do { (inst_ty', inst_fvs) <- rnLHsInstType (text "In an instance declaration") inst_ty
        ; case splitLHsInstDeclTy_maybe inst_ty' of {
            Nothing -> return (ClsInstDecl { cid_poly_ty = inst_ty', cid_binds = emptyLHsBinds
                                           , cid_sigs = [], cid_tyfam_insts = []
+                                          , cid_overlap_mode = oflag
                                           , cid_datafam_insts = [] }
                              , inst_fvs) ;
            Just (inst_tyvars, _, L _ cls,_) ->
@@ -493,6 +495,7 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
                           `plusFV` inst_fvs
        ; return (ClsInstDecl { cid_poly_ty = inst_ty', cid_binds = mbinds'
                              , cid_sigs = uprags', cid_tyfam_insts = ats'
+                             , cid_overlap_mode = oflag
                              , cid_datafam_insts = adts' },
                  all_fvs) } } }
              -- We return the renamed associated data type declarations so
@@ -637,11 +640,11 @@ extendTyVarEnvForMethodBinds ktv_names thing_inside
 
 \begin{code}
 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
-rnSrcDerivDecl (DerivDecl ty)
+rnSrcDerivDecl (DerivDecl ty overlap)
   = do { standalone_deriv_ok <- xoptM Opt_StandaloneDeriving
        ; unless standalone_deriv_ok (addErr standaloneDerivErr)
        ; (ty', fvs) <- rnLHsInstType (text "In a deriving declaration") ty
-       ; return (DerivDecl ty', fvs) }
+       ; return (DerivDecl ty' overlap, fvs) }
 
 standaloneDerivErr :: SDoc
 standaloneDerivErr
diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 1d7936dcd2..aa15a63a2a 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -93,6 +93,7 @@ data DerivSpec theta = DS { ds_loc     :: SrcSpan
                           , ds_tys     :: [Type]
                           , ds_tc      :: TyCon
                           , ds_tc_args :: [Type]
+                          , ds_overlap :: Maybe OverlapMode
                           , ds_newtype :: Bool }
         -- This spec implies a dfun declaration of the form
         --       df :: forall tvs. theta => C tys
@@ -618,7 +619,7 @@ deriveStandalone :: LDerivDecl Name -> TcM [EarlyDerivSpec]
 -- Standalone deriving declarations
 --  e.g.   deriving instance Show a => Show (T a)
 -- Rather like tcLocalInstDecl
-deriveStandalone (L loc (DerivDecl deriv_ty))
+deriveStandalone (L loc (DerivDecl deriv_ty overlap_mode))
   = setSrcSpan loc                   $
     addErrCtxt (standaloneCtxt deriv_ty)  $
     do { traceTc "Standalone deriving decl for" (ppr deriv_ty)
@@ -647,7 +648,7 @@ deriveStandalone (L loc (DerivDecl deriv_ty))
                     ; mkPolyKindedTypeableEqn cls tc }
 
               | isAlgTyCon tc  -- All other classes
-              -> do { spec <- mkEqnHelp tvs cls cls_tys tc tc_args (Just theta)
+              -> do { spec <- mkEqnHelp overlap_mode tvs cls cls_tys tc tc_args (Just theta)
                     ; return [spec] }
 
            _  -> -- Complain about functions, primitive types, etc,
@@ -769,7 +770,7 @@ deriveTyData is_instance tvs tc tc_args (L loc deriv_pred)
                 --              newtype T a s = ... deriving( ST s )
                 --              newtype K a a = ... deriving( Monad )
 
-        ; spec <- mkEqnHelp (univ_kvs' ++ univ_tvs')
+        ; spec <- mkEqnHelp Nothing (univ_kvs' ++ univ_tvs')
                             cls final_cls_tys tc final_tc_args Nothing 
         ; return [spec] } }
 
@@ -851,7 +852,8 @@ and occurrence sites.
 
 
 \begin{code}
-mkEqnHelp :: [TyVar]
+mkEqnHelp :: Maybe OverlapMode
+          -> [TyVar]
           -> Class -> [Type]
           -> TyCon -> [Type]
           -> DerivContext       -- Just    => context supplied (standalone deriving)
@@ -862,7 +864,7 @@ mkEqnHelp :: [TyVar]
 -- where the 'theta' is optional (that's the Maybe part)
 -- Assumes that this declaration is well-kinded
 
-mkEqnHelp tvs cls cls_tys tycon tc_args mtheta
+mkEqnHelp overlap_mode tvs cls cls_tys tycon tc_args mtheta
   | className cls `elem` oldTypeableClassNames
   = do { dflags <- getDynFlags
        ; case checkOldTypeableConditions (dflags, tycon, tc_args) of
@@ -898,10 +900,10 @@ mkEqnHelp tvs cls cls_tys tycon tc_args mtheta
 
        ; dflags <- getDynFlags
        ; if isDataTyCon rep_tc then
-            mkDataTypeEqn dflags tvs cls cls_tys
+            mkDataTypeEqn dflags overlap_mode tvs cls cls_tys
                           tycon tc_args rep_tc rep_tc_args mtheta
          else
-            mkNewTypeEqn dflags tvs cls cls_tys
+            mkNewTypeEqn dflags overlap_mode tvs cls cls_tys
                          tycon tc_args rep_tc rep_tc_args mtheta }
   where
      bale_out msg = failWithTc (derivingThingErr False cls cls_tys (mkTyConApp tycon tc_args) msg)
@@ -991,6 +993,7 @@ See Note [Eta reduction for data family axioms] in TcInstDcls.
 
 \begin{code}
 mkDataTypeEqn :: DynFlags
+              -> Maybe OverlapMode
               -> [Var]                  -- Universally quantified type variables in the instance
               -> Class                  -- Class for which we need to derive an instance
               -> [Type]                 -- Other parameters to the class except the last
@@ -1002,7 +1005,7 @@ mkDataTypeEqn :: DynFlags
               -> DerivContext        -- Context of the instance, for standalone deriving
               -> TcRn EarlyDerivSpec    -- Return 'Nothing' if error
 
-mkDataTypeEqn dflags tvs cls cls_tys
+mkDataTypeEqn dflags overlap_mode tvs cls cls_tys
               tycon tc_args rep_tc rep_tc_args mtheta
   = case checkSideConditions dflags mtheta cls cls_tys rep_tc rep_tc_args of
         -- NB: pass the *representation* tycon to checkSideConditions
@@ -1010,13 +1013,13 @@ mkDataTypeEqn dflags tvs cls cls_tys
         NonDerivableClass       -> bale_out (nonStdErr cls)
         DerivableClassError msg -> bale_out msg
   where
-    go_for_it    = mk_data_eqn tvs cls tycon tc_args rep_tc rep_tc_args mtheta
+    go_for_it    = mk_data_eqn overlap_mode tvs cls tycon tc_args rep_tc rep_tc_args mtheta
     bale_out msg = failWithTc (derivingThingErr False cls cls_tys (mkTyConApp tycon tc_args) msg)
 
-mk_data_eqn :: [TyVar] -> Class
+mk_data_eqn :: Maybe OverlapMode -> [TyVar] -> Class
             -> TyCon -> [TcType] -> TyCon -> [TcType] -> DerivContext
             -> TcM EarlyDerivSpec
-mk_data_eqn tvs cls tycon tc_args rep_tc rep_tc_args mtheta
+mk_data_eqn overlap_mode tvs cls tycon tc_args rep_tc rep_tc_args mtheta
   = do loc                  <- getSrcSpanM
        dfun_name            <- new_dfun_name cls tycon
        case mtheta of
@@ -1028,6 +1031,7 @@ mk_data_eqn tvs cls tycon tc_args rep_tc rep_tc_args mtheta
                    , ds_cls = cls, ds_tys = inst_tys
                    , ds_tc = rep_tc, ds_tc_args = rep_tc_args
                    , ds_theta = inferred_constraints
+                   , ds_overlap = overlap_mode
                    , ds_newtype = False }
         Just theta -> do -- Specified context
             return $ GivenTheta $ DS
@@ -1036,6 +1040,7 @@ mk_data_eqn tvs cls tycon tc_args rep_tc rep_tc_args mtheta
                    , ds_cls = cls, ds_tys = inst_tys
                    , ds_tc = rep_tc, ds_tc_args = rep_tc_args
                    , ds_theta = theta
+                   , ds_overlap = overlap_mode
                    , ds_newtype = False }
   where
     inst_tys = [mkTyConApp tycon tc_args]
@@ -1073,7 +1078,9 @@ mkOldTypeableEqn tvs cls tycon tc_args mtheta
                   DS { ds_loc = loc, ds_name = dfun_name, ds_tvs = []
                      , ds_cls = cls, ds_tys = [mkTyConApp tycon []]
                      , ds_tc = tycon, ds_tc_args = []
-                     , ds_theta = mtheta `orElse` [], ds_newtype = False })  }
+                     , ds_theta = mtheta `orElse` []
+                     , ds_overlap = Nothing -- Or, Just NoOverlap?
+                     , ds_newtype = False })  }
 
 mkPolyKindedTypeableEqn :: Class -> TyCon -> TcM [EarlyDerivSpec]
 -- We can arrive here from a 'deriving' clause
@@ -1098,6 +1105,9 @@ mkPolyKindedTypeableEqn cls tc
                                  -- so we must instantiate it appropiately
                              , ds_tc = tc, ds_tc_args = tc_args
                              , ds_theta = []  -- Context is empty for polykinded Typeable
+                             , ds_overlap = Nothing
+                               -- Perhaps this should be `Just NoOverlap`?
+
                              , ds_newtype = False } }
         where
           (kvs,tc_app_kind) = splitForAllTys (tyConKind tc)
@@ -1545,11 +1555,11 @@ a context for the Data instances:
 %************************************************************************
 
 \begin{code}
-mkNewTypeEqn :: DynFlags -> [Var] -> Class
+mkNewTypeEqn :: DynFlags -> Maybe OverlapMode -> [Var] -> Class
              -> [Type] -> TyCon -> [Type] -> TyCon -> [Type]
              -> DerivContext
              -> TcRn EarlyDerivSpec
-mkNewTypeEqn dflags tvs
+mkNewTypeEqn dflags overlap_mode tvs
              cls cls_tys tycon tc_args rep_tycon rep_tc_args mtheta
 -- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ...
   | ASSERT( length cls_tys + 1 == classArity cls )
@@ -1564,6 +1574,7 @@ mkNewTypeEqn dflags tvs
             , ds_cls = cls, ds_tys = inst_tys
             , ds_tc = rep_tycon, ds_tc_args = rep_tc_args
             , ds_theta = theta
+            , ds_overlap = overlap_mode
             , ds_newtype = True }
         Nothing -> return $ InferTheta $ DS
             { ds_loc = loc
@@ -1571,6 +1582,7 @@ mkNewTypeEqn dflags tvs
             , ds_cls = cls, ds_tys = inst_tys
             , ds_tc = rep_tycon, ds_tc_args = rep_tc_args
             , ds_theta = all_preds
+            , ds_overlap = overlap_mode
             , ds_newtype = True }
   | otherwise
   = case checkSideConditions dflags mtheta cls cls_tys rep_tycon rep_tc_args of
@@ -1584,7 +1596,7 @@ mkNewTypeEqn dflags tvs
         | otherwise                  -> bale_out non_std
   where
         newtype_deriving = xopt Opt_GeneralizedNewtypeDeriving dflags
-        go_for_it        = mk_data_eqn tvs cls tycon tc_args rep_tycon rep_tc_args mtheta
+        go_for_it        = mk_data_eqn overlap_mode tvs cls tycon tc_args rep_tycon rep_tc_args mtheta
         bale_out msg     = failWithTc (derivingThingErr newtype_deriving cls cls_tys inst_ty msg)
 
         non_std    = nonStdErr cls
@@ -2043,9 +2055,10 @@ genInst :: Bool             -- True <=> standalone deriving
         -> OverlapFlag
         -> CommonAuxiliaries
         -> DerivSpec ThetaType -> TcM (InstInfo RdrName, BagDerivStuff, Maybe Name)
-genInst standalone_deriv oflag comauxs
+genInst standalone_deriv default_oflag comauxs
         spec@(DS { ds_tvs = tvs, ds_tc = rep_tycon, ds_tc_args = rep_tc_args
                  , ds_theta = theta, ds_newtype = is_newtype, ds_tys = tys
+                 , ds_overlap = overlap_mode
                  , ds_name = name, ds_cls = clas, ds_loc = loc })
   | is_newtype
   = do { inst_spec <- mkInstance oflag theta spec
@@ -2076,6 +2089,7 @@ genInst standalone_deriv oflag comauxs
                                                 , ib_standalone_deriving = standalone_deriv } }
        ; return ( inst_info, deriv_stuff, Nothing ) }
   where
+    oflag  = setOverlapModeMaybe default_oflag overlap_mode
     rhs_ty = newTyConInstRhs rep_tycon rep_tc_args
 
 genDerivStuff :: SrcSpan -> FixityEnv -> Class -> Name -> TyCon
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 7fa83cc344..ed682df1b4 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -506,6 +506,7 @@ tcLocalInstDecl (L loc (ClsInstD { cid_inst = decl }))
 tcClsInstDecl :: LClsInstDecl Name -> TcM ([InstInfo Name], [FamInst])
 tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = poly_ty, cid_binds = binds
                                   , cid_sigs = uprags, cid_tyfam_insts = ats
+                                  , cid_overlap_mode = overlap_mode
                                   , cid_datafam_insts = adts }))
   = setSrcSpan loc                      $
     addErrCtxt (instDeclCtxt1 poly_ty)  $
@@ -567,7 +568,9 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = poly_ty, cid_binds = binds
         ; dfun_name <- newDFunName clas inst_tys (getLoc poly_ty)
                 -- Dfun location is that of instance *header*
 
-        ; overlap_flag <- getOverlapFlag
+        ; overlap_flag <-
+            do defaultOverlapFlag <- getOverlapFlag
+               return $ setOverlapModeMaybe defaultOverlapFlag overlap_mode
         ; (subst, tyvars') <- tcInstSkolTyVars tyvars
         ; let dfun  	= mkDictFunId dfun_name tyvars theta clas inst_tys
               ispec 	= mkLocalInstance dfun overlap_flag tyvars' clas (substTys subst inst_tys)