| ... |
... |
@@ -288,10 +288,11 @@ Wrinkles |
|
288
|
288
|
|
|
289
|
289
|
(ATF3) What about foralls? For example, supppose we are unifying
|
|
290
|
290
|
(forall a. F a) -> (forall a. F a)
|
|
291
|
|
- Those two (F a) types are unrelated, bound by different foralls.
|
|
|
291
|
+ against some other type. Those two (F a) types are unrelated, bound by
|
|
|
292
|
+ different foralls; we cannot extend the um_fam_env with a binding [F a :-> blah]
|
|
292
|
293
|
|
|
293
|
294
|
So to keep things simple, the entire family-substitution machinery is used
|
|
294
|
|
- only if there are no enclosing foralls (see the (um_foralls env)) check in
|
|
|
295
|
+ only if there are no enclosing foralls (see the `under_forall` check in
|
|
295
|
296
|
`uSatFamApp`). That's fine, because the apartness business is used only for
|
|
296
|
297
|
reducing type-family applications, and class instances, and their arguments
|
|
297
|
298
|
can't have foralls anyway.
|
| ... |
... |
@@ -329,6 +330,8 @@ Wrinkles |
|
329
|
330
|
instance (Generic1 f, Ord (Rep1 f a))
|
|
330
|
331
|
=> Ord (Generically1 f a) where ...
|
|
331
|
332
|
-- The "..." gives rise to [W] Ord (Generically1 f a)
|
|
|
333
|
+ where Rep1 is a type family.
|
|
|
334
|
+
|
|
332
|
335
|
We must use the instance decl (recursively) to simplify the [W] constraint;
|
|
333
|
336
|
we do /not/ want to worry that the `[G] Ord (Rep1 f a)` might be an
|
|
334
|
337
|
alternative path. So `noMatchableGivenDicts` must return False;
|
| ... |
... |
@@ -336,6 +339,12 @@ Wrinkles |
|
336
|
339
|
`DontBindMe`, the unifier must return `SurelyApart`, not `MaybeApart`. See
|
|
337
|
340
|
`go` in `uVarOrFam`
|
|
338
|
341
|
|
|
|
342
|
+ This looks a bit sketchy, because they aren't SurelyApart, but see
|
|
|
343
|
+ Note [What might equal later?] in GHC.Tc.Utils.Unify, esp "Red Herring".
|
|
|
344
|
+
|
|
|
345
|
+ If we are under a forall, we return `MaybeApart`; that seems more conservative,
|
|
|
346
|
+ and class constraints are on tau-types so it doesn't matter.
|
|
|
347
|
+
|
|
339
|
348
|
(ATF6) When /matching/ can we ever have a type-family application on the LHS, in
|
|
340
|
349
|
the template? You might think not, because type-class-instance and
|
|
341
|
350
|
type-family-instance heads can't include type families. E.g.
|
| ... |
... |
@@ -344,12 +353,12 @@ Wrinkles |
|
344
|
353
|
But you'd be wrong: even when matching, we can see type families in the LHS template:
|
|
345
|
354
|
* In `checkValidClass`, in `check_dm` we check that the default method has the
|
|
346
|
355
|
right type, using matching, both ways. And that type may have type-family
|
|
347
|
|
- applications in it. Example in test CoOpt_Singletons.
|
|
|
356
|
+ applications in it. Examples in test CoOpt_Singletons and T26457.
|
|
348
|
357
|
|
|
349
|
358
|
* In the specialiser: see the call to `tcMatchTy` in
|
|
350
|
359
|
`GHC.Core.Opt.Specialise.beats_or_same`
|
|
351
|
360
|
|
|
352
|
|
- * With -fpolymorphic-specialsation, we might get a specialiation rule like
|
|
|
361
|
+ * With -fpolymorphic-specialisation, we might get a specialiation rule like
|
|
353
|
362
|
RULE forall a (d :: Eq (Maybe (F a))) .
|
|
354
|
363
|
f @(Maybe (F a)) d = ...
|
|
355
|
364
|
See #25965.
|
| ... |
... |
@@ -362,7 +371,7 @@ Wrinkles |
|
362
|
371
|
type variables/ that makes the match work. So we simply want to recurse into
|
|
363
|
372
|
the arguments of the type family. E.g.
|
|
364
|
373
|
Template: forall a. Maybe (F a)
|
|
365
|
|
- Target: Mabybe (F Int)
|
|
|
374
|
+ Target: Maybe (F Int)
|
|
366
|
375
|
We want to succeed with substitution [a :-> Int]. See (ATF9).
|
|
367
|
376
|
|
|
368
|
377
|
Conclusion: where we enter via `tcMatchTy`, `tcMatchTys`, `tc_match_tys`,
|
| ... |
... |
@@ -378,10 +387,10 @@ Wrinkles |
|
378
|
387
|
type family G6 a = r | r -> a
|
|
379
|
388
|
type instance G6 [a] = [G a]
|
|
380
|
389
|
type instance G6 Bool = Int
|
|
381
|
|
- and suppose we haev a Wanted constraint
|
|
|
390
|
+ and suppose we have a Wanted constraint
|
|
382
|
391
|
[W] G6 alpha ~ [Int]
|
|
383
|
|
-. According to Section 5.2 of "Injective type families for Haskell", we /match/
|
|
384
|
|
- the RHS each type instance [Int]. So we try
|
|
|
392
|
+ According to Section 5.2 of "Injective type families for Haskell", we /match/
|
|
|
393
|
+ the RHS each of type instance with [Int]. So we try
|
|
385
|
394
|
Template: [G a] Target: [Int]
|
|
386
|
395
|
and we want to succeed with MaybeApart, so that we can generate the improvement
|
|
387
|
396
|
constraint
|
| ... |
... |
@@ -401,15 +410,21 @@ Wrinkles |
|
401
|
410
|
|
|
402
|
411
|
(ATF9) Decomposition. Consider unifying
|
|
403
|
412
|
F a ~ F Int
|
|
404
|
|
- There is a unifying substitition [a :-> Int], and we want to find it, returning
|
|
405
|
|
- Unifiable. (Remember, this is the Core unifier -- we are not doing type inference.)
|
|
406
|
|
- So we should decompose to get (a ~ Int)
|
|
|
413
|
+ when `um_bind_fam_fun` says DontBindMe. There is a unifying substitition [a :-> Int],
|
|
|
414
|
+ and we want to find it, returning Unifiable. Why?
|
|
|
415
|
+ - Remember, this is the Core unifier -- we are not doing type inference
|
|
|
416
|
+ - When we have two equal types, like F a ~ F a, it is ridiculous to say that they
|
|
|
417
|
+ are MaybeApart. Example: the two-way tcMatchTy in `checkValidClass` and #26457.
|
|
407
|
418
|
|
|
408
|
|
- But consider unifying
|
|
|
419
|
+ (ATF9-1) But consider unifying
|
|
409
|
420
|
F Int ~ F Bool
|
|
410
|
|
- Although Int and Bool are SurelyApart, we must return MaybeApart for the outer
|
|
411
|
|
- unification. Hence the use of `don'tBeSoSure` in `go_fam_fam`; it leaves Unifiable
|
|
412
|
|
- alone, but weakens `SurelyApart` to `MaybeApart`.
|
|
|
421
|
+ Although Int and Bool are SurelyApart, we must return MaybeApart for the outer
|
|
|
422
|
+ unification. Hence the use of `don'tBeSoSure` in `go_fam_fam`; it leaves Unifiable
|
|
|
423
|
+ alone, but weakens `SurelyApart` to `MaybeApart`.
|
|
|
424
|
+
|
|
|
425
|
+ (ATF9-2) We want this decomposition to occur even under a forall (this was #26457).
|
|
|
426
|
+ E.g. (forall a. F Int) -> Int ~ (forall a. F Int) ~ Int
|
|
|
427
|
+
|
|
413
|
428
|
|
|
414
|
429
|
(ATF10) Injectivity. Consider (AFT9) where F is known to be injective. Then if we
|
|
415
|
430
|
are unifying
|
| ... |
... |
@@ -1815,6 +1830,9 @@ uVarOrFam env ty1 ty2 kco |
|
1815
|
1830
|
-- , text "fam_env" <+> ppr (um_fam_env substs) ]) $
|
|
1816
|
1831
|
; go NotSwapped substs ty1 ty2 kco }
|
|
1817
|
1832
|
where
|
|
|
1833
|
+ foralld_tvs = um_foralls env
|
|
|
1834
|
+ under_forall = not (isEmptyVarSet foralld_tvs)
|
|
|
1835
|
+
|
|
1818
|
1836
|
-- `go` takes two bites at the cherry; if the first one fails
|
|
1819
|
1837
|
-- it swaps the arguments and tries again; and then it fails.
|
|
1820
|
1838
|
-- The SwapFlag argument tells `go` whether it is on the first
|
| ... |
... |
@@ -1889,7 +1907,6 @@ uVarOrFam env ty1 ty2 kco |
|
1889
|
1907
|
| otherwise
|
|
1890
|
1908
|
= False
|
|
1891
|
1909
|
|
|
1892
|
|
- foralld_tvs = um_foralls env
|
|
1893
|
1910
|
occurs_check = um_unif env && uOccursCheck substs foralld_tvs lhs rhs
|
|
1894
|
1911
|
-- Occurs check, only when unifying
|
|
1895
|
1912
|
-- see Note [Infinitary substitutions]
|
| ... |
... |
@@ -1899,14 +1916,11 @@ uVarOrFam env ty1 ty2 kco |
|
1899
|
1916
|
-- LHS is a saturated type-family application
|
|
1900
|
1917
|
-- Invariant: ty2 is not a TyVarTy
|
|
1901
|
1918
|
go swapped substs lhs@(TyFamLHS tc1 tys1) ty2 kco
|
|
1902
|
|
- -- If we are under a forall, just give up and return MaybeApart
|
|
1903
|
|
- -- see (ATF3) in Note [Apartness and type families]
|
|
1904
|
|
- | not (isEmptyVarSet (um_foralls env))
|
|
1905
|
|
- = maybeApart MARTypeFamily
|
|
1906
|
|
-
|
|
1907
|
|
- -- We are not under any foralls, so the RnEnv2 is empty
|
|
1908
|
1919
|
-- Check if we have an existing substitution for the LHS; if so, recurse
|
|
1909
|
|
- | Just ty1' <- lookupFamEnv (um_fam_env substs) tc1 tys1
|
|
|
1920
|
+ -- But not under a forall; see (ATF3) in Note [Apartness and type families]
|
|
|
1921
|
+ -- Hence the RnEnv2 is empty
|
|
|
1922
|
+ | not under_forall
|
|
|
1923
|
+ , Just ty1' <- lookupFamEnv (um_fam_env substs) tc1 tys1
|
|
1910
|
1924
|
= if | um_unif env -> unify_ty env ty1' ty2 kco
|
|
1911
|
1925
|
-- Below here we are matching
|
|
1912
|
1926
|
-- The return () case deals with:
|
| ... |
... |
@@ -1917,11 +1931,19 @@ uVarOrFam env ty1 ty2 kco |
|
1917
|
1931
|
| otherwise -> maybeApart MARTypeFamily
|
|
1918
|
1932
|
|
|
1919
|
1933
|
-- Check for equality F tys1 ~ F tys2
|
|
|
1934
|
+ -- Very important that this can happen under a forall, so that we
|
|
|
1935
|
+ -- successfully match (forall a. F a) ~ (forall b. F b) See (ATF9-2)
|
|
1920
|
1936
|
| Just (tc2, tys2) <- isSatTyFamApp ty2
|
|
1921
|
1937
|
, tc1 == tc2
|
|
1922
|
1938
|
= go_fam_fam substs tc1 tys1 tys2 kco
|
|
1923
|
1939
|
|
|
|
1940
|
+ -- If we are under a forall, just give up
|
|
|
1941
|
+ -- see (ATF3) and (ATF5) in Note [Apartness and type families]
|
|
|
1942
|
+ | under_forall
|
|
|
1943
|
+ = maybeApart MARTypeFamily
|
|
|
1944
|
+
|
|
1924
|
1945
|
-- Now check if we can bind the (F tys) to the RHS
|
|
|
1946
|
+ -- Again, not under a forall; see (ATF3)
|
|
1925
|
1947
|
-- This can happen even when matching: see (ATF7)
|
|
1926
|
1948
|
| BindMe <- um_bind_fam_fun env tc1 tys1 rhs
|
|
1927
|
1949
|
= if uOccursCheck substs emptyVarSet lhs rhs
|
| ... |
... |
@@ -1935,6 +1957,7 @@ uVarOrFam env ty1 ty2 kco |
|
1935
|
1957
|
-- Maybe um_bind_fam_fun is False of (F a b) but true of (G c d e)
|
|
1936
|
1958
|
-- NB: a type family can appear on the template when matching
|
|
1937
|
1959
|
-- see (ATF6) in Note [Apartness and type families]
|
|
|
1960
|
+ -- Only worth doing this if we are no under a forall
|
|
1938
|
1961
|
| um_unif env
|
|
1939
|
1962
|
, NotSwapped <- swapped
|
|
1940
|
1963
|
, Just lhs2 <- canEqLHS_maybe ty2
|
| ... |
... |
@@ -1949,7 +1972,6 @@ uVarOrFam env ty1 ty2 kco |
|
1949
|
1972
|
-----------------------------
|
|
1950
|
1973
|
-- go_fam_fam: LHS and RHS are both saturated type-family applications,
|
|
1951
|
1974
|
-- for the same type-family F
|
|
1952
|
|
- -- Precondition: um_foralls is empty
|
|
1953
|
1975
|
go_fam_fam substs tc tys1 tys2 kco
|
|
1954
|
1976
|
-- Decompose (F tys1 ~ F tys2): (ATF9)
|
|
1955
|
1977
|
-- Use injectivity information of F: (ATF10)
|
| ... |
... |
@@ -1957,7 +1979,7 @@ uVarOrFam env ty1 ty2 kco |
|
1957
|
1979
|
= do { bind_fam_if_poss -- (ATF11)
|
|
1958
|
1980
|
; unify_tys env inj_tys1 inj_tys2 -- (ATF10)
|
|
1959
|
1981
|
; unless (um_inj_tf env) $ -- (ATF12)
|
|
1960
|
|
- don'tBeSoSure MARTypeFamily $ -- (ATF9)
|
|
|
1982
|
+ don'tBeSoSure MARTypeFamily $ -- (ATF9-1)
|
|
1961
|
1983
|
unify_tys env noninj_tys1 noninj_tys2 }
|
|
1962
|
1984
|
where
|
|
1963
|
1985
|
inj = case tyConInjectivityInfo tc of
|
| ... |
... |
@@ -1970,6 +1992,8 @@ uVarOrFam env ty1 ty2 kco |
|
1970
|
1992
|
bind_fam_if_poss
|
|
1971
|
1993
|
| not (um_unif env) -- Not when matching (ATF11-1)
|
|
1972
|
1994
|
= return ()
|
|
|
1995
|
+ | under_forall -- Not under a forall (ATF3)
|
|
|
1996
|
+ = return ()
|
|
1973
|
1997
|
| BindMe <- um_bind_fam_fun env tc tys1 rhs1
|
|
1974
|
1998
|
= unless (uOccursCheck substs emptyVarSet (TyFamLHS tc tys1) rhs1) $
|
|
1975
|
1999
|
extendFamEnv tc tys1 rhs1
|