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.

1 files changed, 42 insertions, 24 deletions

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