[Git][ghc/ghc][master] compiler: Use type abstractions when deriving

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Sat Sep 21 21:50:02 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
c50d29be by Ryan Hendrickson at 2024-09-21T17:49:15-04:00
compiler: Use type abstractions when deriving

For deriving newtype and deriving via, in order to bring type variables
needed for the coercions into scope, GHC generates type signatures for
derived class methods. As a simplification, drop the type signatures and
instead use type abstractions to bring method type variables into scope.

- - - - -


15 changed files:

- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/ThToHs.hs
- testsuite/tests/deriving/should_compile/T14578.stderr
- testsuite/tests/deriving/should_compile/T14579.stderr
- testsuite/tests/deriving/should_compile/all.T
- + testsuite/tests/deriving/should_compile/deriving-inferred-ty-arg.hs
- + testsuite/tests/deriving/should_compile/deriving-inferred-ty-arg.stderr
- testsuite/tests/ghc-e/should_run/ghc-e005.stderr
- utils/check-exact/ExactPrint.hs


Changes:

=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -192,8 +192,11 @@ type instance XHsRecFields GhcTc = MultiplicityCheckCoercions
 
 type instance XHsFieldBind _ = [AddEpAnn]
 
-type instance XInvisPat GhcPs = EpToken "@"
-type instance XInvisPat GhcRn = NoExtField
+-- The specificity of an invisible pattern from the parser is always
+-- SpecifiedSpec. The specificity field supports code generated when deriving
+-- newtype or via; see Note [Inferred invisible patterns].
+type instance XInvisPat GhcPs = (EpToken "@", Specificity)
+type instance XInvisPat GhcRn = Specificity
 type instance XInvisPat GhcTc = Type
 
 
@@ -474,7 +477,17 @@ pprPat (ConPat { pat_con = con
                        , cpt_binds = binds
                        } = ext
 pprPat (EmbTyPat _ tp) = text "type" <+> ppr tp
-pprPat (InvisPat _ tp) = char '@' <> ppr tp
+pprPat (InvisPat x tp) = char '@' <> delimit (ppr tp)
+  where
+    delimit
+      | inferred     = braces
+      | needs_parens = parens
+      | otherwise    = id
+    inferred = case ghcPass @p of
+      GhcPs -> snd x == InferredSpec
+      GhcRn -> x == InferredSpec
+      GhcTc -> False
+    needs_parens = hsTypeNeedsParens appPrec $ unLoc $ hstp_body tp
 
 pprPat (XPat ext) = case ghcPass @p of
   GhcRn -> case ext of


=====================================
compiler/GHC/Parser.y
=====================================
@@ -3513,7 +3513,7 @@ bindpat :  exp            {% -- See Note [Parser-Validator Details] in GHC.Parse
 
 argpat   :: { LPat GhcPs }
 argpat    : apat                  { $1 }
-          | PREFIX_AT atype       { sLLa $1 $> (InvisPat (epTok $1) (mkHsTyPat $2)) }
+          | PREFIX_AT atype       { sLLa $1 $> (InvisPat (epTok $1, SpecifiedSpec) (mkHsTyPat $2)) }
 
 argpats :: { [LPat GhcPs] }
           : argpat argpats            { $1 : $2 }


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1522,7 +1522,7 @@ isFunLhs e = go e [] [] []
           reassociate _other = Nothing
    go (L l (PatBuilderAppType (L lp pat) tok ty_pat@(HsTP _ (L (EpAnn anc ann cs) _)))) es ops cps
              = go (L lp' pat) (L (EpAnn anc' ann cs) (ArgPatBuilderArgPat invis_pat) : es) ops cps
-             where invis_pat = InvisPat tok ty_pat
+             where invis_pat = InvisPat (tok, SpecifiedSpec) ty_pat
                    anc' = case tok of
                      NoEpTok -> anc
                      EpTok l -> widenAnchor anc [AddEpAnn AnnAnyclass l]


=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -507,11 +507,11 @@ rnBindPat name_maker pat = runCps (rnLPatAndThen name_maker pat)
 rnLArgPatAndThen :: NameMaker -> LocatedA (Pat GhcPs) -> CpsRn (LocatedA (Pat GhcRn))
 rnLArgPatAndThen mk = wrapSrcSpanCps rnArgPatAndThen where
 
-  rnArgPatAndThen (InvisPat _ tp) = do
+  rnArgPatAndThen (InvisPat (_, spec) tp) = do
     liftCps $ unlessXOptM LangExt.TypeAbstractions $
       addErr (TcRnIllegalInvisibleTypePattern tp)
     tp' <- rnHsTyPat HsTypePatCtx tp
-    pure (InvisPat noExtField tp')
+    pure (InvisPat spec tp')
   rnArgPatAndThen p = rnPatAndThen mk p
 
 -- ----------- Entry point 3: rnLPatAndThen -------------------
@@ -677,12 +677,12 @@ rnPatAndThen mk (SplicePat _ splice)
 rnPatAndThen _ (EmbTyPat _ tp)
   = do { tp' <- rnHsTyPat HsTypePatCtx tp
        ; return (EmbTyPat noExtField tp') }
-rnPatAndThen _ (InvisPat _ tp)
+rnPatAndThen _ (InvisPat (_, spec) tp)
   = do { liftCps $ addErr (TcRnMisplacedInvisPat tp)
          -- Invisible patterns are handled in `rnLArgPatAndThen`
          -- so unconditionally emit error here
        ; tp' <- rnHsTyPat HsTypePatCtx tp
-       ; return (InvisPat noExtField tp')
+       ; return (InvisPat spec tp')
        }
 
 --------------------


=====================================
compiler/GHC/Tc/Deriv.hs
=====================================
@@ -281,8 +281,9 @@ renameDeriv inst_infos bagBinds
     setXOptM LangExt.KindSignatures $
     -- Derived decls (for newtype-deriving) can use ScopedTypeVariables &
     -- KindSignatures
+    setXOptM LangExt.TypeAbstractions $
     setXOptM LangExt.TypeApplications $
-    -- GND/DerivingVia uses TypeApplications in generated code
+    -- GND/DerivingVia uses TypeAbstractions & TypeApplications in generated code
     -- (See Note [Newtype-deriving instances] in GHC.Tc.Deriv.Generate)
     unsetXOptM LangExt.RebindableSyntax $
     -- See Note [Avoid RebindableSyntax when deriving]
@@ -1971,12 +1972,9 @@ genInstBinds spec@(DS { ds_tvs = tyvars, ds_mechanism = mechanism
     extensions
       | isDerivSpecNewtype mechanism || isDerivSpecVia mechanism
       = [
-          -- Both these flags are needed for higher-rank uses of coerce...
-          LangExt.ImpredicativeTypes, LangExt.RankNTypes
-          -- ...and this flag is needed to support the instance signatures
-          -- that bring type variables into scope.
+          -- Both these flags are needed for higher-rank uses of coerce
           -- See Note [Newtype-deriving instances] in GHC.Tc.Deriv.Generate
-        , LangExt.InstanceSigs
+          LangExt.ImpredicativeTypes, LangExt.RankNTypes
           -- Skip unboxed tuples checking for derived instances when imported
           -- in a different module, see #20524
         , LangExt.UnboxedTuples
@@ -2010,8 +2008,8 @@ genInstBinds spec@(DS { ds_tvs = tyvars, ds_mechanism = mechanism
             -> gen_newtype_or_via via_ty
 
     gen_newtype_or_via ty = do
-      let (binds, sigs) = gen_Newtype_binds loc clas tyvars inst_tys ty
-      return (binds, sigs, emptyBag, [])
+      let binds = gen_Newtype_binds loc clas tyvars inst_tys ty
+      return (binds, [], emptyBag, [])
 
 -- | Generate the associated type family instances for a derived instance.
 genFamInsts :: DerivSpec theta -> TcM [FamInst]


=====================================
compiler/GHC/Tc/Deriv/Generate.hs
=====================================
@@ -1697,17 +1697,21 @@ coercing from.  So from, say,
   newtype T x = MkT <rep-ty>
 
   instance C a <rep-ty> => C a (T x) where
-    op :: forall c. a -> [T x] -> c -> Int
-    op = coerce @(a -> [<rep-ty>] -> c -> Int)
-                @(a -> [T x]      -> c -> Int)
-                op
+    op @c = coerce @(a -> [<rep-ty>] -> c -> Int)
+                   @(a -> [T x]      -> c -> Int)
+                   op
 
-In addition to the type applications, we also have an explicit
-type signature on the entire RHS. This brings the method-bound variable
-`c` into scope over the two type applications.
+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.
 
+(In the surface syntax, only specified type variables can be used in type
+abstractions. Since a method signature could contain both specified and
+inferred type variables, we need an internal-only way to represent the inferred
+case. We handle this by smuggling a Specificity field in XInvisPat. See
+Note [Inferred invisible patterns].)
+
 Giving 'coerce' two explicitly-visible type arguments grants us finer control
 over how it should be instantiated. Recall
 
@@ -1720,7 +1724,6 @@ a polytype.  E.g.
    class C a where op :: a -> forall b. b -> b
    newtype T x = MkT <rep-ty>
    instance C <rep-ty> => C (T x) where
-     op :: T x -> forall b. b -> b
      op = coerce @(<rep-ty> -> forall b. b -> b)
                  @(T x      -> forall b. b -> b)
                 op
@@ -1734,6 +1737,74 @@ However, to allow VTA with polytypes we must switch on
 -XImpredicativeTypes locally in GHC.Tc.Deriv.genInst.
 See #8503 for more discussion.
 
+Note [Inferred invisible patterns]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider the following:
+
+  class R a where
+    r :: forall b. Proxy b -> a
+
+When newtype-deriving an instance of `R`, following
+Note [GND and QuantifiedConstraints], we might generate the following code:
+
+  instance R <rep-ty> => R <new-ty> where
+    r = \ @b -> coerce @(Proxy b -> <rep-ty>)
+                      @(Proxy b -> <new-ty>)
+                      r
+
+The code being generated is an HsSyn AST, except for the arguments to coerce,
+which are XHsTypes carrying Core types. As Core types, they must be fully
+elaborated, so we actually want something more like the following:
+
+  instance R <rep-ty> => R <new-ty> where
+    r = \ @b -> coerce @(Proxy @{k} b -> <rep-ty>)
+                      @(Proxy @{k} b -> <new-ty>)
+                      r
+
+where the `k` corresponds to the `k` in the elaborated type of `r`:
+
+  class R (a :: Type) where
+    r :: forall {k :: Type} (b :: k). Proxy @{k} b -> a
+
+However, `k` is not bound in the definition of `r` in the derived instance, and
+binding it requires a way to create an inferred (because `k` is inferred in the
+signature of `r`) invisible pattern.
+
+So we actually generate the following for `R`:
+
+  instance R <rep-ty> => R <new-ty> where
+    r = \ @{k :: Type} -> \ @(b :: k) ->
+            coerce @(Proxy @{k} b -> <rep-ty>)
+                   @(Proxy @{k} b -> <new-ty>)
+                   r
+
+The `\ @{k :: Type} ->` (note the braces!) is the big lambda that binds `k`, and
+represents an inferred invisible pattern. Inferred invisible patterns aren't
+allowed in the surface syntax of Haskell, for the reason that the order in
+which inferred foralls are added to a signature is not specified, so it is
+ambiguous which pattern would bind to which forall. But when deriving an
+instance, the patterns are being created after the type of the method has been
+elaborated, so an order for the inferred foralls has already been determined.
+This makes inferred invisible patterns safe for internal use.
+
+(You might wonder if you could bring `k` into scope via the pattern signature
+in `\ @(b :: k)`, but that does not work in general; e.g. if
+`r :: Proxy Any -> a`; see `C5` in test `deriving-inferred-ty-arg`.)
+
+The implementation is straightforward: we have a Specificity field in
+XInvisPat, which is always SpecifiedSpec when coming from the parser or
+Template Haskell, but takes the specificity of the corresponding forall from
+the method type during instance deriving. When type checking an invisible
+pattern, we allow inferred patterns to bind inferred foralls just like we allow
+specified patterns to bind specified foralls.
+
+More discussion of this scenario and some rejected alternatives at
+https://gitlab.haskell.org/ghc/ghc/-/merge_requests/13190
+
+See also https://github.com/ghc-proposals/ghc-proposals/pull/675, which
+was triggered by this ticket, and explores source-language syntax in this
+space.
+
 Note [Newtype-deriving trickiness]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider (#12768):
@@ -1805,16 +1876,15 @@ See Note [Instances in no-evidence implications] in GHC.Tc.Solver.Equality.
 But this isn't the death knell for combining QuantifiedConstraints with GND.
 On the contrary, if we generate GND bindings in a slightly different way, then
 we can avoid this situation altogether. Instead of applying `coerce` to two
-polymorphic types, we instead let an instance signature do the polymorphic
-instantiation, and omit the `forall`s in the type applications.
-More concretely, we generate the following code instead:
+polymorphic types, we instead use a type abstraction to bind the type
+variables, and omit the `forall`s in the type applications. More concretely, we
+generate the following code instead:
 
   instance (C m, forall p q. Coercible p q => Coercible (m p) (m q)) =>
       C (T m) where
-    join :: forall a. T m (T m a) -> T m a
-    join = coerce @(  m   (m a) ->   m a)
-                  @(T m (T m a) -> T m a)
-                  join
+    join @a = coerce @(  m   (m a) ->   m a)
+                     @(T m (T m a) -> T m a)
+                     join
 
 Now the visible type arguments are both monotypes, so we don't need any of this
 funny quantified constraint instantiation business. While this particular
@@ -1823,120 +1893,25 @@ ImpredicativeTypes to typecheck GND-generated code for class methods with
 higher-rank types. See Note [Newtype-deriving instances].
 
 You might think that that second @(T m (T m a) -> T m a) argument is redundant
-in the presence of the instance signature, but in fact leaving it off will
-break this example (from the T15290d test case):
+with the type information provided by the class, but in fact leaving it off
+will break the following example (from the T12616 test case):
+
+  type m ~> n = forall a. m a -> n a
+  data StateT s m a = ...
+  newtype OtherStateT s m a = OtherStateT (StateT s m a)
 
-  class C a where
-    c :: Int -> forall b. b -> a
+  class MonadTrans t where
+    lift :: (Monad m) => m ~> t m
 
-  instance C Int
+  instance MonadTrans (StateT s)
 
-  instance C Age where
-    c :: Int -> forall b. b -> Age
-    c = coerce @(Int -> forall b. b -> Int)
-               c
+  instance MonadTrans (OtherStateT s) where
+    lift @m = coerce @(m ~> StateT s m)
+                     lift
 
 That is because we still need to instantiate the second argument of
 coerce with a polytype, and we can only do that with VTA or QuickLook.
 
-Be aware that the use of an instance signature doesn't /solve/ this
-problem; it just makes it less likely to occur. For example, if a class has
-a truly higher-rank type like so:
-
-  class CProblem m where
-    op :: (forall b. ... (m b) ...) -> Int
-
-Then the same situation will arise again. But at least it won't arise for the
-common case of methods with ordinary, prenex-quantified types.
-
------
--- Wrinkle: Use HsOuterExplicit
------
-
-One minor complication with the plan above is that we need to ensure that the
-type variables from a method's instance signature properly scope over the body
-of the method. For example, recall:
-
-  instance (C m, forall p q. Coercible p q => Coercible (m p) (m q)) =>
-      C (T m) where
-    join :: forall a. T m (T m a) -> T m a
-    join = coerce @(  m   (m a) ->   m a)
-                  @(T m (T m a) -> T m a)
-                  join
-
-In the example above, it is imperative that the `a` in the instance signature
-for `join` scope over the body of `join` by way of ScopedTypeVariables.
-This might sound obvious, but note that in gen_Newtype_binds, which is
-responsible for generating the code above, the type in `join`'s instance
-signature is given as a Core type, whereas gen_Newtype_binds will eventually
-produce HsBinds (i.e., source Haskell) that is renamed and typechecked. We
-must ensure that `a` is in scope over the body of `join` during renaming
-or else the generated code will be rejected.
-
-In short, we need to convert the instance signature from a Core type to an
-HsType (i.e., a source Haskell type). Two possible options are:
-
-1. Convert the Core type entirely to an HsType (i.e., a source Haskell type).
-2. Embed the entire Core type using HsCoreTy.
-
-Neither option is quite satisfactory:
-
-1. Converting a Core type to an HsType in full generality is surprisingly
-   complicated. Previous versions of GHCs did this, but it was the source of
-   numerous bugs (see #14579 and #16518, for instance).
-2. While HsCoreTy is much less complicated that option (1), it's not quite
-   what we want. In order for `a` to be in scope over the body of `join` during
-   renaming, the `forall` must be contained in an HsOuterExplicit.
-   (See Note [Lexically scoped type variables] in GHC.Hs.Type.) HsCoreTy
-   bypasses HsOuterExplicit, so this won't work either.
-
-As a compromise, we adopt a combination of the two options above:
-
-* Split apart the top-level ForAllTys in the instance signature's Core type,
-* Convert the top-level ForAllTys to an HsOuterExplicit, and
-* Embed the remainder of the Core type in an HsCoreTy.
-
-This retains most of the simplicity of option (2) while still ensuring that
-the type variables are correctly scoped.
-
-Note that splitting apart top-level ForAllTys will expand any type synonyms
-in the Core type itself. This ends up being important to fix a corner case
-observed in #18914. Consider this example:
-
-  type T f = forall a. f a
-
-  class C f where
-    m :: T f
-
-  newtype N f a = MkN (f a)
-    deriving C
-
-What code should `deriving C` generate? It will have roughly the following
-shape:
-
-  instance C f => C (N f) where
-    m :: T (N f)
-    m = coerce @(...) (...) (m @f)
-
-At a minimum, we must instantiate `coerce` with `@(T f)` and `@(T (N f))`, but
-with the `forall`s removed in order to make them monotypes. However, the
-`forall` is hidden underneath the `T` type synonym, so we must first expand `T`
-before we can strip of the `forall`. Expanding `T`, we get
-`coerce @(forall a. f a) @(forall a. N f a)`, and after omitting the `forall`s,
-we get `coerce @(f a) @(N f a)`.
-
-We can't stop there, however, or else we would end up with this code:
-
-  instance C f => C (N f) where
-    m :: T (N f)
-    m = coerce @(f a) @(N f a) (m @f)
-
-Notice that the type variable `a` is completely unbound. In order to make sure
-that `a` is in scope, we must /also/ expand the `T` in `m :: T (N f)` to get
-`m :: forall a. N f a`. Fortunately, we will do just that in the plan outlined
-above, since when we split off the top-level ForAllTys in the instance
-signature, we must first expand the T type synonym.
-
 Note [GND and ambiguity]
 ~~~~~~~~~~~~~~~~~~~~~~~~
 We make an effort to make the code generated through GND be robust w.r.t.
@@ -1950,7 +1925,6 @@ ambiguous type variables. As one example, consider the following example
 A naïve attempt and generating a C T instance would be:
 
   instance C T where
-    f :: String
     f = coerce @String @String f
 
 This isn't going to typecheck, however, since GHC doesn't know what to
@@ -1959,7 +1933,6 @@ instantiate the type variable `a` with in the call to `f` in the method body.
 ambiguity here, we explicitly instantiate `a` like so:
 
   instance C T where
-    f :: String
     f = coerce @String @String (f @())
 
 All better now.
@@ -1972,22 +1945,19 @@ gen_Newtype_binds :: SrcSpan
                              -- newtype itself)
                   -> [Type]  -- instance head parameters (incl. newtype)
                   -> Type    -- the representation type
-                  -> (LHsBinds GhcPs, [LSig GhcPs])
+                  -> LHsBinds GhcPs
 -- See Note [Newtype-deriving instances]
 gen_Newtype_binds loc' cls inst_tvs inst_tys rhs_ty
-  = (binds, sigs)
+  = map mk_bind (classMethods cls)
   where
-    (binds, sigs) = mapAndUnzip mk_bind_and_sig (classMethods cls)
-
     -- Same as inst_tys, but with the last argument type replaced by the
     -- representation type.
     underlying_inst_tys :: [Type]
     underlying_inst_tys = changeLast inst_tys rhs_ty
 
     locn = noAnnSrcSpan loc'
-    loca = noAnnSrcSpan loc'
-    -- For each class method, generate its derived binding and instance
-    -- signature. Using the first example from
+    -- For each class method, generate its derived binding. Using the first
+    -- example from
     -- Note [Newtype-deriving instances]:
     --
     --   class C a b where
@@ -1999,43 +1969,30 @@ gen_Newtype_binds loc' cls inst_tvs inst_tys rhs_ty
     --
     --   instance C a <rep-ty> => C a (T x) where
     --     <derived-op-impl>
-    mk_bind_and_sig :: Id -> (LHsBind GhcPs, LSig GhcPs)
-    mk_bind_and_sig meth_id
-      = ( -- The derived binding, e.g.,
-          --
-          --   op = coerce @(a -> [<rep-ty>] -> c -> Int)
-          --               @(a -> [T x]      -> c -> Int)
-          --               op
-          mkRdrFunBind loc_meth_RDR [mkSimpleMatch
-                                        (mkPrefixFunRhs loc_meth_RDR)
-                                        (noLocA []) rhs_expr]
-        , -- The derived instance signature, e.g.,
-          --
-          --   op :: forall c. a -> [T x] -> c -> Int
-          --
-          -- Make sure that `forall c` is in an HsOuterExplicit so that it
-          -- scopes over the body of `op`. See "Wrinkle: Use HsOuterExplicit" in
-          -- Note [GND and QuantifiedConstraints].
-          L loca $ ClassOpSig noAnn False [loc_meth_RDR]
-                 $ L loca $ mkHsExplicitSigType noAnn
-                              (map mk_hs_tvb to_tvbs)
-                              (nlHsCoreTy to_rho)
-        )
+    mk_bind :: Id -> LHsBind GhcPs
+    mk_bind meth_id
+      = -- The derived binding, e.g.,
+        --
+        --   op @c = coerce @(a -> [<rep-ty>] -> c -> Int)
+        --                  @(a -> [T x]      -> c -> Int)
+        --                  op
+        mkRdrFunBind loc_meth_RDR [mkSimpleMatch
+                                      (mkPrefixFunRhs loc_meth_RDR)
+                                      (noLocA (map mk_ty_pat to_tvbs)) rhs_expr]
+
       where
         Pair from_ty to_ty = mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty meth_id
         (_, _, from_tau)  = tcSplitSigmaTy from_ty
         (to_tvbs, to_rho) = tcSplitForAllInvisTVBinders to_ty
         (_, to_tau)       = tcSplitPhiTy to_rho
-        -- The use of tcSplitForAllInvisTVBinders above expands type synonyms,
-        -- which is important to ensure correct type variable scoping.
-        -- See "Wrinkle: Use HsOuterExplicit" in
-        -- Note [GND and QuantifiedConstraints].
-
-        mk_hs_tvb :: VarBndr TyVar flag -> LHsTyVarBndr flag GhcPs
-        mk_hs_tvb (Bndr tv flag) = noLocA $ KindedTyVar noAnn
-                                                        flag
-                                                        (noLocA (getRdrName tv))
-                                                        (nlHsCoreTy (tyVarKind tv))
+        -- The `to_tvbs` bind variables that are mentioned in `to_rho` and
+        -- hence in `to_tau`. So we bring `to_tvbs` into scope via the
+        -- `mkSimpleMatch` above, so that their use in `to_tau` in `rhs_expr`
+        -- is well-scoped.
+
+        mk_ty_pat :: VarBndr TyVar Specificity -> LPat GhcPs
+        mk_ty_pat (Bndr tv spec) = noLocA $ InvisPat (noAnn, spec) $ mkHsTyPat $
+          nlHsTyVar NotPromoted $ getRdrName tv
 
         meth_RDR = getRdrName meth_id
         loc_meth_RDR = L locn meth_RDR


=====================================
compiler/GHC/Tc/Gen/Pat.hs
=====================================
@@ -175,8 +175,11 @@ tcMatchPats match_ctxt pats pat_tys thing_inside
                -- E.g.    f :: forall a. Bool -> a -> blah
                --         f @b True  x = rhs1  -- b is bound to skolem a
                --         f @c False y = rhs2  -- c is bound to skolem a
-               | L _ (InvisPat _ tp) <- pat
-               , isSpecifiedForAllTyFlag vis
+               -- Also handles invisible (Inferred) case originating from type
+               -- class deriving; see Note [Inferred invisible patterns]
+               | L _ (InvisPat pat_spec tp) <- pat
+               , Invisible spec <- vis
+               , pat_spec == spec
                = do { (_p, (ps, res)) <- tc_ty_pat tp tv $
                                          loop pats pat_tys
                     ; return (ps, res) }


=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1520,10 +1520,13 @@ cvtp (ViewP e p)       = do { e' <- cvtl e; p' <- cvtPat p
 cvtp (TypeP t)         = do { t' <- cvtType t
                             ; return $ EmbTyPat noAnn (mkHsTyPat t') }
 cvtp (InvisP t)        = do { t' <- parenthesizeHsType appPrec <$> cvtType t
-                            ; pure (InvisPat noAnn (mkHsTyPat t'))}
+                            ; pure (InvisPat noAnnSpecified (mkHsTyPat t'))}
 cvtp (OrP ps)          = do { ps' <- cvtPats ps
                             ; pure (OrPat noExtField ps')}
 
+noAnnSpecified :: XInvisPat GhcPs
+noAnnSpecified = (noAnn, Hs.SpecifiedSpec)
+
 cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs))
 cvtPatFld (s,p)
   = do  { L ls s' <- vNameN s


=====================================
testsuite/tests/deriving/should_compile/T14578.stderr
=====================================
@@ -4,13 +4,6 @@ Derived class instances:
   instance (GHC.Internal.Base.Applicative f,
             GHC.Internal.Base.Applicative g, GHC.Internal.Base.Semigroup a) =>
            GHC.Internal.Base.Semigroup (T14578.Wat f g a) where
-    (GHC.Internal.Base.<>) ::
-      T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a
-    GHC.Internal.Base.sconcat ::
-      GHC.Internal.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a
-    GHC.Internal.Base.stimes ::
-      forall (b :: *). GHC.Internal.Real.Integral b =>
-                       b -> T14578.Wat f g a -> T14578.Wat f g a
     (GHC.Internal.Base.<>)
       = GHC.Prim.coerce
           @(T14578.App (Data.Functor.Compose.Compose f g) a
@@ -28,7 +21,7 @@ Derived class instances:
             -> T14578.Wat f g a)
           (GHC.Internal.Base.sconcat
              @(T14578.App (Data.Functor.Compose.Compose f g) a))
-    GHC.Internal.Base.stimes
+    GHC.Internal.Base.stimes @b
       = GHC.Prim.coerce
           @(b
             -> T14578.App (Data.Functor.Compose.Compose f g) a
@@ -39,56 +32,38 @@ Derived class instances:
   
   instance GHC.Internal.Base.Functor f =>
            GHC.Internal.Base.Functor (T14578.App f) where
-    GHC.Internal.Base.fmap ::
-      forall (a :: *) (b :: *). (a -> b)
-                                -> T14578.App f a -> T14578.App f b
-    (GHC.Internal.Base.<$) ::
-      forall (a :: *) (b :: *). a -> T14578.App f b -> T14578.App f a
-    GHC.Internal.Base.fmap
+    GHC.Internal.Base.fmap @a @b
       = GHC.Prim.coerce
           @((a -> b) -> f a -> f b)
           @((a -> b) -> T14578.App f a -> T14578.App f b)
           (GHC.Internal.Base.fmap @f)
-    (GHC.Internal.Base.<$)
+    (GHC.Internal.Base.<$) @a @b
       = GHC.Prim.coerce
           @(a -> f b -> f a) @(a -> T14578.App f b -> T14578.App f a)
           ((GHC.Internal.Base.<$) @f)
   
   instance GHC.Internal.Base.Applicative f =>
            GHC.Internal.Base.Applicative (T14578.App f) where
-    GHC.Internal.Base.pure :: forall (a :: *). a -> T14578.App f a
-    (GHC.Internal.Base.<*>) ::
-      forall (a :: *) (b :: *). T14578.App f (a -> b)
-                                -> T14578.App f a -> T14578.App f b
-    GHC.Internal.Base.liftA2 ::
-      forall (a :: *) (b :: *) (c :: *). (a -> b -> c)
-                                         -> T14578.App f a -> T14578.App f b -> T14578.App f c
-    (GHC.Internal.Base.*>) ::
-      forall (a :: *) (b :: *). T14578.App f a
-                                -> T14578.App f b -> T14578.App f b
-    (GHC.Internal.Base.<*) ::
-      forall (a :: *) (b :: *). T14578.App f a
-                                -> T14578.App f b -> T14578.App f a
-    GHC.Internal.Base.pure
+    GHC.Internal.Base.pure @a
       = GHC.Prim.coerce
           @(a -> f a) @(a -> T14578.App f a) (GHC.Internal.Base.pure @f)
-    (GHC.Internal.Base.<*>)
+    (GHC.Internal.Base.<*>) @a @b
       = GHC.Prim.coerce
           @(f (a -> b) -> f a -> f b)
           @(T14578.App f (a -> b) -> T14578.App f a -> T14578.App f b)
           ((GHC.Internal.Base.<*>) @f)
-    GHC.Internal.Base.liftA2
+    GHC.Internal.Base.liftA2 @a @b @c
       = GHC.Prim.coerce
           @((a -> b -> c) -> f a -> f b -> f c)
           @((a -> b -> c)
             -> T14578.App f a -> T14578.App f b -> T14578.App f c)
           (GHC.Internal.Base.liftA2 @f)
-    (GHC.Internal.Base.*>)
+    (GHC.Internal.Base.*>) @a @b
       = GHC.Prim.coerce
           @(f a -> f b -> f b)
           @(T14578.App f a -> T14578.App f b -> T14578.App f b)
           ((GHC.Internal.Base.*>) @f)
-    (GHC.Internal.Base.<*)
+    (GHC.Internal.Base.<*) @a @b
       = GHC.Prim.coerce
           @(f a -> f b -> f a)
           @(T14578.App f a -> T14578.App f b -> T14578.App f a)


=====================================
testsuite/tests/deriving/should_compile/T14579.stderr
=====================================
@@ -2,10 +2,6 @@
 ==================== Derived instances ====================
 Derived class instances:
   instance GHC.Classes.Eq a => GHC.Classes.Eq (T14579.Glurp a) where
-    (GHC.Classes.==) ::
-      T14579.Glurp a -> T14579.Glurp a -> GHC.Types.Bool
-    (GHC.Classes./=) ::
-      T14579.Glurp a -> T14579.Glurp a -> GHC.Types.Bool
     (GHC.Classes.==)
       = GHC.Prim.coerce
           @(T14579.Wat 'GHC.Internal.Data.Proxy.Proxy
@@ -22,8 +18,6 @@ Derived class instances:
   instance forall a (x :: GHC.Internal.Data.Proxy.Proxy a).
            GHC.Classes.Eq a =>
            GHC.Classes.Eq (T14579.Wat x) where
-    (GHC.Classes.==) :: T14579.Wat x -> T14579.Wat x -> GHC.Types.Bool
-    (GHC.Classes./=) :: T14579.Wat x -> T14579.Wat x -> GHC.Types.Bool
     (GHC.Classes.==)
       = GHC.Prim.coerce
           @(GHC.Internal.Maybe.Maybe a


=====================================
testsuite/tests/deriving/should_compile/all.T
=====================================
@@ -150,3 +150,4 @@ test('T15798c', normal, compile, [''])
 test('T24955a', normal, compile, [''])
 test('T24955b', normal, compile, [''])
 test('T24955c', normal, compile, [''])
+test('deriving-inferred-ty-arg', normal, compile, ['-ddump-deriv -dsuppress-uniques'])


=====================================
testsuite/tests/deriving/should_compile/deriving-inferred-ty-arg.hs
=====================================
@@ -0,0 +1,27 @@
+{-# LANGUAGE DataKinds, TypeFamilies #-}
+module DerivingInferredTyArg where
+
+import Data.Functor.Const
+import Data.Proxy
+
+class C a where
+  m :: forall {k} (b :: k). Const a b
+
+class C2 a where
+  m2 :: forall {k} {b :: k}. Const a b
+
+class C3 a where
+  m3 :: forall {k} (b :: k) {p :: Proxy b}. Const a p
+
+data VisProxy k (a :: k) = VisProxy
+
+class C4 a where
+  m4 :: forall {k} (b :: k) {p :: VisProxy k b}. Const a p
+
+type family Any :: k
+
+class C5 a where
+  m5 :: Proxy Any -> a
+
+newtype T a = MkT a
+  deriving (C, C2, C3, C4, C5)


=====================================
testsuite/tests/deriving/should_compile/deriving-inferred-ty-arg.stderr
=====================================
@@ -0,0 +1,52 @@
+
+==================== Derived instances ====================
+Derived class instances:
+  instance DerivingInferredTyArg.C a =>
+           DerivingInferredTyArg.C (DerivingInferredTyArg.T a) where
+    DerivingInferredTyArg.m @{k} @b
+      = GHC.Prim.coerce
+          @(GHC.Internal.Data.Functor.Const.Const a b)
+          @(GHC.Internal.Data.Functor.Const.Const
+              (DerivingInferredTyArg.T a) b)
+          (DerivingInferredTyArg.m @a)
+  
+  instance DerivingInferredTyArg.C2 a =>
+           DerivingInferredTyArg.C2 (DerivingInferredTyArg.T a) where
+    DerivingInferredTyArg.m2 @{k} @{b}
+      = GHC.Prim.coerce
+          @(GHC.Internal.Data.Functor.Const.Const a b)
+          @(GHC.Internal.Data.Functor.Const.Const
+              (DerivingInferredTyArg.T a) b)
+          (DerivingInferredTyArg.m2 @a)
+  
+  instance DerivingInferredTyArg.C3 a =>
+           DerivingInferredTyArg.C3 (DerivingInferredTyArg.T a) where
+    DerivingInferredTyArg.m3 @{k} @b @{p}
+      = GHC.Prim.coerce
+          @(GHC.Internal.Data.Functor.Const.Const a p)
+          @(GHC.Internal.Data.Functor.Const.Const
+              (DerivingInferredTyArg.T a) p)
+          (DerivingInferredTyArg.m3 @a)
+  
+  instance DerivingInferredTyArg.C4 a =>
+           DerivingInferredTyArg.C4 (DerivingInferredTyArg.T a) where
+    DerivingInferredTyArg.m4 @{k} @b @{p}
+      = GHC.Prim.coerce
+          @(GHC.Internal.Data.Functor.Const.Const a p)
+          @(GHC.Internal.Data.Functor.Const.Const
+              (DerivingInferredTyArg.T a) p)
+          (DerivingInferredTyArg.m4 @a)
+  
+  instance DerivingInferredTyArg.C5 a =>
+           DerivingInferredTyArg.C5 (DerivingInferredTyArg.T a) where
+    DerivingInferredTyArg.m5 @{k}
+      = GHC.Prim.coerce
+          @(GHC.Internal.Data.Proxy.Proxy DerivingInferredTyArg.Any -> a)
+          @(GHC.Internal.Data.Proxy.Proxy DerivingInferredTyArg.Any
+            -> DerivingInferredTyArg.T a)
+          (DerivingInferredTyArg.m5 @a)
+  
+
+Derived type family instances:
+
+


=====================================
testsuite/tests/ghc-e/should_run/ghc-e005.stderr
=====================================
@@ -9,23 +9,18 @@ Module: GHC.Internal.Exception
 Type: ErrorCall
 
 HasCallStack backtrace:
-    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
-    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
-    throwIO, called at libraries/exceptions/src/Control/Monad/Catch.hs:371:12 in exceptions-0.10.7-inplace:Control.Monad.Catch
-    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
-    throwM, called at compiler/GHC/Driver/Monad.hs:167:54 in ghc-9.9-inplace:GHC.Driver.Monad
-    a type signature in an instance, called at compiler/GHC/Driver/Monad.hs:167:54 in ghc-9.9-inplace:GHC.Driver.Monad
-    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
-    throwM, called at ghc/GHCi/UI/Monad.hs:288:15 in ghc-bin-9.9.20240223-inplace:GHCi.UI.Monad
-    a type signature in an instance, called at ghc/GHCi/UI/Monad.hs:288:15 in ghc-bin-9.9.20240223-inplace:GHCi.UI.Monad
-    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
-    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
-    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
-    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
-    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
-    throwM, called at libraries/haskeline/System/Console/Haskeline/InputT.hs:53:39 in haskeline-0.8.2.1-inplace:System.Console.Haskeline.InputT
-    a type signature in an instance, called at libraries/haskeline/System/Console/Haskeline/InputT.hs:53:39 in haskeline-0.8.2.1-inplace:System.Console.Haskeline.InputT
-    throwM, called at ghc/GHCi/UI/Monad.hs:215:52 in ghc-bin-9.9.20240223-inplace:GHCi.UI.Monad
-
-
+  collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+  toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+  throwIO, called at libraries/exceptions/src/Control/Monad/Catch.hs:371:12 in exceptions-0.10.7-inplace:Control.Monad.Catch
+  throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+  throwM, called at compiler/GHC/Driver/Monad.hs:167:54 in ghc-9.11-inplace:GHC.Driver.Monad
+  throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+  throwM, called at ghc/GHCi/UI/Monad.hs:288:15 in ghc-bin-9.11.20240823-inplace:GHCi.UI.Monad
+  throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+  throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+  throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+  throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+  throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+  throwM, called at libraries/haskeline/System/Console/Haskeline/InputT.hs:53:39 in haskeline-0.8.2.1-inplace:System.Console.Haskeline.InputT
+  throwM, called at ghc/GHCi/UI/Monad.hs:215:52 in ghc-bin-9.11.20240823-inplace:GHCi.UI.Monad
 


=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -4877,10 +4877,10 @@ instance ExactPrint (Pat GhcPs) where
     tp' <- markAnnotated tp
     return (EmbTyPat toktype' tp')
 
-  exact (InvisPat tokat tp) = do
+  exact (InvisPat (tokat, spec) tp) = do
     tokat' <- markEpToken tokat
     tp' <- markAnnotated tp
-    pure (InvisPat tokat' tp')
+    pure (InvisPat (tokat', spec) tp')
 
 -- ---------------------------------------------------------------------
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c50d29be95247b92f23386d4aa61d8bb9bfc767e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c50d29be95247b92f23386d4aa61d8bb9bfc767e
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/20240921/37099b63/attachment-0001.html>


More information about the ghc-commits mailing list