diff options
Diffstat (limited to 'compiler/GHC/Parser/PostProcess.hs')
| -rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 17 |
1 files changed, 8 insertions, 9 deletions
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 |