diff options
Diffstat (limited to 'compiler/GHC/Hs/Decls.hs')
| -rw-r--r-- | compiler/GHC/Hs/Decls.hs | 57 |
1 files changed, 32 insertions, 25 deletions
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index 51f1e2a127..2024b61b81 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -74,8 +74,8 @@ module GHC.Hs.Decls ( CImportSpec(..), -- ** Data-constructor declarations ConDecl(..), LConDecl, - HsConDeclDetails, hsConDeclArgTys, hsConDeclTheta, - getConNames, getConArgs, + HsConDeclH98Details, HsConDeclGADTDetails(..), hsConDeclTheta, + getConNames, getRecConArgs_maybe, -- ** Document comments DocDecl(..), LDocDecl, docDeclDoc, -- ** Deprecations @@ -1476,9 +1476,9 @@ data ConDecl pass -- Whether or not there is an /explicit/ forall, we still -- need to capture the implicitly-bound type/kind variables - , con_mb_cxt :: Maybe (LHsContext pass) -- ^ User-written context (if any) - , con_args :: HsConDeclDetails pass -- ^ Arguments; never InfixCon - , con_res_ty :: LHsType pass -- ^ Result type + , 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_doc :: Maybe LHsDocString -- ^ A possible Haddock comment. @@ -1495,7 +1495,7 @@ data ConDecl pass -- False => con_ex_tvs is empty , con_ex_tvs :: [LHsTyVarBndr Specificity pass] -- ^ Existentials only , con_mb_cxt :: Maybe (LHsContext pass) -- ^ User-written context (if any) - , con_args :: HsConDeclDetails pass -- ^ Arguments; can be InfixCon + , con_args :: HsConDeclH98Details pass -- ^ Arguments; can be infix , con_doc :: Maybe LHsDocString -- ^ A possible Haddock comment. @@ -1626,27 +1626,35 @@ or contexts in two parts: quantification occurs after a visible argument type. -} --- | Haskell data Constructor Declaration Details -type HsConDeclDetails pass +-- | The arguments in a Haskell98-style data constructor. +type HsConDeclH98Details pass = HsConDetails (HsScaled pass (LBangType pass)) (XRec pass [LConDeclField pass]) +-- | 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]) + getConNames :: ConDecl GhcRn -> [Located Name] getConNames ConDeclH98 {con_name = name} = [name] getConNames ConDeclGADT {con_names = names} = names -getConArgs :: ConDecl GhcRn -> HsConDeclDetails GhcRn -getConArgs d = con_args d - -hsConDeclArgTys :: HsConDeclDetails (GhcPass p) -> [HsScaled (GhcPass p) (LBangType (GhcPass p))] -hsConDeclArgTys (PrefixCon tys) = tys -hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2] -hsConDeclArgTys (RecCon flds) = map (hsLinear . cd_fld_type . unLoc) (unLoc flds) - -- Remark: with the record syntax, constructors have all their argument - -- linear, despite the fact that projections do not make sense on linear - -- constructors. The design here is that the record projection themselves are - -- typed to take an unrestricted argument (that is the record itself is - -- unrestricted). By the transfer property, projections are then correct in - -- that all the non-projected fields have multiplicity Many, and can be dropped. +-- | Return @'Just' fields@ if a data constructor declaration uses record +-- syntax (i.e., 'RecCon'), where @fields@ are the field selectors. +-- Otherwise, return 'Nothing'. +getRecConArgs_maybe :: ConDecl GhcRn -> Maybe (Located [LConDeclField GhcRn]) +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 hsConDeclTheta :: Maybe (LHsContext (GhcPass p)) -> [LHsType (GhcPass p)] hsConDeclTheta Nothing = [] @@ -1726,15 +1734,14 @@ pprConDecl (ConDeclH98 { con_name = L _ con cxt = fromMaybe noLHsContext mcxt pprConDecl (ConDeclGADT { con_names = cons, con_qvars = qvars - , con_mb_cxt = mcxt, con_args = args + , con_mb_cxt = mcxt, con_g_args = args , con_res_ty = res_ty, con_doc = doc }) = ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon <+> (sep [pprHsForAll (mkHsForAllInvisTele qvars) cxt, ppr_arrow_chain (get_args args ++ [ppr res_ty]) ]) where - get_args (PrefixCon args) = map ppr args - get_args (RecCon fields) = [pprConDeclFields (unLoc fields)] - get_args (InfixCon {}) = pprPanic "pprConDecl:GADT" (ppr cons) + get_args (PrefixConGADT args) = map ppr args + get_args (RecConGADT fields) = [pprConDeclFields (unLoc fields)] cxt = fromMaybe noLHsContext mcxt |