Introduce and use ConGadtSigBody (preparatory refactor for #18389)wip/T18389-task-zero

This patch removes the `con_g_args :: HsConDeclGADTDetails pass` and `con_res_ty :: LHsType pass` fields of `ConDeclGADT` in favor of a unified `con_body :: ConGadtSigBody pass` field. There are two major differences between `HsConDeclGADTDetails` and `ConGadtSigBody`: 1. `HsConDeclGADTDetails` only contains the argument type, while `ConGadtSigBody` contains both the argument and result types. 2. The `PrefixConGADT` constructor of `ConGadtSigBody` now uses a new `PrefixConGadtSigBody` data type. `PrefixConGadtSigBody` closely mirrors the structure of `HsType`, but with minor, data constructor–specific tweaks. This will become vital in a future patch which implements nested `forall`s and contexts in prefix GADT constructor types (see #18389). Besides the refactoring in the GHC API (and some minor changes in GHC AST–related test cases) this does not introduce any user-visible changes in behavior.
author: Ryan Scott <ryan.gl.scott@gmail.com> 2021-05-04 20:09:31 -0400
committer: Ryan Scott <ryan.gl.scott@gmail.com> 2022-04-02 07:11:30 -0400
commit: ff8d81265090dc89e067a08028d9c598f72529ab (patch)
tree: 1e3393647bd970d9fa515529cadcce35aceff16b
parent: d85c7dcb7c457efc23b20ac8f4e4ae88bae5b050 (diff)
download: haskell-wip/T18389-task-zero.tar.gz
26 files changed, 736 insertions, 523 deletions
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index 568783bdb5..a61b6f1514 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -76,7 +76,9 @@ module GHC.Hs.Decls (
   CImportSpec(..),
   -- ** Data-constructor declarations
   ConDecl(..), LConDecl,
-  HsConDeclH98Details, HsConDeclGADTDetails(..), hsConDeclTheta,
+  HsConDeclH98Details,
+  ConGadtSigBody(..), PrefixConGadtSigBody(..),
+  anonPrefixConGadtSigArgs, prefixConGadtSigRes, hsConDeclTheta,
   getConNames, getRecConArgs_maybe,
   -- ** Document comments
   DocDecl(..), LDocDecl, docDeclDoc,
@@ -624,9 +626,9 @@ getRecConArgs_maybe (ConDeclH98{con_args = args}) = case args of
   PrefixCon{} -> Nothing
   RecCon flds -> Just flds
   InfixCon{}  -> Nothing
-getRecConArgs_maybe (ConDeclGADT{con_g_args = args}) = case args of
-  PrefixConGADT{} -> Nothing
-  RecConGADT flds _ -> Just flds
+getRecConArgs_maybe (ConDeclGADT{con_body = body}) = case body of
+  PrefixConGADT{}     -> Nothing
+  RecConGADT flds _ _ -> Just flds
 
 hsConDeclTheta :: Maybe (LHsContext (GhcPass p)) -> [LHsType (GhcPass p)]
 hsConDeclTheta Nothing            = []
@@ -701,14 +703,20 @@ pprConDecl (ConDeclH98 { con_name = L _ con
                                  <+> pprConDeclFields (unLoc fields)
 
 pprConDecl (ConDeclGADT { con_names = cons, con_bndrs = L _ outer_bndrs
-                        , con_mb_cxt = mcxt, con_g_args = args
-                        , con_res_ty = res_ty, con_doc = doc })
+                        , con_mb_cxt = mcxt, con_body = body, con_doc = doc })
   = pprMaybeWithDoc doc $ ppr_con_names cons <+> dcolon
     <+> (sep [pprHsOuterSigTyVarBndrs outer_bndrs <+> pprLHsContext mcxt,
-              sep (ppr_args args ++ [ppr res_ty]) ])
+              ppr_body body ])
   where
-    ppr_args (PrefixConGADT args) = map (\(HsScaled arr t) -> ppr t <+> ppr_arr arr) args
-    ppr_args (RecConGADT fields _) = [pprConDeclFields (unLoc fields) <+> arrow]
+    ppr_body (PrefixConGADT args) = ppr_prefix_body args
+    ppr_body (RecConGADT fields _ res_ty) =
+      sep [ pprConDeclFields (unLoc fields)
+          , arrow <+> ppr res_ty ]
+
+    ppr_prefix_body (PCGSRes res_ty) = ppr res_ty
+    ppr_prefix_body (PCGSAnonArg (HsScaled arr arg) body') =
+      sep [ ppr arg
+          , ppr_arr arr <+> ppr_prefix_body body' ]
 
     -- Display linear arrows as unrestricted with -XNoLinearTypes
     -- (cf. dataConDisplayType in Note [Displaying linear fields] in GHC.Core.DataCon)
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index 987e47f047..780ece9ae8 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -181,10 +181,15 @@ deriving instance Data (ConDecl GhcPs)
 deriving instance Data (ConDecl GhcRn)
 deriving instance Data (ConDecl GhcTc)
 
--- deriving instance DataIdLR p p => Data (HsConDeclGADTDetails p)
-deriving instance Data (HsConDeclGADTDetails GhcPs)
-deriving instance Data (HsConDeclGADTDetails GhcRn)
-deriving instance Data (HsConDeclGADTDetails GhcTc)
+-- deriving instance DataIdLR p p => Data (ConGadtSigBody p)
+deriving instance Data (ConGadtSigBody GhcPs)
+deriving instance Data (ConGadtSigBody GhcRn)
+deriving instance Data (ConGadtSigBody GhcTc)
+
+-- deriving instance DataIdLR p p => Data (PrefixConGadtSigBody p)
+deriving instance Data (PrefixConGadtSigBody GhcPs)
+deriving instance Data (PrefixConGadtSigBody GhcRn)
+deriving instance Data (PrefixConGadtSigBody GhcTc)
 
 -- deriving instance DataIdLR p p   => Data (TyFamInstDecl p)
 deriving instance Data (TyFamInstDecl GhcPs)
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index 208d7777f7..73bc26642d 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -74,7 +74,7 @@ module GHC.Hs.Type (
         splitLHsPatSynTy,
         splitLHsForAllTyInvis, splitLHsForAllTyInvis_KP, splitLHsQualTy,
         splitLHsSigmaTyInvis, splitLHsGadtTy,
-        splitHsFunType, hsTyGetAppHead_maybe,
+        splitLHsPrefixGadtSigBody, hsTyGetAppHead_maybe,
         mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy,
         ignoreParens, hsSigWcType, hsPatSigType,
         hsTyKindSig,
@@ -89,6 +89,7 @@ module GHC.Hs.Type (
 
 import GHC.Prelude
 
+import Language.Haskell.Syntax.Decls
 import Language.Haskell.Syntax.Type
 
 import {-# SOURCE #-} GHC.Hs.Expr ( pprSplice )
@@ -477,32 +478,41 @@ mkHsAppKindTy ext ty k
 -}
 
 ---------------------------------
--- splitHsFunType decomposes a type (t1 -> t2 ... -> tn)
--- Breaks up any parens in the result type:
---      splitHsFunType (a -> (b -> c)) = ([a,b], c)
--- It returns API Annotations for any parens removed
-splitHsFunType ::
+-- | Decomposes the body of prefix GADT constructor type into its argument
+-- and result types, breaking up parentheses as necessary in the process.
+-- (See also 'splitLHsGadtTy', which decomposes the top-level @forall@s and
+-- context of a GADT constructor type.)
+-- For example:
+--
+-- @
+-- 'splitLHsPrefixGadtSigBody' (a -> (b -> T c)) =
+--   'PCGSAnonArg' a ('PCGSAnonArg' b ('PCGSRes' (T c)))
+-- @
+--
+-- It returns exact print annotations for any parentheses removed, as well as
+-- for any associated comments.
+splitLHsPrefixGadtSigBody ::
      LHsType (GhcPass p)
   -> ( [AddEpAnn], EpAnnComments -- The locations of any parens and
-                                  -- comments discarded
-     , [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
-splitHsFunType ty = go ty
+                                 -- comments discarded
+     , PrefixConGadtSigBody (GhcPass p) )
+splitLHsPrefixGadtSigBody ty = go ty
   where
     go (L l (HsParTy an ty))
       = let
-          (anns, cs, args, res) = splitHsFunType ty
+          (anns, cs, body) = go ty
           anns' = anns ++ annParen2AddEpAnn an
           cs' = cs S.<> epAnnComments (ann l) S.<> epAnnComments an
-        in (anns', cs', args, res)
+        in (anns', cs', body)
 
     go (L ll (HsFunTy (EpAnn _ _ cs) mult x y))
-      | (anns, csy, args, res) <- splitHsFunType y
-      = (anns, csy S.<> epAnnComments (ann ll), HsScaled mult x':args, res)
+      | (anns, csy, body) <- go y
+      = (anns, csy S.<> epAnnComments (ann ll), PCGSAnonArg (HsScaled mult x') body)
       where
         L l t = x
         x' = L (addCommentsToSrcAnn l cs) t
 
-    go other = ([], emptyComments, [], other)
+    go res_ty = ([], emptyComments, PCGSRes res_ty)
 
 -- | Retrieve the name of the \"head\" of a nested type application.
 -- This is somewhat like @GHC.Tc.Gen.HsType.splitHsAppTys@, but a little more
@@ -597,7 +607,7 @@ splitLHsSigmaTyInvis ty
 --
 -- This function is careful not to look through parentheses.
 -- See @Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts)@
--- "GHC.Hs.Decls" for why this is important.
+-- "Language.Haskell.Syntax.Decls" for why this is important.
 splitLHsGadtTy ::
      LHsSigType GhcPs
   -> (HsOuterSigTyVarBndrs GhcPs, Maybe (LHsContext GhcPs), LHsType GhcPs)
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index ef5ad6e494..e945b3bc6e 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -1465,10 +1465,10 @@ hsConDeclsBinders cons
         in case unLoc r of
            -- remove only the first occurrence of any seen field in order to
            -- avoid circumventing detection of duplicate fields (#9156)
-           ConDeclGADT { con_names = names, con_g_args = args }
+           ConDeclGADT { con_names = names, con_body = body }
              -> (map (L loc . unLoc) names ++ ns, flds ++ fs)
              where
-                (remSeen', flds) = get_flds_gadt remSeen args
+                (remSeen', flds) = get_flds_gadt remSeen body
                 (ns, fs) = go remSeen' rs
 
            ConDeclH98 { con_name = name, con_args = args }
@@ -1482,9 +1482,9 @@ hsConDeclsBinders cons
     get_flds_h98 remSeen (RecCon flds) = get_flds remSeen flds
     get_flds_h98 remSeen _ = (remSeen, [])
 
-    get_flds_gadt :: Seen p -> HsConDeclGADTDetails (GhcPass p)
+    get_flds_gadt :: Seen p -> ConGadtSigBody (GhcPass p)
                   -> (Seen p, [LFieldOcc (GhcPass p)])
-    get_flds_gadt remSeen (RecConGADT flds _) = get_flds remSeen flds
+    get_flds_gadt remSeen (RecConGADT flds _ _) = get_flds remSeen flds
     get_flds_gadt remSeen _ = (remSeen, [])
 
     get_flds :: Seen p -> LocatedL [LConDeclField (GhcPass p)]
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index c4839ae449..372f444cf3 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/compiler/GHC/HsToCore/Docs.hs
@@ -399,8 +399,8 @@ subordinates env instMap decl = case decl of
 conArgDocs :: ConDecl GhcRn -> IntMap (HsDoc GhcRn)
 conArgDocs (ConDeclH98{con_args = args}) =
   h98ConArgDocs args
-conArgDocs (ConDeclGADT{con_g_args = args, con_res_ty = res_ty}) =
-  gadtConArgDocs args (unLoc res_ty)
+conArgDocs (ConDeclGADT{con_body = body}) =
+  gadtConSigBodyDocs body
 
 h98ConArgDocs :: HsConDeclH98Details GhcRn -> IntMap (HsDoc GhcRn)
 h98ConArgDocs con_args = case con_args of
@@ -409,10 +409,15 @@ h98ConArgDocs con_args = case con_args of
                                        , unLoc (hsScaledThing arg2) ]
   RecCon _           -> IM.empty
 
-gadtConArgDocs :: HsConDeclGADTDetails GhcRn -> HsType GhcRn -> IntMap (HsDoc GhcRn)
-gadtConArgDocs con_args res_ty = case con_args of
-  PrefixConGADT args -> con_arg_docs 0 $ map (unLoc . hsScaledThing) args ++ [res_ty]
-  RecConGADT _ _     -> con_arg_docs 1 [res_ty]
+gadtConSigBodyDocs :: ConGadtSigBody GhcRn -> IntMap (HsDoc GhcRn)
+gadtConSigBodyDocs body = case body of
+  PrefixConGADT body'   -> con_arg_docs 0 $ prefix_gadt_con_sig_body_tys body'
+  RecConGADT _ _ res_ty -> con_arg_docs 1 [unLoc res_ty]
+  where
+    prefix_gadt_con_sig_body_tys :: PrefixConGadtSigBody GhcRn -> [HsType GhcRn]
+    prefix_gadt_con_sig_body_tys (PCGSRes res_ty)        = [unLoc res_ty]
+    prefix_gadt_con_sig_body_tys (PCGSAnonArg arg body') =
+      unLoc (hsScaledThing arg):prefix_gadt_con_sig_body_tys body'
 
 con_arg_docs :: Int -> [HsType GhcRn] -> IntMap (HsDoc GhcRn)
 con_arg_docs n = IM.fromList . catMaybes . zipWith f [n..]
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index dfa634b399..d57fba4ef9 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -890,18 +890,17 @@ repC (L _ (ConDeclH98 { con_name = con
 repC (L _ (ConDeclGADT { con_names  = cons
                        , con_bndrs  = L _ outer_bndrs
                        , con_mb_cxt = mcxt
-                       , con_g_args = args
-                       , con_res_ty = res_ty }))
+                       , con_body   = body }))
   | null_outer_imp_tvs && null_outer_exp_tvs
                                  -- No implicit or explicit variables
   , Nothing <- mcxt              -- No context
                                  -- ==> no need for a forall
-  = repGadtDataCons cons args res_ty
+  = repGadtDataCons cons body
 
   | otherwise
   = addHsOuterSigTyVarBinds outer_bndrs $ \ outer_bndrs' ->
              -- See Note [Don't quantify implicit type variables in quotes]
-    do { c'    <- repGadtDataCons cons args res_ty
+    do { c'    <- repGadtDataCons cons body
        ; ctxt' <- repMbContext mcxt
        ; if null_outer_exp_tvs && isNothing mcxt
          then return c'
@@ -2685,22 +2684,40 @@ repH98DataCon con details
              rep2 recCName [unC con', unC arg_vtys]
 
 repGadtDataCons :: [LocatedN Name]
-                -> HsConDeclGADTDetails GhcRn
-                -> LHsType GhcRn
+                -> ConGadtSigBody GhcRn
                 -> MetaM (Core (M TH.Con))
-repGadtDataCons cons details res_ty
+repGadtDataCons cons body
     = do cons' <- mapM lookupLOcc cons -- See Note [Binders and occurrences]
-         case details of
-           PrefixConGADT ps -> do
-             arg_tys <- repPrefixConArgs ps
-             res_ty' <- repLTy res_ty
-             rep2 gadtCName [ unC (nonEmptyCoreList cons'), unC arg_tys, unC res_ty']
-           RecConGADT ips _ -> do
+         case body of
+           PrefixConGADT prefix_body ->
+             repPrefixGadtDataCons cons' prefix_body
+           RecConGADT ips _ res_ty -> do
              arg_vtys <- repRecConArgs ips
              res_ty'  <- repLTy res_ty
              rep2 recGadtCName [unC (nonEmptyCoreList cons'), unC arg_vtys,
                                 unC res_ty']
 
+repPrefixGadtDataCons :: [Core TH.Name]
+                      -> PrefixConGadtSigBody GhcRn
+                      -> MetaM (Core (M TH.Con))
+repPrefixGadtDataCons cons prefix_body = do
+  (arg_tys, core_arg_tys, core_res_ty) <- go prefix_body
+  verifyLinearFields arg_tys
+  core_arg_tys' <- coreListM bangTypeTyConName core_arg_tys
+  rep2 gadtCName [ unC (nonEmptyCoreList cons), unC core_arg_tys', unC core_res_ty]
+  where
+    go :: PrefixConGadtSigBody GhcRn
+       -> MetaM ( [HsScaled GhcRn (LHsType GhcRn)]
+                , [Core (M TH.BangType)]
+                , Core (M TH.Type) )
+    go (PCGSRes res_ty) = do
+      core_res_ty <- repLTy res_ty
+      pure ([], [], core_res_ty)
+    go (PCGSAnonArg arg_ty body) = do
+      core_arg_ty <- repBangTy (hsScaledThing arg_ty)
+      (arg_tys, core_arg_tys, core_res_ty) <- go body
+      pure (arg_ty:arg_tys, core_arg_ty:core_arg_tys, core_res_ty)
+
 -- TH currently only supports linear constructors.
 -- We also accept the (->) arrow when -XLinearTypes is off, because this
 -- denotes a linear field.
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 19f198e2c3..5fa5d0f281 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -1381,9 +1381,19 @@ instance (ToHie tyarg, ToHie arg, ToHie rec) => ToHie (HsConDetails tyarg arg re
   toHie (RecCon rec) = toHie rec
   toHie (InfixCon a b) = concatM [ toHie a, toHie b]
 
-instance ToHie (HsConDeclGADTDetails GhcRn) where
-  toHie (PrefixConGADT args) = toHie args
-  toHie (RecConGADT rec _) = toHie rec
+instance ToHie (ConGadtSigBody GhcRn) where
+  toHie (PrefixConGADT body) = toHie body
+  toHie (RecConGADT flds _ res_ty) = concatM
+    [ toHie flds
+    , toHie res_ty
+    ]
+
+instance ToHie (PrefixConGadtSigBody GhcRn) where
+  toHie (PCGSRes res_ty) = toHie res_ty
+  toHie (PCGSAnonArg arg_ty body) = concatM
+    [ toHie arg_ty
+    , toHie body
+    ]
 
 instance HiePass p => ToHie (LocatedAn NoEpAnns (HsCmdTop (GhcPass p))) where
   toHie (L span top) = concatM $ makeNodeA top span : case top of
@@ -1599,8 +1609,7 @@ instance ToHie a => ToHie (HsScaled GhcRn a) where
 instance ToHie (LocatedA (ConDecl GhcRn)) where
   toHie (L span decl) = concatM $ makeNode decl (locA span) : case decl of
       ConDeclGADT { con_names = names, con_bndrs = L outer_bndrs_loc outer_bndrs
-                  , con_mb_cxt = ctx, con_g_args = args, con_res_ty = typ
-                  , con_doc = doc} ->
+                  , con_mb_cxt = ctx, con_body = body, con_doc = doc } ->
         [ toHie $ map (C (Decl ConDec $ getRealSpanA span)) names
         , case outer_bndrs of
             HsOuterImplicit{hso_ximplicit = imp_vars} ->
@@ -1609,18 +1618,23 @@ instance ToHie (LocatedA (ConDecl GhcRn)) where
             HsOuterExplicit{hso_bndrs = exp_bndrs} ->
               toHie $ tvScopes resScope NoScope exp_bndrs
         , toHie ctx
-        , toHie args
-        , toHie typ
+        , toHie body
         , toHie doc
         ]
         where
-          rhsScope = combineScopes argsScope tyScope
           ctxScope = maybe NoScope mkLScopeA ctx
-          argsScope = case args of
-            PrefixConGADT xs -> scaled_args_scope xs
-            RecConGADT x _   -> mkLScopeA x
-          tyScope = mkLScopeA typ
+          rhsScope = case body of
+            PrefixConGADT prefix_body ->
+              prefix_con_gadt_sig_body_scope prefix_body
+            RecConGADT flds _ res_ty ->
+              combineScopes (mkLScopeA flds) (mkLScopeA res_ty)
           resScope = ResolvedScopes [ctxScope, rhsScope]
+
+          prefix_con_gadt_sig_body_scope :: PrefixConGadtSigBody GhcRn -> Scope
+          prefix_con_gadt_sig_body_scope (PCGSRes res_ty) = mkLScopeA res_ty
+          prefix_con_gadt_sig_body_scope (PCGSAnonArg arg_ty body') =
+            combineScopes (mkLScopeA $ hsScaledThing arg_ty)
+                          (prefix_con_gadt_sig_body_scope body')
       ConDeclH98 { con_name = name, con_ex_tvs = qvars
                  , con_mb_cxt = ctx, con_args = dets
                  , con_doc = doc} ->
@@ -1637,7 +1651,7 @@ instance ToHie (LocatedA (ConDecl GhcRn)) where
             PrefixCon _ xs -> scaled_args_scope xs
             InfixCon a b   -> scaled_args_scope [a, b]
             RecCon x       -> mkLScopeA x
-    where scaled_args_scope :: [HsScaled GhcRn (LHsType GhcRn)] -> Scope
+          scaled_args_scope :: [HsScaled GhcRn (LHsType GhcRn)] -> Scope
           scaled_args_scope = foldr combineScopes NoScope . map (mkLScopeA . hsScaledThing)
 
 instance ToHie (LocatedL [LocatedA (ConDeclField GhcRn)]) where
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 568f5df5e6..74a44fa384 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -720,7 +720,8 @@ mkConDeclH98 ann name mb_forall mb_cxt args
 -- * This splits up the constructor type into its quantified type variables (if
 --   provided), context (if provided), argument types, and result type, and
 --   records whether this is a prefix or record GADT constructor. See
---   Note [GADT abstract syntax] in "GHC.Hs.Decls" for more details.
+--   @Note [GADT abstract syntax]@ in "Language.Haskell.Syntax.Decls" for more
+--   details.
 mkGadtDecl :: SrcSpan
            -> [LocatedN RdrName]
            -> LHsSigType GhcPs
@@ -730,7 +731,7 @@ mkGadtDecl loc names ty annsIn = do
   cs <- getCommentsFor loc
   let l = noAnnSrcSpan loc
 
-  (args, res_ty, annsa, csa) <-
+  (body, annsa, csa) <-
     case body_ty of
      L ll (HsFunTy af hsArr (L loc' (HsRecTy an rf)) res_ty) -> do
        let an' = addCommentsToEpAnn (locA loc') an (comments af)
@@ -740,22 +741,20 @@ mkGadtDecl loc names ty annsIn = do
                                  (PsErrIllegalGadtRecordMultiplicity hsArr)
                  return noHsUniTok
 
-       return ( RecConGADT (L (SrcSpanAnn an' (locA loc')) rf) arr, res_ty
+       return ( RecConGADT (L (SrcSpanAnn an' (locA loc')) rf) arr res_ty
               , [], epAnnComments (ann ll))
      _ -> do
-       let (anns, cs, arg_types, res_type) = splitHsFunType body_ty
-       return (PrefixConGADT arg_types, res_type, anns, cs)
+       let (anns, cs, prefix_body) = splitLHsPrefixGadtSigBody body_ty
+       return (PrefixConGADT prefix_body, anns, cs)
 
-  let an = case outer_bndrs of
-        _                -> EpAnn (spanAsAnchor loc) (annsIn ++ annsa) (cs Semi.<> csa)
+  let an = EpAnn (spanAsAnchor loc) (annsIn ++ annsa) (cs Semi.<> csa)
 
   pure $ L l ConDeclGADT
                      { con_g_ext  = an
                      , con_names  = names
                      , con_bndrs  = L (getLoc ty) outer_bndrs
                      , con_mb_cxt = mcxt
-                     , con_g_args = args
-                     , con_res_ty = res_ty
+                     , con_body   = body
                      , con_doc    = Nothing }
   where
     (outer_bndrs, mcxt, body_ty) = splitLHsGadtTy ty
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
index 271d9db30f..2ce0dd5274 100644
--- a/compiler/GHC/Parser/PostProcess/Haddock.hs
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -696,22 +696,14 @@ instance HasHaddock (LocatedA (ConDecl GhcPs)) where
   addHaddock (L l_con_decl con_decl) =
     extendHdkA (locA l_con_decl) $
     case con_decl of
-      ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt, con_g_args, con_res_ty } -> do
+      ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt, con_body } -> do
         -- discardHasInnerDocs is ok because we don't need this info for GADTs.
         con_doc' <- discardHasInnerDocs $ getConDoc (getLocA (head con_names))
-        con_g_args' <-
-          case con_g_args of
-            PrefixConGADT ts -> PrefixConGADT <$> addHaddock ts
-            RecConGADT (L l_rec flds) arr -> do
-              -- discardHasInnerDocs is ok because we don't need this info for GADTs.
-              flds' <- traverse (discardHasInnerDocs . addHaddockConDeclField) flds
-              pure $ RecConGADT (L l_rec flds') arr
-        con_res_ty' <- addHaddock con_res_ty
+        con_body' <- addHaddock con_body
         pure $ L l_con_decl $
           ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt,
                         con_doc = lexLHsDocString <$> con_doc',
-                        con_g_args = con_g_args',
-                        con_res_ty = con_res_ty' }
+                        con_body = con_body' }
       ConDeclH98 { con_ext, con_name, con_forall, con_ex_tvs, con_mb_cxt, con_args } ->
         addConTrailingDoc (srcSpanEnd $ locA l_con_decl) $
         case con_args of
@@ -738,6 +730,20 @@ instance HasHaddock (LocatedA (ConDecl GhcPs)) where
                            con_doc = lexLHsDocString <$> con_doc',
                            con_args = RecCon (L l_rec flds') }
 
+instance HasHaddock (ConGadtSigBody GhcPs) where
+  addHaddock (PrefixConGADT body) = PrefixConGADT <$> addHaddock body
+  addHaddock (RecConGADT (L l_rec flds) arr res_ty) = do
+    -- discardHasInnerDocs is ok because we don't need this info for GADTs.
+    flds'   <- traverse (discardHasInnerDocs . addHaddockConDeclField) flds
+    res_ty' <- addHaddock res_ty
+    pure $ RecConGADT (L l_rec flds') arr res_ty'
+
+instance HasHaddock (PrefixConGadtSigBody GhcPs) where
+  addHaddock (PCGSAnonArg arg_ty body) =
+    PCGSAnonArg <$> addHaddock arg_ty <*> addHaddock body
+  addHaddock (PCGSRes res_ty) =
+    PCGSRes <$> addHaddock res_ty
+
 -- Keep track of documentation comments on the data constructor or any of its
 -- fields.
 --
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index bbcd5244af..5d1da01b37 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -35,7 +35,7 @@ module GHC.Rename.HsType (
         FreeKiTyVars, filterInScopeM,
         extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars,
         extractHsTysRdrTyVars, extractRdrKindSigVars,
-        extractConDeclGADTDetailsTyVars, extractDataDefnKindVars,
+        extractConGadtSigBodyTyVars, extractDataDefnKindVars,
         extractHsOuterTvBndrs, extractHsTyArgRdrKiTyVars,
         nubL, nubN
   ) where
@@ -1903,14 +1903,21 @@ extractRdrKindSigVars (L _ resultSig) = case resultSig of
   TyVarSig _ (L _ (KindedTyVar _ _ _ k)) -> extractHsTyRdrTyVars k
   _ -> []
 
--- | Extracts free type and kind variables from an argument in a GADT
--- constructor, returning variable occurrences in left-to-right order.
--- See @Note [Ordering of implicit variables]@.
-extractConDeclGADTDetailsTyVars ::
-  HsConDeclGADTDetails GhcPs -> FreeKiTyVars -> FreeKiTyVars
-extractConDeclGADTDetailsTyVars con_args = case con_args of
-  PrefixConGADT args      -> extract_scaled_ltys args
-  RecConGADT (L _ flds) _ -> extract_ltys $ map (cd_fld_type . unLoc) $ flds
+-- | Extracts free type and kind variables from the argument and result types
+-- in a GADT constructor, returning variable occurrences in left-to-right
+-- order. See @Note [Ordering of implicit variables]@.
+extractConGadtSigBodyTyVars :: ConGadtSigBody GhcPs -> FreeKiTyVars
+extractConGadtSigBodyTyVars body = case body of
+  PrefixConGADT body'         -> extract_prefix_con_gadt_sig_body body'
+  RecConGADT (L _ flds) _ res -> extract_ltys (map (cd_fld_type . unLoc) flds) $
+                                 extractHsTyRdrTyVars res
+
+extract_prefix_con_gadt_sig_body :: PrefixConGadtSigBody GhcPs -> FreeKiTyVars
+extract_prefix_con_gadt_sig_body prefix_body = go prefix_body []
+  where
+    go :: PrefixConGadtSigBody GhcPs -> FreeKiTyVars -> FreeKiTyVars
+    go (PCGSRes res_ty)       acc = extract_lty res_ty acc
+    go (PCGSAnonArg arg body) acc = extract_scaled_lty arg (go body acc)
 
 -- | Get type/kind variables mentioned in the kind signature, preserving
 -- left-to-right order:
@@ -1926,10 +1933,6 @@ extractDataDefnKindVars (HsDataDefn { dd_kindSig = ksig })
 extract_lctxt :: LHsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
 extract_lctxt ctxt = extract_ltys (unLoc ctxt)
 
-extract_scaled_ltys :: [HsScaled GhcPs (LHsType GhcPs)]
-                    -> FreeKiTyVars -> FreeKiTyVars
-extract_scaled_ltys args acc = foldr extract_scaled_lty acc args
-
 extract_scaled_lty :: HsScaled GhcPs (LHsType GhcPs)
                    -> FreeKiTyVars -> FreeKiTyVars
 extract_scaled_lty (HsScaled m ty) acc = extract_lty ty $ extract_hs_arrow m acc
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 29937ea5f0..6b152bcb57 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -2352,8 +2352,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
 rnConDecl (ConDeclGADT { con_names   = names
                        , con_bndrs   = L l outer_bndrs
                        , con_mb_cxt  = mcxt
-                       , con_g_args  = args
-                       , con_res_ty  = res_ty
+                       , con_body    = body
                        , con_doc     = mb_doc })
   = do  { mapM_ (addLocMA checkConName) names
         ; new_names <- mapM (lookupLocatedTopConstructorRnN) names
@@ -2366,31 +2365,22 @@ rnConDecl (ConDeclGADT { con_names   = names
               implicit_bndrs =
                 extractHsOuterTvBndrs outer_bndrs           $
                 extractHsTysRdrTyVars (hsConDeclTheta mcxt) $
-                extractConDeclGADTDetailsTyVars args        $
-                extractHsTysRdrTyVars [res_ty] []
+                extractConGadtSigBodyTyVars body
 
         ; let ctxt = ConDeclCtx new_names
 
         ; bindHsOuterTyVarBndrs ctxt Nothing implicit_bndrs outer_bndrs $ \outer_bndrs' ->
     do  { (new_cxt, fvs1)    <- rnMbContext ctxt mcxt
-        ; (new_args, fvs2)   <- rnConDeclGADTDetails (unLoc (head new_names)) ctxt args
-        ; (new_res_ty, fvs3) <- rnLHsType ctxt res_ty
+        ; (new_body, fvs2)   <- rnConGadtSigBody (unLoc (head new_names)) ctxt body
 
-         -- Ensure that there are no nested `forall`s or contexts, per
-         -- Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts)
-         -- in GHC.Hs.Type.
-       ; addNoNestedForallsContextsErr ctxt
-           (text "GADT constructor type signature") new_res_ty
-
-        ; let all_fvs = fvs1 `plusFV` fvs2 `plusFV` fvs3
+        ; let all_fvs = fvs1 `plusFV` fvs2
 
         ; traceRn "rnConDecl (ConDeclGADT)"
             (ppr names $$ ppr outer_bndrs')
         ; new_mb_doc <- traverse rnLHsDoc mb_doc
         ; return (ConDeclGADT { con_g_ext = noAnn, con_names = new_names
                               , con_bndrs = L l outer_bndrs', con_mb_cxt = new_cxt
-                              , con_g_args = new_args, con_res_ty = new_res_ty
-                              , con_doc = new_mb_doc },
+                              , con_body = new_body, con_doc = new_mb_doc },
                   all_fvs) } }
 
 rnMbContext :: HsDocContext -> Maybe (LHsContext GhcPs)
@@ -2415,17 +2405,32 @@ rnConDeclH98Details con doc (RecCon flds)
   = do { (new_flds, fvs) <- rnRecConDeclFields con doc flds
        ; return (RecCon new_flds, fvs) }
 
-rnConDeclGADTDetails ::
+rnConGadtSigBody ::
       Name
    -> HsDocContext
-   -> HsConDeclGADTDetails GhcPs
-   -> RnM (HsConDeclGADTDetails GhcRn, FreeVars)
-rnConDeclGADTDetails _ doc (PrefixConGADT tys)
-  = do { (new_tys, fvs) <- mapFvRn (rnScaledLHsType doc) tys
-       ; return (PrefixConGADT new_tys, fvs) }
-rnConDeclGADTDetails con doc (RecConGADT flds arr)
-  = do { (new_flds, fvs) <- rnRecConDeclFields con doc flds
-       ; return (RecConGADT new_flds arr, fvs) }
+   -> ConGadtSigBody GhcPs
+   -> RnM (ConGadtSigBody GhcRn, FreeVars)
+rnConGadtSigBody _ doc (PrefixConGADT body)
+  = do { (new_body, fvs) <- rnPrefixConGadtSigBody doc body
+       ; return (PrefixConGADT new_body, fvs) }
+rnConGadtSigBody con doc (RecConGADT flds arr res_ty)
+  = do { (new_flds,   fvs1) <- rnRecConDeclFields con doc flds
+       ; (new_res_ty, fvs2) <- rnGADTResultTy doc res_ty
+       ; return (RecConGADT new_flds arr new_res_ty, fvs1 `plusFV` fvs2) }
+
+rnPrefixConGadtSigBody ::
+      HsDocContext
+   -> PrefixConGadtSigBody GhcPs
+   -> RnM (PrefixConGadtSigBody GhcRn, FreeVars)
+rnPrefixConGadtSigBody doc = go
+  where
+    go (PCGSRes res_ty) = do
+      (new_res_ty, fvs) <- rnGADTResultTy doc res_ty
+      pure (PCGSRes new_res_ty, fvs)
+    go (PCGSAnonArg arg_ty body) = do
+      (new_arg_ty, fvs1) <- rnScaledLHsType doc arg_ty
+      (new_body,   fvs2) <- go body
+      pure (PCGSAnonArg new_arg_ty new_body, fvs1 `plusFV` fvs2)
 
 rnRecConDeclFields ::
      Name
@@ -2439,6 +2444,19 @@ rnRecConDeclFields con doc (L l fields)
                 -- since that is done by GHC.Rename.Names.extendGlobalRdrEnvRn
         ; pure (L l new_fields, fvs) }
 
+rnGADTResultTy ::
+     HsDocContext
+  -> LHsType GhcPs
+  -> RnM (LHsType GhcRn, FreeVars)
+rnGADTResultTy doc res_ty
+  = do { (new_res_ty, fvs) <- rnLHsType doc res_ty
+         -- Ensure that there are no nested `forall`s or contexts, per
+         -- Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts)
+         -- in Language.Haskell.Syntax.Decls.
+       ; addNoNestedForallsContextsErr doc
+           (text "GADT constructor type signature") new_res_ty
+       ; pure (new_res_ty, fvs) }
+
 -------------------------------------------------
 
 -- | Brings pattern synonym names and also pattern synonym selectors
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 3a4cb78820..7b473a532e 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -978,7 +978,7 @@ getLocalNonValBinders fixity_env
             = [( find_con_name rdr
                , concatMap find_con_decl_flds (unLoc cdflds) )]
         find_con_flds (L _ (ConDeclGADT { con_names = rdrs
-                                        , con_g_args = RecConGADT flds _ }))
+                                        , con_body = RecConGADT flds _ _ }))
             = [ ( find_con_name rdr
                  , concatMap find_con_decl_flds (unLoc flds))
               | L _ rdr <- rdrs ]
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 597af3d778..796853ae82 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -278,7 +278,7 @@ Note [No nested foralls or contexts in instance types] in GHC.Hs.Type).
 --
 -- * In GADT constructor types (in 'rnConDecl').
 --   See @Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts)@
---   in "GHC.Hs.Type".
+--   in "Language.Haskell.Syntax.Decls".
 --
 -- * In instance declaration types (in 'rnClsIntDecl' and 'rnSrcDerivDecl' in
 --   "GHC.Rename.Module" and 'renameSig' in "GHC.Rename.Bind").
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 302f93e691..5f4312d093 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -99,6 +99,7 @@ import GHC.Utils.Constants (debugIsOn)
 import GHC.Utils.Misc
 
 import Control.Monad
+import Data.Foldable
 import Data.Functor.Identity
 import Data.List ( partition)
 import Data.List.NonEmpty ( NonEmpty(..) )
@@ -1604,16 +1605,22 @@ kcTyClDecl (FamDecl _ (FamilyDecl { fdInfo   = fd_info })) fam_tc
 
 -------------------
 
--- Kind-check the types of the arguments to a data constructor.
+-- Kind-check the type of an argument to a data constructor.
 -- This includes doing kind unification if the type is a newtype.
 -- See Note [Implementation of UnliftedNewtypes] for why we need
--- the first two arguments.
+-- the first argument.
+kcConArgTy :: ContextKind -> HsScaled GhcRn (LHsType GhcRn) -> TcM ()
+kcConArgTy exp_kind (HsScaled mult ty) = do
+  { _ <- tcCheckLHsType (getBangType ty) exp_kind
+  ; void $ tcMult mult
+    -- See Note [Implementation of UnliftedNewtypes], STEP 2
+  }
+
+-- Kind-check the types of the arguments to a data constructor.
 kcConArgTys :: NewOrData -> TcKind -> [HsScaled GhcRn (LHsType GhcRn)] -> TcM ()
 kcConArgTys new_or_data res_kind arg_tys = do
   { let exp_kind = getArgExpKind new_or_data res_kind
-  ; forM_ arg_tys (\(HsScaled mult ty) -> do _ <- tcCheckLHsType (getBangType ty) exp_kind
-                                             tcMult mult)
-    -- See Note [Implementation of UnliftedNewtypes], STEP 2
+  ; traverse_ (kcConArgTy exp_kind) arg_tys
   }
 
 -- Kind-check the types of arguments to a Haskell98 data constructor.
@@ -1624,12 +1631,28 @@ kcConH98Args new_or_data res_kind con_args = case con_args of
   RecCon (L _ flds) -> kcConArgTys new_or_data res_kind $
                        map (hsLinear . cd_fld_type . unLoc) flds
 
--- Kind-check the types of arguments to a GADT data constructor.
-kcConGADTArgs :: NewOrData -> TcKind -> HsConDeclGADTDetails GhcRn -> TcM ()
-kcConGADTArgs new_or_data res_kind con_args = case con_args of
-  PrefixConGADT tys     ->   kcConArgTys new_or_data res_kind tys
-  RecConGADT (L _ flds) _ -> kcConArgTys new_or_data res_kind $
-                             map (hsLinear . cd_fld_type . unLoc) flds
+-- Kind-check the types of the arguments and result in a GADT data constructor.
+kcConGadtSigBody :: NewOrData -> Kind -> ConGadtSigBody GhcRn -> TcM ()
+kcConGadtSigBody new_or_data res_kind body = case body of
+  PrefixConGADT prefix_body ->
+    kcPrefixConGadtSigBody new_or_data res_kind prefix_body
+  RecConGADT (L _ flds) _ res_ty -> do
+    _ <- tcCheckLHsType res_ty (TheKind res_kind)
+    kcConArgTys new_or_data res_kind $ map (hsLinear . cd_fld_type . unLoc) flds
+
+-- Kind-check the types of the arguments and result in a prefix GADT data constructor.
+kcPrefixConGadtSigBody :: NewOrData -> Kind -> PrefixConGadtSigBody GhcRn -> TcM ()
+kcPrefixConGadtSigBody new_or_data res_kind = go
+  where
+    exp_kind :: ContextKind
+    exp_kind = getArgExpKind new_or_data res_kind
+
+    go :: PrefixConGadtSigBody GhcRn -> TcM ()
+    go (PCGSRes res_ty) =
+      void $ tcCheckLHsType res_ty (TheKind res_kind)
+    go (PCGSAnonArg arg_ty body) = do
+      go body
+      kcConArgTy exp_kind arg_ty
 
 kcConDecls :: NewOrData
            -> TcKind             -- The result kind signature
@@ -1668,7 +1691,7 @@ kcConDecl new_or_data
           _tc_res_kind   -- Not used in GADT case (and doesn't make sense)
           (ConDeclGADT
     { con_names = names, con_bndrs = L _ outer_bndrs, con_mb_cxt = cxt
-    , con_g_args = args, con_res_ty = res_ty })
+    , con_body = body })
   = -- See Note [kcConDecls: kind-checking data type decls]
     addErrCtxt (dataConCtxt names) $
     discardResult                      $
@@ -1676,10 +1699,9 @@ kcConDecl new_or_data
     bindOuterSigTKBndrs_Tv outer_bndrs $
         -- Why "_Tv"?  See Note [Using TyVarTvs for kind-checking GADTs]
     do { _ <- tcHsContext cxt
-       ; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty)
+       ; traceTc "kcConDecl:GADT {" (ppr names)
        ; con_res_kind <- newOpenTypeKind
-       ; _ <- tcCheckLHsType res_ty (TheKind con_res_kind)
-       ; kcConGADTArgs new_or_data con_res_kind args
+       ; kcConGadtSigBody new_or_data con_res_kind body
        ; traceTc "kcConDecl:GADT }" (ppr names $$ ppr con_res_kind)
        ; return () }
 
@@ -2174,7 +2196,7 @@ newtype instance Foo 'Red = FooRedC Int#
 
 Note that, in the GADT case, we might have a kind signature with arrows
 (newtype XYZ a b :: Type -> Type where ...). We want only the final
-component of the kind for checking in kcConDecl, so we call etaExpanAlgTyCon
+component of the kind for checking in kcConDecl, so we call etaExpandAlgTyCon
 in kcTyClDecl.
 
 STEP 3: Type-checking (desugaring), as done by tcTyClDecl. The key function
@@ -3480,8 +3502,7 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map
   -- we get the res_kind by typechecking the result type.
           (ConDeclGADT { con_names = names
                        , con_bndrs = L _ outer_hs_bndrs
-                       , con_mb_cxt = cxt, con_g_args = hs_args
-                       , con_res_ty = hs_res_ty })
+                       , con_mb_cxt = cxt, con_body = body })
   = addErrCtxt (dataConCtxt names) $
     do { traceTc "tcConDecl 1 gadt" (ppr names)
        ; let (L _ name : _) = names
@@ -3490,26 +3511,8 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map
            <- pushLevelAndSolveEqualitiesX "tcConDecl:GADT" $
               tcOuterTKBndrs skol_info outer_hs_bndrs       $
               do { ctxt <- tcHsContext cxt
-                 ; (res_ty, res_kind) <- tcInferLHsTypeKind hs_res_ty
-                         -- See Note [GADT return kinds]
-
-                 -- For data instances (only), ensure that the return type,
-                 -- res_ty, is a substitution instance of the header.
-                 -- See Note [GADT return types]
-                 ; case dd_info of
-                      DDataType -> return ()
-                      DDataInstance hdr_ty ->
-                        do { (subst, _meta_tvs) <- newMetaTyVars (binderVars tc_bndrs)
-                           ; let head_shape = substTy subst hdr_ty
-                           ; discardResult $
-                             popErrCtxt $  -- Drop dataConCtxt
-                             addErrCtxt (dataConResCtxt names) $
-                             unifyType Nothing res_ty head_shape }
-
-                   -- See Note [Datatype return kinds]
-                 ; let exp_kind = getArgExpKind new_or_data res_kind
-                 ; btys <- tcConGADTArgs exp_kind hs_args
-
+                 ; (btys, res_ty) <-
+                     tcConGadtSigBody names new_or_data dd_info tc_bndrs body
                  ; let (arg_tys, stricts) = unzip btys
                  ; field_lbls <- lookupConstructorFields name
                  ; return (ctxt, arg_tys, res_ty, field_lbls, stricts)
@@ -3550,7 +3553,7 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map
        ; dflags <- getDynFlags
        ; let
            buildOneDataCon (L _ name) = do
-             { is_infix <- tcConIsInfixGADT name hs_args
+             { is_infix <- tcConIsInfixGADT name body
              ; rep_nm   <- newTyConRepName name
 
              ; let bang_opts = SrcBangOpts (initBangOpts dflags)
@@ -3663,14 +3666,14 @@ tcConIsInfixH98 _   details
            PrefixCon{} -> return False
 
 tcConIsInfixGADT :: Name
-             -> HsConDeclGADTDetails GhcRn
-             -> TcM Bool
-tcConIsInfixGADT con details
-  = case details of
+                 -> ConGadtSigBody GhcRn
+                 -> TcM Bool
+tcConIsInfixGADT con body
+  = case body of
            RecConGADT{} -> return False
-           PrefixConGADT arg_tys       -- See Note [Infix GADT constructors]
+           PrefixConGADT prefix_body   -- See Note [Infix GADT constructors]
                | isSymOcc (getOccName con)
-               , [_ty1,_ty2] <- map hsScaledThing arg_tys
+               , [_ty1,_ty2] <- map hsScaledThing $ anonPrefixConGadtSigArgs prefix_body
                   -> do { fix_env <- getFixityEnv
                         ; return (con `elemNameEnv` fix_env) }
                | otherwise -> return False
@@ -3689,15 +3692,68 @@ tcConH98Args exp_kind (InfixCon bty1 bty2)
 tcConH98Args exp_kind (RecCon fields)
   = tcRecConDeclFields exp_kind fields
 
-tcConGADTArgs :: ContextKind  -- expected kind of arguments
-                              -- always OpenKind for datatypes, but unlifted newtypes
-                              -- might have a specific kind
-              -> HsConDeclGADTDetails GhcRn
-              -> TcM [(Scaled TcType, HsSrcBang)]
-tcConGADTArgs exp_kind (PrefixConGADT btys)
-  = mapM (tcConArg exp_kind) btys
-tcConGADTArgs exp_kind (RecConGADT fields _)
-  = tcRecConDeclFields exp_kind fields
+tcConGadtSigBody :: [LocatedN Name]
+                 -> NewOrData
+                 -> DataDeclInfo
+                 -> [TcTyConBinder]
+                 -> ConGadtSigBody GhcRn
+                 -> TcM ([(Scaled TcType, HsSrcBang)], TcType)
+tcConGadtSigBody names new_or_data dd_info tc_bndrs body =
+  case body of
+    PrefixConGADT btys ->
+      tcPrefixConGadtSigBody names new_or_data dd_info tc_bndrs btys
+    RecConGADT fields _ res_ty -> do
+      -- See Note [GADT return kinds]
+      (tc_res_ty, tc_res_kind) <- tcConGadtResTy names dd_info tc_bndrs res_ty
+      -- See Note [Datatype return kinds]
+      let exp_kind = getArgExpKind new_or_data tc_res_kind
+      tc_arg_tys <- tcRecConDeclFields exp_kind fields
+      pure (tc_arg_tys, tc_res_ty)
+
+tcPrefixConGadtSigBody :: [LocatedN Name]
+                       -> NewOrData
+                       -> DataDeclInfo
+                       -> [TcTyConBinder]
+                       -> PrefixConGadtSigBody GhcRn
+                       -> TcM ([(Scaled TcType, HsSrcBang)], TcType)
+tcPrefixConGadtSigBody names new_or_data dd_info tc_bndrs prefix_body = do
+  (tc_arg_tys, tc_res_ty, _) <- go prefix_body
+  pure (tc_arg_tys, tc_res_ty)
+  where
+    go :: PrefixConGadtSigBody GhcRn
+       -> TcM ([(Scaled TcType, HsSrcBang)], TcType, TcKind)
+    go (PCGSRes res_ty) = do
+      (tc_res_ty, tc_res_kind) <- tcConGadtResTy names dd_info tc_bndrs res_ty
+      pure ([], tc_res_ty, tc_res_kind)
+    go (PCGSAnonArg arg_ty body) = do
+      (tc_arg_tys, tc_res_ty, tc_res_kind) <- go body
+      -- See Note [Datatype return kinds]
+      let exp_kind = getArgExpKind new_or_data tc_res_kind
+      tc_arg_ty <- tcConArg exp_kind arg_ty
+      pure (tc_arg_ty:tc_arg_tys, tc_res_ty, tc_res_kind)
+
+tcConGadtResTy :: [LocatedN Name]
+               -> DataDeclInfo
+               -> [TcTyConBinder]
+               -> LHsType GhcRn -> TcM (TcType, TcKind)
+tcConGadtResTy names dd_info tc_bndrs res_ty = do
+  -- See Note [GADT return kinds]
+  res@(tc_res_ty, _tc_res_kind) <- tcInferLHsTypeKind res_ty
+
+  -- For data instances (only), ensure that the return type,
+  -- res_ty, is a substitution instance of the header.
+  -- See Note [GADT return types]
+  case dd_info of
+     DDataType -> return ()
+     DDataInstance hdr_ty ->
+       do { (subst, _meta_tvs) <- newMetaTyVars (binderVars tc_bndrs)
+          ; let head_shape = substTy subst hdr_ty
+          ; discardResult $
+            popErrCtxt $  -- Drop dataConCtxt
+            addErrCtxt (dataConResCtxt names) $
+            unifyType Nothing tc_res_ty head_shape }
+
+  pure res
 
 tcConArg :: ContextKind  -- expected kind for args; always OpenKind for datatypes,
                          -- but might be an unlifted type with UnliftedNewtypes
@@ -3712,15 +3768,22 @@ tcConArg exp_kind (HsScaled w bty)
 tcRecConDeclFields :: ContextKind
                    -> LocatedL [LConDeclField GhcRn]
                    -> TcM [(Scaled TcType, HsSrcBang)]
-tcRecConDeclFields exp_kind fields
-  = mapM (tcConArg exp_kind) btys
+tcRecConDeclFields exp_kind (L _ fields)
+  = concatMapM tc_field fields
   where
-    -- We need a one-to-one mapping from field_names to btys
-    combined = map (\(L _ f) -> (cd_fld_names f,hsLinear (cd_fld_type f)))
-                   (unLoc fields)
-    explode (ns,ty) = zip ns (repeat ty)
-    exploded = concatMap explode combined
-    (_,btys) = unzip exploded
+    -- We need to ensure that each distinct field name gets its own type.
+    -- For example, if we have:
+    --
+    --   data T = MkT { a,b,c :: Int }
+    --
+    -- Then we should return /three/ Int types, not just one! At the same
+    -- time, we don't want to kind-check Int three separate times, as that
+    -- would be redundant. Therefore, we kind-check Int once and 'replicate'
+    -- it so that we return three occurrences of it.
+    tc_field :: LConDeclField GhcRn -> TcM [(Scaled TcType, HsSrcBang)]
+    tc_field (L _ f) = do
+      bty' <- tcConArg exp_kind $ hsLinear $ cd_fld_type f
+      pure $ replicate (length (cd_fld_names f)) bty'
 
 tcDataConMult :: HsArrow GhcRn -> TcM Mult
 tcDataConMult arr@(HsUnrestrictedArrow _) = do
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 7644109ae0..765afc86aa 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -684,7 +684,11 @@ cvtConstr (GadtC c strtys ty)
   = do  { c'      <- mapM cNameN c
         ; args    <- mapM cvt_arg strtys
         ; ty'     <- cvtType ty
-        ; mk_gadt_decl c' (PrefixConGADT $ map hsLinear args) ty'}
+        ; mk_gadt_decl c' $ PrefixConGADT $ mk_prefix_body args ty' }
+  where
+    mk_prefix_body :: [LHsType GhcPs] -> LHsType GhcPs -> PrefixConGadtSigBody GhcPs
+    mk_prefix_body args res = foldr (\arg body -> PCGSAnonArg (hsLinear arg) body)
+                                    (PCGSRes res) args
 
 cvtConstr (RecGadtC [] _varstrtys _ty)
   = failWith (text "RecGadtC must have at least one constructor name")
@@ -694,19 +698,18 @@ cvtConstr (RecGadtC c varstrtys ty)
         ; ty'      <- cvtType ty
         ; rec_flds <- mapM cvt_id_arg varstrtys
         ; lrec_flds <- returnLA rec_flds
-        ; mk_gadt_decl c' (RecConGADT lrec_flds noHsUniTok) ty' }
+        ; mk_gadt_decl c' $ RecConGADT lrec_flds noHsUniTok ty' }
 
-mk_gadt_decl :: [LocatedN RdrName] -> HsConDeclGADTDetails GhcPs -> LHsType GhcPs
+mk_gadt_decl :: [LocatedN RdrName] -> ConGadtSigBody GhcPs
              -> CvtM (LConDecl GhcPs)
-mk_gadt_decl names args res_ty
+mk_gadt_decl names body
   = do bndrs <- returnLA mkHsOuterImplicit
        returnLA $ ConDeclGADT
                    { con_g_ext  = noAnn
                    , con_names  = names
                    , con_bndrs  = bndrs
                    , con_mb_cxt = Nothing
-                   , con_g_args = args
-                   , con_res_ty = res_ty
+                   , con_body   = body
                    , con_doc    = Nothing }
 
 cvtSrcUnpackedness :: TH.SourceUnpackedness -> SrcUnpackedness
diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs
index baeef95b17..3ed3e5a4b0 100644
--- a/compiler/Language/Haskell/Syntax/Decls.hs
+++ b/compiler/Language/Haskell/Syntax/Decls.hs
@@ -73,7 +73,9 @@ module Language.Haskell.Syntax.Decls (
   CImportSpec(..),
   -- ** Data-constructor declarations
   ConDecl(..), LConDecl,
-  HsConDeclH98Details, HsConDeclGADTDetails(..),
+  HsConDeclH98Details,
+  ConGadtSigBody(..), PrefixConGadtSigBody(..),
+  anonPrefixConGadtSigArgs, prefixConGadtSigRes,
   -- ** Document comments
   DocDecl(..), LDocDecl, docDeclDoc,
   -- ** Deprecations
@@ -1062,8 +1064,7 @@ data ConDecl pass
         --   implicit.  The 'XRec' is used to anchor exact print
         --   annotations, AnnForall and AnnDot.
       , con_mb_cxt  :: Maybe (LHsContext pass)   -- ^ User-written context (if any)
-      , con_g_args  :: HsConDeclGADTDetails pass -- ^ Arguments; never infix
-      , con_res_ty  :: LHsType pass              -- ^ Result type
+      , con_body    :: ConGadtSigBody pass       -- ^ The argument and result types
 
       , con_doc     :: Maybe (LHsDoc pass) -- ^ A possible Haddock
                                                  -- comment.
@@ -1108,17 +1109,17 @@ There are two broad ways to classify GADT constructors:
     data T a where
       K :: forall a. Ord a => [a] -> ... -> T a
 
-This distinction is recorded in the `con_args :: HsConDetails pass`, which
-tracks if we're dealing with a RecCon or PrefixCon. It is easy to distinguish
-the two in the AST since record GADT constructors use HsRecTy. This distinction
-is made in GHC.Parser.PostProcess.mkGadtDecl.
+This distinction is recorded in the `con_body :: ConGadtSigBody pass` field,
+which tracks if we're dealing with a RecConGADT or PrefixConGADT. It is easy to
+distinguish the two in the AST since record GADT constructors use HsRecTy. This
+distinction is made in GHC.Parser.PostProcess.mkGadtDecl.
 
 It is worth elaborating a bit more on the process of splitting the argument
 types of a GADT constructor, since there are some non-obvious details involved.
 While splitting the argument types of a record GADT constructor is easy (they
 are stored in an HsRecTy), splitting the arguments of a prefix GADT constructor
 is trickier. The basic idea is that we must split along the outermost function
-arrows ((->) and (%1 ->)) in the type, which GHC.Hs.Type.splitHsFunType
+arrows ((->) and (%1 ->)) in the type, which GHC.Hs.Type.splitLHsPrefixGadtSigBody
 accomplishes. But what about type operators? Consider:
 
   C :: a :*: b -> a :*: b -> a :+: b
@@ -1182,24 +1183,18 @@ or contexts in two parts:
 1. GHC, in the process of splitting apart a GADT's type,
    extracts out the leading `forall` and context (if they are provided). To
    accomplish this splitting, the renamer uses the
-   GHC.Hs.Type.splitLHsGADTPrefixTy function, which is careful not to remove
+   GHC.Hs.Type.splitLHsGadtTy function, which is careful not to remove
    parentheses surrounding the leading `forall` or context (as these
    parentheses can be syntactically significant). If the third result returned
-   by splitLHsGADTPrefixTy contains any `forall`s or contexts, then they must
-   be nested, so they will be rejected.
+   by splitLHsGadtTy contains any `forall`s or contexts, then they must
+   be nested, so they will be rejected later in the renamer.
 
    Note that this step applies to both prefix and record GADTs alike, as they
-   both have syntax which permits `forall`s and contexts. The difference is
-   where this step happens:
-
-   * For prefix GADTs, this happens in the renamer (in rnConDecl), as we cannot
-     split until after the type operator fixities have been resolved.
-   * For record GADTs, this happens in the parser (in mkGadtDecl).
-2. If the GADT type is prefix, the renamer (in the ConDeclGADTPrefixPs case of
-   rnConDecl) will then check for nested `forall`s/contexts in the body of a
-   prefix GADT type, after it has determined what all of the argument types are.
-   This step is necessary to catch examples like MkT4 above, where the nested
-   quantification occurs after a visible argument type.
+   both have syntax which permits `forall`s and contexts.
+2. The renamer (in GHC.Rename.Module.rnGADTResultTy) will then check for nested
+   `forall`s/contexts in the body of a GADT constructor type. This step is
+   necessary to catch examples like MkT4 above, where the nested quantification
+   occurs after a visible argument type.
 -}
 
 -- | The arguments in a Haskell98-style data constructor.
@@ -1208,15 +1203,43 @@ type HsConDeclH98Details pass
 -- The Void argument to HsConDetails here is a reflection of the fact that
 -- type applications are not allowed in data constructor declarations.
 
--- | The arguments in a GADT constructor. Unlike Haskell98-style constructors,
--- GADT constructors cannot be declared with infix syntax. As a result, we do
--- not use 'HsConDetails' here, as 'InfixCon' would be an unrepresentable
--- state. (There is a notion of infix GADT constructors for the purposes of
--- derived Show instances—see Note [Infix GADT constructors] in
--- GHC.Tc.TyCl—but that is an orthogonal concern.)
-data HsConDeclGADTDetails pass
-   = PrefixConGADT [HsScaled pass (LBangType pass)]
-   | RecConGADT (XRec pass [LConDeclField pass]) (LHsUniToken "->" "→" pass)
+-- | The argument and result types in a GADT constructor.
+-- See @Note [GADT abstract syntax]@.
+--
+-- Unlike Haskell98-style constructors, GADT constructors cannot be declared
+-- with infix syntax. As a result, we do not use 'HsConDetails' here, as
+-- 'InfixCon' would be an unrepresentable state. (There is a notion of infix
+-- GADT constructors for the purposes of derived 'Show' instances—see
+-- @Note [Infix GADT constructors]@ in "GHC.Tc.TyCl"—but that is an
+-- orthogonal concern.)
+data ConGadtSigBody pass
+   = PrefixConGADT (PrefixConGadtSigBody pass)
+   | RecConGADT (XRec pass [LConDeclField pass]) (LHsUniToken "->" "→" pass) (LHsType pass)
+
+-- | The argument and result types in a prefix GADT constructor. This closely
+-- resembles the structure of 'HsType', but with data constructor–specific
+-- tweaks. See @Note [GADT abstract syntax]@.
+data PrefixConGadtSigBody pass
+    -- | The result type.
+  = PCGSRes (LHsType pass)
+    -- | An argument followed by a function arrow (e.g., @MkT :: !Int -> ...@).
+    -- This is much like 'HsFunTy', except that 'PCGSAnonArg' uses an
+    -- 'LBangType' instead of an 'LHsType' to represent the argument.
+  | PCGSAnonArg (HsScaled pass (LBangType pass))
+                (PrefixConGadtSigBody pass)
+
+-- | Retrieve the visible, non-dependent arguments in a prefix GADT
+-- constructor type. Note that this takes O(/n/) time, where /n/ is the number
+-- of arguments.
+anonPrefixConGadtSigArgs :: PrefixConGadtSigBody pass -> [HsScaled pass (LBangType pass)]
+anonPrefixConGadtSigArgs (PCGSAnonArg arg body) = arg : anonPrefixConGadtSigArgs body
+anonPrefixConGadtSigArgs PCGSRes{}              = []
+
+-- | Retrieve the result type in a prefix GADT constructor type. Note that this
+-- takes O(/n/) time, where /n/ is the number of arguments.
+prefixConGadtSigRes :: PrefixConGadtSigBody pass -> LHsType pass
+prefixConGadtSigRes (PCGSAnonArg _ body) = prefixConGadtSigRes body
+prefixConGadtSigRes (PCGSRes res_ty)     = res_ty
 
 instance Outputable NewOrData where
   ppr NewType  = text "newtype"
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index 0c84e9faa6..b85483dc18 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -1067,9 +1067,9 @@ data ConDeclField pass  -- Record fields have Haddock docs on them
 --   (see 'HsPatSynDetails' in "GHC.Hs.Binds").
 --
 -- One notable exception is the arguments in a GADT constructor, which uses
--- a separate data type entirely (see 'HsConDeclGADTDetails' in
--- "GHC.Hs.Decls"). This is because GADT constructors cannot be declared with
--- infix syntax, unlike the concepts above (#18844).
+-- a separate data type entirely (see 'ConGadtSigBody' in
+-- "Language.Haskell.Syntax.Decls"). This is because GADT constructors cannot
+-- be declared with infix syntax, unlike the concepts above (#18844).
 data HsConDetails tyarg arg rec
   = PrefixCon [tyarg] [arg]     -- C @t1 @t2 p1 p2 p3
   | RecCon    rec               -- C { x = p1, y = p2 }
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
index 781d006b54..e8dd84df3f 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
@@ -857,41 +857,41 @@
                  (NoExtField)))
                (Nothing)
                (PrefixConGADT
-                [])
-               (L
-                (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-18 })
-                (HsAppTy
-                 (NoExtField)
+                (PCGSRes
                  (L
-                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-14 })
-                  (HsTyVar
-                   (EpAnn
-                    (Anchor
-                     { T17544.hs:25:13-14 }
-                     (UnchangedAnchor))
-                    []
-                    (EpaComments
-                     []))
-                   (NotPromoted)
+                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-18 })
+                  (HsAppTy
+                   (NoExtField)
                    (L
                     (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-14 })
-                    (Unqual
-                     {OccName: D5}))))
-                 (L
-                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:16-18 })
-                  (HsTyVar
-                   (EpAnn
-                    (Anchor
-                     { T17544.hs:25:16-18 }
-                     (UnchangedAnchor))
-                    []
-                    (EpaComments
-                     []))
-                   (NotPromoted)
+                    (HsTyVar
+                     (EpAnn
+                      (Anchor
+                       { T17544.hs:25:13-14 }
+                       (UnchangedAnchor))
+                      []
+                      (EpaComments
+                       []))
+                     (NotPromoted)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-14 })
+                      (Unqual
+                       {OccName: D5}))))
                    (L
                     (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:16-18 })
-                    (Unqual
-                     {OccName: Int}))))))
+                    (HsTyVar
+                     (EpAnn
+                      (Anchor
+                       { T17544.hs:25:16-18 }
+                       (UnchangedAnchor))
+                      []
+                      (EpaComments
+                       []))
+                     (NotPromoted)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:16-18 })
+                      (Unqual
+                       {OccName: Int}))))))))
                (Nothing)))]
             []))))]
        (Nothing)))))
@@ -1119,41 +1119,41 @@
                  (NoExtField)))
                (Nothing)
                (PrefixConGADT
-                [])
-               (L
-                (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-18 })
-                (HsAppTy
-                 (NoExtField)
+                (PCGSRes
                  (L
-                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-14 })
-                  (HsTyVar
-                   (EpAnn
-                    (Anchor
-                     { T17544.hs:31:13-14 }
-                     (UnchangedAnchor))
-                    []
-                    (EpaComments
-                     []))
-                   (NotPromoted)
+                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-18 })
+                  (HsAppTy
+                   (NoExtField)
                    (L
                     (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-14 })
-                    (Unqual
-                     {OccName: D6}))))
-                 (L
-                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:16-18 })
-                  (HsTyVar
-                   (EpAnn
-                    (Anchor
-                     { T17544.hs:31:16-18 }
-                     (UnchangedAnchor))
-                    []
-                    (EpaComments
-                     []))
-                   (NotPromoted)
+                    (HsTyVar
+                     (EpAnn
+                      (Anchor
+                       { T17544.hs:31:13-14 }
+                       (UnchangedAnchor))
+                      []
+                      (EpaComments
+                       []))
+                     (NotPromoted)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-14 })
+                      (Unqual
+                       {OccName: D6}))))
                    (L
                     (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:16-18 })
-                    (Unqual
-                     {OccName: Int}))))))
+                    (HsTyVar
+                     (EpAnn
+                      (Anchor
+                       { T17544.hs:31:16-18 }
+                       (UnchangedAnchor))
+                      []
+                      (EpaComments
+                       []))
+                     (NotPromoted)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:16-18 })
+                      (Unqual
+                       {OccName: Int}))))))))
                (Nothing)))]
             []))))]
        (Nothing)))))
@@ -1381,41 +1381,41 @@
                  (NoExtField)))
                (Nothing)
                (PrefixConGADT
-                [])
-               (L
-                (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-18 })
-                (HsAppTy
-                 (NoExtField)
+                (PCGSRes
                  (L
-                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-14 })
-                  (HsTyVar
-                   (EpAnn
-                    (Anchor
-                     { T17544.hs:37:13-14 }
-                     (UnchangedAnchor))
-                    []
-                    (EpaComments
-                     []))
-                   (NotPromoted)
+                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-18 })
+                  (HsAppTy
+                   (NoExtField)
                    (L
                     (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-14 })
-                    (Unqual
-                     {OccName: D7}))))
-                 (L
-                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:16-18 })
-                  (HsTyVar
-                   (EpAnn
-                    (Anchor
-                     { T17544.hs:37:16-18 }
-                     (UnchangedAnchor))
-                    []
-                    (EpaComments
-                     []))
-                   (NotPromoted)
+                    (HsTyVar
+                     (EpAnn
+                      (Anchor
+                       { T17544.hs:37:13-14 }
+                       (UnchangedAnchor))
+                      []
+                      (EpaComments
+                       []))
+                     (NotPromoted)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-14 })
+                      (Unqual
+                       {OccName: D7}))))
                    (L
                     (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:16-18 })
-                    (Unqual
-                     {OccName: Int}))))))
+                    (HsTyVar
+                     (EpAnn
+                      (Anchor
+                       { T17544.hs:37:16-18 }
+                       (UnchangedAnchor))
+                      []
+                      (EpaComments
+                       []))
+                     (NotPromoted)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:16-18 })
+                      (Unqual
+                       {OccName: Int}))))))))
                (Nothing)))]
             []))))]
        (Nothing)))))
@@ -1643,41 +1643,41 @@
                  (NoExtField)))
                (Nothing)
                (PrefixConGADT
-                [])
-               (L
-                (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-18 })
-                (HsAppTy
-                 (NoExtField)
+                (PCGSRes
                  (L
-                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-14 })
-                  (HsTyVar
-                   (EpAnn
-                    (Anchor
-                     { T17544.hs:43:13-14 }
-                     (UnchangedAnchor))
-                    []
-                    (EpaComments
-                     []))
-                   (NotPromoted)
+                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-18 })
+                  (HsAppTy
+                   (NoExtField)
                    (L
                     (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-14 })
-                    (Unqual
-                     {OccName: D8}))))
-                 (L
-                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:16-18 })
-                  (HsTyVar
-                   (EpAnn
-                    (Anchor
-                     { T17544.hs:43:16-18 }
-                     (UnchangedAnchor))
-                    []
-                    (EpaComments
-                     []))
-                   (NotPromoted)
+                    (HsTyVar
+                     (EpAnn
+                      (Anchor
+                       { T17544.hs:43:13-14 }
+                       (UnchangedAnchor))
+                      []
+                      (EpaComments
+                       []))
+                     (NotPromoted)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-14 })
+                      (Unqual
+                       {OccName: D8}))))
                    (L
                     (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:16-18 })
-                    (Unqual
-                     {OccName: Int}))))))
+                    (HsTyVar
+                     (EpAnn
+                      (Anchor
+                       { T17544.hs:43:16-18 }
+                       (UnchangedAnchor))
+                      []
+                      (EpaComments
+                       []))
+                     (NotPromoted)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:16-18 })
+                      (Unqual
+                       {OccName: Int}))))))))
                (Nothing)))]
             []))))]
        (Nothing)))))
@@ -1905,41 +1905,41 @@
                  (NoExtField)))
                (Nothing)
                (PrefixConGADT
-                [])
-               (L
-                (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-18 })
-                (HsAppTy
-                 (NoExtField)
+                (PCGSRes
                  (L
-                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-14 })
-                  (HsTyVar
-                   (EpAnn
-                    (Anchor
-                     { T17544.hs:49:13-14 }
-                     (UnchangedAnchor))
-                    []
-                    (EpaComments
-                     []))
-                   (NotPromoted)
+                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-18 })
+                  (HsAppTy
+                   (NoExtField)
                    (L
                     (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-14 })
-                    (Unqual
-                     {OccName: D9}))))
-                 (L
-                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:16-18 })
-                  (HsTyVar
-                   (EpAnn
-                    (Anchor
-                     { T17544.hs:49:16-18 }
-                     (UnchangedAnchor))
-                    []
-                    (EpaComments
-                     []))
-                   (NotPromoted)
+                    (HsTyVar
+                     (EpAnn
+                      (Anchor
+                       { T17544.hs:49:13-14 }
+                       (UnchangedAnchor))
+                      []
+                      (EpaComments
+                       []))
+                     (NotPromoted)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-14 })
+                      (Unqual
+                       {OccName: D9}))))
                    (L
                     (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:16-18 })
-                    (Unqual
-                     {OccName: Int}))))))
+                    (HsTyVar
+                     (EpAnn
+                      (Anchor
+                       { T17544.hs:49:16-18 }
+                       (UnchangedAnchor))
+                      []
+                      (EpaComments
+                       []))
+                     (NotPromoted)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:16-18 })
+                      (Unqual
+                       {OccName: Int}))))))))
                (Nothing)))]
             []))))]
        (Nothing)))))
@@ -2167,41 +2167,41 @@
                  (NoExtField)))
                (Nothing)
                (PrefixConGADT
-                [])
-               (L
-                (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-20 })
-                (HsAppTy
-                 (NoExtField)
+                (PCGSRes
                  (L
-                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-16 })
-                  (HsTyVar
-                   (EpAnn
-                    (Anchor
-                     { T17544.hs:55:14-16 }
-                     (UnchangedAnchor))
-                    []
-                    (EpaComments
-                     []))
-                   (NotPromoted)
+                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-20 })
+                  (HsAppTy
+                   (NoExtField)
                    (L
                     (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-16 })
-                    (Unqual
-                     {OccName: D10}))))
-                 (L
-                  (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:18-20 })
-                  (HsTyVar
-                   (EpAnn
-                    (Anchor
-                     { T17544.hs:55:18-20 }
-                     (UnchangedAnchor))
-                    []
-                    (EpaComments
-                     []))
-                   (NotPromoted)
+                    (HsTyVar
+                     (EpAnn
+                      (Anchor
+                       { T17544.hs:55:14-16 }
+                       (UnchangedAnchor))
+                      []
+                      (EpaComments
+                       []))
+                     (NotPromoted)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-16 })
+                      (Unqual
+                       {OccName: D10}))))
                    (L
                     (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:18-20 })
-                    (Unqual
-                     {OccName: Int}))))))
+                    (HsTyVar
+                     (EpAnn
+                      (Anchor
+                       { T17544.hs:55:18-20 }
+                       (UnchangedAnchor))
+                      []
+                      (EpaComments
+                       []))
+                     (NotPromoted)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:18-20 })
+                      (Unqual
+                       {OccName: Int}))))))))
                (Nothing)))]
             []))))]
        (Nothing)))))
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
index 63fe2c10d5..549f04a660 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
@@ -88,22 +88,22 @@
             (NoExtField)))
           (Nothing)
           (PrefixConGADT
-           [])
-          (L
-           (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 })
-           (HsTyVar
-            (EpAnn
-             (Anchor
-              { T17544_kw.hs:16:18-20 }
-              (UnchangedAnchor))
-             []
-             (EpaComments
-              []))
-            (NotPromoted)
+           (PCGSRes
             (L
              (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 })
-             (Unqual
-              {OccName: Foo}))))
+             (HsTyVar
+              (EpAnn
+               (Anchor
+                { T17544_kw.hs:16:18-20 }
+                (UnchangedAnchor))
+               []
+               (EpaComments
+                []))
+              (NotPromoted)
+              (L
+               (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 })
+               (Unqual
+                {OccName: Foo}))))))
           (Just
            (L
             { T17544_kw.hs:15:10-35 }
@@ -172,7 +172,8 @@
             (NoExtField)))
           (Nothing)
           (PrefixConGADT
-           [(HsScaled
+           (PCGSAnonArg
+            (HsScaled
              (HsUnrestrictedArrow
               (L
                (TokenLoc
@@ -199,22 +200,23 @@
                 (EpaComments
                  []))
                (HsBoxedOrConstraintTuple)
-               [])))])
-          (L
-           (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:19:24-26 })
-           (HsTyVar
-            (EpAnn
-             (Anchor
-              { T17544_kw.hs:19:24-26 }
-              (UnchangedAnchor))
-             []
-             (EpaComments
-              []))
-            (NotPromoted)
-            (L
-             (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:19:24-26 })
-             (Unqual
-              {OccName: Bar}))))
+               [])))
+            (PCGSRes
+             (L
+              (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:19:24-26 })
+              (HsTyVar
+               (EpAnn
+                (Anchor
+                 { T17544_kw.hs:19:24-26 }
+                 (UnchangedAnchor))
+                []
+                (EpaComments
+                 []))
+               (NotPromoted)
+               (L
+                (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:19:24-26 })
+                (Unqual
+                 {OccName: Bar})))))))
           (Just
            (L
             { T17544_kw.hs:18:13-38 }
diff --git a/testsuite/tests/indexed-types/should_compile/T14111b.hs b/testsuite/tests/indexed-types/should_compile/T14111b.hs
new file mode 100644
index 0000000000..179597f48f
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T14111b.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE MagicHash, UnboxedSums, NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE GADTs ,ExplicitNamespaces#-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module T14111b where
+
+import GHC.Exts
+import GHC.Types
+import Prelude (undefined)
+import Data.Kind
+import Data.Void
+
+data family Maybe(x :: TYPE (r :: RuntimeRep))
+
+data instance Maybe (a :: Type ) where
+  MaybeSum :: { unMaybeSum :: (# a  | (# #) #) } -> Maybe a
+
+data instance Maybe (x :: TYPE ('BoxedRep 'Unlifted)) where
+  MaybeSumU :: { unMaybeSumU :: (# x | (# #) #) } -> Maybe x
diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T
index 3549a37f70..666e0acaf0 100644
--- a/testsuite/tests/indexed-types/should_compile/all.T
+++ b/testsuite/tests/indexed-types/should_compile/all.T
@@ -302,6 +302,7 @@ test('GivenLoop', normal, compile, [''])
 test('T18875', normal, compile, [''])
 test('T8707', normal, compile, ['-O'])
 test('T14111', normal, compile, ['-O'])
+test('T14111b', normal, compile, ['-O'])
 test('T19336', normal, compile, ['-O'])
 test('T11715b', normal, ghci_script, ['T11715b.script'])
 test('T4254', normal, compile, [''])
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index cfaa1b102e..8006bde050 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -591,7 +591,8 @@
                 ,{Name: g}]))
               (Nothing)
               (PrefixConGADT
-               [(HsScaled
+               (PCGSAnonArg
+                (HsScaled
                  (HsUnrestrictedArrow
                   (L
                    (TokenLoc
@@ -682,39 +683,40 @@
                            (NotPromoted)
                            (L
                             (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:32-33 })
-                            {Name: xx}))))))))))))])
-              (L
-               (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:39-45 })
-               (HsAppTy
-                (NoExtField)
-                (L
-                 (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:39-43 })
-                 (HsAppTy
-                  (NoExtField)
-                  (L
-                   (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:39-41 })
-                   (HsTyVar
-                    (EpAnnNotUsed)
-                    (NotPromoted)
-                    (L
-                     (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:39-41 })
-                     {Name: DumpRenamedAst.Nat})))
-                  (L
-                   (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:43 })
-                   (HsTyVar
-                    (EpAnnNotUsed)
-                    (NotPromoted)
-                    (L
-                     (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:43 })
-                     {Name: f})))))
-                (L
-                 (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:45 })
-                 (HsTyVar
-                  (EpAnnNotUsed)
-                  (NotPromoted)
-                  (L
-                   (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:45 })
-                   {Name: g})))))
+                            {Name: xx}))))))))))))
+                (PCGSRes
+                 (L
+                  (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:39-45 })
+                  (HsAppTy
+                   (NoExtField)
+                   (L
+                    (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:39-43 })
+                    (HsAppTy
+                     (NoExtField)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:39-41 })
+                      (HsTyVar
+                       (EpAnnNotUsed)
+                       (NotPromoted)
+                       (L
+                        (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:39-41 })
+                        {Name: DumpRenamedAst.Nat})))
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:43 })
+                      (HsTyVar
+                       (EpAnnNotUsed)
+                       (NotPromoted)
+                       (L
+                        (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:43 })
+                        {Name: f})))))
+                   (L
+                    (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:45 })
+                    (HsTyVar
+                     (EpAnnNotUsed)
+                     (NotPromoted)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:45 })
+                      {Name: g}))))))))
               (Nothing)))]
            [])))))])
    ,(TyClGroup
diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr
index 0a2f60dd59..177eaf5ed8 100644
--- a/testsuite/tests/parser/should_compile/T15323.stderr
+++ b/testsuite/tests/parser/should_compile/T15323.stderr
@@ -186,42 +186,44 @@
                     (Unqual
                      {OccName: v}))))))))]))
           (PrefixConGADT
-           [])
-          (L
-           (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:41-54 })
-           (HsAppTy
-            (NoExtField)
+           (PCGSRes
             (L
-             (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:41-52 })
-             (HsTyVar
-              (EpAnn
-               (Anchor
-                { T15323.hs:6:41-52 }
-                (UnchangedAnchor))
-               []
-               (EpaComments
-                []))
-              (NotPromoted)
+             (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:41-54 })
+             (HsAppTy
+              (NoExtField)
               (L
                (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:41-52 })
-               (Unqual
-                {OccName: MaybeDefault}))))
-            (L
-             (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:54 })
-             (HsTyVar
-              (EpAnn
-               (Anchor
-                { T15323.hs:6:54 }
-                (UnchangedAnchor))
-               []
-               (EpaComments
-                []))
-              (NotPromoted)
+               (HsTyVar
+                (EpAnn
+                 (Anchor
+                  { T15323.hs:6:41-52 }
+                  (UnchangedAnchor))
+                 []
+                 (EpaComments
+                  []))
+                (NotPromoted)
+                (L
+                 (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:41-52 })
+                 (Unqual
+                  {OccName: MaybeDefault}))))
               (L
                (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:54 })
-               (Unqual
-                {OccName: v}))))))
+               (HsTyVar
+                (EpAnn
+                 (Anchor
+                  { T15323.hs:6:54 }
+                  (UnchangedAnchor))
+                 []
+                 (EpaComments
+                  []))
+                (NotPromoted)
+                (L
+                 (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:54 })
+                 (Unqual
+                  {OccName: v}))))))))
           (Nothing)))]
        []))))]
   (Nothing)
   (Nothing)))
+
+
diff --git a/testsuite/tests/printer/T18791.stderr b/testsuite/tests/printer/T18791.stderr
index 65fe422f4a..85ce986517 100644
--- a/testsuite/tests/printer/T18791.stderr
+++ b/testsuite/tests/printer/T18791.stderr
@@ -88,7 +88,8 @@
             (NoExtField)))
           (Nothing)
           (PrefixConGADT
-           [(HsScaled
+           (PCGSAnonArg
+            (HsScaled
              (HsUnrestrictedArrow
               (L
                (TokenLoc
@@ -115,22 +116,23 @@
                (L
                 (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:10-12 })
                 (Unqual
-                 {OccName: Int})))))])
-          (L
-           (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:17 })
-           (HsTyVar
-            (EpAnn
-             (Anchor
-              { T18791.hs:5:17 }
-              (UnchangedAnchor))
-             []
-             (EpaComments
-              []))
-            (NotPromoted)
-            (L
-             (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:17 })
-             (Unqual
-              {OccName: T}))))
+                 {OccName: Int})))))
+            (PCGSRes
+             (L
+              (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:17 })
+              (HsTyVar
+               (EpAnn
+                (Anchor
+                 { T18791.hs:5:17 }
+                 (UnchangedAnchor))
+                []
+                (EpaComments
+                 []))
+               (NotPromoted)
+               (L
+                (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:17 })
+                (Unqual
+                 {OccName: T})))))))
           (Nothing)))]
        []))))]
   (Nothing)
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 3d493cfd22..0e81894017 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -3224,8 +3224,8 @@ instance ExactPrint (ConDecl GhcPs) where
   exact (ConDeclGADT { con_g_ext = an
                      , con_names = cons
                      , con_bndrs = bndrs
-                     , con_mb_cxt = mcxt, con_g_args = args
-                     , con_res_ty = res_ty, con_doc = doc }) = do
+                     , con_mb_cxt = mcxt
+                     , con_body = body, con_doc = doc }) = do
     mapM_ markAnnotated doc
     mapM_ markAnnotated cons
     markEpAnn an AnnDcolon
@@ -3237,13 +3237,14 @@ instance ExactPrint (ConDecl GhcPs) where
     mapM_ markAnnotated mcxt
     when (isJust mcxt) $ markEpAnn an AnnDarrow
     -- mapM_ markAnnotated args
-    case args of
-        PrefixConGADT args' -> mapM_ markAnnotated args'
-        RecConGADT fields arr -> do
+    case body of
+        PrefixConGADT body' ->
+          exact_prefix_con_gadt_sig_body body'
+        RecConGADT fields arr res_ty -> do
           markAnnotated fields
           markUniToken arr
+          markAnnotated res_ty
           -- mapM_ markAnnotated (unLoc fields)
-    markAnnotated res_ty
   -- markAST _ (GHC.ConDeclGADT _ lns (GHC.L l forall) qvars mbCxt args typ _) = do
   --   setContext (Set.singleton PrefixOp) $ markListIntercalate lns
   --   mark GHC.AnnDcolon
@@ -3254,6 +3255,12 @@ instance ExactPrint (ConDecl GhcPs) where
   --   markLocated typ
   --   markManyOptional GHC.AnnCloseP
   --   markTrailingSemi
+      where
+        exact_prefix_con_gadt_sig_body (PCGSRes res_ty) =
+          markAnnotated res_ty
+        exact_prefix_con_gadt_sig_body (PCGSAnonArg arg_ty body') = do
+          markAnnotated arg_ty
+          exact_prefix_con_gadt_sig_body body'
 
 -- pprConDecl (ConDeclGADT { con_names = cons, con_qvars = qvars
 --                         , con_mb_cxt = mcxt, con_args = args
diff --git a/utils/haddock b/utils/haddock
-Subproject 58237d76c96325f25627bfd7cdad5b93364d29a
+Subproject d1aa841631b018c00b65e7a129c7e103cc8df6a
author	Ryan Scott <ryan.gl.scott@gmail.com>	2021-05-04 20:09:31 -0400
committer	Ryan Scott <ryan.gl.scott@gmail.com>	2022-04-02 07:11:30 -0400
commit	ff8d81265090dc89e067a08028d9c598f72529ab (patch)
tree	1e3393647bd970d9fa515529cadcce35aceff16b
parent	d85c7dcb7c457efc23b20ac8f4e4ae88bae5b050 (diff)
download	haskell-wip/T18389-task-zero.tar.gz