2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[TcInstDecls]{Typechecking instance declarations}
7 module TcInstDcls ( tcInstDecls1, tcInstDecls2 ) where
9 #include "HsVersions.h"
11 import HsSyn ( InstDecl(..), HsType(..),
12 MonoBinds(..), HsExpr(..), HsLit(..), Sig(..),
13 andMonoBindList, collectMonoBinders,
16 import RnHsSyn ( RenamedHsBinds, RenamedInstDecl, RenamedTyClDecl )
17 import TcHsSyn ( TcMonoBinds, mkHsConApp )
18 import TcBinds ( tcSpecSigs )
19 import TcClassDcl ( tcMethodBind, mkMethodBind, badMethodErr,
20 tcClassDecl2, getGenericInstances )
22 import TcMType ( tcInstType, checkValidTheta, checkValidInstHead, instTypeErr,
23 checkAmbiguity, SourceTyCtxt(..) )
24 import TcType ( mkClassPred, tcSplitForAllTys, tyVarsOfType,
25 tcSplitSigmaTy, getClassPredTys, tcSplitPredTy_maybe, mkTyVarTys,
26 TyVarDetails(..), tcSplitDFunTy, pprClassPred )
27 import Inst ( InstOrigin(..), tcInstClassOp, newDicts, instToId,
28 showLIE, tcExtendLocalInstEnv )
29 import TcDeriv ( tcDeriving )
30 import TcEnv ( tcExtendGlobalValEnv, tcExtendTyVarEnv2,
31 InstInfo(..), InstBindings(..),
32 newDFunName, tcExtendLocalValEnv
34 import TcHsType ( kcHsSigType, tcHsKindedType )
35 import TcUnify ( checkSigTyVars )
36 import TcSimplify ( tcSimplifyCheck, tcSimplifyTop )
37 import Subst ( mkTyVarSubst, substTheta, substTy )
38 import DataCon ( classDataCon )
39 import Class ( classBigSig )
40 import Var ( idName, idType )
42 import MkId ( mkDictFunId, rUNTIME_ERROR_ID )
43 import FunDeps ( checkInstFDs )
44 import Name ( getSrcLoc )
45 import NameSet ( unitNameSet, emptyNameSet, nameSetToList )
46 import UnicodeUtil ( stringToUtf8 )
47 import Maybe ( catMaybes )
48 import ListSetOps ( minusList )
53 Typechecking instance declarations is done in two passes. The first
54 pass, made by @tcInstDecls1@, collects information to be used in the
57 This pre-processed info includes the as-yet-unprocessed bindings
58 inside the instance declaration. These are type-checked in the second
59 pass, when the class-instance envs and GVE contain all the info from
60 all the instance and value decls. Indeed that's the reason we need
61 two passes over the instance decls.
64 Here is the overall algorithm.
65 Assume that we have an instance declaration
67 instance c => k (t tvs) where b
71 $LIE_c$ is the LIE for the context of class $c$
73 $betas_bar$ is the free variables in the class method type, excluding the
76 $LIE_cop$ is the LIE constraining a particular class method
78 $tau_cop$ is the tau type of a class method
80 $LIE_i$ is the LIE for the context of instance $i$
82 $X$ is the instance constructor tycon
84 $gammas_bar$ is the set of type variables of the instance
86 $LIE_iop$ is the LIE for a particular class method instance
88 $tau_iop$ is the tau type for this instance of a class method
90 $alpha$ is the class variable
92 $LIE_cop' = LIE_cop [X gammas_bar / alpha, fresh betas_bar]$
94 $tau_cop' = tau_cop [X gammas_bar / alpha, fresh betas_bar]$
97 ToDo: Update the list above with names actually in the code.
101 First, make the LIEs for the class and instance contexts, which means
102 instantiate $thetaC [X inst_tyvars / alpha ]$, yielding LIElistC' and LIEC',
103 and make LIElistI and LIEI.
105 Then process each method in turn.
107 order the instance methods according to the ordering of the class methods
109 express LIEC' in terms of LIEI, yielding $dbinds_super$ or an error
111 Create final dictionary function from bindings generated already
113 df = lambda inst_tyvars
120 in <op1,op2,...,opn,sd1,...,sdm>
122 Here, Bop1 \ldots Bopn bind the methods op1 \ldots opn,
123 and $dbinds_super$ bind the superclass dictionaries sd1 \ldots sdm.
127 %************************************************************************
129 \subsection{Extracting instance decls}
131 %************************************************************************
133 Gather up the instance declarations from their various sources
136 tcInstDecls1 -- Deal with both source-code and imported instance decls
137 :: [RenamedTyClDecl] -- For deriving stuff
138 -> [RenamedInstDecl] -- Source code instance decls
139 -> TcM (TcGblEnv, -- The full inst env
140 [InstInfo], -- Source-code instance decls to process;
141 -- contains all dfuns for this module
142 RenamedHsBinds) -- Supporting bindings for derived instances
144 tcInstDecls1 tycl_decls inst_decls
146 -- Stop if addInstInfos etc discovers any errors
147 -- (they recover, so that we get more than one error each round)
149 -- (1) Do the ordinary instance declarations
150 mappM tcLocalInstDecl1 inst_decls `thenM` \ local_inst_infos ->
153 local_inst_info = catMaybes local_inst_infos
154 clas_decls = filter isClassDecl tycl_decls
156 -- (2) Instances from generic class declarations
157 getGenericInstances clas_decls `thenM` \ generic_inst_info ->
159 -- Next, construct the instance environment so far, consisting of
160 -- a) local instance decls
161 -- b) generic instances
162 addInsts local_inst_info $
163 addInsts generic_inst_info $
165 -- (3) Compute instances from "deriving" clauses;
166 -- This stuff computes a context for the derived instance decl, so it
167 -- needs to know about all the instances possible; hence inst_env4
168 tcDeriving tycl_decls `thenM` \ (deriv_inst_info, deriv_binds, keep_alive) ->
169 addInsts deriv_inst_info $
171 getGblEnv `thenM` \ gbl_env ->
172 returnM (gbl_env { tcg_keep = tcg_keep gbl_env `unionNameSets` keep_alive },
173 generic_inst_info ++ deriv_inst_info ++ local_inst_info,
176 addInsts :: [InstInfo] -> TcM a -> TcM a
177 addInsts infos thing_inside
178 = tcExtendLocalInstEnv (map iDFunId infos) thing_inside
182 tcLocalInstDecl1 :: RenamedInstDecl
183 -> TcM (Maybe InstInfo) -- Nothing if there was an error
184 -- A source-file instance declaration
185 -- Type-check all the stuff before the "where"
187 -- We check for respectable instance type, and context
188 -- but only do this for non-imported instance decls.
189 -- Imported ones should have been checked already, and may indeed
190 -- contain something illegal in normal Haskell, notably
191 -- instance CCallable [Char]
192 tcLocalInstDecl1 decl@(InstDecl poly_ty binds uprags src_loc)
193 = -- Prime error recovery, set source location
194 recoverM (returnM Nothing) $
196 addErrCtxt (instDeclCtxt1 poly_ty) $
198 -- Typecheck the instance type itself. We can't use
199 -- tcHsSigType, because it's not a valid user type.
200 kcHsSigType poly_ty `thenM` \ kinded_ty ->
201 tcHsKindedType kinded_ty `thenM` \ poly_ty' ->
203 (tyvars, theta, tau) = tcSplitSigmaTy poly_ty'
205 checkValidTheta InstThetaCtxt theta `thenM_`
206 checkAmbiguity tyvars theta (tyVarsOfType tau) `thenM_`
207 checkValidInstHead tau `thenM` \ (clas,inst_tys) ->
208 checkTc (checkInstFDs theta clas inst_tys)
209 (instTypeErr (pprClassPred clas inst_tys) msg) `thenM_`
210 newDFunName clas inst_tys src_loc `thenM` \ dfun_name ->
211 returnM (Just (InstInfo { iDFunId = mkDictFunId dfun_name tyvars theta clas inst_tys,
212 iBinds = VanillaInst binds uprags }))
214 msg = parens (ptext SLIT("the instance types do not agree with the functional dependencies of the class"))
218 %************************************************************************
220 \subsection{Type-checking instance declarations, pass 2}
222 %************************************************************************
225 tcInstDecls2 :: [RenamedTyClDecl] -> [InstInfo]
226 -> TcM (TcLclEnv, TcMonoBinds)
227 -- (a) From each class declaration,
228 -- generate any default-method bindings
229 -- (b) From each instance decl
230 -- generate the dfun binding
232 tcInstDecls2 tycl_decls inst_decls
233 = do { -- (a) Default methods from class decls
234 (dm_binds_s, dm_ids_s) <- mapAndUnzipM tcClassDecl2 $
235 filter isClassDecl tycl_decls
236 ; tcExtendLocalValEnv (concat dm_ids_s) $ do
238 -- (b) instance declarations
239 ; inst_binds_s <- mappM tcInstDecl2 inst_decls
242 ; tcl_env <- getLclEnv
243 ; returnM (tcl_env, andMonoBindList dm_binds_s `AndMonoBinds`
244 andMonoBindList inst_binds_s) }
247 ======= New documentation starts here (Sept 92) ==============
249 The main purpose of @tcInstDecl2@ is to return a @HsBinds@ which defines
250 the dictionary function for this instance declaration. For example
252 instance Foo a => Foo [a] where
256 might generate something like
258 dfun.Foo.List dFoo_a = let op1 x = ...
264 HOWEVER, if the instance decl has no context, then it returns a
265 bigger @HsBinds@ with declarations for each method. For example
267 instance Foo [a] where
273 dfun.Foo.List a = Dict [Foo.op1.List a, Foo.op2.List a]
274 const.Foo.op1.List a x = ...
275 const.Foo.op2.List a y = ...
277 This group may be mutually recursive, because (for example) there may
278 be no method supplied for op2 in which case we'll get
280 const.Foo.op2.List a = default.Foo.op2 (dfun.Foo.List a)
282 that is, the default method applied to the dictionary at this type.
284 What we actually produce in either case is:
286 AbsBinds [a] [dfun_theta_dicts]
287 [(dfun.Foo.List, d)] ++ (maybe) [(const.Foo.op1.List, op1), ...]
288 { d = (sd1,sd2, ..., op1, op2, ...)
293 The "maybe" says that we only ask AbsBinds to make global constant methods
294 if the dfun_theta is empty.
297 For an instance declaration, say,
299 instance (C1 a, C2 b) => C (T a b) where
302 where the {\em immediate} superclasses of C are D1, D2, we build a dictionary
303 function whose type is
305 (C1 a, C2 b, D1 (T a b), D2 (T a b)) => C (T a b)
307 Notice that we pass it the superclass dictionaries at the instance type; this
308 is the ``Mark Jones optimisation''. The stuff before the "=>" here
309 is the @dfun_theta@ below.
311 First comes the easy case of a non-local instance decl.
315 tcInstDecl2 :: InstInfo -> TcM TcMonoBinds
317 tcInstDecl2 (InstInfo { iDFunId = dfun_id, iBinds = binds })
318 = -- Prime error recovery
319 recoverM (returnM EmptyMonoBinds) $
320 addSrcLoc (getSrcLoc dfun_id) $
321 addErrCtxt (instDeclCtxt2 (idType dfun_id)) $
323 inst_ty = idType dfun_id
324 (inst_tyvars, _) = tcSplitForAllTys inst_ty
325 -- The tyvars of the instance decl scope over the 'where' part
326 -- Those tyvars are inside the dfun_id's type, which is a bit
327 -- bizarre, but OK so long as you realise it!
330 -- Instantiate the instance decl with tc-style type variables
331 tcInstType InstTv inst_ty `thenM` \ (inst_tyvars', dfun_theta', inst_head') ->
333 Just pred = tcSplitPredTy_maybe inst_head'
334 (clas, inst_tys') = getClassPredTys pred
335 (class_tyvars, sc_theta, _, op_items) = classBigSig clas
337 -- Instantiate the super-class context with inst_tys
338 sc_theta' = substTheta (mkTyVarSubst class_tyvars inst_tys') sc_theta
339 origin = InstanceDeclOrigin
341 -- Create dictionary Ids from the specified instance contexts.
342 newDicts origin sc_theta' `thenM` \ sc_dicts ->
343 newDicts origin dfun_theta' `thenM` \ dfun_arg_dicts ->
344 newDicts origin [pred] `thenM` \ [this_dict] ->
345 -- Default-method Ids may be mentioned in synthesised RHSs,
346 -- but they'll already be in the environment.
349 -- Typecheck the methods
350 let -- These insts are in scope; quite a few, eh?
351 avail_insts = [this_dict] ++ dfun_arg_dicts ++ sc_dicts
353 tcMethods clas inst_tyvars inst_tyvars'
354 dfun_theta' inst_tys' avail_insts
355 op_items binds `thenM` \ (meth_ids, meth_binds) ->
357 -- Figure out bindings for the superclass context
358 tcSuperClasses inst_tyvars' dfun_arg_dicts sc_dicts
359 `thenM` \ (zonked_inst_tyvars, sc_binds_inner, sc_binds_outer) ->
361 -- Deal with 'SPECIALISE instance' pragmas by making them
362 -- look like SPECIALISE pragmas for the dfun
364 uprags = case binds of
365 VanillaInst _ uprags -> uprags
367 spec_prags = [ SpecSig (idName dfun_id) ty loc
368 | SpecInstSig ty loc <- uprags ]
369 xtve = inst_tyvars `zip` inst_tyvars'
371 tcExtendGlobalValEnv [dfun_id] (
372 tcExtendTyVarEnv2 xtve $
373 tcSpecSigs spec_prags
374 ) `thenM` \ prag_binds ->
376 -- Create the result bindings
378 dict_constr = classDataCon clas
379 scs_and_meths = map instToId sc_dicts ++ meth_ids
380 this_dict_id = instToId this_dict
381 inlines | null dfun_arg_dicts = emptyNameSet
382 | otherwise = unitNameSet (idName dfun_id)
383 -- Always inline the dfun; this is an experimental decision
384 -- because it makes a big performance difference sometimes.
385 -- Often it means we can do the method selection, and then
386 -- inline the method as well. Marcin's idea; see comments below.
388 -- BUT: don't inline it if it's a constant dictionary;
389 -- we'll get all the benefit without inlining, and we get
390 -- a **lot** of code duplication if we inline it
392 -- See Note [Inline dfuns] below
396 = -- Blatant special case for CCallable, CReturnable
397 -- If the dictionary is empty then we should never
398 -- select anything from it, so we make its RHS just
399 -- emit an error message. This in turn means that we don't
400 -- mention the constructor, which doesn't exist for CCallable, CReturnable
401 -- Hardly beautiful, but only three extra lines.
402 HsApp (TyApp (HsVar rUNTIME_ERROR_ID) [idType this_dict_id])
403 (HsLit (HsStringPrim (mkFastString (stringToUtf8 msg))))
405 | otherwise -- The common case
406 = mkHsConApp dict_constr inst_tys' (map HsVar scs_and_meths)
407 -- We don't produce a binding for the dict_constr; instead we
408 -- rely on the simplifier to unfold this saturated application
409 -- We do this rather than generate an HsCon directly, because
410 -- it means that the special cases (e.g. dictionary with only one
411 -- member) are dealt with by the common MkId.mkDataConWrapId code rather
412 -- than needing to be repeated here.
415 msg = "Compiler error: bad dictionary " ++ showSDoc (ppr clas)
417 dict_bind = VarMonoBind this_dict_id dict_rhs
418 all_binds = sc_binds_inner `AndMonoBinds` meth_binds `AndMonoBinds` dict_bind
422 (map instToId dfun_arg_dicts)
423 [(inst_tyvars', dfun_id, this_dict_id)]
426 showLIE (text "instance") `thenM_`
427 returnM (main_bind `AndMonoBinds` prag_binds `AndMonoBinds` sc_binds_outer)
430 tcMethods clas inst_tyvars inst_tyvars' dfun_theta' inst_tys'
431 avail_insts op_items (VanillaInst monobinds uprags)
432 = -- Check that all the method bindings come from this class
434 sel_names = [idName sel_id | (sel_id, _) <- op_items]
435 bad_bndrs = collectMonoBinders monobinds `minusList` sel_names
437 mappM (addErrTc . badMethodErr clas) bad_bndrs `thenM_`
439 -- Make the method bindings
441 mk_method_bind = mkMethodBind InstanceDeclOrigin clas inst_tys' monobinds
443 mapAndUnzipM mk_method_bind op_items `thenM` \ (meth_insts, meth_infos) ->
445 -- And type check them
446 -- It's really worth making meth_insts available to the tcMethodBind
447 -- Consider instance Monad (ST s) where
448 -- {-# INLINE (>>) #-}
449 -- (>>) = ...(>>=)...
450 -- If we don't include meth_insts, we end up with bindings like this:
451 -- rec { dict = MkD then bind ...
452 -- then = inline_me (... (GHC.Base.>>= dict) ...)
454 -- The trouble is that (a) 'then' and 'dict' are mutually recursive,
455 -- and (b) the inline_me prevents us inlining the >>= selector, which
456 -- would unravel the loop. Result: (>>) ends up as a loop breaker, and
457 -- is not inlined across modules. Rather ironic since this does not
458 -- happen without the INLINE pragma!
460 -- Solution: make meth_insts available, so that 'then' refers directly
461 -- to the local 'bind' rather than going via the dictionary.
463 -- BUT WATCH OUT! If the method type mentions the class variable, then
464 -- this optimisation is not right. Consider
468 -- instance C Int where
470 -- The occurrence of 'op' on the rhs gives rise to a constraint
472 -- The trouble is that the 'meth_inst' for op, which is 'available', also
473 -- looks like 'op at Int'. But they are not the same.
475 all_insts = avail_insts ++ catMaybes meth_insts
476 xtve = inst_tyvars `zip` inst_tyvars'
477 tc_method_bind = tcMethodBind xtve inst_tyvars' dfun_theta' all_insts uprags
479 mapM tc_method_bind meth_infos `thenM` \ meth_binds_s ->
481 returnM ([meth_id | (_,meth_id,_) <- meth_infos],
482 andMonoBindList meth_binds_s)
485 -- Derived newtype instances
486 tcMethods clas inst_tyvars inst_tyvars' dfun_theta' inst_tys'
487 avail_insts op_items (NewTypeDerived rep_tys)
488 = getInstLoc InstanceDeclOrigin `thenM` \ inst_loc ->
489 mapAndUnzip3M (do_one inst_loc) op_items `thenM` \ (meth_ids, meth_binds, rhs_insts) ->
492 (ptext SLIT("newtype derived instance"))
493 inst_tyvars' avail_insts rhs_insts `thenM` \ lie_binds ->
495 -- I don't think we have to do the checkSigTyVars thing
497 returnM (meth_ids, lie_binds `AndMonoBinds` andMonoBindList meth_binds)
500 do_one inst_loc (sel_id, _)
501 = -- The binding is like "op @ NewTy = op @ RepTy"
502 -- Make the *binder*, like in mkMethodBind
503 tcInstClassOp inst_loc sel_id inst_tys' `thenM` \ meth_inst ->
505 -- Make the *occurrence on the rhs*
506 tcInstClassOp inst_loc sel_id rep_tys' `thenM` \ rhs_inst ->
508 meth_id = instToId meth_inst
510 return (meth_id, VarMonoBind meth_id (HsVar (instToId rhs_inst)), rhs_inst)
512 -- Instantiate rep_tys with the relevant type variables
513 rep_tys' = map (substTy subst) rep_tys
514 subst = mkTyVarSubst inst_tyvars (mkTyVarTys inst_tyvars')
517 Note: [Superclass loops]
518 ~~~~~~~~~~~~~~~~~~~~~~~~~
519 We have to be very, very careful when generating superclasses, lest we
520 accidentally build a loop. Here's an example:
524 class S a => C a where { opc :: a -> a }
525 class S b => D b where { opd :: b -> b }
533 From (instance C Int) we get the constraint set {ds1:S Int, dd:D Int}
534 Simplifying, we may well get:
535 $dfCInt = :C ds1 (opd dd)
538 Notice that we spot that we can extract ds1 from dd.
540 Alas! Alack! We can do the same for (instance D Int):
542 $dfDInt = :D ds2 (opc dc)
546 And now we've defined the superclass in terms of itself.
549 Solution: treat the superclass context separately, and simplify it
550 all the way down to nothing on its own. Don't toss any 'free' parts
551 out to be simplified together with other bits of context.
552 Hence the tcSimplifyTop below.
554 At a more basic level, don't include this_dict in the context wrt
555 which we simplify sc_dicts, else sc_dicts get bound by just selecting
559 tcSuperClasses inst_tyvars' dfun_arg_dicts sc_dicts
560 = addErrCtxt superClassCtxt $
561 getLIE (tcSimplifyCheck doc inst_tyvars'
563 sc_dicts) `thenM` \ (sc_binds1, sc_lie) ->
565 -- It's possible that the superclass stuff might have done unification
566 checkSigTyVars inst_tyvars' `thenM` \ zonked_inst_tyvars ->
568 -- We must simplify this all the way down
569 -- lest we build superclass loops
570 -- See Note [Superclass loops] above
571 tcSimplifyTop sc_lie `thenM` \ sc_binds2 ->
573 returnM (zonked_inst_tyvars, sc_binds1, sc_binds2)
576 doc = ptext SLIT("instance declaration superclass context")
580 ------------------------------
581 [Inline dfuns] Inlining dfuns unconditionally
582 ------------------------------
584 The code above unconditionally inlines dict funs. Here's why.
585 Consider this program:
587 test :: Int -> Int -> Bool
588 test x y = (x,y) == (y,x) || test y x
589 -- Recursive to avoid making it inline.
591 This needs the (Eq (Int,Int)) instance. If we inline that dfun
592 the code we end up with is good:
595 \r -> case ==# [ww ww1] of wild {
596 PrelBase.False -> Test.$wtest ww1 ww;
598 case ==# [ww1 ww] of wild1 {
599 PrelBase.False -> Test.$wtest ww1 ww;
600 PrelBase.True -> PrelBase.True [];
603 Test.test = \r [w w1]
606 case w1 of w3 { PrelBase.I# ww1 -> Test.$wtest ww ww1; };
609 If we don't inline the dfun, the code is not nearly as good:
611 (==) = case PrelTup.$fEq(,) PrelBase.$fEqInt PrelBase.$fEqInt of tpl {
612 PrelBase.:DEq tpl1 tpl2 -> tpl2;
617 let { y = PrelBase.I#! [ww1]; } in
618 let { x = PrelBase.I#! [ww]; } in
619 let { sat_slx = PrelTup.(,)! [y x]; } in
620 let { sat_sly = PrelTup.(,)! [x y];
622 case == sat_sly sat_slx of wild {
623 PrelBase.False -> Test.$wtest ww1 ww;
624 PrelBase.True -> PrelBase.True [];
631 case w1 of w3 { PrelBase.I# ww1 -> Test.$wtest ww ww1; };
634 Why doesn't GHC inline $fEq? Because it looks big:
636 PrelTup.zdfEqZ1T{-rcX-}
637 = \ @ a{-reT-} :: * @ b{-reS-} :: *
638 zddEq{-rf6-} _Ks :: {PrelBase.Eq{-23-} a{-reT-}}
639 zddEq1{-rf7-} _Ks :: {PrelBase.Eq{-23-} b{-reS-}} ->
641 zeze{-rf0-} _Kl :: (b{-reS-} -> b{-reS-} -> PrelBase.Bool{-3c-})
642 zeze{-rf0-} = PrelBase.zeze{-01L-}@ b{-reS-} zddEq1{-rf7-} } in
644 zeze1{-rf3-} _Kl :: (a{-reT-} -> a{-reT-} -> PrelBase.Bool{-3c-})
645 zeze1{-rf3-} = PrelBase.zeze{-01L-} @ a{-reT-} zddEq{-rf6-} } in
647 zeze2{-reN-} :: ((a{-reT-}, b{-reS-}) -> (a{-reT-}, b{-reS-})-> PrelBase.Bool{-3c-})
648 zeze2{-reN-} = \ ds{-rf5-} _Ks :: (a{-reT-}, b{-reS-})
649 ds1{-rf4-} _Ks :: (a{-reT-}, b{-reS-}) ->
651 of wild{-reW-} _Kd { (a1{-rf2-} _Ks, a2{-reZ-} _Ks) ->
653 of wild1{-reX-} _Kd { (b1{-rf1-} _Ks, b2{-reY-} _Ks) ->
655 (zeze1{-rf3-} a1{-rf2-} b1{-rf1-})
656 (zeze{-rf0-} a2{-reZ-} b2{-reY-})
660 a1{-reR-} :: ((a{-reT-}, b{-reS-})-> (a{-reT-}, b{-reS-})-> PrelBase.Bool{-3c-})
661 a1{-reR-} = \ a2{-reV-} _Ks :: (a{-reT-}, b{-reS-})
662 b1{-reU-} _Ks :: (a{-reT-}, b{-reS-}) ->
663 PrelBase.not{-r6I-} (zeze2{-reN-} a2{-reV-} b1{-reU-})
665 PrelBase.zdwZCDEq{-r8J-} @ (a{-reT-}, b{-reS-}) a1{-reR-} zeze2{-reN-})
667 and it's not as bad as it seems, because it's further dramatically
668 simplified: only zeze2 is extracted and its body is simplified.
671 %************************************************************************
673 \subsection{Error messages}
675 %************************************************************************
678 instDeclCtxt1 hs_inst_ty
679 = inst_decl_ctxt (case hs_inst_ty of
680 HsForAllTy _ _ _ (HsPredTy pred) -> ppr pred
681 HsPredTy pred -> ppr pred
682 other -> ppr hs_inst_ty) -- Don't expect this
683 instDeclCtxt2 dfun_ty
684 = inst_decl_ctxt (ppr (mkClassPred cls tys))
686 (_,_,cls,tys) = tcSplitDFunTy dfun_ty
688 inst_decl_ctxt doc = ptext SLIT("In the instance declaration for") <+> quotes doc
690 superClassCtxt = ptext SLIT("When checking the super-classes of an instance declaration")