TcSimplify.lhs 86.4 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3
4
5
%
\section[TcSimplify]{TcSimplify}

6
7
8


\begin{code}
9
module TcSimplify (
10
	tcSimplifyInfer, tcSimplifyInferCheck,
11
	tcSimplifyCheck, tcSimplifyRestricted,
12
	tcSimplifyRuleLhs, tcSimplifyIPs, 
13
	tcSimplifySuperClasses,
14
	tcSimplifyTop, tcSimplifyInteractive,
15
	tcSimplifyBracket,
16

17
	tcSimplifyDeriv, tcSimplifyDefault,
18
	bindInstsOfLocalFuns
19
20
    ) where

21
#include "HsVersions.h"
22

23
import {-# SOURCE #-} TcUnify( unifyType )
24
import HsSyn		( HsBind(..), HsExpr(..), LHsExpr, mkCoTyApps,
25
26
			  ExprCoFn(..), (<.>), nlHsTyApp, emptyLHsBinds )
import TcHsSyn		( mkHsApp )
27

28
import TcRnMonad
29
import Inst		( lookupInst, LookupInstResult(..),
30
			  tyVarsOfInst, fdPredsOfInsts,
31
			  isDict, isClassDict, isLinearInst, linearInstType,
32
			  isMethodFor, isMethod,
33
			  instToId, tyVarsOfInsts,  cloneDict,
34
			  ipNamesOfInsts, ipNamesOfInst, dictPred,
35
36
			  fdPredsOfInst, 
			  newDictBndrs, newDictBndrsO, tcInstClassOp,
37
38
			  getDictClassTys, isTyVarDict, instLoc,
			  zonkInst, tidyInsts, tidyMoreInsts,
39
			  pprInsts, pprDictsInFull, pprInstInFull, tcGetInstEnvs,
40
			  isInheritableInst, pprDictsTheta
sof's avatar
sof committed
41
			)
42
43
import TcEnv		( tcGetGlobalTyVars, tcLookupId, findGlobals, pprBinders,
			  lclEnvElts, tcMetaTy )
44
import InstEnv		( lookupInstEnv, classInstances, pprInstances )
45
import TcMType		( zonkTcTyVarsAndFV, tcInstTyVars, zonkTcPredType  )
46
import TcType		( TcTyVar, TcTyVarSet, ThetaType, TcPredType, tidyPred,
47
                          mkClassPred, isOverloadedTy, mkTyConApp, isSkolemTyVar,
48
			  mkTyVarTy, tcGetTyVar, isTyVarClassPred, mkTyVarTys,
49
			  tyVarsOfPred, tcEqType, pprPred, mkPredTy, tcIsTyVarTy )
50
import TcIface		( checkWiredInTyCon )
51
import Id		( idType, mkUserLocal )
52
import Var		( TyVar )
53
import TyCon		( TyCon )
54
import Name		( Name, getOccName, getSrcLoc )
55
import NameSet		( NameSet, mkNameSet, elemNameSet )
56
import Class		( classBigSig, classKey )
57
import FunDeps		( oclose, grow, improve, pprEquation )
58
import PrelInfo		( isNumericClass, isStandardClass ) 
59
60
import PrelNames	( splitName, fstName, sndName, integerTyConName,
			  showClassKey, eqClassKey, ordClassKey )
61
import Type		( zipTopTvSubst, substTheta, substTy )
62
import TysWiredIn	( pairTyCon, doubleTy, doubleTyCon )
63
import ErrUtils		( Message )
64
import BasicTypes	( TopLevelFlag, isNotTopLevel )
65
import VarSet
66
import VarEnv		( TidyEnv )
67
import FiniteMap
68
import Bag
69
import Outputable
70
import ListSetOps	( equivClasses )
71
import Util		( zipEqual, isSingleton )
72
import List		( partition )
73
import SrcLoc		( Located(..) )
74
import DynFlags		( DynFlags(ctxtStkDepth), 
75
76
			  DynFlag( Opt_GlasgowExts, Opt_AllowUndecidableInstances, 
			  Opt_WarnTypeDefaults, Opt_ExtendedDefaultRules ) )
77
78
79
80
81
\end{code}


%************************************************************************
%*									*
82
\subsection{NOTES}
83
84
85
%*									*
%************************************************************************

86
87
88
89
	--------------------------------------
	Notes on functional dependencies (a bug)
	--------------------------------------

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
Consider this:

	class C a b | a -> b
	class D a b | a -> b

	instance D a b => C a b	-- Undecidable 
				-- (Not sure if it's crucial to this eg)
	f :: C a b => a -> Bool
	f _ = True
	
	g :: C a b => a -> Bool
	g = f

Here f typechecks, but g does not!!  Reason: before doing improvement,
we reduce the (C a b1) constraint from the call of f to (D a b1).

Here is a more complicated example:

108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
| > class Foo a b | a->b
| >
| > class Bar a b | a->b
| >
| > data Obj = Obj
| >
| > instance Bar Obj Obj
| >
| > instance (Bar a b) => Foo a b
| >
| > foo:: (Foo a b) => a -> String
| > foo _ = "works"
| >
| > runFoo:: (forall a b. (Foo a b) => a -> w) -> w
| > runFoo f = f Obj
| 
| *Test> runFoo foo
| 
| <interactive>:1:
|     Could not deduce (Bar a b) from the context (Foo a b)
|       arising from use of `foo' at <interactive>:1
|     Probable fix:
|         Add (Bar a b) to the expected type of an expression
|     In the first argument of `runFoo', namely `foo'
|     In the definition of `it': it = runFoo foo
| 
| Why all of the sudden does GHC need the constraint Bar a b? The
| function foo didn't ask for that... 

The trouble is that to type (runFoo foo), GHC has to solve the problem:

	Given constraint	Foo a b
	Solve constraint	Foo a b'

Notice that b and b' aren't the same.  To solve this, just do
improvement and then they are the same.  But GHC currently does
	simplify constraints
	apply improvement
	and loop

That is usually fine, but it isn't here, because it sees that Foo a b is
not the same as Foo a b', and so instead applies the instance decl for
instance Bar a b => Foo a b.  And that's where the Bar constraint comes
from.

The Right Thing is to improve whenever the constraint set changes at
all.  Not hard in principle, but it'll take a bit of fiddling to do.  



158
	--------------------------------------
159
		Notes on quantification
160
	--------------------------------------
161
162
163
164
165
166

Suppose we are about to do a generalisation step.
We have in our hand

	G	the environment
	T	the type of the RHS
167
	C	the constraints from that RHS
168
169
170
171
172
173
174
175
176
177
178

The game is to figure out

	Q	the set of type variables over which to quantify
	Ct	the constraints we will *not* quantify over
	Cq	the constraints we will quantify over

So we're going to infer the type

	forall Q. Cq => T

179
and float the constraints Ct further outwards.
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217

Here are the things that *must* be true:

 (A)	Q intersect fv(G) = EMPTY			limits how big Q can be
 (B)	Q superset fv(Cq union T) \ oclose(fv(G),C)	limits how small Q can be

(A) says we can't quantify over a variable that's free in the
environment.  (B) says we must quantify over all the truly free
variables in T, else we won't get a sufficiently general type.  We do
not *need* to quantify over any variable that is fixed by the free
vars of the environment G.

	BETWEEN THESE TWO BOUNDS, ANY Q WILL DO!

Example:	class H x y | x->y where ...

	fv(G) = {a}	C = {H a b, H c d}
			T = c -> b

	(A)  Q intersect {a} is empty
	(B)  Q superset {a,b,c,d} \ oclose({a}, C) = {a,b,c,d} \ {a,b} = {c,d}

	So Q can be {c,d}, {b,c,d}

Other things being equal, however, we'd like to quantify over as few
variables as possible: smaller types, fewer type applications, more
constraints can get into Ct instead of Cq.


-----------------------------------------
We will make use of

  fv(T)	 	the free type vars of T

  oclose(vs,C)	The result of extending the set of tyvars vs
		using the functional dependencies from C

  grow(vs,C)	The result of extend the set of tyvars vs
218
		using all conceivable links from C.
219
220
221
222
223
224
225

		E.g. vs = {a}, C = {H [a] b, K (b,Int) c, Eq e}
		Then grow(vs,C) = {a,b,c}

		Note that grow(vs,C) `superset` grow(vs,simplify(C))
		That is, simplfication can only shrink the result of grow.

226
Notice that
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
   oclose is conservative one way:      v `elem` oclose(vs,C) => v is definitely fixed by vs
   grow is conservative the other way:  if v might be fixed by vs => v `elem` grow(vs,C)


-----------------------------------------

Choosing Q
~~~~~~~~~~
Here's a good way to choose Q:

	Q = grow( fv(T), C ) \ oclose( fv(G), C )

That is, quantify over all variable that that MIGHT be fixed by the
call site (which influences T), but which aren't DEFINITELY fixed by
G.  This choice definitely quantifies over enough type variables,
albeit perhaps too many.

Why grow( fv(T), C ) rather than fv(T)?  Consider

	class H x y | x->y where ...
247

248
249
250
251
252
253
254
	T = c->c
	C = (H c d)

  If we used fv(T) = {c} we'd get the type

	forall c. H c d => c -> b

255
  And then if the fn was called at several different c's, each of
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
  which fixed d differently, we'd get a unification error, because
  d isn't quantified.  Solution: quantify d.  So we must quantify
  everything that might be influenced by c.

Why not oclose( fv(T), C )?  Because we might not be able to see
all the functional dependencies yet:

	class H x y | x->y where ...
	instance H x y => Eq (T x y) where ...

	T = c->c
	C = (Eq (T c d))

  Now oclose(fv(T),C) = {c}, because the functional dependency isn't
  apparent yet, and that's wrong.  We must really quantify over d too.


There really isn't any point in quantifying over any more than
grow( fv(T), C ), because the call sites can't possibly influence
any other type variables.



simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
279
280
281
-------------------------------------
	Note [Ambiguity]
-------------------------------------
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320

It's very hard to be certain when a type is ambiguous.  Consider

	class K x
	class H x y | x -> y
	instance H x y => K (x,y)

Is this type ambiguous?
	forall a b. (K (a,b), Eq b) => a -> a

Looks like it!  But if we simplify (K (a,b)) we get (H a b) and
now we see that a fixes b.  So we can't tell about ambiguity for sure
without doing a full simplification.  And even that isn't possible if
the context has some free vars that may get unified.  Urgle!

Here's another example: is this ambiguous?
	forall a b. Eq (T b) => a -> a
Not if there's an insance decl (with no context)
	instance Eq (T b) where ...

You may say of this example that we should use the instance decl right
away, but you can't always do that:

	class J a b where ...
	instance J Int b where ...

	f :: forall a b. J a b => a -> a

(Notice: no functional dependency in J's class decl.)
Here f's type is perfectly fine, provided f is only called at Int.
It's premature to complain when meeting f's signature, or even
when inferring a type for f.



However, we don't *need* to report ambiguity right away.  It'll always
show up at the call site.... and eventually at main, which needs special
treatment.  Nevertheless, reporting ambiguity promptly is an excellent thing.

321
So here's the plan.  We WARN about probable ambiguity if
322
323
324
325
326

	fv(Cq) is not a subset of  oclose(fv(T) union fv(G), C)

(all tested before quantification).
That is, all the type variables in Cq must be fixed by the the variables
327
in the environment, or by the variables in the type.
328
329
330

Notice that we union before calling oclose.  Here's an example:

331
	class J a b c | a b -> c
332
333
334
	fv(G) = {a}

Is this ambiguous?
335
	forall b c. (J a b c) => b -> b
336
337

Only if we union {a} from G with {b} from T before using oclose,
338
do we see that c is fixed.
339

340
It's a bit vague exactly which C we should use for this oclose call.  If we
341
342
343
344
345
346
347
348
349
don't fix enough variables we might complain when we shouldn't (see
the above nasty example).  Nothing will be perfect.  That's why we can
only issue a warning.


Can we ever be *certain* about ambiguity?  Yes: if there's a constraint

	c in C such that fv(c) intersect (fv(G) union fv(T)) = EMPTY

350
then c is a "bubble"; there's no way it can ever improve, and it's
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
certainly ambiguous.  UNLESS it is a constant (sigh).  And what about
the nasty example?

	class K x
	class H x y | x -> y
	instance H x y => K (x,y)

Is this type ambiguous?
	forall a b. (K (a,b), Eq b) => a -> a

Urk.  The (Eq b) looks "definitely ambiguous" but it isn't.  What we are after
is a "bubble" that's a set of constraints

	Cq = Ca union Cq'  st  fv(Ca) intersect (fv(Cq') union fv(T) union fv(G)) = EMPTY

Hence another idea.  To decide Q start with fv(T) and grow it
by transitive closure in Cq (no functional dependencies involved).
Now partition Cq using Q, leaving the definitely-ambiguous and probably-ok.
369
The definitely-ambiguous can then float out, and get smashed at top level
370
371
372
(which squashes out the constants, like Eq (T a) above)


373
	--------------------------------------
374
		Notes on principal types
375
	--------------------------------------
376
377
378

    class C a where
      op :: a -> a
379

380
381
382
383
384
385
386
    f x = let g y = op (y::Int) in True

Here the principal type of f is (forall a. a->a)
but we'll produce the non-principal type
    f :: forall a. C Int => a -> a


387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
	--------------------------------------
	The need for forall's in constraints
	--------------------------------------

[Exchange on Haskell Cafe 5/6 Dec 2000]

  class C t where op :: t -> Bool
  instance C [t] where op x = True

  p y = (let f :: c -> Bool; f x = op (y >> return x) in f, y ++ [])
  q y = (y ++ [], let f :: c -> Bool; f x = op (y >> return x) in f)

The definitions of p and q differ only in the order of the components in
the pair on their right-hand sides.  And yet:

  ghc and "Typing Haskell in Haskell" reject p, but accept q;
  Hugs rejects q, but accepts p;
  hbc rejects both p and q;
  nhc98 ... (Malcolm, can you fill in the blank for us!).

The type signature for f forces context reduction to take place, and
the results of this depend on whether or not the type of y is known,
which in turn depends on which component of the pair the type checker
analyzes first.  

Solution: if y::m a, float out the constraints
	Monad m, forall c. C (m c)
When m is later unified with [], we can solve both constraints.


417
	--------------------------------------
418
		Notes on implicit parameters
419
	--------------------------------------
420

421
422
423
424
425
Question 1: can we "inherit" implicit parameters
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this:

	f x = (x::Int) + ?y
426

427
428
429
where f is *not* a top-level binding.
From the RHS of f we'll get the constraint (?y::Int).
There are two types we might infer for f:
430

431
432
433
	f :: Int -> Int

(so we get ?y from the context of f's definition), or
434
435
436

	f :: (?y::Int) => Int -> Int

437
438
439
440
441
442
At first you might think the first was better, becuase then
?y behaves like a free variable of the definition, rather than
having to be passed at each call site.  But of course, the WHOLE
IDEA is that ?y should be passed at each call site (that's what
dynamic binding means) so we'd better infer the second.

443
444
BOTTOM LINE: when *inferring types* you *must* quantify 
over implicit parameters. See the predicate isFreeWhenInferring.
445

446
447
448
449
450

Question 2: type signatures
~~~~~~~~~~~~~~~~~~~~~~~~~~~
BUT WATCH OUT: When you supply a type signature, we can't force you
to quantify over implicit parameters.  For example:
451
452
453
454
455
456
457
458
459
460
461

	(?x + 1) :: Int

This is perfectly reasonable.  We do not want to insist on

	(?x + 1) :: (?x::Int => Int)

That would be silly.  Here, the definition site *is* the occurrence site,
so the above strictures don't apply.  Hence the difference between
tcSimplifyCheck (which *does* allow implicit paramters to be inherited)
and tcSimplifyCheckBind (which does not).
462

463
464
465
What about when you supply a type signature for a binding?
Is it legal to give the following explicit, user type 
signature to f, thus:
466

467
	f :: Int -> Int
468
	f x = (x::Int) + ?y
469

470
At first sight this seems reasonable, but it has the nasty property
471
that adding a type signature changes the dynamic semantics.
472
Consider this:
473

474
	(let f x = (x::Int) + ?y
475
476
477
478
 	 in (f 3, f 3 with ?y=5))  with ?y = 6

		returns (3+6, 3+5)
vs
479
	(let f :: Int -> Int
480
	     f x = x + ?y
481
482
483
484
	 in (f 3, f 3 with ?y=5))  with ?y = 6

		returns (3+6, 3+6)

485
486
Indeed, simply inlining f (at the Haskell source level) would change the
dynamic semantics.
487

488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
Nevertheless, as Launchbury says (email Oct 01) we can't really give the
semantics for a Haskell program without knowing its typing, so if you 
change the typing you may change the semantics.

To make things consistent in all cases where we are *checking* against
a supplied signature (as opposed to inferring a type), we adopt the
rule: 

	a signature does not need to quantify over implicit params.

[This represents a (rather marginal) change of policy since GHC 5.02,
which *required* an explicit signature to quantify over all implicit
params for the reasons mentioned above.]

But that raises a new question.  Consider 

	Given (signature)	?x::Int
	Wanted (inferred)	?x::Int, ?y::Bool

Clearly we want to discharge the ?x and float the ?y out.  But
what is the criterion that distinguishes them?  Clearly it isn't
what free type variables they have.  The Right Thing seems to be
to float a constraint that
	neither mentions any of the quantified type variables
	nor any of the quantified implicit parameters

See the predicate isFreeWhenChecking.
515

516

517
518
519
Question 3: monomorphism
~~~~~~~~~~~~~~~~~~~~~~~~
There's a nasty corner case when the monomorphism restriction bites:
520

521
522
	z = (x::Int) + ?y

523
524
The argument above suggests that we *must* generalise
over the ?y parameter, to get
525
526
	z :: (?y::Int) => Int,
but the monomorphism restriction says that we *must not*, giving
527
	z :: Int.
528
529
530
531
532
533
534
535
Why does the momomorphism restriction say this?  Because if you have

	let z = x + ?y in z+z

you might not expect the addition to be done twice --- but it will if
we follow the argument of Question 2 and generalise over ?y.


536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
Question 4: top level
~~~~~~~~~~~~~~~~~~~~~
At the top level, monomorhism makes no sense at all.

    module Main where
	main = let ?x = 5 in print foo

	foo = woggle 3

	woggle :: (?x :: Int) => Int -> Int
	woggle y = ?x + y

We definitely don't want (foo :: Int) with a top-level implicit parameter
(?x::Int) becuase there is no way to bind it.  

551
552
553
554
555
556
557
558

Possible choices
~~~~~~~~~~~~~~~~
(A) Always generalise over implicit parameters
    Bindings that fall under the monomorphism restriction can't
	be generalised

    Consequences:
559
	* Inlining remains valid
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
	* No unexpected loss of sharing
	* But simple bindings like
		z = ?y + 1
	  will be rejected, unless you add an explicit type signature
	  (to avoid the monomorphism restriction)
		z :: (?y::Int) => Int
		z = ?y + 1
	  This seems unacceptable

(B) Monomorphism restriction "wins"
    Bindings that fall under the monomorphism restriction can't
	be generalised
    Always generalise over implicit parameters *except* for bindings
	that fall under the monomorphism restriction

    Consequences
	* Inlining isn't valid in general
	* No unexpected loss of sharing
	* Simple bindings like
		z = ?y + 1
	  accepted (get value of ?y from binding site)

(C) Always generalise over implicit parameters
    Bindings that fall under the monomorphism restriction can't
	be generalised, EXCEPT for implicit parameters
    Consequences
	* Inlining remains valid
	* Unexpected loss of sharing (from the extra generalisation)
	* Simple bindings like
		z = ?y + 1
	  accepted (get value of ?y from occurrence sites)


Discussion
~~~~~~~~~~
None of these choices seems very satisfactory.  But at least we should
decide which we want to do.
597

598
It's really not clear what is the Right Thing To Do.  If you see
599

600
	z = (x::Int) + ?y
601

602
603
604
605
606
607
would you expect the value of ?y to be got from the *occurrence sites*
of 'z', or from the valuue of ?y at the *definition* of 'z'?  In the
case of function definitions, the answer is clearly the former, but
less so in the case of non-fucntion definitions.   On the other hand,
if we say that we get the value of ?y from the definition site of 'z',
then inlining 'z' might change the semantics of the program.
608

609
Choice (C) really says "the monomorphism restriction doesn't apply
610
to implicit parameters".  Which is fine, but remember that every
611
612
613
innocent binding 'x = ...' that mentions an implicit parameter in
the RHS becomes a *function* of that parameter, called at each
use of 'x'.  Now, the chances are that there are no intervening 'with'
614
clauses that bind ?y, so a decent compiler should common up all
615
616
617
those function calls.  So I think I strongly favour (C).  Indeed,
one could make a similar argument for abolishing the monomorphism
restriction altogether.
618

619
BOTTOM LINE: we choose (B) at present.  See tcSimplifyRestricted
620

621

622

623
624
625
626
627
628
629
630
631
%************************************************************************
%*									*
\subsection{tcSimplifyInfer}
%*									*
%************************************************************************

tcSimplify is called when we *inferring* a type.  Here's the overall game plan:

    1. Compute Q = grow( fvs(T), C )
632
633

    2. Partition C based on Q into Ct and Cq.  Notice that ambiguous
634
       predicates will end up in Ct; we deal with them at the top level
635

636
    3. Try improvement, using functional dependencies
637

638
639
640
641
    4. If Step 3 did any unification, repeat from step 1
       (Unification can change the result of 'grow'.)

Note: we don't reduce dictionaries in step 2.  For example, if we have
642
Eq (a,b), we don't simplify to (Eq a, Eq b).  So Q won't be different
643
644
645
646
647
648
649
after step 2.  However note that we may therefore quantify over more
type variables than we absolutely have to.

For the guts, we need a loop, that alternates context reduction and
improvement with unification.  E.g. Suppose we have

	class C x y | x->y where ...
650

651
652
653
654
655
656
and tcSimplify is called with:
	(C Int a, C Int b)
Then improvement unifies a with b, giving
	(C Int a, C Int a)

If we need to unify anything, we rattle round the whole thing all over
657
again.
658

659
660

\begin{code}
661
tcSimplifyInfer
662
663
	:: SDoc
	-> TcTyVarSet		-- fv(T); type vars
664
	-> [Inst]		-- Wanted
665
666
667
	-> TcM ([TcTyVar],	-- Tyvars to quantify (zonked)
		TcDictBinds,	-- Bindings
		[TcId])		-- Dict Ids that must be bound here (zonked)
668
	-- Any free (escaping) Insts are tossed into the environment
669
\end{code}
670

671
672
673

\begin{code}
tcSimplifyInfer doc tau_tvs wanted_lie
674
  = inferLoop doc (varSetElems tau_tvs)
675
	      wanted_lie		`thenM` \ (qtvs, frees, binds, irreds) ->
676

677
678
    extendLIEs frees							`thenM_`
    returnM (qtvs, binds, map instToId irreds)
679
680
681

inferLoop doc tau_tvs wanteds
  =   	-- Step 1
682
683
684
    zonkTcTyVarsAndFV tau_tvs		`thenM` \ tau_tvs' ->
    mappM zonkInst wanteds		`thenM` \ wanteds' ->
    tcGetGlobalTyVars			`thenM` \ gbl_tvs ->
685
    let
686
 	preds = fdPredsOfInsts wanteds'
687
	qtvs  = grow preds tau_tvs' `minusVarSet` oclose preds gbl_tvs
688
689

	try_me inst
690
691
	  | isFreeWhenInferring qtvs inst = Free
	  | isClassDict inst 		  = DontReduceUnlessConstant	-- Dicts
692
	  | otherwise	    		  = ReduceMe NoSCs		-- Lits and Methods
693
    in
694
695
    traceTc (text "infloop" <+> vcat [ppr tau_tvs', ppr wanteds', ppr preds, 
				      ppr (grow preds tau_tvs'), ppr qtvs])	`thenM_`
696
		-- Step 2
697
    reduceContext doc try_me [] wanteds'    `thenM` \ (no_improvement, frees, binds, irreds) ->
698

699
700
		-- Step 3
    if no_improvement then
701
	returnM (varSetElems qtvs, frees, binds, irreds)
702
    else
703
704
705
706
707
708
709
710
711
712
713
714
	-- If improvement did some unification, we go round again.  There
	-- are two subtleties:
	--   a) We start again with irreds, not wanteds
	-- 	Using an instance decl might have introduced a fresh type variable
	--	which might have been unified, so we'd get an infinite loop
	--	if we started again with wanteds!  See example [LOOP]
	--
	--   b) It's also essential to re-process frees, because unification
	--      might mean that a type variable that looked free isn't now.
	--
	-- Hence the (irreds ++ frees)

715
716
717
	-- However, NOTICE that when we are done, we might have some bindings, but
	-- the final qtvs might be empty.  See [NO TYVARS] below.
				
718
	inferLoop doc tau_tvs (irreds ++ frees)	`thenM` \ (qtvs1, frees1, binds1, irreds1) ->
719
	returnM (qtvs1, frees1, binds `unionBags` binds1, irreds1)
720
\end{code}
721

722
723
724
725
726
727
728
729
730
731
732
733
734
Example [LOOP]

	class If b t e r | b t e -> r
	instance If T t e t
	instance If F t e e
	class Lte a b c | a b -> c where lte :: a -> b -> c
	instance Lte Z b T
	instance (Lte a b l,If l b a c) => Max a b c

Wanted:	Max Z (S x) y

Then we'll reduce using the Max instance to:
	(Lte Z (S x) l, If l (S x) Z y)
735
and improve by binding l->T, after which we can do some reduction
736
737
738
on both the Lte and If constraints.  What we *can't* do is start again
with (Max Z (S x) y)!

739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
[NO TYVARS]

	class Y a b | a -> b where
	    y :: a -> X b
	
	instance Y [[a]] a where
	    y ((x:_):_) = X x
	
	k :: X a -> X a -> X a

	g :: Num a => [X a] -> [X a]
	g xs = h xs
	    where
	    h ys = ys ++ map (k (y [[0]])) xs

The excitement comes when simplifying the bindings for h.  Initially
try to simplify {y @ [[t1]] t2, 0 @ t1}, with initial qtvs = {t2}.
From this we get t1:=:t2, but also various bindings.  We can't forget
the bindings (because of [LOOP]), but in fact t1 is what g is
758
759
760
polymorphic in.  

The net effect of [NO TYVARS] 
761

762
\begin{code}
763
764
isFreeWhenInferring :: TyVarSet -> Inst	-> Bool
isFreeWhenInferring qtvs inst
765
766
767
  =  isFreeWrtTyVars qtvs inst		-- Constrains no quantified vars
  && isInheritableInst inst		-- And no implicit parameter involved
					-- (see "Notes on implicit parameters")
768
769
770
771
772
773
774
775
776
777

isFreeWhenChecking :: TyVarSet	-- Quantified tyvars
	 	   -> NameSet	-- Quantified implicit parameters
		   -> Inst -> Bool
isFreeWhenChecking qtvs ips inst
  =  isFreeWrtTyVars qtvs inst
  && isFreeWrtIPs    ips inst

isFreeWrtTyVars qtvs inst = not (tyVarsOfInst inst `intersectsVarSet` qtvs)
isFreeWrtIPs     ips inst = not (any (`elemNameSet` ips) (ipNamesOfInst inst))
778
\end{code}
779

780

781
782
783
784
785
%************************************************************************
%*									*
\subsection{tcSimplifyCheck}
%*									*
%************************************************************************
786

787
@tcSimplifyCheck@ is used when we know exactly the set of variables
788
we are going to quantify over.  For example, a class or instance declaration.
789
790

\begin{code}
791
tcSimplifyCheck
792
	 :: SDoc
793
794
	 -> [TcTyVar]		-- Quantify over these
	 -> [Inst]		-- Given
795
796
	 -> [Inst]		-- Wanted
	 -> TcM TcDictBinds	-- Bindings
797

798
-- tcSimplifyCheck is used when checking expression type signatures,
799
-- class decls, instance decls etc.
800
801
802
803
--
-- NB: tcSimplifyCheck does not consult the
--	global type variables in the environment; so you don't
--	need to worry about setting them before calling tcSimplifyCheck
804
tcSimplifyCheck doc qtvs givens wanted_lie
805
806
807
808
  = ASSERT( all isSkolemTyVar qtvs )
    do	{ (qtvs', frees, binds) <- tcSimplCheck doc get_qtvs AddSCs givens wanted_lie
	; extendLIEs frees
	; return binds }
809
  where
810
811
--  get_qtvs = zonkTcTyVarsAndFV qtvs
    get_qtvs = return (mkVarSet qtvs)	-- All skolems
812
813
814
815
816
817


-- tcSimplifyInferCheck is used when we know the constraints we are to simplify
-- against, but we don't know the type variables over which we are going to quantify.
-- This happens when we have a type signature for a mutually recursive group
tcSimplifyInferCheck
818
	 :: SDoc
819
820
	 -> TcTyVarSet		-- fv(T)
	 -> [Inst]		-- Given
821
	 -> [Inst]		-- Wanted
822
823
824
825
	 -> TcM ([TcTyVar],	-- Variables over which to quantify
		 TcDictBinds)	-- Bindings

tcSimplifyInferCheck doc tau_tvs givens wanted_lie
826
827
828
  = do	{ (qtvs', frees, binds) <- tcSimplCheck doc get_qtvs AddSCs givens wanted_lie
	; extendLIEs frees
	; return (qtvs', binds) }
829
830
831
832
833
834
835
836
837
838
839
840
  where
	-- Figure out which type variables to quantify over
	-- You might think it should just be the signature tyvars,
	-- but in bizarre cases you can get extra ones
	-- 	f :: forall a. Num a => a -> a
	--	f x = fst (g (x, head [])) + 1
	--	g a b = (b,a)
	-- Here we infer g :: forall a b. a -> b -> (b,a)
	-- We don't want g to be monomorphic in b just because
	-- f isn't quantified over b.
    all_tvs = varSetElems (tau_tvs `unionVarSet` tyVarsOfInsts givens)

841
842
    get_qtvs = zonkTcTyVarsAndFV all_tvs	`thenM` \ all_tvs' ->
	       tcGetGlobalTyVars		`thenM` \ gbl_tvs ->
843
844
845
	       let
	          qtvs = all_tvs' `minusVarSet` gbl_tvs
			-- We could close gbl_tvs, but its not necessary for
846
			-- soundness, and it'll only affect which tyvars, not which
847
848
			-- dictionaries, we quantify over
	       in
849
	       returnM qtvs
850
851
852
853
\end{code}

Here is the workhorse function for all three wrappers.

854
\begin{code}
855
856
tcSimplCheck doc get_qtvs want_scs givens wanted_lie
  = do	{ (qtvs, frees, binds, irreds) <- check_loop givens wanted_lie
857

858
859
860
861
862
		-- Complain about any irreducible ones
	; if not (null irreds)
	  then do { givens' <- mappM zonkInst given_dicts_and_ips
		  ; groupErrs (addNoInstanceErrs (Just doc) givens') irreds }
	  else return ()
863

864
	; returnM (qtvs, frees, binds) }
865
  where
866
867
868
869
    given_dicts_and_ips = filter (not . isMethod) givens
	-- For error reporting, filter out methods, which are 
	-- only added to the given set as an optimisation

870
871
    ip_set = mkNameSet (ipNamesOfInsts givens)

872
873
    check_loop givens wanteds
      =		-- Step 1
874
875
    	mappM zonkInst givens	`thenM` \ givens' ->
    	mappM zonkInst wanteds	`thenM` \ wanteds' ->
876
    	get_qtvs 		`thenM` \ qtvs' ->
877

878
879
880
881
 		    -- Step 2
    	let
 	    -- When checking against a given signature we always reduce
 	    -- until we find a match against something given, or can't reduce
882
 	    try_me inst | isFreeWhenChecking qtvs' ip_set inst = Free
883
 			| otherwise  			       = ReduceMe want_scs
884
    	in
885
    	reduceContext doc try_me givens' wanteds'	`thenM` \ (no_improvement, frees, binds, irreds) ->
886

887
888
 		    -- Step 3
    	if no_improvement then
889
 	    returnM (varSetElems qtvs', frees, binds, irreds)
890
    	else
891
 	    check_loop givens' (irreds ++ frees) 	`thenM` \ (qtvs', frees1, binds1, irreds1) ->
892
 	    returnM (qtvs', frees1, binds `unionBags` binds1, irreds1)
893
894
895
\end{code}


896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
%************************************************************************
%*									*
		tcSimplifySuperClasses
%*									*
%************************************************************************

Note [SUPERCLASS-LOOP 1]
~~~~~~~~~~~~~~~~~~~~~~~~
We have to be very, very careful when generating superclasses, lest we
accidentally build a loop. Here's an example:

  class S a

  class S a => C a where { opc :: a -> a }
  class S b => D b where { opd :: b -> b }
  
  instance C Int where
     opc = opd
  
  instance D Int where
     opd = opc

From (instance C Int) we get the constraint set {ds1:S Int, dd:D Int}
Simplifying, we may well get:
	$dfCInt = :C ds1 (opd dd)
	dd  = $dfDInt
	ds1 = $p1 dd
Notice that we spot that we can extract ds1 from dd.  

Alas!  Alack! We can do the same for (instance D Int):

	$dfDInt = :D ds2 (opc dc)
	dc  = $dfCInt
	ds2 = $p1 dc

And now we've defined the superclass in terms of itself.

Solution: never generate a superclass selectors at all when
satisfying the superclass context of an instance declaration.

Two more nasty cases are in
	tcrun021
	tcrun033

\begin{code}
tcSimplifySuperClasses qtvs givens sc_wanteds
  = ASSERT( all isSkolemTyVar qtvs )
    do	{ (_, frees, binds1) <- tcSimplCheck doc get_qtvs NoSCs givens sc_wanteds
944
945
	; ext_default        <- doptM Opt_ExtendedDefaultRules
	; binds2	     <- tc_simplify_top doc ext_default NoSCs frees
946
947
948
949
950
951
952
	; return (binds1 `unionBags` binds2) }
  where
    get_qtvs = return (mkVarSet qtvs)
    doc = ptext SLIT("instance declaration superclass context")
\end{code}


953
954
955
956
957
958
%************************************************************************
%*									*
\subsection{tcSimplifyRestricted}
%*									*
%************************************************************************

959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
tcSimplifyRestricted infers which type variables to quantify for a 
group of restricted bindings.  This isn't trivial.

Eg1:	id = \x -> x
	We want to quantify over a to get id :: forall a. a->a
	
Eg2:	eq = (==)
	We do not want to quantify over a, because there's an Eq a 
	constraint, so we get eq :: a->a->Bool	(notice no forall)

So, assume:
	RHS has type 'tau', whose free tyvars are tau_tvs
	RHS has constraints 'wanteds'

Plan A (simple)
  Quantify over (tau_tvs \ ftvs(wanteds))
  This is bad. The constraints may contain (Monad (ST s))
  where we have 	instance Monad (ST s) where...
  so there's no need to be monomorphic in s!

  Also the constraint might be a method constraint,
  whose type mentions a perfectly innocent tyvar:
	  op :: Num a => a -> b -> a
  Here, b is unconstrained.  A good example would be
	foo = op (3::Int)
  We want to infer the polymorphic type
	foo :: forall b. b -> b


Plan B (cunning, used for a long time up to and including GHC 6.2)
  Step 1: Simplify the constraints as much as possible (to deal 
  with Plan A's problem).  Then set
	qtvs = tau_tvs \ ftvs( simplify( wanteds ) )

  Step 2: Now simplify again, treating the constraint as 'free' if 
  it does not mention qtvs, and trying to reduce it otherwise.
  The reasons for this is to maximise sharing.

  This fails for a very subtle reason.  Suppose that in the Step 2
  a constraint (Foo (Succ Zero) (Succ Zero) b) gets thrown upstairs as 'free'.
  In the Step 1 this constraint might have been simplified, perhaps to
  (Foo Zero Zero b), AND THEN THAT MIGHT BE IMPROVED, to bind 'b' to 'T'.
  This won't happen in Step 2... but that in turn might prevent some other
1002
1003
  constraint (Baz [a] b) being simplified (e.g. via instance Baz [a] T where {..}) 
  and that in turn breaks the invariant that no constraints are quantified over.
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015

  Test typecheck/should_compile/tc177 (which failed in GHC 6.2) demonstrates
  the problem.


Plan C (brutal)
  Step 1: Simplify the constraints as much as possible (to deal 
  with Plan A's problem).  Then set
	qtvs = tau_tvs \ ftvs( simplify( wanteds ) )
  Return the bindings from Step 1.
  

1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
A note about Plan C (arising from "bug" reported by George Russel March 2004)
Consider this:

      instance (HasBinary ty IO) => HasCodedValue ty

      foo :: HasCodedValue a => String -> IO a

      doDecodeIO :: HasCodedValue a => () -> () -> IO a
      doDecodeIO codedValue view  
        = let { act = foo "foo" } in  act

You might think this should work becuase the call to foo gives rise to a constraint
(HasCodedValue t), which can be satisfied by the type sig for doDecodeIO.  But the
restricted binding act = ... calls tcSimplifyRestricted, and PlanC simplifies the
constraint using the (rather bogus) instance declaration, and now we are stuffed.
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051

I claim this is not really a bug -- but it bit Sergey as well as George.  So here's
plan D


Plan D (a variant of plan B)
  Step 1: Simplify the constraints as much as possible (to deal 
  with Plan A's problem), BUT DO NO IMPROVEMENT.  Then set
	qtvs = tau_tvs \ ftvs( simplify( wanteds ) )

  Step 2: Now simplify again, treating the constraint as 'free' if 
  it does not mention qtvs, and trying to reduce it otherwise.

  The point here is that it's generally OK to have too few qtvs; that is,
  to make the thing more monomorphic than it could be.  We don't want to
  do that in the common cases, but in wierd cases it's ok: the programmer
  can always add a signature.  

  Too few qtvs => too many wanteds, which is what happens if you do less
  improvement.

1052

1053
1054
\begin{code}
tcSimplifyRestricted 	-- Used for restricted binding groups
1055
			-- i.e. ones subject to the monomorphism restriction
1056
	:: SDoc
1057
1058
	-> TopLevelFlag
	-> [Name]		-- Things bound in this group
1059
	-> TcTyVarSet		-- Free in the type of the RHSs
1060
	-> [Inst]		-- Free in the RHSs
1061
1062
	-> TcM ([TcTyVar],	-- Tyvars to quantify (zonked)
		TcDictBinds)	-- Bindings
1063
1064
1065
	-- tcSimpifyRestricted returns no constraints to
	-- quantify over; by definition there are none.
	-- They are all thrown back in the LIE
1066

1067
tcSimplifyRestricted doc top_lvl bndrs tau_tvs wanteds
1068
1069
1070
1071
	-- Zonk everything in sight
  = mappM zonkInst wanteds			`thenM` \ wanteds' ->

   	-- 'reduceMe': Reduce as far as we can.  Don't stop at
1072
1073
1074
1075
	-- dicts; the idea is to get rid of as many type
	-- variables as possible, and we don't want to stop
	-- at (say) Monad (ST s), because that reduces
	-- immediately, with no constraint on s.
1076
1077
	--
	-- BUT do no improvement!  See Plan D above
1078
1079
	-- HOWEVER, some unification may take place, if we instantiate
	-- 	    a method Inst with an equality constraint
1080
1081
    reduceContextWithoutImprovement 
	doc reduceMe wanteds' 		`thenM` \ (_frees, _binds, constrained_dicts) ->
1082
1083

	-- Next, figure out the tyvars we will quantify over
1084
1085
1086
    zonkTcTyVarsAndFV (varSetElems tau_tvs)	`thenM` \ tau_tvs' ->
    tcGetGlobalTyVars				`thenM` \ gbl_tvs' ->
    mappM zonkInst constrained_dicts		`thenM` \ constrained_dicts' ->
1087
    let
1088
1089
1090
	constrained_tvs' = tyVarsOfInsts constrained_dicts'
	qtvs' = (tau_tvs' `minusVarSet` oclose (fdPredsOfInsts constrained_dicts) gbl_tvs')
			 `minusVarSet` constrained_tvs'
1091
    in
1092
    traceTc (text "tcSimplifyRestricted" <+> vcat [
1093
		pprInsts wanteds, pprInsts _frees, pprInsts constrained_dicts',
1094
		ppr _binds,
1095
		ppr constrained_tvs', ppr tau_tvs', ppr qtvs' ])	`thenM_`
1096

1097
1098
1099
1100
	-- The first step may have squashed more methods than
	-- necessary, so try again, this time more gently, knowing the exact
	-- set of type variables to quantify over.
	--
1101
	-- We quantify only over constraints that are captured by qtvs';
1102
1103
1104
1105
1106
1107
1108
1109
	-- these will just be a subset of non-dicts.  This in contrast
	-- to normal inference (using isFreeWhenInferring) in which we quantify over
	-- all *non-inheritable* constraints too.  This implements choice
	-- (B) under "implicit parameter and monomorphism" above.
	--
	-- Remember that we may need to do *some* simplification, to
	-- (for example) squash {Monad (ST s)} into {}.  It's not enough
	-- just to float all constraints
1110
1111
1112
1113
1114
	--
	-- At top level, we *do* squash methods becuase we want to 
	-- expose implicit parameters to the test that follows
    let
	is_nested_group = isNotTopLevel top_lvl
1115
        try_me inst | isFreeWrtTyVars qtvs' inst,
1116
		      (is_nested_group || isDict inst) = Free
1117
	            | otherwise  		       = ReduceMe AddSCs
1118
    in
1119
1120
1121
    reduceContextWithoutImprovement 
	doc try_me wanteds' 		`thenM` \ (frees, binds, irreds) ->
    ASSERT( null irreds )
1122
1123
1124
1125

	-- See "Notes on implicit parameters, Question 4: top level"
    if is_nested_group then
	extendLIEs frees	`thenM_`
1126
        returnM (varSetElems qtvs', binds)
1127
1128
1129
1130
1131
1132
    else
	let
    	    (non_ips, bad_ips) = partition isClassDict frees
	in    
	addTopIPErrs bndrs bad_ips	`thenM_`
	extendLIEs non_ips		`thenM_`
1133
        returnM (varSetElems qtvs', binds)
1134
1135
\end{code}

1136
1137
1138

%************************************************************************
%*									*
1139
		tcSimplifyRuleLhs
1140
1141
1142
%*									*
%************************************************************************

1143
1144
1145
1146
On the LHS of transformation rules we only simplify methods and constants,
getting dictionaries.  We want to keep all of them unsimplified, to serve
as the available stuff for the RHS of the rule.

1147
1148
1149
Example.  Consider the following left-hand side of a rule
	
	f (x == y) (y > z) = ...
1150

1151
If we typecheck this expression we get constraints
1152

1153
	d1 :: Ord a, d2 :: Eq a
1154

1155
We do NOT want to "simplify" to the LHS
1156

1157
1158
	forall x::a, y::a, z::a, d1::Ord a.
	  f ((==) (eqFromOrd d1) x y) ((>) d1 y z) = ...
1159

1160
Instead we want	
1161

1162
1163
	forall x::a, y::a, z::a, d1::Ord a, d2::Eq a.
	  f ((==) d2 x y) ((>) d1 y z) = ...
1164

1165
Here is another example:
1166
1167
1168
1169

	fromIntegral :: (Integral a, Num b) => a -> b
	{-# RULES "foo"  fromIntegral = id :: Int -> Int #-}

1170
1171
In the rule, a=b=Int, and Num Int is a superclass of Integral Int. But
we *dont* want to get
1172
1173

	forall dIntegralInt.
1174
	   fromIntegral Int Int dIntegralInt (scsel dIntegralInt) = id Int
1175

1176
because the scsel will mess up RULE matching.  Instead we want
1177
1178

	forall dIntegralInt, dNumInt.
1179
	  fromIntegral Int Int dIntegralInt dNumInt = id Int
1180

1181
Even if we have 
1182

1183
	g (x == y) (y == z) = ..
1184

1185
where the two dictionaries are *identical*, we do NOT WANT
1186

1187
1188
1189
1190
1191
	forall x::a, y::a, z::a, d1::Eq a
	  f ((==) d1 x y) ((>) d1 y z) = ...

because that will only match if the dict args are (visibly) equal.
Instead we want to quantify over the dictionaries separately.
1192

1193
1194
1195
In short, tcSimplifyRuleLhs must *only* squash LitInst and MethInts, leaving
all dicts unchanged, with absolutely no sharing.  It's simpler to do this
from scratch, rather than further parameterise simpleReduceLoop etc
1196

1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
\begin{code}
tcSimplifyRuleLhs :: [Inst] -> TcM ([Inst], TcDictBinds)
tcSimplifyRuleLhs wanteds
  = go [] emptyBag wanteds
  where
    go dicts binds []
	= return (dicts, binds)
    go dicts binds (w:ws)
	| isDict w
	= go (w:dicts) binds ws
	| otherwise
	= do { w' <- zonkInst w  -- So that (3::Int) does not generate a call
				 -- to fromInteger; this looks fragile to me
	     ; lookup_result <- lookupInst w'
	     ; case lookup_result of
		 GenInst ws' rhs -> go dicts (addBind binds w rhs) (ws' ++ ws)
		 SimpleInst rhs  -> go dicts (addBind binds w rhs) ws
		 NoInstance	 -> pprPanic "tcSimplifyRuleLhs" (ppr w)
	  }
\end{code}
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227

tcSimplifyBracket is used when simplifying the constraints arising from
a Template Haskell bracket [| ... |].  We want to check that there aren't
any constraints that can't be satisfied (e.g. Show Foo, where Foo has no
Show instance), but we aren't otherwise interested in the results.
Nor do we care about ambiguous dictionaries etc.  We will type check
this bracket again at its usage site.

\begin{code}
tcSimplifyBracket :: [Inst] -> TcM ()
tcSimplifyBracket wanteds
1228
  = simpleReduceLoop doc reduceMe wanteds	`thenM_`
1229
1230
    returnM ()
  where
1231
    doc = text "tcSimplifyBracket"
1232
1233
1234
\end{code}


1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
%************************************************************************
%*									*
\subsection{Filtering at a dynamic binding}
%*									*
%************************************************************************

When we have
	let ?x = R in B

we must discharge all the ?x constraints from B.  We also do an improvement
1245
step; if we have ?x::t1 and ?x::t2 we must unify t1, t2.
1246
1247
1248
1249
1250
1251

Actually, the constraints from B might improve the types in ?x. For example

	f :: (?x::Int) => Char -> Char
	let ?x = 3 in f 'c'

1252
then the constraint (?x::Int) arising from the call to f will
1253
force the binding for ?x to be of type Int.
1254
1255

\begin{code}
1256
tcSimplifyIPs :: [Inst]		-- The implicit parameters bound here
1257
1258
1259
1260
1261
1262
	      -> [Inst]		-- Wanted
	      -> TcM TcDictBinds
tcSimplifyIPs given_ips wanteds
  = simpl_loop given_ips wanteds	`thenM` \ (frees, binds) ->
    extendLIEs frees			`thenM_`
    returnM binds
1263
  where
1264
1265
    doc	     = text "tcSimplifyIPs" <+> ppr given_ips
    ip_set   = mkNameSet (ipNamesOfInsts given_ips)
1266

1267
	-- Simplify any methods that mention the implicit parameter
1268
    try_me inst | isFreeWrtIPs ip_set inst = Free
1269
		| otherwise		   = ReduceMe NoSCs
1270
1271

    simpl_loop givens wanteds
1272
1273
      = mappM zonkInst givens		`thenM` \ givens' ->
        mappM zonkInst wanteds		`thenM` \ wanteds' ->
1274

1275
        reduceContext doc try_me givens' wanteds'    `thenM` \ (no_improvement, frees, binds, irreds) ->
1276
1277
1278

        if no_improvement then
	    ASSERT( null irreds )
1279
	    returnM (frees, binds)
1280
	else
1281
	    simpl_loop givens' (irreds ++ frees)	`thenM` \ (frees1, binds1) ->
1282
	    returnM (frees1, binds `unionBags` binds1)
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
\end{code}


%************************************************************************
%*									*
\subsection[binds-for-local-funs]{@bindInstsOfLocalFuns@}
%*									*
%************************************************************************

When doing a binding group, we may have @Insts@ of local functions.
For example, we might have...
\begin{verbatim}
let f x = x + 1	    -- orig local function (overloaded)
    f.1 = f Int	    -- two instances of f
    f.2 = f Float
 in
    (f.1 5, f.2 6.7)
\end{verbatim}
The point is: we must drop the bindings for @f.1@ and @f.2@ here,
where @f@ is in scope; those @Insts@ must certainly not be passed
upwards towards the top-level.	If the @Insts@ were binding-ified up
there, they would have unresolvable references to @f@.

We pass in an @init_lie@ of @Insts@ and a list of locally-bound @Ids@.
For each method @Inst@ in the @init_lie@ that mentions one of the
@Ids@, we create a binding.  We return the remaining @Insts@ (in an
@LIE@), as well as the @HsBinds@ generated.

\begin{code}
1312
1313
1314
1315
1316
1317
1318
bindInstsOfLocalFuns ::	[Inst] -> [TcId] -> TcM TcDictBinds
-- Simlifies only MethodInsts, and generate only bindings of form 
--	fm = f tys dicts
-- We're careful not to even generate bindings of the form
--	d1 = d2
-- You'd think that'd be fine, but it interacts with what is
-- arguably a bug in Match.tidyEqnInfo (see notes there)
1319

1320
bindInstsOfLocalFuns wanteds local_ids
1321
  | null overloaded_ids
1322
	-- Common case
1323
  = extendLIEs wanteds		`thenM_`
1324
    returnM emptyLHsBinds
1325
1326

  | otherwise
1327
  = simpleReduceLoop doc try_me for_me	`thenM` \ (frees, binds, irreds) ->
1328
    ASSERT( null irreds )
1329
    extendLIEs not_for_me	`thenM_`
1330
1331
    extendLIEs frees		`thenM_`
    returnM binds
1332
1333
1334
  where
    doc		     = text "bindInsts" <+> ppr local_ids
    overloaded_ids   = filter is_overloaded local_ids
1335
    is_overloaded id = isOverloadedTy (idType id)
1336
    (for_me, not_for_me) = partition (isMethodFor overloaded_set) wanteds
1337
1338

    overloaded_set = mkVarSet overloaded_ids	-- There can occasionally be a lot of them
1339
						-- so it's worth building a set, so that
1340
						-- lookup (in isMethodFor) is faster
1341
    try_me inst | isMethod inst = ReduceMe NoSCs
1342
		| otherwise	= Free
1343
\end{code}
1344

1345

1346
1347
%************************************************************************
%*									*
1348
\subsection{Data types for the reduction mechanism}
1349
1350
1351
%*									*
%************************************************************************

1352
1353
The main control over context reduction is here

1354
\begin{code}
1355
data WhatToDo
1356
 = ReduceMe WantSCs	-- Try to reduce this
1357
			-- If there's no instance, behave exactly like
1358
1359
			-- DontReduce: add the inst to the irreductible ones, 
			-- but don't produce an error message of any kind.
1360
			-- It might be quite legitimate such as (Eq a)!
1361

1362
1363
 | DontReduceUnlessConstant	-- Return as irreducible unless it can
				-- be reduced to a constant in one step
1364

1365
 | Free			  -- Return as free
1366

1367
reduceMe :: Inst -> WhatToDo
1368
reduceMe inst = ReduceMe AddSCs
1369

1370
1371
data WantSCs = NoSCs | AddSCs	-- Tells whether we should add the superclasses
				-- of a predicate when adding it to the avails
1372
1373
	-- The reason for this flag is entirely the super-class loop problem
	-- Note [SUPER-CLASS LOOP 1]
1374
\end{code}
1375
1376
1377
1378



\begin{code}
1379
type Avails = FiniteMap Inst Avail