From b70fc87dfe3b38b4cbc76285bccbce16d3ac6914 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Fri, 21 Aug 2009 21:07:00 +0000 Subject: [PATCH] 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. --- compiler/typecheck/TcDeriv.lhs | 1 + 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 4aa2089..d7c80c4 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 c35e2d6..479bd67 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 -- 1.7.10.4