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.

4 files changed, 55 insertions, 32 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)]