2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[TcSimplify]{TcSimplify}
7 #include "HsVersions.h"
10 tcSimplify, tcSimplifyAndCheck,
11 tcSimplifyTop, tcSimplifyThetas, tcSimplifyCheckThetas, tcSimplifyRank2,
17 import HsSyn ( MonoBinds(..), HsExpr(..), InPat, OutPat, HsLit,
18 Match, HsBinds, HsType, ArithSeqInfo, Fixity,
19 GRHSsAndBinds, Stmt, DoOrListComp, Fake )
20 import HsBinds ( andMonoBinds )
21 import TcHsSyn ( TcIdOcc(..), SYN_IE(TcIdBndr), SYN_IE(TcExpr),
22 SYN_IE(TcMonoBinds), SYN_IE(TcDictBinds) )
25 import Inst ( lookupInst, lookupSimpleInst,
26 tyVarsOfInst, isTyVarDict, isDict,
27 matchesInst, instToId, instBindingRequired,
28 instCanBeGeneralised, newDictsAtLoc,
30 Inst(..), SYN_IE(LIE), zonkLIE, emptyLIE,
31 plusLIE, unitLIE, consLIE, InstOrigin(..),
33 import TcEnv ( tcGetGlobalTyVars )
34 import SpecEnv ( SpecEnv )
35 import TcType ( SYN_IE(TcType), SYN_IE(TcTyVar), SYN_IE(TcTyVarSet), TcMaybe, tcInstType )
36 import Unify ( unifyTauTy )
38 import Bag ( Bag, unitBag, listToBag, foldBag, filterBag, emptyBag, bagToList,
39 snocBag, consBag, unionBags, isEmptyBag )
40 import Class ( GenClass, SYN_IE(Class), SYN_IE(ClassInstEnv),
41 isSuperClassOf, classSuperDictSelId, classInstEnv
44 import PrelInfo ( isNumericClass, isStandardClass, isCcallishClass )
46 import Maybes ( expectJust, firstJust, catMaybes, seqMaybe, maybeToBool )
47 import Outputable ( Outputable(..){-instance * []-} )
49 import PprType ( GenType, GenTyVar )
51 import SrcLoc ( noSrcLoc )
52 import Type ( GenType, SYN_IE(Type), SYN_IE(TauType), mkTyVarTy, getTyVar, eqSimpleTy,
54 import TysWiredIn ( intTy, unitTy )
55 import TyVar ( GenTyVar, SYN_IE(GenTyVarSet),
56 elementOfTyVarSet, emptyTyVarSet, unionTyVarSets,
57 isEmptyTyVarSet, tyVarSetToList )
58 import Unique ( Unique )
63 %************************************************************************
65 \subsection[tcSimplify-main]{Main entry function}
67 %************************************************************************
69 * May modify the substitution to bind ambiguous type variables.
73 (1) If an inst constrains only ``global'' type variables, (or none),
74 return it as a ``global'' inst.
78 (2) Simplify it repeatedly (checking for (1) of course) until it is a dict
79 constraining only a type variable.
81 (3) If it constrains a ``local'' type variable, return it as a ``local'' inst.
82 Otherwise it must be ambiguous, so try to resolve the ambiguity.
86 tcSimpl :: Bool -- True <=> simplify const insts
87 -> TcTyVarSet s -- ``Global'' type variables
88 -> TcTyVarSet s -- ``Local'' type variables
89 -- ASSERT: both these tyvar sets are already zonked
90 -> LIE s -- Given; these constrain only local tyvars
92 -> TcM s (LIE s, -- Free
93 TcMonoBinds s, -- Bindings
94 LIE s) -- Remaining wanteds; no dups
96 tcSimpl squash_consts global_tvs local_tvs givens wanteds
97 = -- ASSSERT: global_tvs and local_tvs are already zonked
98 -- Make sure the insts fixed points of the substitution
99 zonkLIE givens `thenNF_Tc` \ givens ->
100 zonkLIE wanteds `thenNF_Tc` \ wanteds ->
102 -- Deal with duplicates and type constructors
104 squash_consts (\tv -> tv `elementOfTyVarSet` global_tvs)
105 givens wanteds `thenTc` \ (globals, tycon_binds, locals_and_ambigs) ->
107 -- Now disambiguate if necessary
109 ambigs = filterBag is_ambiguous locals_and_ambigs
111 if not (isEmptyBag ambigs) then
112 -- Some ambiguous dictionaries. We now disambiguate them,
113 -- which binds the offending type variables to suitable types in the
114 -- substitution, and then we retry the whole process. This
115 -- time there won't be any ambiguous ones.
116 -- There's no need to back-substitute on global and local tvs,
117 -- because the ambiguous type variables can't be in either.
119 -- Why do we retry the whole process? Because binding a type variable
120 -- to a particular type might enable a short-cut simplification which
121 -- elimTyCons will have missed the first time.
123 disambiguateDicts ambigs `thenTc_`
124 tcSimpl squash_consts global_tvs local_tvs givens wanteds
127 -- No ambiguous dictionaries. Just bash on with the results
130 -- Check for non-generalisable insts
132 locals = locals_and_ambigs -- ambigs is empty
133 cant_generalise = filterBag (not . instCanBeGeneralised) locals
135 checkTc (isEmptyBag cant_generalise)
136 (genCantGenErr cant_generalise) `thenTc_`
139 -- Deal with superclass relationships
140 elimSCs givens locals `thenNF_Tc` \ (sc_binds, locals2) ->
143 returnTc (globals, sc_binds `AndMonoBinds` tycon_binds, locals2)
145 is_ambiguous (Dict _ _ ty _ _)
146 = not (getTyVar "is_ambiguous" ty `elementOfTyVarSet` local_tvs)
149 The main wrapper is @tcSimplify@. It just calls @tcSimpl@, but with
150 the ``don't-squash-consts'' flag set depending on top-level ness. For
151 top level defns we *do* squash constants, so that they stay local to a
152 single defn. This makes things which are inlined more likely to be
153 exportable, because their constants are "inside". Later passes will
154 float them out if poss, after inlinings are sorted out.
158 :: TcTyVarSet s -- ``Local'' type variables
160 -> TcM s (LIE s, -- Free
161 TcDictBinds s, -- Bindings
162 LIE s) -- Remaining wanteds; no dups
164 tcSimplify local_tvs wanteds
165 = tcGetGlobalTyVars `thenNF_Tc` \ global_tvs ->
166 tcSimpl False global_tvs local_tvs emptyBag wanteds
169 @tcSimplifyAndCheck@ is similar to the above, except that it checks
170 that there is an empty wanted-set at the end. It may still return
171 some of constant insts, which have to be resolved finally at the end.
175 :: TcTyVarSet s -- ``Local'' type variables; ASSERT is fixpoint
178 -> TcM s (LIE s, -- Free
179 TcDictBinds s) -- Bindings
181 tcSimplifyAndCheck local_tvs givens wanteds
182 = tcGetGlobalTyVars `thenNF_Tc` \ global_tvs ->
183 tcSimpl False global_tvs local_tvs
184 givens wanteds `thenTc` \ (free_insts, binds, wanteds') ->
185 checkTc (isEmptyBag wanteds')
186 (reduceErr wanteds') `thenTc_`
187 returnTc (free_insts, binds)
190 @tcSimplifyRank2@ checks that the argument of a rank-2 polymorphic function
194 tcSimplifyRank2 :: TcTyVarSet s -- ``Local'' type variables; ASSERT is fixpoint
196 -> TcM s (LIE s, -- Free
197 TcDictBinds s) -- Bindings
200 tcSimplifyRank2 local_tvs givens
201 = zonkLIE givens `thenNF_Tc` \ givens' ->
203 (\tv -> not (tv `elementOfTyVarSet` local_tvs))
204 -- This predicate claims that all
205 -- any non-local tyvars are global,
206 -- thereby postponing dealing with
207 -- ambiguity until the enclosing Gen
208 emptyLIE givens' `thenTc` \ (free, dict_binds, wanteds) ->
210 checkTc (isEmptyBag wanteds) (reduceErr wanteds) `thenTc_`
212 returnTc (free, dict_binds)
215 @tcSimplifyTop@ deals with constant @Insts@, using the standard simplification
216 mechansim with the extra flag to say ``beat out constant insts''.
219 tcSimplifyTop :: LIE s -> TcM s (TcDictBinds s)
221 = tcSimpl True emptyTyVarSet emptyTyVarSet emptyBag dicts `thenTc` \ (_, binds, _) ->
225 %************************************************************************
227 \subsection[elimTyCons]{@elimTyCons@}
229 %************************************************************************
232 elimTyCons :: Bool -- True <=> Simplify const insts
233 -> (TcTyVar s -> Bool) -- Free tyvar predicate
236 -> TcM s (LIE s, -- Free
237 TcDictBinds s, -- Bindings
238 LIE s -- Remaining wanteds; no dups;
239 -- dicts only (no Methods)
243 The bindings returned may mention any or all of ``givens'', so the
244 order in which the generated binds are put together is {\em tricky}.
245 Case~4 of @try@ is the general case to see.
247 When we do @eTC givens (wanted:wanteds)@ [some details omitted], we...
249 (1) first look up @wanted@; this gives us one binding to heave in:
252 (2) step (1) also gave us some @simpler_wanteds@; we simplify
253 these and get some (simpler-wanted-)bindings {\em that must be
254 in scope} for the @wanted=rhs@ binding above!
256 (3) we simplify the remaining @wanteds@ (recursive call), giving
257 us yet more bindings.
259 The final arrangement of the {\em non-recursive} bindings is
261 let <simpler-wanted-binds> in
263 let <yet-more-bindings> ...
266 elimTyCons squash_consts is_free_tv givens wanteds
267 = eTC givens (bagToList wanteds) `thenTc` \ (_, free, binds, irreds) ->
268 returnTc (free,binds,irreds)
270 -- eTC :: LIE s -> [Inst s]
271 -- -> TcM s (LIE s, LIE s, TcDictBinds s, LIE s)
273 eTC givens [] = returnTc (givens, emptyBag, EmptyMonoBinds, emptyBag)
275 eTC givens (wanted:wanteds)
276 -- Case 0: same as an existing inst
277 | maybeToBool maybe_equiv
278 = eTC givens wanteds `thenTc` \ (givens1, frees, binds, irreds) ->
280 -- Create a new binding iff it's needed
281 this = expectJust "eTC" maybe_equiv
282 new_binds | instBindingRequired wanted = (VarMonoBind (instToId wanted) (HsVar (instToId this)))
286 returnTc (givens1, frees, new_binds, irreds)
288 -- Case 1: constrains no type variables at all
289 -- In this case we have a quick go to see if it has an
290 -- instance which requires no inputs (ie a constant); if so we use
291 -- it; if not, we give up on the instance and just heave it out the
292 -- top in the free result
293 | isEmptyTyVarSet tvs_of_wanted
294 = simplify_it squash_consts {- If squash_consts is false,
295 simplify only if trival -}
296 givens wanted wanteds
298 -- Case 2: constrains free vars only, so fling it out the top in free_ids
299 | all is_free_tv (tyVarSetToList tvs_of_wanted)
300 = eTC (wanted `consBag` givens) wanteds `thenTc` \ (givens1, frees, binds, irreds) ->
301 returnTc (givens1, wanted `consBag` frees, binds, irreds)
303 -- Case 3: is a dict constraining only a tyvar,
304 -- so return it as part of the "wanteds" result
306 = eTC (wanted `consBag` givens) wanteds `thenTc` \ (givens1, frees, binds, irreds) ->
307 returnTc (givens1, frees, binds, wanted `consBag` irreds)
309 -- Case 4: is not a simple dict, so look up in instance environment
311 = simplify_it True {- Simplify even if not trivial -}
312 givens wanted wanteds
314 tvs_of_wanted = tyVarsOfInst wanted
316 -- Look for something in "givens" that matches "wanted"
317 Just the_equiv = maybe_equiv
318 maybe_equiv = foldBag seqMaybe try Nothing givens
319 try given | wanted `matchesInst` given = Just given
320 | otherwise = Nothing
323 simplify_it simplify_always givens wanted wanteds
324 -- Recover immediately on no-such-instance errors
325 = recoverTc (returnTc (wanted `consBag` givens, emptyLIE, EmptyMonoBinds, emptyLIE))
326 (simplify_one simplify_always givens wanted)
327 `thenTc` \ (givens1, frees1, binds1, irreds1) ->
328 eTC givens1 wanteds `thenTc` \ (givens2, frees2, binds2, irreds2) ->
329 returnTc (givens2, frees1 `plusLIE` frees2,
330 binds1 `AndMonoBinds` binds2,
331 irreds1 `plusLIE` irreds2)
334 simplify_one simplify_always givens wanted
335 | not (instBindingRequired wanted)
336 = -- No binding required for this chap, so squash right away
337 lookupInst wanted `thenTc` \ (simpler_wanteds, _) ->
338 eTC givens simpler_wanteds `thenTc` \ (givens1, frees1, binds1, irreds1) ->
339 returnTc (wanted `consBag` givens1, frees1, binds1, irreds1)
342 = -- An binding is required for this inst
343 lookupInst wanted `thenTc` \ (simpler_wanteds, bind@(VarMonoBind _ rhs)) ->
345 if (not_var rhs && not simplify_always) then
346 -- Ho ho! It isn't trivial to simplify "wanted",
347 -- because the rhs isn't a simple variable. Unless the flag
348 -- simplify_always is set, just give up now and
349 -- just fling it out the top.
350 returnTc (wanted `consLIE` givens, unitLIE wanted, EmptyMonoBinds, emptyLIE)
352 -- Aha! Either it's easy, or simplify_always is True
353 -- so we must do it right here.
354 eTC givens simpler_wanteds `thenTc` \ (givens1, frees1, binds1, irreds1) ->
355 returnTc (wanted `consLIE` givens1, frees1,
356 binds1 `AndMonoBinds` bind,
359 not_var :: TcExpr s -> Bool
360 not_var (HsVar _) = False
365 %************************************************************************
367 \subsection[elimSCs]{@elimSCs@}
369 %************************************************************************
372 elimSCs :: LIE s -- Given; no dups
373 -> LIE s -- Wanted; no dups; all dictionaries, all
374 -- constraining just a type variable
375 -> NF_TcM s (TcDictBinds s, -- Bindings
376 LIE s) -- Minimal wanted set
378 elimSCs givens wanteds
379 = -- Sort the wanteds so that subclasses occur before superclasses
381 (filterBag isDict givens) -- Filter out non-dictionaries
384 elimSCs_help :: LIE s -- Given; no dups
385 -> [Inst s] -- Wanted; no dups;
386 -> NF_TcM s (TcDictBinds s, -- Bindings
387 LIE s) -- Minimal wanted set
389 elimSCs_help given [] = returnNF_Tc (EmptyMonoBinds, emptyLIE)
391 elimSCs_help givens (wanted:wanteds)
392 = trySC givens wanted `thenNF_Tc` \ (givens1, binds1, irreds1) ->
393 elimSCs_help givens1 wanteds `thenNF_Tc` \ (binds2, irreds2) ->
394 returnNF_Tc (binds1 `AndMonoBinds` binds2, irreds1 `plusLIE` irreds2)
397 trySC :: LIE s -- Givens
399 -> NF_TcM s (LIE s, -- New givens,
400 TcDictBinds s, -- Bindings
401 LIE s) -- Irreducible wanted set
403 trySC givens wanted@(Dict _ wanted_class wanted_ty wanted_orig loc)
404 | not (maybeToBool maybe_best_subclass_chain)
405 = -- No superclass relationship
406 returnNF_Tc ((wanted `consLIE` givens), EmptyMonoBinds, unitLIE wanted)
409 = -- There's a subclass relationship with a "given"
410 -- Build intermediate dictionaries
412 theta = [ (clas, wanted_ty) | clas <- reverse classes ]
413 -- The reverse is because the list comes back in the "wrong" order I think
415 newDictsAtLoc wanted_orig loc theta `thenNF_Tc` \ (intermediates, _) ->
417 -- Create bindings for the wanted dictionary and the intermediates.
418 -- Later binds may depend on earlier ones, so each new binding is pushed
419 -- on the front of the accumulating parameter list of bindings
421 mk_bind (dict,clas) dict_sub@(Dict _ dict_sub_class ty _ _)
422 = ((dict_sub, dict_sub_class),
423 (VarMonoBind (instToId dict)
424 (DictApp (TyApp (HsVar (RealId (classSuperDictSelId dict_sub_class
427 [instToId dict_sub])))
428 (_, new_binds) = mapAccumR mk_bind (wanted,wanted_class) (given : intermediates)
430 returnNF_Tc (wanted `consLIE` givens `plusLIE` listToBag intermediates,
431 andMonoBinds new_binds,
435 maybe_best_subclass_chain = foldBag choose_best find_subclass_chain Nothing givens
436 Just (given, classes, _) = maybe_best_subclass_chain
438 choose_best c1@(Just (_,_,n1)) c2@(Just (_,_,n2)) | n1 <= n2 = c1
440 choose_best Nothing c2 = c2
441 choose_best c1 Nothing = c1
443 find_subclass_chain given@(Dict _ given_class given_ty _ _)
444 | wanted_ty `eqSimpleTy` given_ty
445 = case (wanted_class `isSuperClassOf` given_class) of
447 Just classes -> Just (given,
453 | otherwise = Nothing
456 sortSC :: LIE s -- Expected to be all dicts (no MethodIds), all of
457 -- which constrain type variables
458 -> [Inst s] -- Sorted with subclasses before superclasses
460 sortSC dicts = sortLt lt (bagToList dicts)
462 (Dict _ c1 ty1 _ _) `lt` (Dict _ c2 ty2 _ _)
463 = maybeToBool (c2 `isSuperClassOf` c1)
464 -- The ice is a bit thin here because this "lt" isn't a total order
465 -- But it *is* transitive, so it works ok
469 %************************************************************************
471 \subsection[simple]{@Simple@ versions}
473 %************************************************************************
475 Much simpler versions when there are no bindings to make!
477 @tcSimplifyThetas@ simplifies class-type constraints formed by
478 @deriving@ declarations and when specialising instances. We are
479 only interested in the simplified bunch of class/type constraints.
482 tcSimplifyThetas :: (Class -> ClassInstEnv) -- How to find the ClassInstEnv
483 -> [(Class, TauType)] -- Given
484 -> [(Class, TauType)] -- Wanted
485 -> TcM s [(Class, TauType)]
488 tcSimplifyThetas inst_mapper given wanted
489 = elimTyConsSimple inst_mapper wanted `thenTc` \ wanted1 ->
490 returnTc (elimSCsSimple given wanted1)
493 @tcSimplifyCheckThetas@ just checks class-type constraints, essentially;
494 used with \tr{default} declarations. We are only interested in
495 whether it worked or not.
498 tcSimplifyCheckThetas :: [(Class, TauType)] -- Simplify this to nothing at all
501 tcSimplifyCheckThetas theta
502 = elimTyConsSimple classInstEnv theta `thenTc` \ theta1 ->
503 ASSERT( null theta1 )
509 elimTyConsSimple :: (Class -> ClassInstEnv)
511 -> TcM s [(Class,Type)]
512 elimTyConsSimple inst_mapper theta
515 elim [] = returnTc []
516 elim ((clas,ty):rest) = elim_one clas ty `thenTc` \ r1 ->
517 elim rest `thenTc` \ r2 ->
521 = case getTyVar_maybe ty of
523 Just tv -> returnTc [(clas,ty)]
525 otherwise -> recoverTc (returnTc []) $
526 lookupSimpleInst (inst_mapper clas) clas ty `thenTc` \ theta ->
529 elimSCsSimple :: [(Class,Type)] -- Given
530 -> [(Class,Type)] -- Wanted
531 -> [(Class,Type)] -- Subset of wanted; no dups, no subclass relnships
533 elimSCsSimple givens [] = []
534 elimSCsSimple givens (c_t@(clas,ty) : rest)
535 | any (`subsumes` c_t) givens ||
536 any (`subsumes` c_t) rest -- (clas,ty) is old hat
537 = elimSCsSimple givens rest
538 | otherwise -- (clas,ty) is new
539 = c_t : elimSCsSimple (c_t : givens) rest
541 rest' = elimSCsSimple rest
542 (c1,t1) `subsumes` (c2,t2) = t1 `eqSimpleTy` t2 &&
543 (c1 == c2 || maybeToBool (c2 `isSuperClassOf` c1))
544 -- We deal with duplicates here ^^^^^^^^
545 -- It's a simple place to do it, although it's done in elimTyCons in the
546 -- full-blown version of the simpifier.
549 %************************************************************************
551 \subsection[binds-for-local-funs]{@bindInstsOfLocalFuns@}
553 %************************************************************************
555 When doing a binding group, we may have @Insts@ of local functions.
556 For example, we might have...
558 let f x = x + 1 -- orig local function (overloaded)
559 f.1 = f Int -- two instances of f
564 The point is: we must drop the bindings for @f.1@ and @f.2@ here,
565 where @f@ is in scope; those @Insts@ must certainly not be passed
566 upwards towards the top-level. If the @Insts@ were binding-ified up
567 there, they would have unresolvable references to @f@.
569 We pass in an @init_lie@ of @Insts@ and a list of locally-bound @Ids@.
570 For each method @Inst@ in the @init_lie@ that mentions one of the
571 @Ids@, we create a binding. We return the remaining @Insts@ (in an
572 @LIE@), as well as the @HsBinds@ generated.
575 bindInstsOfLocalFuns :: LIE s -> [TcIdBndr s] -> TcM s (LIE s, TcMonoBinds s)
577 bindInstsOfLocalFuns init_lie local_ids
578 = foldrTc bind_inst (emptyBag, EmptyMonoBinds) (bagToList init_lie)
580 bind_inst inst@(Method uniq (TcId id) tys rho orig loc) (insts, binds)
581 | id `is_elem` local_ids
582 = lookupInst inst `thenTc` \ (dict_insts, bind) ->
583 returnTc (listToBag dict_insts `plusLIE` insts,
584 bind `AndMonoBinds` binds)
586 bind_inst some_other_inst (insts, binds)
587 -- Either not a method, or a method instance for an id not in local_ids
588 = returnTc (some_other_inst `consBag` insts, binds)
590 is_elem = isIn "bindInstsOfLocalFuns"
594 %************************************************************************
596 \section[Disambig]{Disambiguation of overloading}
598 %************************************************************************
601 If a dictionary constrains a type variable which is
604 not mentioned in the environment
606 and not mentioned in the type of the expression
608 then it is ambiguous. No further information will arise to instantiate
609 the type variable; nor will it be generalised and turned into an extra
610 parameter to a function.
612 It is an error for this to occur, except that Haskell provided for
613 certain rules to be applied in the special case of numeric types.
618 at least one of its classes is a numeric class, and
620 all of its classes are numeric or standard
622 then the type variable can be defaulted to the first type in the
623 default-type list which is an instance of all the offending classes.
625 So here is the function which does the work. It takes the ambiguous
626 dictionaries and either resolves them (producing bindings) or
627 complains. It works by splitting the dictionary list by type
628 variable, and using @disambigOne@ to do the real business.
630 IMPORTANT: @disambiguate@ assumes that its argument dictionaries
631 constrain only a simple type variable.
634 type SimpleDictInfo s = (Inst s, Class, TcTyVar s)
636 disambiguateDicts :: LIE s -> TcM s ()
638 disambiguateDicts insts
639 = mapTc disambigOne inst_infos `thenTc` \ binds_lists ->
642 inst_infos = equivClasses cmp_tyvars (map mk_inst_info (bagToList insts))
643 (_,_,tv1) `cmp_tyvars` (_,_,tv2) = tv1 `cmp` tv2
645 mk_inst_info dict@(Dict _ clas ty _ _)
646 = (dict, clas, getTyVar "disambiguateDicts" ty)
649 @disambigOne@ assumes that its arguments dictionaries constrain all
650 the same type variable.
652 ADR Comment 20/6/94: I've changed the @CReturnable@ case to default to
653 @()@ instead of @Int@. I reckon this is the Right Thing to do since
654 the most common use of defaulting is code like:
656 _ccall_ foo `seqPrimIO` bar
658 Since we're not using the result of @foo@, the result if (presumably)
662 disambigOne :: [SimpleDictInfo s] -> TcM s ()
664 disambigOne dict_infos
665 | any isNumericClass classes && all isStandardClass classes
666 = -- THE DICTS OBEY THE DEFAULTABLE CONSTRAINT
667 -- SO, TRY DEFAULT TYPES IN ORDER
669 -- Failure here is caused by there being no type in the
670 -- default list which can satisfy all the ambiguous classes.
671 -- For example, if Real a is reqd, but the only type in the
672 -- default list is Int.
673 tcGetDefaultTys `thenNF_Tc` \ default_tys ->
675 try_default [] -- No defaults work, so fail
676 = failTc (ambigErr dicts)
678 try_default (default_ty : default_tys)
679 = tryTc (try_default default_tys) $ -- If default_ty fails, we try
680 -- default_tys instead
681 tcSimplifyCheckThetas thetas `thenTc` \ _ ->
684 thetas = classes `zip` repeat default_ty
686 -- See if any default works, and if so bind the type variable to it
687 try_default default_tys `thenTc` \ chosen_default_ty ->
688 tcInstType [] chosen_default_ty `thenNF_Tc` \ chosen_default_tc_ty -> -- Tiresome!
689 unifyTauTy chosen_default_tc_ty (mkTyVarTy tyvar)
691 | all isCcallishClass classes
692 = -- Default CCall stuff to (); we don't even both to check that () is an
693 -- instance of CCallable/CReturnable, because we know it is.
694 unifyTauTy (mkTyVarTy tyvar) unitTy
696 | otherwise -- No defaults
697 = failTc (ambigErr dicts)
700 (_,_,tyvar) = head dict_infos -- Should be non-empty
701 dicts = [dict | (dict,_,_) <- dict_infos]
702 classes = [clas | (_,clas,_) <- dict_infos]
710 ToDo: for these error messages, should we note the location as coming
711 from the insts, or just whatever seems to be around in the monad just
715 genCantGenErr insts sty -- Can't generalise these Insts
716 = hang (ptext SLIT("Cannot generalise these overloadings (in a _ccall_):"))
717 4 (vcat (map (ppr sty) (bagToList insts)))
722 = vcat (map (pprInst sty "Ambiguous overloading") insts)
725 @reduceErr@ complains if we can't express required dictionaries in
726 terms of the signature.
730 = vcat (map (pprInst sty "Context required by inferred type, but missing on a type signature")