[Git][ghc/ghc][wip/T25148] Yet more review comments
Ryan Scott (@RyanGlScott)
gitlab at gitlab.haskell.org
Tue Sep 24 12:13:37 UTC 2024
Ryan Scott pushed to branch wip/T25148 at Glasgow Haskell Compiler / GHC
Commits:
6c892383 by Ryan Scott at 2024-09-24T08:13:29-04:00
Yet more review comments
- - - - -
1 changed file:
- compiler/GHC/Tc/Deriv/Generate.hs
Changes:
=====================================
compiler/GHC/Tc/Deriv/Generate.hs
=====================================
@@ -1699,12 +1699,16 @@ coercing from. So from, say,
instance C a <rep-ty> => C a (T x) where
op @c = coerce @(a -> [<rep-ty>] -> c -> Int)
@(a -> [T x] -> c -> Int)
- op
+ (op @c)
In addition to the type applications, we also use a type abstraction to bring
-the method-bound variable `c` into scope over the two type applications.
-See Note [GND and QuantifiedConstraints] for more information on why this
-is important.
+the method-bound variable `c` into scope. We do this for two reasons:
+
+* We need to bring `c` into scope over the two type applications to `coerce`.
+ See Note [GND and QuantifiedConstraints] for more information on why this
+ is important.
+* We need to bring `c` into scope over the type application to `op`. See
+ Note [GND and ambiguity] for more information on why this is important.
(In the surface syntax, only specified type variables can be used in type
abstractions. Since a method signature could contain both specified and
@@ -1970,26 +1974,33 @@ ambiguous type variables. Here are a couple of examples to illustrate this:
newtype T a = MkT a
deriving newtype Facts
- If we only generate the following code for the derived `Facts` instance:
+ When generating code for the derived `Facts` instance, we must use a type
+ abstraction to bring `n` into scope over the type applications to `coerce`
+ (see Note [Newtype-deriving instances] for more why this is needed). A first
+ attempt at generating the instance would be:
instance Facts a => Facts (T a) where
- fact1 = coerce @(Proxy a -> Dict (0 <= n))
- @(Proxy (T a) -> Dict (0 <= n))
- (fact1 @a)
+ fact1 @n = coerce @(Proxy a -> Dict (0 <= n))
+ @(Proxy (T a) -> Dict (0 <= n))
+ (fact1 @a)
- Then it won't typecheck, as GHC won't know how to instantiate `n` in the call
- to `fact1 @a`. To compensate for the possibility of ambiguity here, we bind
- `n` on the LHS of `fact1`'s equation using a type abstraction and explicitly
- instantiate `n` on the RHS:
+ This still won't typecheck, however, as GHC doesn't know how to instantiate
+ `n` in the call to `fact1 @a`. To compensate for the possibility of ambiguity
+ here, we also visibly apply `n` in the call to `fact1` on the RHS:
instance Facts a => Facts (T a) where
fact1 @n = coerce @(Proxy a -> Dict (0 <= n))
@(Proxy (T a) -> Dict (0 <= n))
- (fact1 @a @n)
+ (fact1 @a @n) -- Note the @n here!
+
+ This takes advantage of the fact that we *already* need to bring `n` into
+ scope using a type abstraction, and so we are able to use it both for
+ instantiating the call to `coerce` and instantiating the call to `fact1`.
- Note that we use this same approach for resolving ambiguity in default
- methods, as described in Note [Default methods in instances] (Wrinkle:
- Ambiguous types from vanilla method type signatures) in GHC.Tc.TyCl.Instance.
+ Note that we use this same type abstractions-based approach for resolving
+ ambiguity in default methods, as described in Note [Default methods in
+ instances] (Wrinkle: Ambiguous types from vanilla method type signatures) in
+ GHC.Tc.TyCl.Instance.
-}
gen_Newtype_binds :: SrcSpan
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6c892383d1edfa7a21cb194a60893df0e2720973
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6c892383d1edfa7a21cb194a60893df0e2720973
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240924/ec6f9602/attachment-0001.html>
More information about the ghc-commits
mailing list