diff options
| 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 /compiler/GHC/ThToHs.hs | |
| parent | d85c7dcb7c457efc23b20ac8f4e4ae88bae5b050 (diff) | |
| download | haskell-wip/T18389-task-zero.tar.gz | |
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.
Diffstat (limited to 'compiler/GHC/ThToHs.hs')
| -rw-r--r-- | compiler/GHC/ThToHs.hs | 15 |
1 files changed, 9 insertions, 6 deletions
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 |