diff options
| author | simonpj@microsoft.com <unknown> | 2009-08-21 21:07:00 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2009-08-21 21:07:00 +0000 |
| commit | b70fc87dfe3b38b4cbc76285bccbce16d3ac6914 (patch) | |
| tree | 74dba9c3a11e476b1cf61026c5a15d90153ede94 | |
| parent | b0ec2cb2ab74b21ea1f790c062cd213aa9d9ef02 (diff) | |
| download | haskell-b70fc87dfe3b38b4cbc76285bccbce16d3ac6914.tar.gz | |
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.
| -rw-r--r-- | compiler/typecheck/TcDeriv.lhs | 1 | ||||
| -rw-r--r-- | compiler/typecheck/TcInstDcls.lhs | 17 |
2 files changed, 13 insertions, 5 deletions
diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 4aa2089e8b..d7c80c4016 100644 --- 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 c35e2d64b2..479bd670be 100644 --- 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 |