From 46b7ded55b37bcfccb1563625af1e45454524120 Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Thu, 20 Aug 2009 07:26:08 +0000 Subject: [PATCH] FIX #2767 & original problem of #3208 --- compiler/deSugar/DsBinds.lhs | 14 +++++++------- compiler/deSugar/DsMonad.lhs | 2 +- compiler/typecheck/Inst.lhs | 2 +- compiler/typecheck/TcMType.lhs | 2 +- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs index 0c8e37a..7f752f8 100644 --- a/compiler/deSugar/DsBinds.lhs +++ b/compiler/deSugar/DsBinds.lhs @@ -262,22 +262,22 @@ dsHsBind auto_scc rest (AbsBinds all_tyvars dicts exports binds) ; poly_tup_id <- newSysLocalDs (exprType poly_tup_expr) - ; let dict_args = map Var dicts - - mk_bind ((tyvars, global, local, prags), n) -- locals !! n == local - = -- Need to make fresh locals to bind in the selector, because - -- some of the tyvars will be bound to 'Any' + ; let mk_bind ((tyvars, global, local, prags), n) -- locals!!n == local + = -- Need to make fresh locals to bind in the selector, + -- because some of the tyvars will be bound to 'Any' do { ty_args <- mapM mk_ty_arg all_tyvars ; let substitute = substTyWith all_tyvars ty_args ; locals' <- newSysLocalsDs (map substitute local_tys) ; tup_id <- newSysLocalDs (substitute tup_ty) - ; mb_specs <- mapM (dsSpec all_tyvars dicts tyvars global local core_bind) + ; mb_specs <- mapM (dsSpec all_tyvars dicts tyvars global + local core_bind) prags ; let (spec_binds, rules) = unzip (catMaybes mb_specs) global' = addIdSpecialisations global rules rhs = mkLams tyvars $ mkLams dicts $ mkTupleSelector locals' (locals' !! n) tup_id $ - mkApps (mkTyApps (Var poly_tup_id) ty_args) dict_args + mkVarApps (mkTyApps (Var poly_tup_id) ty_args) + dicts ; return ((global', rhs) : spec_binds) } where mk_ty_arg all_tyvar diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs index 58a154a..e275cb9 100644 --- a/compiler/deSugar/DsMonad.lhs +++ b/compiler/deSugar/DsMonad.lhs @@ -230,7 +230,7 @@ newPredVarDs :: PredType -> DsM Var newPredVarDs pred | isEqPred pred = do { uniq <- newUnique; - ; let name = mkSystemName uniq (mkOccNameFS tcName (fsLit "co")) + ; let name = mkSystemName uniq (mkOccNameFS tcName (fsLit "co_pv")) kind = mkPredTy pred ; return (mkCoVar name kind) } | otherwise diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs index 51bacba..4f2dfab 100644 --- a/compiler/typecheck/Inst.lhs +++ b/compiler/typecheck/Inst.lhs @@ -1173,7 +1173,7 @@ mkEqInst (EqPred ty1 ty2) co ; return inst } where - mkName uniq src_span = mkInternalName uniq (mkVarOcc "co") src_span + mkName uniq src_span = mkInternalName uniq (mkVarOcc "co_ei") src_span mkEqInst pred _ = pprPanic "mkEqInst" (ppr pred) mkWantedEqInst :: PredType -> TcM Inst diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs index 030a7f6..94c2d25 100644 --- a/compiler/typecheck/TcMType.lhs +++ b/compiler/typecheck/TcMType.lhs @@ -415,7 +415,7 @@ occurCheckErr ty containingTy newCoVars :: [(TcType,TcType)] -> TcM [CoVar] newCoVars spec = do { us <- newUniqueSupply - ; return [ mkCoVar (mkSysTvName uniq (fsLit "co")) + ; return [ mkCoVar (mkSysTvName uniq (fsLit "co_kv")) (mkCoKind ty1 ty2) | ((ty1,ty2), uniq) <- spec `zip` uniqsFromSupply us] } -- 1.7.10.4