diff options
37 files changed, 1514 insertions, 1422 deletions
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index 8bb7834f3b..1db54bfc4b 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -27,7 +27,7 @@ module GHC.Hs.Decls ( -- * Toplevel declarations HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, - NewOrData(..), newOrDataToFlavour, + NewOrData, newOrDataToFlavour, anyLConIsGadt, StandaloneKindSig(..), LStandaloneKindSig, standaloneKindSigName, -- ** Class or type declarations @@ -43,7 +43,8 @@ module GHC.Hs.Decls ( tyClDeclLName, tyClDeclTyVars, hsDeclHasCusk, famResultKindSignature, FamilyDecl(..), LFamilyDecl, - FunDep(..), + FunDep(..), ppDataDefnHeader, + pp_vanilla_decl_head, -- ** Instance declarations InstDecl(..), LInstDecl, FamilyInfo(..), @@ -132,6 +133,7 @@ import GHC.Types.ForeignCall import GHC.Data.Bag import GHC.Data.Maybe import Data.Data (Data) +import Data.Foldable (toList) {- ************************************************************************ @@ -399,10 +401,10 @@ countTyClDecls decls count isNewTy decls, -- ...instances count isFamilyDecl decls) where - isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = DataType } } = True + isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_cons = DataTypeCons _ } } = True isDataTy _ = False - isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True + isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_cons = NewTypeCon _ } } = True isNewTy _ = False -- FIXME: tcdName is commonly used by both GHC and third-party tools, so it @@ -501,8 +503,8 @@ pprTyClDeclFlavour (ClassDecl {}) = text "class" pprTyClDeclFlavour (SynDecl {}) = text "type" pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }}) = pprFlavour info <+> text "family" -pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } }) - = ppr nd +pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_cons = nd } }) + = ppr (dataDefnConsNewOrData nd) instance OutputableBndrId p => Outputable (FunDep (GhcPass p)) where ppr = pprFunDep @@ -665,9 +667,10 @@ type instance XConDeclH98 (GhcPass _) = EpAnn [AddEpAnn] type instance XXConDecl (GhcPass _) = DataConCantHappen +-- Codomain could be 'NonEmpty', but at the moment all users need a list. getConNames :: ConDecl GhcRn -> [LocatedN Name] getConNames ConDeclH98 {con_name = name} = [name] -getConNames ConDeclGADT {con_names = names} = names +getConNames ConDeclGADT {con_names = names} = toList names -- | Return @'Just' fields@ if a data constructor declaration uses record -- syntax (i.e., 'RecCon'), where @fields@ are the field selectors. @@ -685,28 +688,38 @@ hsConDeclTheta :: Maybe (LHsContext (GhcPass p)) -> [LHsType (GhcPass p)] hsConDeclTheta Nothing = [] hsConDeclTheta (Just (L _ theta)) = theta +ppDataDefnHeader + :: (OutputableBndrId p) + => (Maybe (LHsContext (GhcPass p)) -> SDoc) -- Printing the header + -> HsDataDefn (GhcPass p) + -> SDoc +ppDataDefnHeader pp_hdr HsDataDefn + { dd_ctxt = context + , dd_cType = mb_ct + , dd_kindSig = mb_sig + , dd_cons = condecls } + = ppr (dataDefnConsNewOrData condecls) <+> pp_ct <+> pp_hdr context <+> pp_sig + where + pp_ct = case mb_ct of + Nothing -> empty + Just ct -> ppr ct + pp_sig = case mb_sig of + Nothing -> empty + Just kind -> dcolon <+> ppr kind + pp_data_defn :: (OutputableBndrId p) => (Maybe (LHsContext (GhcPass p)) -> SDoc) -- Printing the header -> HsDataDefn (GhcPass p) -> SDoc -pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = context - , dd_cType = mb_ct - , dd_kindSig = mb_sig - , dd_cons = condecls, dd_derivs = derivings }) +pp_data_defn pp_hdr defn@HsDataDefn + { dd_cons = condecls + , dd_derivs = derivings } | null condecls - = ppr new_or_data <+> pp_ct <+> pp_hdr context <+> pp_sig - <+> pp_derivings derivings + = ppDataDefnHeader pp_hdr defn <+> pp_derivings derivings | otherwise - = hang (ppr new_or_data <+> pp_ct <+> pp_hdr context <+> pp_sig) - 2 (pp_condecls condecls $$ pp_derivings derivings) + = hang (ppDataDefnHeader pp_hdr defn) 2 (pp_condecls (toList condecls) $$ pp_derivings derivings) where - pp_ct = case mb_ct of - Nothing -> empty - Just ct -> ppr ct - pp_sig = case mb_sig of - Nothing -> empty - Just kind -> dcolon <+> ppr kind pp_derivings ds = vcat (map ppr ds) instance OutputableBndrId p @@ -720,15 +733,10 @@ instance OutputableBndrId p pp_condecls :: forall p. OutputableBndrId p => [LConDecl (GhcPass p)] -> SDoc pp_condecls cs - | gadt_syntax -- In GADT syntax + | anyLConIsGadt cs -- In GADT syntax = hang (text "where") 2 (vcat (map ppr cs)) | otherwise -- In H98 syntax = equals <+> sep (punctuate (text " |") (map ppr cs)) - where - gadt_syntax = case cs of - [] -> False - (L _ ConDeclH98{} : _) -> False - (L _ ConDeclGADT{} : _) -> True instance (OutputableBndrId p) => Outputable (ConDecl (GhcPass p)) where ppr = pprConDecl @@ -756,7 +764,7 @@ pprConDecl (ConDeclH98 { con_name = L _ con 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 }) - = pprMaybeWithDoc doc $ ppr_con_names cons <+> dcolon + = pprMaybeWithDoc doc $ ppr_con_names (toList cons) <+> dcolon <+> (sep [pprHsOuterSigTyVarBndrs outer_bndrs <+> pprLHsContext mcxt, sep (ppr_args args ++ [ppr res_ty]) ]) where @@ -850,9 +858,9 @@ pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = -- pp_data_defn pretty-prints the kind sig. See #14817. pprDataFamInstFlavour :: DataFamInstDecl (GhcPass p) -> SDoc -pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = - (FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }})}) - = ppr nd +pprDataFamInstFlavour DataFamInstDecl + { dfid_eqn = FamEqn { feqn_rhs = HsDataDefn { dd_cons = cons }}} + = ppr (dataDefnConsNewOrData cons) pprHsFamInstLHS :: (OutputableBndrId p) => IdP (GhcPass p) @@ -932,6 +940,14 @@ instance Outputable NewOrData where ppr NewType = text "newtype" ppr DataType = text "data" +-- At the moment we only call this with @f = '[]'@ and @f = 'DataDefnCons'@. +anyLConIsGadt :: Foldable f => f (GenLocated l (ConDecl pass)) -> Bool +anyLConIsGadt xs = case toList xs of + L _ ConDeclGADT {} : _ -> True + _ -> False +{-# SPECIALIZE anyLConIsGadt :: [GenLocated l (ConDecl pass)] -> Bool #-} +{-# SPECIALIZE anyLConIsGadt :: DataDefnCons (GenLocated l (ConDecl pass)) -> Bool #-} + {- ************************************************************************ * * diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index 3e74eea3db..195df82d8a 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -147,6 +147,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import Data.Either +import Data.Foldable ( toList ) import Data.Function import Data.List ( partition, deleteBy ) @@ -1439,7 +1440,7 @@ hsDataDefnBinders :: IsPass p => HsDataDefn (GhcPass p) -> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)]) hsDataDefnBinders (HsDataDefn { dd_cons = cons }) - = hsConDeclsBinders cons + = hsConDeclsBinders (toList cons) -- See Note [Binders in family instances] ------------------- @@ -1466,7 +1467,7 @@ hsConDeclsBinders cons -- 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 } - -> (map (L loc . unLoc) names ++ ns, flds ++ fs) + -> (toList (L loc . unLoc <$> names) ++ ns, flds ++ fs) where (remSeen', flds) = get_flds_gadt remSeen args (ns, fs) = go remSeen' rs diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs index f8436fecd8..f162dadaf5 100644 --- a/compiler/GHC/HsToCore/Docs.hs +++ b/compiler/GHC/HsToCore/Docs.hs @@ -28,6 +28,7 @@ import GHC.Parser.Annotation import Control.Applicative import Control.Monad.IO.Class import Data.Bifunctor (first) +import Data.Foldable (toList) import Data.IntMap (IntMap) import qualified Data.IntMap as IM import Data.Map.Strict (Map) @@ -366,13 +367,13 @@ subordinates env instMap decl = case decl of -> [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))] dataSubs dd = constrs ++ fields ++ derivs where - cons = map unLoc $ (dd_cons dd) + cons = unLoc <$> dd_cons dd constrs = [ ( unLoc cname , maybeToList $ fmap unLoc $ con_doc c , conArgDocs c) - | c <- cons, cname <- getConNames c ] + | c <- toList cons, cname <- getConNames c ] fields = [ (foExt n, maybeToList $ fmap unLoc doc, IM.empty) - | Just flds <- map getRecConArgs_maybe cons + | Just flds <- toList $ fmap getRecConArgs_maybe cons , (L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (L _ n) <- ns ] derivs = [ (instName, [unLoc doc], IM.empty) diff --git a/compiler/GHC/HsToCore/Errors/Ppr.hs b/compiler/GHC/HsToCore/Errors/Ppr.hs index ede0e6febf..092a690b25 100644 --- a/compiler/GHC/HsToCore/Errors/Ppr.hs +++ b/compiler/GHC/HsToCore/Errors/Ppr.hs @@ -114,8 +114,6 @@ instance Diagnostic DsMessage where | isTyVar b = text "type variable" <+> quotes (ppr b) | isEvVar b = text "constraint" <+> quotes (ppr (varType b)) | otherwise = text "variable" <+> quotes (ppr b) - DsMultipleConForNewtype names - -> mkSimpleDecorated $ text "Multiple constructors for newtype:" <+> pprQuotedList names DsLazyPatCantBindVarsOfUnliftedType unlifted_bndrs -> mkSimpleDecorated $ hang (text "A lazy (~) pattern cannot bind variables of unlifted type." $$ @@ -226,7 +224,6 @@ instance Diagnostic DsMessage where DsRuleLhsTooComplicated{} -> WarningWithoutFlag DsRuleIgnoredDueToConstructor{} -> WarningWithoutFlag DsRuleBindersNotBound{} -> WarningWithoutFlag - DsMultipleConForNewtype{} -> ErrorWithoutFlag DsLazyPatCantBindVarsOfUnliftedType{} -> ErrorWithoutFlag DsNotYetHandledByTH{} -> ErrorWithoutFlag DsAggregatedViewExpressions{} -> WarningWithoutFlag @@ -263,7 +260,6 @@ instance Diagnostic DsMessage where DsRuleLhsTooComplicated{} -> noHints DsRuleIgnoredDueToConstructor{} -> noHints DsRuleBindersNotBound{} -> noHints - DsMultipleConForNewtype{} -> noHints DsLazyPatCantBindVarsOfUnliftedType{} -> noHints DsNotYetHandledByTH{} -> noHints DsAggregatedViewExpressions{} -> noHints diff --git a/compiler/GHC/HsToCore/Errors/Types.hs b/compiler/GHC/HsToCore/Errors/Types.hs index 1b1c5532f8..028a02544d 100644 --- a/compiler/GHC/HsToCore/Errors/Types.hs +++ b/compiler/GHC/HsToCore/Errors/Types.hs @@ -122,8 +122,6 @@ data DsMessage !CoreExpr -- ^ The optimised LHS - | DsMultipleConForNewtype [LocatedN Name] - | DsLazyPatCantBindVarsOfUnliftedType [Var] | DsNotYetHandledByTH !ThRejectionReason diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs index ac122446b7..e6f8ce4c51 100644 --- a/compiler/GHC/HsToCore/Quote.hs +++ b/compiler/GHC/HsToCore/Quote.hs @@ -98,6 +98,7 @@ import Data.List.NonEmpty ( NonEmpty(..) ) import Data.Function import Control.Monad.Trans.Reader import Control.Monad.Trans.Class +import Data.Foldable ( toList ) data MetaWrappers = MetaWrappers { -- Applies its argument to a type argument `m` and dictionary `Quote m` @@ -517,17 +518,16 @@ repDataDefn :: Core TH.Name -> HsDataDefn GhcRn -> MetaM (Core (M TH.Dec)) repDataDefn tc opts - (HsDataDefn { dd_ND = new_or_data, dd_ctxt = cxt, dd_kindSig = ksig + (HsDataDefn { dd_ctxt = cxt, dd_kindSig = ksig , dd_cons = cons, dd_derivs = mb_derivs }) = do { cxt1 <- repLContext cxt ; derivs1 <- repDerivs mb_derivs - ; case (new_or_data, cons) of - (NewType, [con]) -> do { con' <- repC con + ; case cons of + NewTypeCon con -> do { con' <- repC con ; ksig' <- repMaybeLTy ksig ; repNewtype cxt1 tc opts ksig' con' derivs1 } - (NewType, _) -> lift $ failWithDs (DsMultipleConForNewtype (getConNames $ unLoc $ head cons)) - (DataType, _) -> do { ksig' <- repMaybeLTy ksig + DataTypeCons cons -> do { ksig' <- repMaybeLTy ksig ; consL <- mapM repC cons ; cons1 <- coreListM conTyConName consL ; repData cxt1 tc opts ksig' cons1 @@ -2704,7 +2704,7 @@ repH98DataCon con details arg_vtys <- repRecConArgs ips rep2 recCName [unC con', unC arg_vtys] -repGadtDataCons :: [LocatedN Name] +repGadtDataCons :: NonEmpty (LocatedN Name) -> HsConDeclGADTDetails GhcRn -> LHsType GhcRn -> MetaM (Core (M TH.Con)) @@ -2714,11 +2714,11 @@ repGadtDataCons cons details res_ty PrefixConGADT ps -> do arg_tys <- repPrefixConArgs ps res_ty' <- repLTy res_ty - rep2 gadtCName [ unC (nonEmptyCoreList cons'), unC arg_tys, unC res_ty'] + rep2 gadtCName [ unC (nonEmptyCoreList' cons'), unC arg_tys, unC res_ty'] RecConGADT ips _ -> do arg_vtys <- repRecConArgs ips res_ty' <- repLTy res_ty - rep2 recGadtCName [unC (nonEmptyCoreList cons'), unC arg_vtys, + rep2 recGadtCName [unC (nonEmptyCoreList' cons'), unC arg_vtys, unC res_ty'] -- TH currently only supports linear constructors. @@ -3001,6 +3001,8 @@ nonEmptyCoreList :: [Core a] -> Core [a] nonEmptyCoreList [] = panic "coreList: empty argument" nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs)) +nonEmptyCoreList' :: NonEmpty (Core a) -> Core [a] +nonEmptyCoreList' xs@(MkC x:|_) = MkC (mkListExpr (exprType x) (toList $ fmap unC xs)) coreStringLit :: MonadThings m => String -> m (Core String) coreStringLit s = do { z <- mkStringExpr s; return(MkC z) } diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs index de66cdaef2..61a88fc4c7 100644 --- a/compiler/GHC/Iface/Ext/Ast.hs +++ b/compiler/GHC/Iface/Ext/Ast.hs @@ -69,7 +69,9 @@ import qualified Data.ByteString as BS import qualified Data.Map as M import qualified Data.Set as S import Data.Data ( Data, Typeable ) +import Data.Foldable ( toList ) import Data.Functor.Identity ( Identity(..) ) +import Data.List.NonEmpty ( NonEmpty(..) ) import Data.Void ( Void, absurd ) import Control.Monad ( forM_ ) import Control.Monad.Trans.State.Strict @@ -556,6 +558,9 @@ instance HasLoc a => HasLoc [a] where loc [] = noSrcSpan loc xs = foldl1' combineSrcSpans $ map loc xs +instance HasLoc a => HasLoc (DataDefnCons a) where + loc = loc . toList + instance (HasLoc a, HiePass p) => HasLoc (FamEqn (GhcPass p) a) where loc (FamEqn _ a outer_bndrs b _ c) = case outer_bndrs of HsOuterImplicit{} -> @@ -589,6 +594,12 @@ instance ToHie Void where instance (ToHie a) => ToHie [a] where toHie = concatMapM toHie +instance (ToHie a) => ToHie (NonEmpty a) where + toHie = concatMapM toHie + +instance (ToHie a) => ToHie (DataDefnCons a) where + toHie = concatMapM toHie + instance (ToHie a) => ToHie (Bag a) where toHie = toHie . bagToList @@ -1474,8 +1485,8 @@ instance ToHie (LocatedA (TyClDecl GhcRn)) where quant_scope = mkLScopeA $ fromMaybe (noLocA []) $ dd_ctxt defn rhs_scope = sig_sc `combineScopes` con_sc `combineScopes` deriv_sc sig_sc = maybe NoScope mkLScopeA $ dd_kindSig defn - con_sc = foldr combineScopes NoScope $ map mkLScopeA $ dd_cons defn - deriv_sc = foldr combineScopes NoScope $ map mkLScopeA $ dd_derivs defn + con_sc = foldr combineScopes NoScope $ mkLScopeA <$> dd_cons defn + deriv_sc = foldr combineScopes NoScope $ mkLScopeA <$> dd_derivs defn ClassDecl { tcdCtxt = context , tcdLName = name , tcdTyVars = vars @@ -1568,7 +1579,7 @@ instance ToHie (LocatedAn NoEpAnns (InjectivityAnn GhcRn)) where ] instance ToHie (HsDataDefn GhcRn) where - toHie (HsDataDefn _ _ ctx _ mkind cons derivs) = concatM + toHie (HsDataDefn _ ctx _ mkind cons derivs) = concatM [ toHie ctx , toHie mkind , toHie cons @@ -1611,7 +1622,7 @@ instance ToHie (LocatedA (ConDecl GhcRn)) where ConDeclGADT { con_names = names, con_bndrs = L outer_bndrs_loc outer_bndrs , con_mb_cxt = ctx, con_g_args = args, con_res_ty = typ , con_doc = doc} -> - [ toHie $ map (C (Decl ConDec $ getRealSpanA span)) names + [ toHie $ C (Decl ConDec $ getRealSpanA span) <$> names , case outer_bndrs of HsOuterImplicit{hso_ximplicit = imp_vars} -> bindingsOnly $ map (C $ TyVarBind (mkScopeA outer_bndrs_loc) resScope) diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 4b367b2da9..e530750745 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -12,6 +12,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE LambdaCase #-} -- | This module provides the generated Happy parser for Haskell. It exports -- a number of parsers which may be used in any library that uses the GHC API. @@ -1660,7 +1661,7 @@ pattern_synonym_sig :: { LSig GhcPs } : 'pattern' con_list '::' sigtype {% acsA (\cs -> sLL $1 (reLoc $>) $ PatSynSig (EpAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnPattern $1]) cs) - (unLoc $2) $4) } + (toList $ unLoc $2) $4) } qvarcon :: { LocatedN RdrName } : qvar { $1 } @@ -3544,10 +3545,9 @@ con :: { LocatedN RdrName } (NameAnn NameParens (glAA $1) (glNRR $2) (glAA $3) []) } | sysdcon { L (getLoc $1) $ nameRdrName (dataConName (unLoc $1)) } -con_list :: { Located [LocatedN RdrName] } -con_list : con { sL1N $1 [$1] } - | con ',' con_list {% do { h <- addTrailingCommaN $1 (gl $2) - ; return (sLL (reLocN $1) $> (h : unLoc $3)) }} +con_list :: { Located (NonEmpty (LocatedN RdrName)) } +con_list : con { sL1N $1 (pure $1) } + | con ',' con_list {% sLL (reLocN $1) $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } qcon_list :: { Located [LocatedN RdrName] } qcon_list : qcon { sL1N $1 [$1] } diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs index 1a368b0fac..b515d89541 100644 --- a/compiler/GHC/Parser/Errors/Ppr.hs +++ b/compiler/GHC/Parser/Errors/Ppr.hs @@ -503,6 +503,12 @@ instance Diagnostic PsMessage where ] PsErrInvalidCApiImport {} -> mkSimpleDecorated $ vcat [ text "Wrapper stubs can't be used with CApiFFI."] + PsErrMultipleConForNewtype tycon n -> mkSimpleDecorated $ vcat + [ sep + [ text "A newtype must have exactly one constructor," + , nest 2 $ text "but" <+> quotes (ppr tycon) <+> text "has" <+> speakN n ] + , text "In the newtype declaration for" <+> quotes (ppr tycon) ] + diagnosticReason = \case PsUnknownMessage m -> diagnosticReason m PsHeaderMessage m -> psHeaderMessageReason m @@ -619,6 +625,7 @@ instance Diagnostic PsMessage where PsErrParseRightOpSectionInPat{} -> ErrorWithoutFlag PsErrIllegalGadtRecordMultiplicity{} -> ErrorWithoutFlag PsErrInvalidCApiImport {} -> ErrorWithoutFlag + PsErrMultipleConForNewtype {} -> ErrorWithoutFlag diagnosticHints = \case PsUnknownMessage m -> diagnosticHints m @@ -788,6 +795,7 @@ instance Diagnostic PsMessage where PsErrInvalidPackageName{} -> noHints PsErrIllegalGadtRecordMultiplicity{} -> noHints PsErrInvalidCApiImport {} -> noHints + PsErrMultipleConForNewtype {} -> noHints diagnosticCode = constructorCode diff --git a/compiler/GHC/Parser/Errors/Types.hs b/compiler/GHC/Parser/Errors/Types.hs index aac26d5532..1b16911700 100644 --- a/compiler/GHC/Parser/Errors/Types.hs +++ b/compiler/GHC/Parser/Errors/Types.hs @@ -463,6 +463,8 @@ data PsMessage | PsErrInvalidCApiImport + | PsErrMultipleConForNewtype !RdrName !Int + deriving Generic -- | Extra details about a parse error, which helps diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 19dac05130..e0bf363f4b 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -230,23 +230,23 @@ mkTyData loc' new_or_data cType (L _ (mcxt, tycl_hdr)) ; tyvars <- checkTyVars (ppr new_or_data) equalsDots tc tparams ; cs <- getCommentsFor (locA loc) -- Get any remaining comments ; let anns' = addAnns (EpAnn (spanAsAnchor $ locA loc) annsIn emptyComments) ann cs - ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv + ; data_cons <- checkNewOrData (locA loc) (unLoc tc) new_or_data data_cons + ; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv ; return (L loc (DataDecl { tcdDExt = anns', tcdLName = tc, tcdTyVars = tyvars, tcdFixity = fixity, tcdDataDefn = defn })) } -mkDataDefn :: NewOrData - -> Maybe (LocatedP CType) +mkDataDefn :: Maybe (LocatedP CType) -> Maybe (LHsContext GhcPs) -> Maybe (LHsKind GhcPs) - -> [LConDecl GhcPs] + -> DataDefnCons (LConDecl GhcPs) -> HsDeriving GhcPs -> P (HsDataDefn GhcPs) -mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv +mkDataDefn cType mcxt ksig data_cons maybe_deriv = do { checkDatatypeContext mcxt ; return (HsDataDefn { dd_ext = noExtField - , dd_ND = new_or_data, dd_cType = cType + , dd_cType = cType , dd_ctxt = mcxt , dd_cons = data_cons , dd_kindSig = ksig @@ -327,7 +327,8 @@ mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr) = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr ; cs <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan ; let fam_eqn_ans = addAnns (EpAnn (spanAsAnchor loc) ann cs) anns emptyComments - ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv + ; data_cons <- checkNewOrData loc (unLoc tc) new_or_data data_cons + ; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv ; return (L (noAnnSrcSpan loc) (DataFamInstD noExtField (DataFamInstDecl (FamEqn { feqn_ext = fam_eqn_ans , feqn_tycon = tc @@ -752,7 +753,7 @@ mkConDeclH98 ann name mb_forall mb_cxt args -- records whether this is a prefix or record GADT constructor. See -- Note [GADT abstract syntax] in "GHC.Hs.Decls" for more details. mkGadtDecl :: SrcSpan - -> [LocatedN RdrName] + -> NonEmpty (LocatedN RdrName) -> LHsUniToken "::" "∷" GhcPs -> LHsSigType GhcPs -> P (LConDecl GhcPs) @@ -2621,6 +2622,12 @@ mkOpaquePragma src , inl_rule = FunLike } +checkNewOrData :: SrcSpan -> RdrName -> NewOrData -> [a] -> P (DataDefnCons a) +checkNewOrData span name = curry $ \ case + (NewType, [a]) -> pure $ NewTypeCon a + (DataType, as) -> pure $ DataTypeCons as + (NewType, as) -> addFatalError $ mkPlainErrorMsgEnvelope span $ PsErrMultipleConForNewtype name (length as) + ----------------------------------------------------------------------------- -- utilities for foreign declarations diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs index 8b57a72d52..2194739373 100644 --- a/compiler/GHC/Parser/PostProcess/Haddock.hs +++ b/compiler/GHC/Parser/PostProcess/Haddock.hs @@ -48,7 +48,7 @@ Alternative approaches that did not work properly: -} module GHC.Parser.PostProcess.Haddock (addHaddockToModule) where -import GHC.Prelude hiding (mod) +import GHC.Prelude hiding (head, mod) import GHC.Hs @@ -60,6 +60,7 @@ import Data.Semigroup import Data.Foldable import Data.Traversable import Data.Maybe +import Data.List.NonEmpty (head) import Control.Monad import Control.Monad.Trans.State.Strict import Control.Monad.Trans.Reader @@ -584,7 +585,7 @@ instance HasHaddock (HsDataDefn GhcPs) where -- = MkT1 Int Bool -- ^ Comment on MkT1 -- | MkT2 Char Int -- ^ Comment on MkT2 -- - dd_cons' <- addHaddock (dd_cons defn) + dd_cons' <- traverse addHaddock (dd_cons defn) -- Process the deriving clauses: -- diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index 6e196d2b60..7e2c4a0388 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/compiler/GHC/Rename/Module.hs @@ -16,7 +16,7 @@ module GHC.Rename.Module ( rnSrcDecls, addTcgDUs, findSplice, rnWarningTxt ) where -import GHC.Prelude +import GHC.Prelude hiding ( head ) import {-# SOURCE #-} GHC.Rename.Expr( rnLExpr ) import {-# SOURCE #-} GHC.Rename.Splice ( rnSpliceDecl, rnTopSpliceDecls ) @@ -72,9 +72,10 @@ import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Control.Arrow ( first ) +import Data.Foldable ( toList ) import Data.List ( mapAccumL ) import qualified Data.List.NonEmpty as NE -import Data.List.NonEmpty ( NonEmpty(..) ) +import Data.List.NonEmpty ( NonEmpty(..), head ) import Data.Maybe ( isNothing, fromMaybe, mapMaybe ) import qualified Data.Set as Set ( difference, fromList, toList, null ) import Data.Function ( on ) @@ -1819,11 +1820,11 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, rnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdFixity = fixity, - tcdDataDefn = defn@HsDataDefn{ dd_ND = new_or_data - , dd_kindSig = kind_sig} }) + tcdDataDefn = defn@HsDataDefn{ dd_cons = cons, dd_kindSig = kind_sig} }) = do { tycon' <- lookupLocatedTopConstructorRnN tycon ; let kvs = extractDataDefnKindVars defn doc = TyDataCtx tycon + new_or_data = dataDefnConsNewOrData cons ; traceRn "rntycl-data" (ppr tycon <+> ppr kvs) ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' no_rhs_kvs -> do { (defn', fvs) <- rnDataDefn doc defn @@ -1940,8 +1941,7 @@ rnTySyn doc rhs = rnLHsType doc rhs rnDataDefn :: HsDocContext -> HsDataDefn GhcPs -> RnM (HsDataDefn GhcRn, FreeVars) -rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType - , dd_ctxt = context, dd_cons = condecls +rnDataDefn doc (HsDataDefn { dd_cType = cType, dd_ctxt = context, dd_cons = condecls , dd_kindSig = m_sig, dd_derivs = derivs }) = do { -- DatatypeContexts (i.e., stupid contexts) can't be combined with -- GADT syntax. See Note [The stupid context] in GHC.Core.DataCon. @@ -1966,17 +1966,14 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType ; let all_fvs = fvs1 `plusFV` fvs3 `plusFV` con_fvs `plusFV` sig_fvs - ; return ( HsDataDefn { dd_ext = noExtField - , dd_ND = new_or_data, dd_cType = cType + ; return ( HsDataDefn { dd_ext = noExtField, dd_cType = cType , dd_ctxt = context', dd_kindSig = m_sig' , dd_cons = condecls' , dd_derivs = derivs' } , all_fvs ) } where - h98_style = case condecls of -- Note [Stupid theta] - (L _ (ConDeclGADT {})) : _ -> False - _ -> True + h98_style = not $ anyLConIsGadt condecls -- Note [Stupid theta] rn_derivs ds = do { deriv_strats_ok <- xoptM LangExt.DerivingStrategies @@ -2312,7 +2309,7 @@ are no data constructors we allow h98_style = True ***************************************************** -} ----------------- -rnConDecls :: [LConDecl GhcPs] -> RnM ([LConDecl GhcRn], FreeVars) +rnConDecls :: DataDefnCons (LConDecl GhcPs) -> RnM (DataDefnCons (LConDecl GhcRn), FreeVars) rnConDecls = mapFvRn (wrapLocFstMA rnConDecl) rnConDecl :: ConDecl GhcPs -> RnM (ConDecl GhcRn, FreeVars) @@ -2370,7 +2367,7 @@ rnConDecl (ConDeclGADT { con_names = names extractConDeclGADTDetailsTyVars args $ extractHsTysRdrTyVars [res_ty] [] - ; let ctxt = ConDeclCtx new_names + ; let ctxt = ConDeclCtx (toList new_names) ; bindHsOuterTyVarBndrs ctxt Nothing implicit_bndrs outer_bndrs $ \outer_bndrs' -> do { (new_cxt, fvs1) <- rnMbContext ctxt mcxt diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs index 8f47d2215e..e4f11fa3fd 100644 --- a/compiler/GHC/Rename/Names.hs +++ b/compiler/GHC/Rename/Names.hs @@ -96,6 +96,7 @@ import Data.Ord ( comparing ) import Data.List ( partition, (\\), find, sortBy, groupBy, sortOn ) import Data.Function ( on ) import qualified Data.Set as S +import Data.Foldable ( toList ) import System.FilePath ((</>)) import System.IO @@ -982,7 +983,7 @@ getLocalNonValBinders fixity_env , con_g_args = RecConGADT flds _ })) = [ ( find_con_name rdr , concatMap find_con_decl_flds (unLoc flds)) - | L _ rdr <- rdrs ] + | L _ rdr <- toList rdrs ] find_con_flds _ = [] diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs index 78e3285a24..82f9623067 100644 --- a/compiler/GHC/Rename/Utils.hs +++ b/compiler/GHC/Rename/Utils.hs @@ -37,7 +37,7 @@ module GHC.Rename.Utils ( where -import GHC.Prelude +import GHC.Prelude hiding (unzip) import GHC.Core.Type import GHC.Hs @@ -68,6 +68,7 @@ import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE ) import qualified Data.List.NonEmpty as NE import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Bag +import qualified Data.List as List {- ********************************************************* @@ -327,10 +328,17 @@ addFvRn :: FreeVars -> RnM (thing, FreeVars) -> RnM (thing, FreeVars) addFvRn fvs1 thing_inside = do { (res, fvs2) <- thing_inside ; return (res, fvs1 `plusFV` fvs2) } -mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars) -mapFvRn f xs = do stuff <- mapM f xs - case unzip stuff of - (ys, fvs_s) -> return (ys, plusFVs fvs_s) +mapFvRn :: Traversable f => (a -> RnM (b, FreeVars)) -> f a -> RnM (f b, FreeVars) +mapFvRn f xs = do + stuff <- mapM f xs + case unzip stuff of + (ys, fvs_s) -> return (ys, foldl' (flip plusFV) emptyFVs fvs_s) +{-# SPECIALIZE mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars) #-} + +unzip :: Functor f => f (a, b) -> (f a, f b) +unzip = \ xs -> (fmap fst xs, fmap snd xs) +{-# NOINLINE [1] unzip #-} +{-# RULES "unzip/List" unzip = List.unzip #-} mapMaybeFvRn :: (a -> RnM (b, FreeVars)) -> Maybe a -> RnM (Maybe b, FreeVars) mapMaybeFvRn _ Nothing = return (Nothing, emptyFVs) diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs index 67697eb55e..d0eb6337ef 100644 --- a/compiler/GHC/Tc/TyCl.hs +++ b/compiler/GHC/Tc/TyCl.hs @@ -102,9 +102,11 @@ import GHC.Utils.Misc import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import Control.Monad +import Data.Foldable ( toList, traverse_ ) import Data.Functor.Identity import Data.List ( partition) import Data.List.NonEmpty ( NonEmpty(..) ) +import qualified Data.List.NonEmpty as NE import qualified Data.Set as Set import Data.Tuple( swap ) @@ -1286,7 +1288,7 @@ mk_prom_err_env (DataDecl { tcdLName = L _ name = unitNameEnv name (APromotionErr TyConPE) `plusNameEnv` mkNameEnv [ (con, APromotionErr RecDataConPE) - | L _ con' <- cons + | L _ con' <- toList cons , L _ con <- getConNames con' ] mk_prom_err_env decl @@ -1355,14 +1357,13 @@ getInitialKind strategy getInitialKind strategy (DataDecl { tcdLName = L _ name , tcdTyVars = ktvs - , tcdDataDefn = HsDataDefn { dd_kindSig = m_sig - , dd_ND = new_or_data } }) - = do { let flav = newOrDataToFlavour new_or_data + , tcdDataDefn = HsDataDefn { dd_kindSig = m_sig, dd_cons = cons } }) + = do { let flav = newOrDataToFlavour (dataDefnConsNewOrData cons) ctxt = DataKindCtxt name ; tc <- kcDeclHeader strategy name flav ktvs $ case m_sig of Just ksig -> TheKind <$> tcLHsKindSig ctxt ksig - Nothing -> return $ dataDeclDefaultResultKind strategy new_or_data + Nothing -> return $ dataDeclDefaultResultKind strategy (dataDefnConsNewOrData cons) ; return [tc] } getInitialKind InitialKindInfer (FamDecl { tcdFam = decl }) @@ -1570,8 +1571,7 @@ kcTyClDecl :: TyClDecl GhcRn -> MonoTcTyCon -> TcM () -- - In this function, those TcTyVars are unified with other kind variables during -- kind inference (see [How TcTyCons work]) -kcTyClDecl (DataDecl { tcdLName = (L _ _name), tcdDataDefn = defn }) tycon - | HsDataDefn { dd_ctxt = ctxt, dd_cons = cons, dd_ND = new_or_data } <- defn +kcTyClDecl (DataDecl { tcdLName = (L _ _name), tcdDataDefn = HsDataDefn { dd_ctxt = ctxt, dd_cons = cons } }) tycon = tcExtendNameTyVarEnv (tcTyConScopedTyVars tycon) $ -- NB: binding these tyvars isn't necessary for GADTs, but it does no -- harm. For GADTs, each data con brings its own tyvars into scope, @@ -1579,7 +1579,7 @@ kcTyClDecl (DataDecl { tcdLName = (L _ _name), tcdDataDefn = defn }) tycon -- (conceivably) shadowed. do { traceTc "kcTyClDecl" (ppr tycon $$ ppr (tyConTyVars tycon) $$ ppr (tyConResKind tycon)) ; _ <- tcHsContext ctxt - ; kcConDecls new_or_data (tyConResKind tycon) cons + ; kcConDecls (dataDefnConsNewOrData cons) (tyConResKind tycon) cons } kcTyClDecl (SynDecl { tcdLName = L _ _name, tcdRhs = rhs }) tycon @@ -1634,14 +1634,14 @@ kcConGADTArgs new_or_data res_kind con_args = case con_args of RecConGADT (L _ flds) _ -> kcConArgTys new_or_data res_kind $ map (hsLinear . cd_fld_type . unLoc) flds -kcConDecls :: NewOrData +kcConDecls :: Foldable f + => NewOrData -> TcKind -- The result kind signature -- Used only in H98 case - -> [LConDecl GhcRn] -- The data constructors + -> f (LConDecl GhcRn) -- The data constructors -> TcM () -- See Note [kcConDecls: kind-checking data type decls] -kcConDecls new_or_data tc_res_kind cons - = mapM_ (wrapLocMA_ (kcConDecl new_or_data tc_res_kind)) cons +kcConDecls new_or_data tc_res_kind = traverse_ (wrapLocMA_ (kcConDecl new_or_data tc_res_kind)) -- Kind check a data constructor. In additional to the data constructor, -- we also need to know about whether or not its corresponding type was @@ -1658,7 +1658,7 @@ kcConDecl :: NewOrData kcConDecl new_or_data tc_res_kind (ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs , con_mb_cxt = ex_ctxt, con_args = args }) - = addErrCtxt (dataConCtxt [name]) $ + = addErrCtxt (dataConCtxt (NE.singleton name)) $ discardResult $ bindExplicitTKBndrs_Tv ex_tvs $ do { _ <- tcHsContext ex_ctxt @@ -2873,7 +2873,7 @@ tcDataDefn :: SDoc -> RolesInfo -> Name -> HsDataDefn GhcRn -> TcM (TyCon, [DerivInfo]) -- NB: not used for newtype/data instances (whether associated or not) tcDataDefn err_ctxt roles_info tc_name - (HsDataDefn { dd_ND = new_or_data, dd_cType = cType + (HsDataDefn { dd_cType = cType , dd_ctxt = ctxt , dd_kindSig = mb_ksig -- Already in tc's kind -- via inferInitialKinds @@ -2885,12 +2885,12 @@ tcDataDefn err_ctxt roles_info tc_name -- - for H98 constructors only, the ConDecl -- But it does no harm to bring them into scope -- over GADT ConDecls as well; and it's awkward not to - do { gadt_syntax <- dataDeclChecks tc_name new_or_data ctxt cons + do { gadt_syntax <- dataDeclChecks tc_name ctxt cons ; tcg_env <- getGblEnv ; let hsc_src = tcg_src tcg_env ; unless (mk_permissive_kind hsc_src cons) $ - checkDataKindSig (DataDeclSort new_or_data) res_kind + checkDataKindSig (DataDeclSort (dataDefnConsNewOrData cons)) res_kind ; stupid_tc_theta <- pushLevelAndSolveEqualities skol_info tc_bndrs $ tcHsContext ctxt @@ -2918,8 +2918,7 @@ tcDataDefn err_ctxt roles_info tc_name ; res_kind <- zonkTcTypeToTypeX ze res_kind ; tycon <- fixM $ \ rec_tycon -> do - { data_cons <- tcConDecls new_or_data DDataType rec_tycon - tc_bndrs res_kind cons + { data_cons <- tcConDecls DDataType rec_tycon tc_bndrs res_kind cons ; tc_rhs <- mk_tc_rhs hsc_src rec_tycon data_cons ; tc_rep_nm <- newTyConRepName tc_name @@ -2943,7 +2942,7 @@ tcDataDefn err_ctxt roles_info tc_name ; return (tycon, [deriv_info]) } where skol_info = TyConSkol flav tc_name - flav = newOrDataToFlavour new_or_data + flav = newOrDataToFlavour (dataDefnConsNewOrData cons) -- Abstract data types in hsig files can have arbitrary kinds, -- because they may be implemented by type synonyms @@ -2953,23 +2952,21 @@ tcDataDefn err_ctxt roles_info tc_name -- so one could not have, say, a data family instance in an hsig file that -- has kind `Bool`. Therefore, this check need only occur in the code that -- typechecks data type declarations. - mk_permissive_kind HsigFile [] = True + mk_permissive_kind HsigFile (DataTypeCons []) = True mk_permissive_kind _ _ = False -- In an hs-boot or a signature file, -- a 'data' declaration with no constructors -- indicates a nominally distinct abstract data type. - mk_tc_rhs (isHsBootOrSig -> True) _ [] + mk_tc_rhs (isHsBootOrSig -> True) _ (DataTypeCons []) = return AbstractTyCon - mk_tc_rhs _ tycon data_cons - = case new_or_data of - DataType -> return $ + mk_tc_rhs _ tycon data_cons = case data_cons of + DataTypeCons data_cons -> return $ mkLevPolyDataTyConRhs (isFixedRuntimeRepKind (tyConResKind tycon)) data_cons - NewType -> assert (not (null data_cons)) $ - mkNewTyConRhs tc_name tycon (head data_cons) + NewTypeCon data_con -> mkNewTyConRhs tc_name tycon data_con ------------------------- kcTyFamInstEqn :: TcTyCon -> LTyFamInstEqn GhcRn -> TcM () @@ -3312,26 +3309,20 @@ that 'a' must have that kind, and to bring 'k' into scope. ************************************************************************ -} -dataDeclChecks :: Name -> NewOrData - -> Maybe (LHsContext GhcRn) -> [LConDecl GhcRn] +dataDeclChecks :: Name + -> Maybe (LHsContext GhcRn) -> DataDefnCons (LConDecl GhcRn) -> TcM Bool -dataDeclChecks tc_name new_or_data mctxt cons +dataDeclChecks tc_name mctxt cons = do { let stupid_theta = fromMaybeContext mctxt -- Check that we don't use GADT syntax in H98 world ; gadtSyntax_ok <- xoptM LangExt.GADTSyntax - ; let gadt_syntax = consUseGadtSyntax cons + ; let gadt_syntax = anyLConIsGadt cons ; checkTc (gadtSyntax_ok || not gadt_syntax) (badGadtDecl tc_name) -- Check that the stupid theta is empty for a GADT-style declaration. -- See Note [The stupid context] in GHC.Core.DataCon. ; checkTc (null stupid_theta || not gadt_syntax) (badStupidTheta tc_name) - -- Check that a newtype has exactly one constructor - -- Do this before checking for empty data decls, so that - -- we don't suggest -XEmptyDataDecls for newtypes - ; checkTc (new_or_data == DataType || isSingleton cons) - (newtypeConError tc_name (length cons)) - -- Check that there's at least one condecl, -- or else we're reading an hs-boot file, or -XEmptyDataDecls ; empty_data_decls <- xoptM LangExt.EmptyDataDecls @@ -3342,12 +3333,6 @@ dataDeclChecks tc_name new_or_data mctxt cons ----------------------------------- -consUseGadtSyntax :: [LConDecl GhcRn] -> Bool -consUseGadtSyntax (L _ (ConDeclGADT {}) : _) = True -consUseGadtSyntax _ = False - -- All constructors have same shape - ------------------------------------ data DataDeclInfo = DDataType -- data T a b = T1 a | T2 b | DDataInstance -- data instance D [a] = D1 a | D2 @@ -3360,19 +3345,30 @@ mkDDHeaderTy dd_info rep_tycon tc_bndrs mkTyVarTys (binderVars tc_bndrs) DDataInstance header_ty -> header_ty -tcConDecls :: NewOrData - -> DataDeclInfo +-- We use `concatMapDataDefnConsTcM` here, since the following is illegal: +-- @newtype T a where T1, T2 :: a -> T a@ +-- It would be represented as a single 'ConDeclGadt' with multiple names, which is valid for 'data', but not 'newtype'. +-- So when 'tcConDecl' expands the 'ConDecl' per each name it has, if we are type-checking a 'newtype' declaration, we +-- must fail if it returns more than one. +tcConDecls :: DataDeclInfo -> KnotTied TyCon -- Representation TyCon -> [TcTyConBinder] -- Binders of representation TyCon -> TcKind -- Result kind - -> [LConDecl GhcRn] -> TcM [DataCon] -tcConDecls new_or_data dd_info rep_tycon tmpl_bndrs res_kind - = concatMapM $ addLocMA $ - tcConDecl new_or_data dd_info rep_tycon tmpl_bndrs res_kind - (mkTyConTagMap rep_tycon) + -> DataDefnCons (LConDecl GhcRn) -> TcM (DataDefnCons DataCon) +tcConDecls dd_info rep_tycon tmpl_bndrs res_kind + = concatMapDataDefnConsTcM (tyConName rep_tycon) $ \ new_or_data -> + addLocMA $ tcConDecl new_or_data dd_info rep_tycon tmpl_bndrs res_kind (mkTyConTagMap rep_tycon) -- mkTyConTagMap: it's important that we pay for tag allocation here, -- once per TyCon. See Note [Constructor tag allocation], fixes #14657 +-- 'concatMap' for 'DataDefnCons', but fail if the given function returns multiple values and the argument is a 'NewTypeCon'. +concatMapDataDefnConsTcM :: Name -> (NewOrData -> a -> TcM (NonEmpty b)) -> DataDefnCons a -> TcM (DataDefnCons b) +concatMapDataDefnConsTcM name f = \ case + NewTypeCon a -> f NewType a >>= \ case + b:|[] -> pure (NewTypeCon b) + bs -> failWithTc $ newtypeConError name (length bs) + DataTypeCons as -> DataTypeCons <$> concatMapM (fmap toList . f DataType) as + tcConDecl :: NewOrData -> DataDeclInfo -> KnotTied TyCon -- Representation tycon. Knot-tied! @@ -3380,14 +3376,14 @@ tcConDecl :: NewOrData -> TcKind -- Result kind -> NameEnv ConTag -> ConDecl GhcRn - -> TcM [DataCon] + -> TcM (NonEmpty DataCon) tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map (ConDeclH98 { con_name = lname@(L _ name) , con_ex_tvs = explicit_tkv_nms , con_mb_cxt = hs_ctxt , con_args = hs_args }) - = addErrCtxt (dataConCtxt [lname]) $ + = addErrCtxt (dataConCtxt (NE.singleton lname)) $ do { -- NB: the tyvars from the declaration header are in scope -- Get hold of the existential type variables @@ -3475,7 +3471,7 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map -- constructor type signature into the data constructor; -- that way checkValidDataCon can complain if it's wrong. - ; return [dc] } + ; return (NE.singleton dc) } tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map -- NB: don't use res_kind here, as it's ill-scoped. Instead, @@ -3486,7 +3482,7 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map , con_res_ty = hs_res_ty }) = addErrCtxt (dataConCtxt names) $ do { traceTc "tcConDecl 1 gadt" (ppr names) - ; let (L _ name : _) = names + ; let L _ name :| _ = names ; skol_info <- mkSkolemInfo (DataConSkol name) ; (tclvl, wanted, (outer_bndrs, (ctxt, arg_tys, res_ty, field_lbls, stricts))) <- pushLevelAndSolveEqualitiesX "tcConDecl:GADT" $ @@ -4345,7 +4341,7 @@ checkFieldCompat fld con1 con2 res1 res2 fty1 fty2 checkValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM () checkValidDataCon dflags existential_ok tc con = setSrcSpan con_loc $ - addErrCtxt (dataConCtxt [L (noAnnSrcSpan con_loc) con_name]) $ + addErrCtxt (dataConCtxt (NE.singleton (L (noAnnSrcSpan con_loc) con_name))) $ do { let tc_tvs = tyConTyVars tc res_ty_tmpl = mkFamilyTyConApp tc (mkTyVarTys tc_tvs) arg_tys = dataConOrigArgTys con @@ -5239,13 +5235,13 @@ fieldTypeMisMatch field_name con1 con2 sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, text "give different types for field", quotes (ppr field_name)] -dataConCtxt :: [LocatedN Name] -> SDoc -dataConCtxt cons = text "In the definition of data constructor" <> plural cons - <+> ppr_cons cons +dataConCtxt :: NonEmpty (LocatedN Name) -> SDoc +dataConCtxt cons = text "In the definition of data constructor" <> plural (toList cons) + <+> ppr_cons (toList cons) -dataConResCtxt :: [LocatedN Name] -> SDoc -dataConResCtxt cons = text "In the result type of data constructor" <> plural cons - <+> ppr_cons cons +dataConResCtxt :: NonEmpty (LocatedN Name) -> SDoc +dataConResCtxt cons = text "In the result type of data constructor" <> plural (toList cons) + <+> ppr_cons (toList cons) ppr_cons :: [LocatedN Name] -> SDoc ppr_cons [con] = quotes (ppr con) diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs index 879280d203..32d710dec7 100644 --- a/compiler/GHC/Tc/TyCl/Instance.hs +++ b/compiler/GHC/Tc/TyCl/Instance.hs @@ -79,7 +79,6 @@ import GHC.Types.Name import GHC.Types.Name.Set import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Utils.Panic.Plain import GHC.Types.SrcLoc import GHC.Utils.Misc import GHC.Data.BooleanFormula ( isUnsatisfied, pprBooleanFormulaNice ) @@ -674,8 +673,7 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env , feqn_pats = hs_pats , feqn_tycon = lfam_name@(L _ fam_name) , feqn_fixity = fixity - , feqn_rhs = HsDataDefn { dd_ND = new_or_data - , dd_cType = cType + , feqn_rhs = HsDataDefn { dd_cType = cType , dd_ctxt = hs_ctxt , dd_cons = hs_cons , dd_kindSig = m_ksig @@ -688,10 +686,11 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env -- Check that the family declaration is for the right kind ; checkTc (isDataFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc) - ; gadt_syntax <- dataDeclChecks fam_name new_or_data hs_ctxt hs_cons + ; gadt_syntax <- dataDeclChecks fam_name hs_ctxt hs_cons -- Do /not/ check that the number of patterns = tyConArity fam_tc -- See [Arity of data families] in GHC.Core.FamInstEnv ; skol_info <- mkSkolemInfo FamInstSkol + ; let new_or_data = dataDefnConsNewOrData hs_cons ; (qtvs, pats, tc_res_kind, stupid_theta) <- tcDataFamInstHeader mb_clsinfo skol_info fam_tc outer_bndrs fixity hs_ctxt hs_pats m_ksig new_or_data @@ -767,19 +766,17 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env do { data_cons <- tcExtendTyVarEnv (binderVars tc_ty_binders) $ -- For H98 decls, the tyvars scope -- over the data constructors - tcConDecls new_or_data (DDataInstance orig_res_ty) - rec_rep_tc tc_ty_binders tc_res_kind - hs_cons + tcConDecls (DDataInstance orig_res_ty) rec_rep_tc tc_ty_binders tc_res_kind + hs_cons ; rep_tc_name <- newFamInstTyConName lfam_name pats ; axiom_name <- newFamInstAxiomName lfam_name [pats] - ; tc_rhs <- case new_or_data of - DataType -> return $ + ; tc_rhs <- case data_cons of + DataTypeCons data_cons -> return $ mkLevPolyDataTyConRhs (isFixedRuntimeRepKind res_kind) data_cons - NewType -> assert (not (null data_cons)) $ - mkNewTyConRhs rep_tc_name rec_rep_tc (head data_cons) + NewTypeCon data_con -> mkNewTyConRhs rep_tc_name rec_rep_tc data_con ; let ax_rhs = mkTyConApp rep_tc (mkTyVarTys zonked_post_eta_qtvs) axiom = mkSingleCoAxiom Representational axiom_name @@ -893,7 +890,6 @@ tcDataFamInstHeader -> NewOrData -> TcM ([TcTyVar], [TcType], TcKind, TcThetaType) -- All skolem TcTyVars, all zonked so it's clear what the free vars are - -- The "header" of a data family instance is the part other than -- the data constructors themselves -- e.g. data instance D [a] :: * -> * where ... diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs index 5ba99fe7ac..f7ba81db6b 100644 --- a/compiler/GHC/ThToHs.hs +++ b/compiler/GHC/ThToHs.hs @@ -60,6 +60,7 @@ import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import qualified Data.ByteString as BS import Control.Monad( unless, ap ) import Control.Applicative( (<|>) ) +import Data.List.NonEmpty( NonEmpty (..), nonEmpty ) import Data.Maybe( catMaybes, isNothing ) import Language.Haskell.TH as TH hiding (sigP) import Language.Haskell.TH.Syntax as TH @@ -290,10 +291,10 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs) ; cons' <- mapM cvtConstr constrs ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField - , dd_ND = DataType, dd_cType = Nothing + , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = cons', dd_derivs = derivs' } + , dd_cons = DataTypeCons cons', dd_derivs = derivs' } ; returnJustLA $ TyClD noExtField $ DataDecl { tcdDExt = noAnn , tcdLName = tc', tcdTyVars = tvs' @@ -306,10 +307,10 @@ cvtDec (NewtypeD ctxt tc tvs ksig constr derivs) ; con' <- cvtConstr constr ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField - , dd_ND = NewType, dd_cType = Nothing + , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = [con'] + , dd_cons = NewTypeCon con' , dd_derivs = derivs' } ; returnJustLA $ TyClD noExtField $ DataDecl { tcdDExt = noAnn @@ -377,10 +378,10 @@ cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs) ; cons' <- mapM cvtConstr constrs ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField - , dd_ND = DataType, dd_cType = Nothing + , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = cons', dd_derivs = derivs' } + , dd_cons = DataTypeCons cons', dd_derivs = derivs' } ; returnJustLA $ InstD noExtField $ DataFamInstD { dfid_ext = noExtField @@ -398,10 +399,10 @@ cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs) ; con' <- cvtConstr constr ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField - , dd_ND = NewType, dd_cType = Nothing + , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = [con'], dd_derivs = derivs' } + , dd_cons = NewTypeCon con', dd_derivs = derivs' } ; returnJustLA $ InstD noExtField $ DataFamInstD { dfid_ext = noExtField , dfid_inst = DataFamInstDecl { dfid_eqn = @@ -679,26 +680,24 @@ cvtConstr (ForallC tvs ctxt con) where all_tvs = tvs' ++ ex_tvs -cvtConstr (GadtC [] _strtys _ty) - = failWith (text "GadtC must have at least one constructor name") - -cvtConstr (GadtC c strtys ty) - = do { c' <- mapM cNameN c +cvtConstr (GadtC c strtys ty) = case nonEmpty c of + Nothing -> failWith (text "GadtC must have at least one constructor name") + Just c -> do + { c' <- mapM cNameN c ; args <- mapM cvt_arg strtys ; ty' <- cvtType ty ; mk_gadt_decl c' (PrefixConGADT $ map hsLinear args) ty'} -cvtConstr (RecGadtC [] _varstrtys _ty) - = failWith (text "RecGadtC must have at least one constructor name") - -cvtConstr (RecGadtC c varstrtys ty) - = do { c' <- mapM cNameN c +cvtConstr (RecGadtC c varstrtys ty) = case nonEmpty c of + Nothing -> failWith (text "RecGadtC must have at least one constructor name") + Just c -> do + { c' <- mapM cNameN c ; 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 :: [LocatedN RdrName] -> HsConDeclGADTDetails GhcPs -> LHsType GhcPs +mk_gadt_decl :: NonEmpty (LocatedN RdrName) -> HsConDeclGADTDetails GhcPs -> LHsType GhcPs -> CvtM (LConDecl GhcPs) mk_gadt_decl names args res_ty = do bndrs <- returnLA mkHsOuterImplicit diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs index cb24cda08a..639863c630 100644 --- a/compiler/GHC/Types/Error/Codes.hs +++ b/compiler/GHC/Types/Error/Codes.hs @@ -136,7 +136,6 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "DsRuleLhsTooComplicated" = 69441 GhcDiagnosticCode "DsRuleIgnoredDueToConstructor" = 00828 GhcDiagnosticCode "DsRuleBindersNotBound" = 40548 - GhcDiagnosticCode "DsMultipleConForNewtype" = 05380 GhcDiagnosticCode "DsLazyPatCantBindVarsOfUnliftedType" = 17879 GhcDiagnosticCode "DsNotYetHandledByTH" = 65904 GhcDiagnosticCode "DsAggregatedViewExpressions" = 19551 @@ -267,6 +266,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "PsErrParseRightOpSectionInPat" = 72516 GhcDiagnosticCode "PsErrIllegalGadtRecordMultiplicity" = 37475 GhcDiagnosticCode "PsErrInvalidCApiImport" = 72744 + GhcDiagnosticCode "PsErrMultipleConForNewtype" = 05380 -- Driver diagnostic codes GhcDiagnosticCode "DriverMissingHomeModules" = 32850 diff --git a/compiler/GHC/Utils/Monad.hs b/compiler/GHC/Utils/Monad.hs index b0605b96b0..5366d12dca 100644 --- a/compiler/GHC/Utils/Monad.hs +++ b/compiler/GHC/Utils/Monad.hs @@ -161,8 +161,9 @@ mapSndM :: (Applicative m, Traversable f) => (b -> m c) -> f (a,b) -> m (f (a,c) mapSndM = traverse . traverse -- | Monadic version of concatMap -concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] +concatMapM :: (Monad m, Traversable f) => (a -> m [b]) -> f a -> m [b] concatMapM f xs = liftM concat (mapM f xs) +{-# SPECIALIZE concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b] #-} -- | Applicative version of mapMaybe mapMaybeM :: Applicative m => (a -> m (Maybe b)) -> [a] -> m [b] diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs index 7e1ab91cad..e7c23f84cf 100644 --- a/compiler/Language/Haskell/Syntax/Decls.hs +++ b/compiler/Language/Haskell/Syntax/Decls.hs @@ -2,8 +2,10 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -30,7 +32,7 @@ module Language.Haskell.Syntax.Decls ( -- * Toplevel declarations HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, FunDep(..), HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, - NewOrData(..), + NewOrData(..), DataDefnCons(..), dataDefnConsNewOrData, StandaloneKindSig(..), LStandaloneKindSig, -- ** Class or type declarations @@ -118,6 +120,9 @@ import Data.Int import Data.Bool import Prelude (Show) import qualified Data.List +import Data.Foldable +import Data.Traversable +import Data.List.NonEmpty (NonEmpty (..)) {- ************************************************************************ @@ -873,7 +878,6 @@ data HsDataDefn pass -- The payload of a data type defn -- data/newtype instance T [a] = <constrs> -- @ HsDataDefn { dd_ext :: XCHsDataDefn pass, - dd_ND :: NewOrData, dd_ctxt :: Maybe (LHsContext pass), -- ^ Context dd_cType :: Maybe (XRec pass CType), dd_kindSig:: Maybe (LHsKind pass), @@ -884,7 +888,7 @@ data HsDataDefn pass -- The payload of a data type defn -- -- Always @Nothing@ for H98-syntax decls - dd_cons :: [LConDecl pass], + dd_cons :: DataDefnCons (LConDecl pass), -- ^ Data constructors -- -- For @data T a = T1 | T2 a@ @@ -981,10 +985,22 @@ terms. However, partial standalone kind signatures are not a proper replacement for CUSKs, so this would be a separate feature. -} +-- | When we only care whether a data-type declaration is `data` or `newtype`, but not what constructors it has data NewOrData = NewType -- ^ @newtype Blah ...@ | DataType -- ^ @data Blah ...@ - deriving( Eq, Data ) -- Needed because Demand derives Eq + deriving ( Eq, Data ) -- Needed because Demand derives Eq + +-- | Whether a data-type declaration is `data` or `newtype`, and its constructors +data DataDefnCons a + = NewTypeCon a -- ^ @newtype Blah ...@ + | DataTypeCons [a] -- ^ @data Blah ...@ + deriving ( Eq, Data, Foldable, Functor, Traversable ) -- Needed because Demand derives Eq + +dataDefnConsNewOrData :: DataDefnCons a -> NewOrData +dataDefnConsNewOrData = \ case + NewTypeCon _ -> NewType + DataTypeCons _ -> DataType -- | Located data Constructor Declaration type LConDecl pass = XRec pass (ConDecl pass) @@ -1021,7 +1037,7 @@ type LConDecl pass = XRec pass (ConDecl pass) data ConDecl pass = ConDeclGADT { con_g_ext :: XConDeclGADT pass - , con_names :: [LIdP pass] + , con_names :: NonEmpty (LIdP pass) , con_dcolon :: !(LHsUniToken "::" "∷" pass) -- The following fields describe the type after the '::' -- See Note [GADT abstract syntax] diff --git a/testsuite/tests/ghc-api/exactprint/Test20239.stderr b/testsuite/tests/ghc-api/exactprint/Test20239.stderr index 8ecb791c49..60ff0ec324 100644 --- a/testsuite/tests/ghc-api/exactprint/Test20239.stderr +++ b/testsuite/tests/ghc-api/exactprint/Test20239.stderr @@ -107,219 +107,219 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnn - (Anchor - { Test20239.hs:4:36-55 } - (UnchangedAnchor)) - (AnnListItem - [(AddVbarAnn - (EpaSpan { Test20239.hs:6:34 }))]) - (EpaComments - [])) { Test20239.hs:4:36-55 }) - (ConDeclH98 - (EpAnn - (Anchor - { Test20239.hs:4:36-55 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:4:36-49 }) - (Unqual - {OccName: MigrationQuery})) - (False) - [] - (Nothing) - (PrefixCon - [] - [(HsScaled - (HsLinearArrow - (HsPct1 - (L - (NoTokenLoc) - (HsTok)) - (L - (NoTokenLoc) - (HsNormalTok)))) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:4:51-55 }) - (HsTyVar - (EpAnn - (Anchor - { Test20239.hs:4:51-55 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:4:51-55 }) - (Unqual - {OccName: Query})))))]) - (Nothing))) - ,(L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:36-86 }) - (ConDeclH98 - (EpAnn - (Anchor - { Test20239.hs:6:36-86 } - (UnchangedAnchor)) + (DataTypeCons + [(L + (SrcSpanAnn (EpAnn + (Anchor + { Test20239.hs:4:36-55 } + (UnchangedAnchor)) + (AnnListItem + [(AddVbarAnn + (EpaSpan { Test20239.hs:6:34 }))]) + (EpaComments + [])) { Test20239.hs:4:36-55 }) + (ConDeclH98 + (EpAnn + (Anchor + { Test20239.hs:4:36-55 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:4:36-49 }) + (Unqual + {OccName: MigrationQuery})) + (False) [] - (EpaComments - [])) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:36-48 }) - (Unqual - {OccName: MigrationCode})) - (False) - [] - (Nothing) - (PrefixCon + (Nothing) + (PrefixCon + [] + [(HsScaled + (HsLinearArrow + (HsPct1 + (L + (NoTokenLoc) + (HsTok)) + (L + (NoTokenLoc) + (HsNormalTok)))) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:4:51-55 }) + (HsTyVar + (EpAnn + (Anchor + { Test20239.hs:4:51-55 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:4:51-55 }) + (Unqual + {OccName: Query})))))]) + (Nothing))) + ,(L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:36-86 }) + (ConDeclH98 + (EpAnn + (Anchor + { Test20239.hs:6:36-86 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:36-48 }) + (Unqual + {OccName: MigrationCode})) + (False) [] - [(HsScaled - (HsLinearArrow - (HsPct1 - (L - (NoTokenLoc) - (HsTok)) - (L - (NoTokenLoc) - (HsNormalTok)))) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:50-86 }) - (HsParTy - (EpAnn - (Anchor - { Test20239.hs:6:50 } - (UnchangedAnchor)) - (AnnParen - (AnnParens) - (EpaSpan { Test20239.hs:6:50 }) - (EpaSpan { Test20239.hs:6:86 })) - (EpaComments - [])) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:51-85 }) - (HsFunTy - (EpAnn - (Anchor - { Test20239.hs:6:51-60 } - (UnchangedAnchor)) - (NoEpAnns) - (EpaComments - [])) - (HsUnrestrictedArrow - (L - (TokenLoc - (EpaSpan { Test20239.hs:6:62-63 })) - (HsNormalTok))) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:51-60 }) - (HsTyVar - (EpAnn - (Anchor - { Test20239.hs:6:51-60 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:51-60 }) - (Unqual - {OccName: Connection})))) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:65-85 }) - (HsAppTy - (NoExtField) + (Nothing) + (PrefixCon + [] + [(HsScaled + (HsLinearArrow + (HsPct1 + (L + (NoTokenLoc) + (HsTok)) + (L + (NoTokenLoc) + (HsNormalTok)))) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:50-86 }) + (HsParTy + (EpAnn + (Anchor + { Test20239.hs:6:50 } + (UnchangedAnchor)) + (AnnParen + (AnnParens) + (EpaSpan { Test20239.hs:6:50 }) + (EpaSpan { Test20239.hs:6:86 })) + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:51-85 }) + (HsFunTy + (EpAnn + (Anchor + { Test20239.hs:6:51-60 } + (UnchangedAnchor)) + (NoEpAnns) + (EpaComments + [])) + (HsUnrestrictedArrow (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:65-66 }) - (HsTyVar - (EpAnn - (Anchor - { Test20239.hs:6:65-66 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:65-66 }) - (Unqual - {OccName: IO})))) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:68-85 }) - (HsParTy - (EpAnn - (Anchor - { Test20239.hs:6:68 } - (UnchangedAnchor)) - (AnnParen - (AnnParens) - (EpaSpan { Test20239.hs:6:68 }) - (EpaSpan { Test20239.hs:6:85 })) - (EpaComments - [])) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:69-84 }) - (HsAppTy - (NoExtField) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:69-81 }) - (HsAppTy - (NoExtField) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:69-74 }) - (HsTyVar - (EpAnn - (Anchor - { Test20239.hs:6:69-74 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:69-74 }) - (Unqual - {OccName: Either})))) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:76-81 }) - (HsTyVar - (EpAnn - (Anchor - { Test20239.hs:6:76-81 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:76-81 }) - (Unqual - {OccName: String})))))) - (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:83-84 }) - (HsTupleTy - (EpAnn - (Anchor - { Test20239.hs:6:83 } - (UnchangedAnchor)) - (AnnParen - (AnnParens) - (EpaSpan { Test20239.hs:6:83 }) - (EpaSpan { Test20239.hs:6:84 })) - (EpaComments - [])) - (HsBoxedOrConstraintTuple) - [])))))))))))))]) - (Nothing)))] + (TokenLoc + (EpaSpan { Test20239.hs:6:62-63 })) + (HsNormalTok))) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:51-60 }) + (HsTyVar + (EpAnn + (Anchor + { Test20239.hs:6:51-60 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:51-60 }) + (Unqual + {OccName: Connection})))) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:65-85 }) + (HsAppTy + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:65-66 }) + (HsTyVar + (EpAnn + (Anchor + { Test20239.hs:6:65-66 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:65-66 }) + (Unqual + {OccName: IO})))) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:68-85 }) + (HsParTy + (EpAnn + (Anchor + { Test20239.hs:6:68 } + (UnchangedAnchor)) + (AnnParen + (AnnParens) + (EpaSpan { Test20239.hs:6:68 }) + (EpaSpan { Test20239.hs:6:85 })) + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:69-84 }) + (HsAppTy + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:69-81 }) + (HsAppTy + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:69-74 }) + (HsTyVar + (EpAnn + (Anchor + { Test20239.hs:6:69-74 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:69-74 }) + (Unqual + {OccName: Either})))) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:76-81 }) + (HsTyVar + (EpAnn + (Anchor + { Test20239.hs:6:76-81 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:76-81 }) + (Unqual + {OccName: String})))))) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:83-84 }) + (HsTupleTy + (EpAnn + (Anchor + { Test20239.hs:6:83 } + (UnchangedAnchor)) + (AnnParen + (AnnParens) + (EpaSpan { Test20239.hs:6:83 }) + (EpaSpan { Test20239.hs:6:84 })) + (EpaComments + [])) + (HsBoxedOrConstraintTuple) + [])))))))))))))]) + (Nothing)))]) []))))))])) diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr index 82a2640f34..de2f98d899 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr @@ -836,70 +836,72 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:5-18 }) - (ConDeclGADT - (EpAnn - (Anchor - { T17544.hs:25:5-18 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:5-8 }) - (Unqual - {OccName: MkD5}))] - (L - (TokenLoc - (EpaSpan { T17544.hs:25:10-11 })) - (HsNormalTok)) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-18 }) - (HsOuterImplicit - (NoExtField))) - (Nothing) - (PrefixConGADT - []) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-18 }) - (HsAppTy - (NoExtField) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-14 }) - (HsTyVar - (EpAnn - (Anchor - { T17544.hs:25:13-14 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-14 }) - (Unqual - {OccName: D5})))) + (DataTypeCons + [(L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:5-18 }) + (ConDeclGADT + (EpAnn + (Anchor + { T17544.hs:25:5-18 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (:| (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:16-18 }) - (HsTyVar - (EpAnn - (Anchor - { T17544.hs:25:16-18 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:16-18 }) - (Unqual - {OccName: Int})))))) - (Nothing)))] + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:5-8 }) + (Unqual + {OccName: MkD5})) + []) + (L + (TokenLoc + (EpaSpan { T17544.hs:25:10-11 })) + (HsNormalTok)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-18 }) + (HsOuterImplicit + (NoExtField))) + (Nothing) + (PrefixConGADT + []) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-18 }) + (HsAppTy + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-14 }) + (HsTyVar + (EpAnn + (Anchor + { T17544.hs:25:13-14 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-14 }) + (Unqual + {OccName: D5})))) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:16-18 }) + (HsTyVar + (EpAnn + (Anchor + { T17544.hs:25:16-18 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:16-18 }) + (Unqual + {OccName: Int})))))) + (Nothing)))]) []))))] (Nothing))))) ,(L @@ -1102,70 +1104,72 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:5-18 }) - (ConDeclGADT - (EpAnn - (Anchor - { T17544.hs:31:5-18 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:5-8 }) - (Unqual - {OccName: MkD6}))] - (L - (TokenLoc - (EpaSpan { T17544.hs:31:10-11 })) - (HsNormalTok)) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-18 }) - (HsOuterImplicit - (NoExtField))) - (Nothing) - (PrefixConGADT - []) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-18 }) - (HsAppTy - (NoExtField) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-14 }) - (HsTyVar - (EpAnn - (Anchor - { T17544.hs:31:13-14 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-14 }) - (Unqual - {OccName: D6})))) + (DataTypeCons + [(L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:5-18 }) + (ConDeclGADT + (EpAnn + (Anchor + { T17544.hs:31:5-18 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (:| (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:16-18 }) - (HsTyVar - (EpAnn - (Anchor - { T17544.hs:31:16-18 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:16-18 }) - (Unqual - {OccName: Int})))))) - (Nothing)))] + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:5-8 }) + (Unqual + {OccName: MkD6})) + []) + (L + (TokenLoc + (EpaSpan { T17544.hs:31:10-11 })) + (HsNormalTok)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-18 }) + (HsOuterImplicit + (NoExtField))) + (Nothing) + (PrefixConGADT + []) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-18 }) + (HsAppTy + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-14 }) + (HsTyVar + (EpAnn + (Anchor + { T17544.hs:31:13-14 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-14 }) + (Unqual + {OccName: D6})))) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:16-18 }) + (HsTyVar + (EpAnn + (Anchor + { T17544.hs:31:16-18 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:16-18 }) + (Unqual + {OccName: Int})))))) + (Nothing)))]) []))))] (Nothing))))) ,(L @@ -1368,70 +1372,72 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:5-18 }) - (ConDeclGADT - (EpAnn - (Anchor - { T17544.hs:37:5-18 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:5-8 }) - (Unqual - {OccName: MkD7}))] - (L - (TokenLoc - (EpaSpan { T17544.hs:37:10-11 })) - (HsNormalTok)) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-18 }) - (HsOuterImplicit - (NoExtField))) - (Nothing) - (PrefixConGADT - []) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-18 }) - (HsAppTy - (NoExtField) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-14 }) - (HsTyVar - (EpAnn - (Anchor - { T17544.hs:37:13-14 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-14 }) - (Unqual - {OccName: D7})))) + (DataTypeCons + [(L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:5-18 }) + (ConDeclGADT + (EpAnn + (Anchor + { T17544.hs:37:5-18 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (:| (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:16-18 }) - (HsTyVar - (EpAnn - (Anchor - { T17544.hs:37:16-18 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:16-18 }) - (Unqual - {OccName: Int})))))) - (Nothing)))] + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:5-8 }) + (Unqual + {OccName: MkD7})) + []) + (L + (TokenLoc + (EpaSpan { T17544.hs:37:10-11 })) + (HsNormalTok)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-18 }) + (HsOuterImplicit + (NoExtField))) + (Nothing) + (PrefixConGADT + []) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-18 }) + (HsAppTy + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-14 }) + (HsTyVar + (EpAnn + (Anchor + { T17544.hs:37:13-14 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-14 }) + (Unqual + {OccName: D7})))) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:16-18 }) + (HsTyVar + (EpAnn + (Anchor + { T17544.hs:37:16-18 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:16-18 }) + (Unqual + {OccName: Int})))))) + (Nothing)))]) []))))] (Nothing))))) ,(L @@ -1634,70 +1640,72 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:5-18 }) - (ConDeclGADT - (EpAnn - (Anchor - { T17544.hs:43:5-18 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:5-8 }) - (Unqual - {OccName: MkD8}))] - (L - (TokenLoc - (EpaSpan { T17544.hs:43:10-11 })) - (HsNormalTok)) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-18 }) - (HsOuterImplicit - (NoExtField))) - (Nothing) - (PrefixConGADT - []) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-18 }) - (HsAppTy - (NoExtField) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-14 }) - (HsTyVar - (EpAnn - (Anchor - { T17544.hs:43:13-14 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-14 }) - (Unqual - {OccName: D8})))) + (DataTypeCons + [(L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:5-18 }) + (ConDeclGADT + (EpAnn + (Anchor + { T17544.hs:43:5-18 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (:| (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:16-18 }) - (HsTyVar - (EpAnn - (Anchor - { T17544.hs:43:16-18 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:16-18 }) - (Unqual - {OccName: Int})))))) - (Nothing)))] + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:5-8 }) + (Unqual + {OccName: MkD8})) + []) + (L + (TokenLoc + (EpaSpan { T17544.hs:43:10-11 })) + (HsNormalTok)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-18 }) + (HsOuterImplicit + (NoExtField))) + (Nothing) + (PrefixConGADT + []) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-18 }) + (HsAppTy + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-14 }) + (HsTyVar + (EpAnn + (Anchor + { T17544.hs:43:13-14 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-14 }) + (Unqual + {OccName: D8})))) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:16-18 }) + (HsTyVar + (EpAnn + (Anchor + { T17544.hs:43:16-18 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:16-18 }) + (Unqual + {OccName: Int})))))) + (Nothing)))]) []))))] (Nothing))))) ,(L @@ -1900,70 +1908,72 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:5-18 }) - (ConDeclGADT - (EpAnn - (Anchor - { T17544.hs:49:5-18 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:5-8 }) - (Unqual - {OccName: MkD9}))] - (L - (TokenLoc - (EpaSpan { T17544.hs:49:10-11 })) - (HsNormalTok)) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-18 }) - (HsOuterImplicit - (NoExtField))) - (Nothing) - (PrefixConGADT - []) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-18 }) - (HsAppTy - (NoExtField) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-14 }) - (HsTyVar - (EpAnn - (Anchor - { T17544.hs:49:13-14 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-14 }) - (Unqual - {OccName: D9})))) + (DataTypeCons + [(L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:5-18 }) + (ConDeclGADT + (EpAnn + (Anchor + { T17544.hs:49:5-18 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (:| (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:16-18 }) - (HsTyVar - (EpAnn - (Anchor - { T17544.hs:49:16-18 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:16-18 }) - (Unqual - {OccName: Int})))))) - (Nothing)))] + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:5-8 }) + (Unqual + {OccName: MkD9})) + []) + (L + (TokenLoc + (EpaSpan { T17544.hs:49:10-11 })) + (HsNormalTok)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-18 }) + (HsOuterImplicit + (NoExtField))) + (Nothing) + (PrefixConGADT + []) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-18 }) + (HsAppTy + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-14 }) + (HsTyVar + (EpAnn + (Anchor + { T17544.hs:49:13-14 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-14 }) + (Unqual + {OccName: D9})))) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:16-18 }) + (HsTyVar + (EpAnn + (Anchor + { T17544.hs:49:16-18 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:16-18 }) + (Unqual + {OccName: Int})))))) + (Nothing)))]) []))))] (Nothing))))) ,(L @@ -2166,70 +2176,72 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:5-20 }) - (ConDeclGADT - (EpAnn - (Anchor - { T17544.hs:55:5-20 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:5-9 }) - (Unqual - {OccName: MkD10}))] - (L - (TokenLoc - (EpaSpan { T17544.hs:55:11-12 })) - (HsNormalTok)) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-20 }) - (HsOuterImplicit - (NoExtField))) - (Nothing) - (PrefixConGADT - []) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-20 }) - (HsAppTy - (NoExtField) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-16 }) - (HsTyVar - (EpAnn - (Anchor - { T17544.hs:55:14-16 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-16 }) - (Unqual - {OccName: D10})))) + (DataTypeCons + [(L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:5-20 }) + (ConDeclGADT + (EpAnn + (Anchor + { T17544.hs:55:5-20 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (:| (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:18-20 }) - (HsTyVar - (EpAnn - (Anchor - { T17544.hs:55:18-20 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:18-20 }) - (Unqual - {OccName: Int})))))) - (Nothing)))] + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:5-9 }) + (Unqual + {OccName: MkD10})) + []) + (L + (TokenLoc + (EpaSpan { T17544.hs:55:11-12 })) + (HsNormalTok)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-20 }) + (HsOuterImplicit + (NoExtField))) + (Nothing) + (PrefixConGADT + []) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-20 }) + (HsAppTy + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-16 }) + (HsTyVar + (EpAnn + (Anchor + { T17544.hs:55:14-16 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-16 }) + (Unqual + {OccName: D10})))) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:18-20 }) + (HsTyVar + (EpAnn + (Anchor + { T17544.hs:55:18-20 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:18-20 }) + (Unqual + {OccName: Int})))))) + (Nothing)))]) []))))] (Nothing))))) ,(L diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr index ce76e9de6d..e00ee8798a 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr @@ -79,63 +79,65 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:9-20 }) - (ConDeclGADT - (EpAnn - (Anchor - { T17544_kw.hs:16:9-20 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:9-13 }) - (Unqual - {OccName: MkFoo}))] - (L - (TokenLoc - (EpaSpan { T17544_kw.hs:16:15-16 })) - (HsNormalTok)) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 }) - (HsOuterImplicit - (NoExtField))) - (Nothing) - (PrefixConGADT - []) - (L - (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 }) - (HsTyVar - (EpAnn - (Anchor - { T17544_kw.hs:16:18-20 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) + (DataTypeCons + [(L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:9-20 }) + (ConDeclGADT + (EpAnn + (Anchor + { T17544_kw.hs:16:9-20 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (:| (L - (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 }) + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:9-13 }) (Unqual - {OccName: Foo})))) - (Just + {OccName: MkFoo})) + []) (L - { T17544_kw.hs:15:10-35 } - (WithHsDocIdentifiers - (MultiLineDocString - (HsDocStringNext) - (:| - (L - { T17544_kw.hs:15:14-35 } - (HsDocStringChunk - " Bad comment for MkFoo")) + (TokenLoc + (EpaSpan { T17544_kw.hs:16:15-16 })) + (HsNormalTok)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 }) + (HsOuterImplicit + (NoExtField))) + (Nothing) + (PrefixConGADT + []) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 }) + (HsTyVar + (EpAnn + (Anchor + { T17544_kw.hs:16:18-20 } + (UnchangedAnchor)) + [] + (EpaComments [])) - [])))))] + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 }) + (Unqual + {OccName: Foo})))) + (Just + (L + { T17544_kw.hs:15:10-35 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringNext) + (:| + (L + { T17544_kw.hs:15:14-35 } + (HsDocStringChunk + " Bad comment for MkFoo")) + [])) + [])))))]) [])))) ,(L (SrcSpanAnn (EpAnn @@ -167,11 +169,11 @@ (Prefix) (HsDataDefn (NoExtField) - (NewType) (Nothing) (Nothing) (Nothing) - [(L + (NewTypeCon + (L (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:19:9-26 }) (ConDeclGADT (EpAnn @@ -181,10 +183,12 @@ [] (EpaComments [])) - [(L + (:| + (L (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:19:9-13 }) (Unqual - {OccName: MkBar}))] + {OccName: MkBar})) + []) (L (TokenLoc (EpaSpan { T17544_kw.hs:19:15-16 })) @@ -250,7 +254,7 @@ (HsDocStringChunk " Bad comment for MkBar")) [])) - [])))))] + [])))))) [])))) ,(L (SrcSpanAnn (EpAnn diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr index 7ab8440879..926d97fb35 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr @@ -94,83 +94,83 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnn - (Anchor - { DumpParsedAst.hs:8:14-17 } - (UnchangedAnchor)) - (AnnListItem - [(AddVbarAnn - (EpaSpan { DumpParsedAst.hs:8:19 }))]) - (EpaComments - [])) { DumpParsedAst.hs:8:14-17 }) - (ConDeclH98 - (EpAnn - (Anchor - { DumpParsedAst.hs:8:14-17 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:8:14-17 }) - (Unqual - {OccName: Zero})) - (False) - [] - (Nothing) - (PrefixCon - [] - []) - (Nothing))) - ,(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:8:21-30 }) - (ConDeclH98 - (EpAnn - (Anchor - { DumpParsedAst.hs:8:21-30 } - (UnchangedAnchor)) + (DataTypeCons + [(L + (SrcSpanAnn (EpAnn + (Anchor + { DumpParsedAst.hs:8:14-17 } + (UnchangedAnchor)) + (AnnListItem + [(AddVbarAnn + (EpaSpan { DumpParsedAst.hs:8:19 }))]) + (EpaComments + [])) { DumpParsedAst.hs:8:14-17 }) + (ConDeclH98 + (EpAnn + (Anchor + { DumpParsedAst.hs:8:14-17 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:8:14-17 }) + (Unqual + {OccName: Zero})) + (False) [] - (EpaComments - [])) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:8:21-24 }) - (Unqual - {OccName: Succ})) - (False) - [] - (Nothing) - (PrefixCon + (Nothing) + (PrefixCon + [] + []) + (Nothing))) + ,(L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:8:21-30 }) + (ConDeclH98 + (EpAnn + (Anchor + { DumpParsedAst.hs:8:21-30 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:8:21-24 }) + (Unqual + {OccName: Succ})) + (False) [] - [(HsScaled - (HsLinearArrow - (HsPct1 - (L - (NoTokenLoc) - (HsTok)) - (L - (NoTokenLoc) - (HsNormalTok)))) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:8:26-30 }) - (HsTyVar - (EpAnn - (Anchor - { DumpParsedAst.hs:8:26-30 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:8:26-30 }) - (Unqual - {OccName: Peano})))))]) - (Nothing)))] + (Nothing) + (PrefixCon + [] + [(HsScaled + (HsLinearArrow + (HsPct1 + (L + (NoTokenLoc) + (HsTok)) + (L + (NoTokenLoc) + (HsNormalTok)))) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:8:26-30 }) + (HsTyVar + (EpAnn + (Anchor + { DumpParsedAst.hs:8:26-30 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:8:26-30 }) + (Unqual + {OccName: Peano})))))]) + (Nothing)))]) [])))) ,(L (SrcSpanAnn (EpAnn @@ -532,86 +532,86 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:21-29 }) - (ConDeclH98 - (EpAnn - (Anchor - { DumpParsedAst.hs:15:21-29 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:21-23 }) - (Unqual - {OccName: MkT})) - (False) - [] - (Nothing) - (PrefixCon + (DataTypeCons + [(L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:21-29 }) + (ConDeclH98 + (EpAnn + (Anchor + { DumpParsedAst.hs:15:21-29 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:21-23 }) + (Unqual + {OccName: MkT})) + (False) [] - [(HsScaled - (HsLinearArrow - (HsPct1 - (L - (NoTokenLoc) - (HsTok)) - (L - (NoTokenLoc) - (HsNormalTok)))) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:25-29 }) - (HsParTy - (EpAnn - (Anchor - { DumpParsedAst.hs:15:25 } - (UnchangedAnchor)) - (AnnParen - (AnnParens) - (EpaSpan { DumpParsedAst.hs:15:25 }) - (EpaSpan { DumpParsedAst.hs:15:29 })) - (EpaComments - [])) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:26-28 }) - (HsAppTy - (NoExtField) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:26 }) - (HsTyVar - (EpAnn - (Anchor - { DumpParsedAst.hs:15:26 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:26 }) - (Unqual - {OccName: f})))) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:28 }) - (HsTyVar - (EpAnn - (Anchor - { DumpParsedAst.hs:15:28 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:28 }) - (Unqual - {OccName: a})))))))))]) - (Nothing)))] + (Nothing) + (PrefixCon + [] + [(HsScaled + (HsLinearArrow + (HsPct1 + (L + (NoTokenLoc) + (HsTok)) + (L + (NoTokenLoc) + (HsNormalTok)))) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:25-29 }) + (HsParTy + (EpAnn + (Anchor + { DumpParsedAst.hs:15:25 } + (UnchangedAnchor)) + (AnnParen + (AnnParens) + (EpaSpan { DumpParsedAst.hs:15:25 }) + (EpaSpan { DumpParsedAst.hs:15:29 })) + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:26-28 }) + (HsAppTy + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:26 }) + (HsTyVar + (EpAnn + (Anchor + { DumpParsedAst.hs:15:26 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:26 }) + (Unqual + {OccName: f})))) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:28 }) + (HsTyVar + (EpAnn + (Anchor + { DumpParsedAst.hs:15:28 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:28 }) + (Unqual + {OccName: a})))))))))]) + (Nothing)))]) [])))) ,(L (SrcSpanAnn (EpAnn @@ -1134,7 +1134,6 @@ (Prefix) (HsDataDefn (NoExtField) - (NewType) (Nothing) (Nothing) (Just @@ -1226,7 +1225,8 @@ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:57-60 }) (Unqual {OccName: Type}))))))) - [(L + (NewTypeCon + (L (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:3-45 }) (ConDeclGADT (EpAnn @@ -1236,10 +1236,12 @@ [] (EpaComments [])) - [(L + (:| + (L (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:3-5 }) (Unqual - {OccName: Nat}))] + {OccName: Nat})) + []) (L (TokenLoc (EpaSpan { DumpParsedAst.hs:22:7-8 })) @@ -1441,7 +1443,7 @@ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:45 }) (Unqual {OccName: g})))))) - (Nothing)))] + (Nothing)))) [])))))) ,(L (SrcSpanAnn (EpAnn @@ -1533,3 +1535,5 @@ {FastString: "hello"})))))))] (EmptyLocalBinds (NoExtField)))))])))))])) + + diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr index 456117aa2c..88f23d3ee0 100644 --- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr @@ -109,62 +109,62 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnn - (Anchor - { DumpRenamedAst.hs:10:14-17 } - (UnchangedAnchor)) - (AnnListItem - [(AddVbarAnn - (EpaSpan { DumpRenamedAst.hs:10:19 }))]) - (EpaComments - [])) { DumpRenamedAst.hs:10:14-17 }) - (ConDeclH98 - (EpAnnNotUsed) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:10:14-17 }) - {Name: DumpRenamedAst.Zero}) - (False) - [] - (Nothing) - (PrefixCon + (DataTypeCons + [(L + (SrcSpanAnn (EpAnn + (Anchor + { DumpRenamedAst.hs:10:14-17 } + (UnchangedAnchor)) + (AnnListItem + [(AddVbarAnn + (EpaSpan { DumpRenamedAst.hs:10:19 }))]) + (EpaComments + [])) { DumpRenamedAst.hs:10:14-17 }) + (ConDeclH98 + (EpAnnNotUsed) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:10:14-17 }) + {Name: DumpRenamedAst.Zero}) + (False) [] - []) - (Nothing))) - ,(L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:10:21-30 }) - (ConDeclH98 - (EpAnnNotUsed) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:10:21-24 }) - {Name: DumpRenamedAst.Succ}) - (False) - [] - (Nothing) - (PrefixCon + (Nothing) + (PrefixCon + [] + []) + (Nothing))) + ,(L + (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:10:21-30 }) + (ConDeclH98 + (EpAnnNotUsed) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:10:21-24 }) + {Name: DumpRenamedAst.Succ}) + (False) [] - [(HsScaled - (HsLinearArrow - (HsPct1 - (L - (NoTokenLoc) - (HsTok)) - (L - (NoTokenLoc) - (HsNormalTok)))) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:10:26-30 }) - (HsTyVar - (EpAnnNotUsed) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:10:26-30 }) - {Name: DumpRenamedAst.Peano}))))]) - (Nothing)))] + (Nothing) + (PrefixCon + [] + [(HsScaled + (HsLinearArrow + (HsPct1 + (L + (NoTokenLoc) + (HsTok)) + (L + (NoTokenLoc) + (HsNormalTok)))) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:10:26-30 }) + (HsTyVar + (EpAnnNotUsed) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:10:26-30 }) + {Name: DumpRenamedAst.Peano}))))]) + (Nothing)))]) [])))] [] [] @@ -513,7 +513,6 @@ (Prefix) (HsDataDefn (NoExtField) - (NewType) (Nothing) (Nothing) (Just @@ -575,13 +574,16 @@ (L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:19:57-60 }) {Name: GHC.Types.Type})))))) - [(L + (NewTypeCon + (L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:3-45 }) (ConDeclGADT (EpAnnNotUsed) - [(L + (:| + (L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:3-5 }) - {Name: DumpRenamedAst.Nat})] + {Name: DumpRenamedAst.Nat}) + []) (L (TokenLoc (EpaSpan { DumpRenamedAst.hs:20:7-8 })) @@ -717,7 +719,7 @@ (L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:45 }) {Name: g}))))) - (Nothing)))] + (Nothing)))) [])))))]) ,(TyClGroup (NoExtField) @@ -782,56 +784,56 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:21-29 }) - (ConDeclH98 - (EpAnnNotUsed) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:21-23 }) - {Name: DumpRenamedAst.MkT}) - (False) - [] - (Nothing) - (PrefixCon + (DataTypeCons + [(L + (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:21-29 }) + (ConDeclH98 + (EpAnnNotUsed) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:21-23 }) + {Name: DumpRenamedAst.MkT}) + (False) [] - [(HsScaled - (HsLinearArrow - (HsPct1 - (L - (NoTokenLoc) - (HsTok)) - (L - (NoTokenLoc) - (HsNormalTok)))) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:25-29 }) - (HsParTy - (EpAnnNotUsed) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:26-28 }) - (HsAppTy - (NoExtField) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:26 }) - (HsTyVar - (EpAnnNotUsed) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:26 }) - {Name: f}))) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:28 }) - (HsTyVar - (EpAnnNotUsed) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:28 }) - {Name: a}))))))))]) - (Nothing)))] + (Nothing) + (PrefixCon + [] + [(HsScaled + (HsLinearArrow + (HsPct1 + (L + (NoTokenLoc) + (HsTok)) + (L + (NoTokenLoc) + (HsNormalTok)))) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:25-29 }) + (HsParTy + (EpAnnNotUsed) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:26-28 }) + (HsAppTy + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:26 }) + (HsTyVar + (EpAnnNotUsed) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:26 }) + {Name: f}))) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:28 }) + (HsTyVar + (EpAnnNotUsed) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:28 }) + {Name: a}))))))))]) + (Nothing)))]) [])))] [] [] diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr index 05401b78bb..29225d7f00 100644 --- a/testsuite/tests/parser/should_compile/T14189.stderr +++ b/testsuite/tests/parser/should_compile/T14189.stderr @@ -35,123 +35,123 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnn - (Anchor - { T14189.hs:6:15-20 } - (UnchangedAnchor)) - (AnnListItem - [(AddVbarAnn - (EpaSpan { T14189.hs:6:22 }))]) - (EpaComments - [])) { T14189.hs:6:15-20 }) - (ConDeclH98 - (EpAnnNotUsed) - (L - (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:15-16 }) - {Name: T14189.MT}) - (False) - [] - (Nothing) - (PrefixCon + (DataTypeCons + [(L + (SrcSpanAnn (EpAnn + (Anchor + { T14189.hs:6:15-20 } + (UnchangedAnchor)) + (AnnListItem + [(AddVbarAnn + (EpaSpan { T14189.hs:6:22 }))]) + (EpaComments + [])) { T14189.hs:6:15-20 }) + (ConDeclH98 + (EpAnnNotUsed) + (L + (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:15-16 }) + {Name: T14189.MT}) + (False) [] - [(HsScaled - (HsLinearArrow - (HsPct1 - (L - (NoTokenLoc) - (HsTok)) - (L - (NoTokenLoc) - (HsNormalTok)))) - (L - (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:18-20 }) - (HsTyVar - (EpAnnNotUsed) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:18-20 }) - {Name: GHC.Types.Int}))))]) - (Nothing))) - ,(L - (SrcSpanAnn (EpAnn - (Anchor - { T14189.hs:6:24-25 } - (UnchangedAnchor)) - (AnnListItem - [(AddVbarAnn - (EpaSpan { T14189.hs:6:27 }))]) - (EpaComments - [])) { T14189.hs:6:24-25 }) - (ConDeclH98 - (EpAnnNotUsed) - (L - (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:24-25 }) - {Name: T14189.NT}) - (False) - [] - (Nothing) - (PrefixCon + (Nothing) + (PrefixCon + [] + [(HsScaled + (HsLinearArrow + (HsPct1 + (L + (NoTokenLoc) + (HsTok)) + (L + (NoTokenLoc) + (HsNormalTok)))) + (L + (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:18-20 }) + (HsTyVar + (EpAnnNotUsed) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:18-20 }) + {Name: GHC.Types.Int}))))]) + (Nothing))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { T14189.hs:6:24-25 } + (UnchangedAnchor)) + (AnnListItem + [(AddVbarAnn + (EpaSpan { T14189.hs:6:27 }))]) + (EpaComments + [])) { T14189.hs:6:24-25 }) + (ConDeclH98 + (EpAnnNotUsed) + (L + (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:24-25 }) + {Name: T14189.NT}) + (False) [] - []) - (Nothing))) - ,(L - (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:29-42 }) - (ConDeclH98 - (EpAnnNotUsed) - (L - (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:29 }) - {Name: T14189.F}) - (False) - [] - (Nothing) - (RecCon + (Nothing) + (PrefixCon + [] + []) + (Nothing))) + ,(L + (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:29-42 }) + (ConDeclH98 + (EpAnnNotUsed) (L - (SrcSpanAnn (EpAnn - (Anchor - { T14189.hs:6:31 } - (UnchangedAnchor)) - (AnnList - (Just - (Anchor - { T14189.hs:6:33-40 } - (UnchangedAnchor))) - (Just - (AddEpAnn AnnOpenC (EpaSpan { T14189.hs:6:31 }))) - (Just - (AddEpAnn AnnCloseC (EpaSpan { T14189.hs:6:42 }))) - [] - []) - (EpaComments - [])) { T14189.hs:6:31-42 }) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:33-40 }) - (ConDeclField - (EpAnnNotUsed) - [(L - (SrcSpanAnn + (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:29 }) + {Name: T14189.F}) + (False) + [] + (Nothing) + (RecCon + (L + (SrcSpanAnn (EpAnn + (Anchor + { T14189.hs:6:31 } + (UnchangedAnchor)) + (AnnList + (Just + (Anchor + { T14189.hs:6:33-40 } + (UnchangedAnchor))) + (Just + (AddEpAnn AnnOpenC (EpaSpan { T14189.hs:6:31 }))) + (Just + (AddEpAnn AnnCloseC (EpaSpan { T14189.hs:6:42 }))) + [] + []) + (EpaComments + [])) { T14189.hs:6:31-42 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:33-40 }) + (ConDeclField + (EpAnnNotUsed) + [(L + (SrcSpanAnn + (EpAnnNotUsed) + { T14189.hs:6:33 }) + (FieldOcc + {Name: T14189.f} + (L + (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:33 }) + (Unqual + {OccName: f}))))] + (L + (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:38-40 }) + (HsTyVar (EpAnnNotUsed) - { T14189.hs:6:33 }) - (FieldOcc - {Name: T14189.f} + (NotPromoted) (L - (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:33 }) - (Unqual - {OccName: f}))))] - (L - (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:38-40 }) - (HsTyVar - (EpAnnNotUsed) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:38-40 }) - {Name: GHC.Types.Int}))) - (Nothing)))])) - (Nothing)))] + (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:38-40 }) + {Name: GHC.Types.Int}))) + (Nothing)))])) + (Nothing)))]) [])))] [] [] diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr index ee0748d050..fbcfa63276 100644 --- a/testsuite/tests/parser/should_compile/T15323.stderr +++ b/testsuite/tests/parser/should_compile/T15323.stderr @@ -81,154 +81,156 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:5-54 }) - (ConDeclGADT - (EpAnn - (Anchor - { T15323.hs:6:5-54 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:5-14 }) - (Unqual - {OccName: TestParens}))] - (L - (TokenLoc - (EpaSpan { T15323.hs:6:17-18 })) - (HsNormalTok)) - (L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:20-54 }) - (HsOuterExplicit - (EpAnn - (Anchor - { T15323.hs:6:20-25 } - (UnchangedAnchor)) - ((,) - (AddEpAnn AnnForall (EpaSpan { T15323.hs:6:20-25 })) - (AddEpAnn AnnDot (EpaSpan { T15323.hs:6:29 }))) - (EpaComments - [])) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:27 }) - (UserTyVar + (DataTypeCons + [(L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:5-54 }) + (ConDeclGADT + (EpAnn + (Anchor + { T15323.hs:6:5-54 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (:| + (L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:5-14 }) + (Unqual + {OccName: TestParens})) + []) + (L + (TokenLoc + (EpaSpan { T15323.hs:6:17-18 })) + (HsNormalTok)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:20-54 }) + (HsOuterExplicit + (EpAnn + (Anchor + { T15323.hs:6:20-25 } + (UnchangedAnchor)) + ((,) + (AddEpAnn AnnForall (EpaSpan { T15323.hs:6:20-25 })) + (AddEpAnn AnnDot (EpaSpan { T15323.hs:6:29 }))) + (EpaComments + [])) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:27 }) + (UserTyVar + (EpAnn + (Anchor + { T15323.hs:6:27 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (SpecifiedSpec) + (L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:27 }) + (Unqual + {OccName: v}))))])) + (Just + (L + (SrcSpanAnn (EpAnn + (Anchor + { T15323.hs:6:31-36 } + (UnchangedAnchor)) + (AnnContext + (Just + ((,) + (NormalSyntax) + (EpaSpan { T15323.hs:6:38-39 }))) + [] + []) + (EpaComments + [])) { T15323.hs:6:31-36 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:31-36 }) + (HsParTy + (EpAnn + (Anchor + { T15323.hs:6:31 } + (UnchangedAnchor)) + (AnnParen + (AnnParens) + (EpaSpan { T15323.hs:6:31 }) + (EpaSpan { T15323.hs:6:36 })) + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:32-35 }) + (HsAppTy + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:32-33 }) + (HsTyVar + (EpAnn + (Anchor + { T15323.hs:6:32-33 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:32-33 }) + (Unqual + {OccName: Eq})))) + (L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:35 }) + (HsTyVar + (EpAnn + (Anchor + { T15323.hs:6:35 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:35 }) + (Unqual + {OccName: v}))))))))])) + (PrefixConGADT + []) + (L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:41-54 }) + (HsAppTy + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:41-52 }) + (HsTyVar (EpAnn (Anchor - { T15323.hs:6:27 } + { T15323.hs:6:41-52 } (UnchangedAnchor)) [] (EpaComments [])) - (SpecifiedSpec) + (NotPromoted) (L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:27 }) + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:41-52 }) (Unqual - {OccName: v}))))])) - (Just - (L - (SrcSpanAnn (EpAnn - (Anchor - { T15323.hs:6:31-36 } - (UnchangedAnchor)) - (AnnContext - (Just - ((,) - (NormalSyntax) - (EpaSpan { T15323.hs:6:38-39 }))) - [] - []) - (EpaComments - [])) { T15323.hs:6:31-36 }) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:31-36 }) - (HsParTy + {OccName: MaybeDefault})))) + (L + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:54 }) + (HsTyVar (EpAnn (Anchor - { T15323.hs:6:31 } + { T15323.hs:6:54 } (UnchangedAnchor)) - (AnnParen - (AnnParens) - (EpaSpan { T15323.hs:6:31 }) - (EpaSpan { T15323.hs:6:36 })) + [] (EpaComments [])) + (NotPromoted) (L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:32-35 }) - (HsAppTy - (NoExtField) - (L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:32-33 }) - (HsTyVar - (EpAnn - (Anchor - { T15323.hs:6:32-33 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:32-33 }) - (Unqual - {OccName: Eq})))) - (L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:35 }) - (HsTyVar - (EpAnn - (Anchor - { T15323.hs:6:35 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:35 }) - (Unqual - {OccName: v}))))))))])) - (PrefixConGADT - []) - (L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:41-54 }) - (HsAppTy - (NoExtField) - (L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:41-52 }) - (HsTyVar - (EpAnn - (Anchor - { T15323.hs:6:41-52 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:41-52 }) - (Unqual - {OccName: MaybeDefault})))) - (L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:54 }) - (HsTyVar - (EpAnn - (Anchor - { T15323.hs:6:54 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:54 }) - (Unqual - {OccName: v})))))) - (Nothing)))] + (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:54 }) + (Unqual + {OccName: v})))))) + (Nothing)))]) []))))])) diff --git a/testsuite/tests/parser/should_compile/T20452.stderr b/testsuite/tests/parser/should_compile/T20452.stderr index 810b831cd7..c7808c1019 100644 --- a/testsuite/tests/parser/should_compile/T20452.stderr +++ b/testsuite/tests/parser/should_compile/T20452.stderr @@ -98,31 +98,31 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T20452.hs:5:26-31 }) - (ConDeclH98 - (EpAnn - (Anchor - { T20452.hs:5:26-31 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (L - (SrcSpanAnn (EpAnnNotUsed) { T20452.hs:5:26-31 }) - (Unqual - {OccName: Proxy1})) - (False) - [] - (Nothing) - (PrefixCon + (DataTypeCons + [(L + (SrcSpanAnn (EpAnnNotUsed) { T20452.hs:5:26-31 }) + (ConDeclH98 + (EpAnn + (Anchor + { T20452.hs:5:26-31 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { T20452.hs:5:26-31 }) + (Unqual + {OccName: Proxy1})) + (False) [] - []) - (Nothing)))] + (Nothing) + (PrefixCon + [] + []) + (Nothing)))]) [])))) ,(L (SrcSpanAnn (EpAnn @@ -187,31 +187,31 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T20452.hs:6:26-31 }) - (ConDeclH98 - (EpAnn - (Anchor - { T20452.hs:6:26-31 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (L - (SrcSpanAnn (EpAnnNotUsed) { T20452.hs:6:26-31 }) - (Unqual - {OccName: Proxy2})) - (False) - [] - (Nothing) - (PrefixCon + (DataTypeCons + [(L + (SrcSpanAnn (EpAnnNotUsed) { T20452.hs:6:26-31 }) + (ConDeclH98 + (EpAnn + (Anchor + { T20452.hs:6:26-31 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { T20452.hs:6:26-31 }) + (Unqual + {OccName: Proxy2})) + (False) [] - []) - (Nothing)))] + (Nothing) + (PrefixCon + [] + []) + (Nothing)))]) [])))) ,(L (SrcSpanAnn (EpAnn diff --git a/testsuite/tests/parser/should_fail/T22070.hs b/testsuite/tests/parser/should_fail/T22070.hs new file mode 100644 index 0000000000..3d03eeca53 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T22070.hs @@ -0,0 +1,3 @@ +module T22070 where + +newtype FooBar = Foo | Bar diff --git a/testsuite/tests/parser/should_fail/T22070.stderr b/testsuite/tests/parser/should_fail/T22070.stderr new file mode 100644 index 0000000000..71ff16e7b3 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T22070.stderr @@ -0,0 +1,4 @@ + +T22070.hs:3:1: error: [GHC-05380] + A newtype must have exactly one constructor, but ‘FooBar’ has two + In the newtype declaration for ‘FooBar’ diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T index 4d70833bed..8713d91f2b 100644 --- a/testsuite/tests/parser/should_fail/all.T +++ b/testsuite/tests/parser/should_fail/all.T @@ -208,3 +208,4 @@ test('OpaqueParseFail4', normal, compile_fail, ['']) test('T20385A', normal, compile_fail, ['']) test('T20385B', normal, compile_fail, ['']) test('T16999', normal, compile_fail, ['']) +test('T22070', normal, compile_fail, ['']) diff --git a/testsuite/tests/printer/T18791.stderr b/testsuite/tests/printer/T18791.stderr index f4264de86d..2d8d3060ab 100644 --- a/testsuite/tests/printer/T18791.stderr +++ b/testsuite/tests/printer/T18791.stderr @@ -67,78 +67,80 @@ (Prefix) (HsDataDefn (NoExtField) - (DataType) (Nothing) (Nothing) (Nothing) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:3-17 }) - (ConDeclGADT - (EpAnn - (Anchor - { T18791.hs:5:3-17 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - [(L - (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:3-5 }) - (Unqual - {OccName: MkT}))] - (L - (TokenLoc - (EpaSpan { T18791.hs:5:7-8 })) - (HsNormalTok)) - (L - (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:10-17 }) - (HsOuterImplicit - (NoExtField))) - (Nothing) - (PrefixConGADT - [(HsScaled - (HsUnrestrictedArrow - (L - (TokenLoc - (EpaSpan { T18791.hs:5:14-15 })) - (HsNormalTok))) - (L - (SrcSpanAnn (EpAnn - (Anchor - { T18791.hs:5:10-12 } - (UnchangedAnchor)) - (AnnListItem - []) - (EpaComments - [])) { T18791.hs:5:10-12 }) - (HsTyVar - (EpAnn - (Anchor - { T18791.hs:5:10-12 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:10-12 }) - (Unqual - {OccName: Int})))))]) - (L - (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:17 }) - (HsTyVar - (EpAnn - (Anchor - { T18791.hs:5:17 } - (UnchangedAnchor)) - [] - (EpaComments - [])) - (NotPromoted) + (DataTypeCons + [(L + (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:3-17 }) + (ConDeclGADT + (EpAnn + (Anchor + { T18791.hs:5:3-17 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (:| (L - (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:17 }) + (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:3-5 }) (Unqual - {OccName: T})))) - (Nothing)))] + {OccName: MkT})) + []) + (L + (TokenLoc + (EpaSpan { T18791.hs:5:7-8 })) + (HsNormalTok)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:10-17 }) + (HsOuterImplicit + (NoExtField))) + (Nothing) + (PrefixConGADT + [(HsScaled + (HsUnrestrictedArrow + (L + (TokenLoc + (EpaSpan { T18791.hs:5:14-15 })) + (HsNormalTok))) + (L + (SrcSpanAnn (EpAnn + (Anchor + { T18791.hs:5:10-12 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T18791.hs:5:10-12 }) + (HsTyVar + (EpAnn + (Anchor + { T18791.hs:5:10-12 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:10-12 }) + (Unqual + {OccName: Int})))))]) + (L + (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:17 }) + (HsTyVar + (EpAnn + (Anchor + { T18791.hs:5:17 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (NotPromoted) + (L + (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:17 }) + (Unqual + {OccName: T})))) + (Nothing)))]) []))))])) diff --git a/testsuite/tests/typecheck/should_fail/T2126.stderr b/testsuite/tests/typecheck/should_fail/T2126.stderr index c910148317..801243e651 100644 --- a/testsuite/tests/typecheck/should_fail/T2126.stderr +++ b/testsuite/tests/typecheck/should_fail/T2126.stderr @@ -1,4 +1,4 @@ -T2126.hs:5:1: +T2126.hs:5:1: error: [GHC-05380] A newtype must have exactly one constructor, but ‘X’ has none In the newtype declaration for ‘X’ diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs index 8ec3adbf46..277fcfcd3a 100644 --- a/utils/check-exact/ExactPrint.hs +++ b/utils/check-exact/ExactPrint.hs @@ -2742,14 +2742,14 @@ exactDataDefn :: EpAnn [AddEpAnn] -> HsDataDefn GhcPs -> EPP () exactDataDefn an exactHdr - (HsDataDefn { dd_ND = new_or_data, dd_ctxt = context + (HsDataDefn { dd_ctxt = context , dd_cType = mb_ct , dd_kindSig = mb_sig , dd_cons = condecls, dd_derivs = derivings }) = do annotationsToComments (epAnnAnns an) [AnnOpenP, AnnCloseP] - if new_or_data == DataType - then markEpAnn an AnnData - else markEpAnn an AnnNewtype + markEpAnn an $ case condecls of + DataTypeCons _ -> AnnData + NewTypeCon _ -> AnnNewtype markEpAnn an AnnInstance -- optional mapM_ markAnnotated mb_ct exactHdr context @@ -2760,7 +2760,7 @@ exactDataDefn an exactHdr markAnnotated kind when (isGadt condecls) $ markEpAnn an AnnWhere markEpAnn an AnnOpenC - exact_condecls an condecls + exact_condecls an (toList condecls) markEpAnn an AnnCloseC mapM_ markAnnotated derivings return () diff --git a/utils/check-exact/Utils.hs b/utils/check-exact/Utils.hs index 3f16407175..7b31ffd630 100644 --- a/utils/check-exact/Utils.hs +++ b/utils/check-exact/Utils.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -212,10 +213,10 @@ isListComp = isDoComprehensionContext -- --------------------------------------------------------------------- -isGadt :: [LConDecl (GhcPass p)] -> Bool -isGadt [] = False -isGadt ((L _ (ConDeclGADT{})):_) = True -isGadt _ = False +isGadt :: Foldable f => f (LConDecl (GhcPass p)) -> Bool +isGadt = any $ \ case + L _ ConDeclGADT {} -> True + _ -> False -- --------------------------------------------------------------------- diff --git a/utils/haddock b/utils/haddock -Subproject 43f478af894b5173b4f1087c6d92c41a64250be +Subproject b5e40b15228fdca5ce7d4e2f2241156d0b08526 |