Fix Trac #3423: missed instantiation for newtype-derived instances

Somehow I'd forgotten to instantiate the coercion that is stored in a
'NewtypeDerived' constructor in an InstInfo.  The necessary code is
in TcInstDcls.tc_inst_decl2.

The result was ghc: panic! (the 'impossible' happened)
   (GHC version 6.10.3 for x86_64-unknown-linux):
   No match in record selector Var.tcTyVarDetails
because we were looking at an (uninstantiated) TyVar instead of
an (instantiated) TcTyVar.

diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 4aa2089..d7c80c4 100644 (file)
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -1387,6 +1387,7 @@ genInst standalone_deriv oflag spec
 -- When dealing with the deriving clause
 --    co1 : N [(b,b)] ~ R1:N (b,b)
 --    co2 : R1:N (b,b) ~ Tree (b,b)
+--    co  : N [(b,b)] ~ Tree (b,b)
 
 genDerivBinds :: SrcSpan -> FixityEnv -> Class -> TyCon -> (LHsBinds RdrName, DerivAuxBinds)
 genDerivBinds loc fix_env clas tycon

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index c35e2d6..479bd67 100644 (file)
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -600,9 +600,10 @@ tc_inst_decl2 :: Id -> InstBindings Name -> TcM (LHsBinds Id)
 -- see Note [Newtype deriving superclasses] in TcDeriv.lhs
 
 tc_inst_decl2 dfun_id (NewTypeDerived coi)
-  = do  { let rigid_info   = InstSkol
-              origin       = SigOrigin rigid_info
-              inst_ty      = idType dfun_id
+  = do  { let rigid_info = InstSkol
+              origin     = SigOrigin rigid_info
+              inst_ty    = idType dfun_id
+             inst_tvs   = fst (tcSplitForAllTys inst_ty)
         ; (inst_tvs', theta, inst_head_ty) <- tcSkolSigType rigid_info inst_ty
                 -- inst_head_ty is a PredType
 
@@ -615,7 +616,13 @@ tc_inst_decl2 dfun_id (NewTypeDerived coi)
               (rep_ty, wrapper) 
                 = case coi of
                     IdCo   -> (last_ty, idHsWrapper)
-                    ACo co -> (snd (coercionKind co), WpCast (mk_full_coercion co))
+                    ACo co -> (snd (coercionKind co'), WpCast (mk_full_coercion co'))
+                           where
+                              co' = substTyWith inst_tvs (mkTyVarTys inst_tvs') co
+                               -- NB: the free variable of coi are bound by the
+                               -- universally quantified variables of the dfun_id
+                               -- This is weird, and maybe we should make NewTypeDerived
+                               -- carry a type-variable list too; but it works fine
 
                 -----------------------
                 --        mk_full_coercion
@@ -736,7 +743,7 @@ tc_inst_decl2 dfun_id (VanillaInst monobinds uprags standalone_deriv)
                                 this_dict dfun_id
                                 prag_fn monobinds
        ; (meth_exprs, meth_binds) <- tcExtendTyVarEnv inst_tyvars'  $
-                               mapAndUnzipM tc_meth op_items 
+                                    mapAndUnzipM tc_meth op_items 
 
          -- Figure out bindings for the superclass context
          -- Don't include this_dict in the 'givens', else