From 09947ecee1bdc450ce561543f68bee6765122fb5 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 21 Feb 2021 21:16:24 +0000 Subject: Wrap LHsContext in Maybe in the GHC AST If the context is missing it is captured as Nothing, rather than putting a noLoc in the ParsedSource. Updates haddock submodule --- compiler/GHC/Hs/Decls.hs | 18 ++++---- compiler/GHC/Hs/Type.hs | 52 ++++++++++------------ compiler/GHC/HsToCore/Quote.hs | 9 ++-- compiler/GHC/Iface/Ext/Ast.hs | 4 +- compiler/GHC/Parser.y | 2 +- compiler/GHC/Parser/Errors/Ppr.hs | 2 +- compiler/GHC/Parser/PostProcess.hs | 5 +-- compiler/GHC/Parser/PostProcess/Haddock.hs | 6 +-- compiler/GHC/Rename/HsType.hs | 37 +++++++++------ compiler/GHC/Rename/Module.hs | 6 +-- compiler/GHC/Tc/Deriv.hs | 2 +- compiler/GHC/Tc/Gen/Bind.hs | 4 +- compiler/GHC/Tc/Gen/HsType.hs | 21 +++++---- compiler/GHC/Tc/Gen/Sig.hs | 4 +- compiler/GHC/Tc/TyCl.hs | 19 ++++---- compiler/GHC/Tc/TyCl/Instance.hs | 2 +- compiler/GHC/ThToHs.hs | 16 +++---- compiler/Language/Haskell/Syntax/Decls.hs | 4 +- compiler/Language/Haskell/Syntax/Type.hs | 2 +- .../should_compile_flag_haddock/T17544.stderr | 48 +++++++------------- .../should_compile_flag_haddock/T17544_kw.stderr | 9 ++-- .../parser/should_compile/DumpParsedAst.stderr | 6 +-- .../parser/should_compile/DumpRenamedAst.stderr | 9 ++-- .../tests/parser/should_compile/T14189.stderr | 3 +- .../tests/parser/should_compile/T15323.stderr | 3 +- testsuite/tests/printer/T18791.stderr | 3 +- utils/haddock | 2 +- 27 files changed, 138 insertions(+), 160 deletions(-) diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index 6633cf657f..cfafa76733 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -381,7 +381,7 @@ instance (OutputableBndrId p) => Outputable (TyClDecl (GhcPass p)) where ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity , tcdRhs = rhs }) = hang (text "type" <+> - pp_vanilla_decl_head ltycon tyvars fixity noLHsContext <+> equals) + pp_vanilla_decl_head ltycon tyvars fixity Nothing <+> equals) 4 (ppr rhs) ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity @@ -424,7 +424,7 @@ pp_vanilla_decl_head :: (OutputableBndrId p) => Located (IdP (GhcPass p)) -> LHsQTyVars (GhcPass p) -> LexicalFixity - -> LHsContext (GhcPass p) + -> Maybe (LHsContext (GhcPass p)) -> SDoc pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context = hsep [pprLHsContext context, pp_tyvars tyvars] @@ -512,7 +512,7 @@ pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon , fdResultSig = L _ result , fdInjectivityAnn = mb_inj }) = vcat [ pprFlavour info <+> pp_top_level <+> - pp_vanilla_decl_head ltycon tyvars fixity noLHsContext <+> + pp_vanilla_decl_head ltycon tyvars fixity Nothing <+> pp_kind <+> pp_inj <+> pp_where , nest 2 $ pp_eqns ] where @@ -607,7 +607,7 @@ hsConDeclTheta Nothing = [] hsConDeclTheta (Just (L _ theta)) = theta pp_data_defn :: (OutputableBndrId p) - => (LHsContext (GhcPass p) -> SDoc) -- Printing the header + => (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 @@ -661,7 +661,7 @@ pprConDecl (ConDeclH98 { con_name = L _ con , con_args = args , con_doc = doc }) = sep [ ppr_mbDoc doc - , pprHsForAll (mkHsForAllInvisTele ex_tvs) cxt + , pprHsForAll (mkHsForAllInvisTele ex_tvs) mcxt , ppr_details args ] where -- In ppr_details: let's not print the multiplicities (they are always 1, by @@ -673,19 +673,17 @@ pprConDecl (ConDeclH98 { con_name = L _ con : map (pprHsType . unLoc . hsScaledThing) tys) ppr_details (RecCon fields) = pprPrefixOcc con <+> pprConDeclFields (unLoc fields) - cxt = fromMaybe noLHsContext mcxt 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 }) = ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon - <+> (sep [pprHsOuterSigTyVarBndrs outer_bndrs <+> pprLHsContext cxt, + <+> (sep [pprHsOuterSigTyVarBndrs outer_bndrs <+> pprLHsContext mcxt, ppr_arrow_chain (get_args args ++ [ppr res_ty]) ]) where get_args (PrefixConGADT args) = map ppr args get_args (RecConGADT fields) = [pprConDeclFields (unLoc fields)] - cxt = fromMaybe noLHsContext mcxt ppr_arrow_chain (a:as) = sep (a : map (arrow <+>) as) ppr_arrow_chain [] = empty @@ -740,7 +738,7 @@ ppr_fam_inst_eqn (FamEqn { feqn_tycon = L _ tycon , feqn_pats = pats , feqn_fixity = fixity , feqn_rhs = rhs }) - = pprHsFamInstLHS tycon bndrs pats fixity noLHsContext <+> equals <+> ppr rhs + = pprHsFamInstLHS tycon bndrs pats fixity Nothing <+> equals <+> ppr rhs instance OutputableBndrId p => Outputable (DataFamInstDecl (GhcPass p)) where @@ -770,7 +768,7 @@ pprHsFamInstLHS :: (OutputableBndrId p) -> HsOuterFamEqnTyVarBndrs (GhcPass p) -> HsTyPats (GhcPass p) -> LexicalFixity - -> LHsContext (GhcPass p) + -> Maybe (LHsContext (GhcPass p)) -> SDoc pprHsFamInstLHS thing bndrs typats fixity mb_ctxt = hsep [ pprHsOuterFamEqnTyVarBndrs bndrs diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs index d5560411e4..0e67a4a94e 100644 --- a/compiler/GHC/Hs/Type.hs +++ b/compiler/GHC/Hs/Type.hs @@ -1,10 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} @@ -35,7 +33,7 @@ module GHC.Hs.Type ( HsPatSigType(..), HsPSRn(..), HsSigType(..), LHsSigType, LHsSigWcType, LHsWcType, HsTupleSort(..), - HsContext, LHsContext, noLHsContext, + HsContext, LHsContext, fromMaybeContext, HsTyLit(..), HsIPName(..), hsIPNameFS, HsArg(..), numVisibleArgs, @@ -140,13 +138,8 @@ getBangStrictness _ = (HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict) ************************************************************************ -} -noLHsContext :: LHsContext (GhcPass p) --- Use this when there is no context in the original program --- It would really be more kosher to use a Maybe, to distinguish --- class () => C a where ... --- from --- class C a where ... -noLHsContext = noLoc [] +fromMaybeContext :: Maybe (LHsContext (GhcPass p)) -> HsContext (GhcPass p) +fromMaybeContext mctxt = unLoc $ fromMaybe (noLoc []) mctxt type instance XHsForAllVis (GhcPass _) = NoExtField type instance XHsForAllInvis (GhcPass _) = NoExtField @@ -514,9 +507,9 @@ lhsTypeArgSrcSpan arg = case arg of splitLHsPatSynTy :: LHsSigType (GhcPass p) -> ( [LHsTyVarBndr Specificity (NoGhcTc (GhcPass p))] -- universals - , LHsContext (GhcPass p) -- required constraints + , Maybe (LHsContext (GhcPass p)) -- required constraints , [LHsTyVarBndr Specificity (GhcPass p)] -- existentials - , LHsContext (GhcPass p) -- provided constraints + , Maybe (LHsContext (GhcPass p)) -- provided constraints , LHsType (GhcPass p)) -- body type splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4) where @@ -550,7 +543,8 @@ splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4) -- generally possible to take the returned types and reconstruct the original -- type (parentheses and all) from them. splitLHsSigmaTyInvis :: LHsType (GhcPass p) - -> ([LHsTyVarBndr Specificity (GhcPass p)], LHsContext (GhcPass p), LHsType (GhcPass p)) + -> ([LHsTyVarBndr Specificity (GhcPass p)] + , Maybe (LHsContext (GhcPass p)), LHsType (GhcPass p)) splitLHsSigmaTyInvis ty | (tvs, ty1) <- splitLHsForAllTyInvis ty , (ctxt, ty2) <- splitLHsQualTy ty1 @@ -629,10 +623,11 @@ splitLHsForAllTyInvis_KP lty@(L _ ty) = -- such as @(context => <...>)@. The downside to this is that it is not -- generally possible to take the returned types and reconstruct the original -- type (parentheses and all) from them. -splitLHsQualTy :: LHsType (GhcPass pass) -> (LHsContext (GhcPass pass), LHsType (GhcPass pass)) +splitLHsQualTy :: LHsType (GhcPass pass) + -> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass)) splitLHsQualTy ty | (mb_ctxt, body) <- splitLHsQualTy_KP (ignoreParens ty) - = (fromMaybe noLHsContext mb_ctxt, body) + = (mb_ctxt, body) -- | Decompose a type of the form @context => body@ into its constituent parts. -- @@ -640,7 +635,7 @@ splitLHsQualTy ty -- parentheses, hence the suffix @_KP@ (short for \"Keep Parentheses\"). splitLHsQualTy_KP :: LHsType (GhcPass pass) -> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass)) splitLHsQualTy_KP (L _ (HsQualTy { hst_ctxt = ctxt, hst_body = body })) - = (Just ctxt, body) + = (ctxt, body) splitLHsQualTy_KP body = (Nothing, body) -- | Decompose a type class instance type (of the form @@ -657,12 +652,11 @@ splitLHsQualTy_KP body = (Nothing, body) -- See @Note [No nested foralls or contexts in instance types]@ -- for why this is important. splitLHsInstDeclTy :: LHsSigType GhcRn - -> ([Name], LHsContext GhcRn, LHsType GhcRn) + -> ([Name], Maybe (LHsContext GhcRn), LHsType GhcRn) splitLHsInstDeclTy (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = inst_ty})) = - (hsOuterTyVarNames outer_bndrs, ctxt, body_ty) + (hsOuterTyVarNames outer_bndrs, mb_cxt, body_ty) where (mb_cxt, body_ty) = splitLHsQualTy_KP inst_ty - ctxt = fromMaybe noLHsContext mb_cxt -- | Decompose a type class instance type (of the form -- @forall . context => instance_head@) into the @instance_head@. @@ -897,13 +891,13 @@ pprHsOuterSigTyVarBndrs :: OutputableBndrId p => HsOuterSigTyVarBndrs (GhcPass p) -> SDoc pprHsOuterSigTyVarBndrs (HsOuterImplicit{}) = empty pprHsOuterSigTyVarBndrs (HsOuterExplicit{hso_bndrs = bndrs}) = - pprHsForAll (mkHsForAllInvisTele bndrs) noLHsContext + pprHsForAll (mkHsForAllInvisTele bndrs) Nothing -- | Prints a forall; When passed an empty list, prints @forall .@/@forall ->@ -- only when @-dppr-debug@ is enabled. pprHsForAll :: forall p. OutputableBndrId p => HsForAllTelescope (GhcPass p) - -> LHsContext (GhcPass p) -> SDoc + -> Maybe (LHsContext (GhcPass p)) -> SDoc pprHsForAll tele cxt = pp_tele tele <+> pprLHsContext cxt where @@ -919,15 +913,17 @@ pprHsForAll tele cxt | otherwise = forAllLit <+> interppSP qtvs <> separator pprLHsContext :: (OutputableBndrId p) - => LHsContext (GhcPass p) -> SDoc -pprLHsContext lctxt + => Maybe (LHsContext (GhcPass p)) -> SDoc +pprLHsContext Nothing = empty +pprLHsContext (Just lctxt) | null (unLoc lctxt) = empty - | otherwise = pprLHsContextAlways lctxt + | otherwise = pprLHsContextAlways (Just lctxt) -- For use in a HsQualTy, which always gets printed if it exists. pprLHsContextAlways :: (OutputableBndrId p) - => LHsContext (GhcPass p) -> SDoc -pprLHsContextAlways (L _ ctxt) + => Maybe (LHsContext (GhcPass p)) -> SDoc +pprLHsContextAlways Nothing = parens empty <+> darrow +pprLHsContextAlways (Just (L _ ctxt)) = case ctxt of [] -> parens empty <+> darrow [L _ ty] -> ppr_mono_ty ty <+> darrow @@ -967,7 +963,7 @@ ppr_mono_lty ty = ppr_mono_ty (unLoc ty) ppr_mono_ty :: (OutputableBndrId p) => HsType (GhcPass p) -> SDoc ppr_mono_ty (HsForAllTy { hst_tele = tele, hst_body = ty }) - = sep [pprHsForAll tele noLHsContext, ppr_mono_lty ty] + = sep [pprHsForAll tele Nothing, ppr_mono_lty ty] ppr_mono_ty (HsQualTy { hst_ctxt = ctxt, hst_body = ty }) = sep [pprLHsContextAlways ctxt, ppr_mono_lty ty] @@ -1113,7 +1109,7 @@ lhsTypeHasLeadingPromotionQuote ty go (HsForAllTy{}) = False go (HsQualTy{ hst_ctxt = ctxt, hst_body = body}) - | L _ (c:_) <- ctxt = goL c + | Just (L _ (c:_)) <- ctxt = goL c | otherwise = goL body go (HsBangTy{}) = False go (HsRecTy{}) = False diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs index 0de212ba8e..d3453fcd56 100644 --- a/compiler/GHC/HsToCore/Quote.hs +++ b/compiler/GHC/HsToCore/Quote.hs @@ -1047,7 +1047,7 @@ rep_ty_sig' (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) = do { th_explicit_tvs <- rep_ty_sig_outer_tvs outer_bndrs ; th_ctxt <- repLContext ctxt ; th_tau <- repLTy tau - ; if nullOuterExplicit outer_bndrs && null (unLoc ctxt) + ; if nullOuterExplicit outer_bndrs && null (fromMaybeContext ctxt) then return th_tau else repTForall th_explicit_tvs th_ctxt th_tau } @@ -1294,8 +1294,9 @@ repTyVarBndr (L _ (KindedTyVar _ fl (L _ nm) ki)) -- represent a type context -- -repLContext :: LHsContext GhcRn -> MetaM (Core (M TH.Cxt)) -repLContext ctxt = repContext (unLoc ctxt) +repLContext :: Maybe (LHsContext GhcRn) -> MetaM (Core (M TH.Cxt)) +repLContext Nothing = repContext [] +repLContext (Just ctxt) = repContext (unLoc ctxt) repContext :: HsContext GhcRn -> MetaM (Core (M TH.Cxt)) repContext ctxt = do preds <- repListM typeTyConName repLTy ctxt @@ -1307,7 +1308,7 @@ repHsSigType (L _ (HsSig { sig_bndrs = outer_bndrs, sig_body = body })) = addHsOuterSigTyVarBinds outer_bndrs $ \ th_outer_bndrs -> do { th_ctxt <- repLContext ctxt ; th_tau <- repLTy tau - ; if nullOuterExplicit outer_bndrs && null (unLoc ctxt) + ; if nullOuterExplicit outer_bndrs && null (fromMaybeContext ctxt) then pure th_tau else repTForall th_outer_bndrs th_ctxt th_tau } diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs index dfa0b91e9b..3fe14085a9 100644 --- a/compiler/GHC/Iface/Ext/Ast.hs +++ b/compiler/GHC/Iface/Ext/Ast.hs @@ -1393,7 +1393,7 @@ instance ToHie (Located (TyClDecl GhcRn)) where , toHie defn ] where - quant_scope = mkLScope $ dd_ctxt defn + quant_scope = mkLScope $ fromMaybe (noLoc []) $ dd_ctxt defn rhs_scope = sig_sc `combineScopes` con_sc `combineScopes` deriv_sc sig_sc = maybe NoScope mkLScope $ dd_kindSig defn con_sc = foldr combineScopes NoScope $ map mkLScope $ dd_cons defn @@ -1418,7 +1418,7 @@ instance ToHie (Located (TyClDecl GhcRn)) where , toHie deftyps ] where - context_scope = mkLScope context + context_scope = mkLScope $ fromMaybe (noLoc []) context rhs_scope = foldl1' combineScopes $ map mkScope [ loc deps, loc sigs, loc (bagToList meths), loc typs, loc deftyps] diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 1b2cc3eead..ff380f8c75 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -2041,7 +2041,7 @@ ctype :: { LHsType GhcPs } forall_anns } | context '=>' ctype {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2) >> return (sLL $1 $> $ - HsQualTy { hst_ctxt = $1 + HsQualTy { hst_ctxt = Just $1 , hst_xqual = noExtField , hst_body = $3 }) } | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExtField $1 $3)) diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs index 22103fa08b..8e083b0141 100644 --- a/compiler/GHC/Parser/Errors/Ppr.hs +++ b/compiler/GHC/Parser/Errors/Ppr.hs @@ -417,7 +417,7 @@ pp_err = \case PsErrIllegalDataTypeContext c -> text "Illegal datatype context (use DatatypeContexts):" - <+> pprLHsContext c + <+> pprLHsContext (Just c) PsErrMalformedDecl what for -> text "Malformed" <+> what diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 4b02077c9c..3159902647 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -180,7 +180,7 @@ mkClassDecl :: SrcSpan mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls layoutInfo = do { (binds, sigs, ats, at_defs, _, docs) <- cvBindsAndSigs where_cls - ; let cxt = fromMaybe (noLoc []) mcxt + ; let cxt = mcxt ; (cls, tparams, fixity, ann) <- checkTyClHdr True tycl_hdr ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan ; (tyvars,annst) <- checkTyVars (text "class") whereDots cls tparams @@ -224,10 +224,9 @@ mkDataDefn :: NewOrData -> P (HsDataDefn GhcPs) mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv = do { checkDatatypeContext mcxt - ; let cxt = fromMaybe (noLoc []) mcxt ; return (HsDataDefn { dd_ext = noExtField , dd_ND = new_or_data, dd_cType = cType - , dd_ctxt = cxt + , dd_ctxt = mcxt , dd_cons = data_cons , dd_kindSig = ksig , dd_derivs = maybe_deriv }) } diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs index 43ac07a482..c226b777ba 100644 --- a/compiler/GHC/Parser/PostProcess/Haddock.hs +++ b/compiler/GHC/Parser/PostProcess/Haddock.hs @@ -979,10 +979,10 @@ instance HasHaddock (Located (HsType GhcPs)) where pure $ L l (HsForAllTy noExtField tele body') -- (Eq a, Num a) => t - HsQualTy _ lhs rhs -> do - registerHdkA lhs + HsQualTy _ mlhs rhs -> do + traverse registerHdkA mlhs rhs' <- addHaddock rhs - pure $ L l (HsQualTy noExtField lhs rhs') + pure $ L l (HsQualTy noExtField mlhs rhs') -- arg -> res HsFunTy u mult lhs rhs -> do diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs index b0e82ced7a..8634d5939f 100644 --- a/compiler/GHC/Rename/HsType.hs +++ b/compiler/GHC/Rename/HsType.hs @@ -254,26 +254,35 @@ rnWcBody ctxt nwc_rdrs hs_ty , hst_tele = tele', hst_body = hs_body' } , fvs) } - rn_ty env (HsQualTy { hst_ctxt = L cx hs_ctxt + rn_ty env (HsQualTy { hst_ctxt = m_ctxt , hst_body = hs_ty }) - | Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt + | Just (L cx hs_ctxt) <- m_ctxt + , Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt , L lx (HsWildCardTy _) <- ignoreParens hs_ctxt_last = do { (hs_ctxt1', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt1 ; setSrcSpan lx $ checkExtraConstraintWildCard env hs_ctxt1 ; let hs_ctxt' = hs_ctxt1' ++ [L lx (HsWildCardTy noExtField)] ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty ; return (HsQualTy { hst_xqual = noExtField - , hst_ctxt = L cx hs_ctxt', hst_body = hs_ty' } + , hst_ctxt = Just (L cx hs_ctxt') + , hst_body = hs_ty' } , fvs1 `plusFV` fvs2) } - | otherwise + | Just (L cx hs_ctxt) <- m_ctxt = do { (hs_ctxt', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty ; return (HsQualTy { hst_xqual = noExtField - , hst_ctxt = L cx hs_ctxt' + , hst_ctxt = Just (L cx hs_ctxt') , hst_body = hs_ty' } , fvs1 `plusFV` fvs2) } + | Nothing <- m_ctxt + = do { (hs_ty', fvs2) <- rnLHsTyKi env hs_ty + ; return (HsQualTy { hst_xqual = noExtField + , hst_ctxt = Nothing + , hst_body = hs_ty' } + , fvs2) } + rn_ty env hs_ty = rnHsTyKi env hs_ty rn_top_constraint env = rnLHsTyKi (env { rtke_what = RnTopConstraint }) @@ -564,16 +573,17 @@ rnLHsTypeArgs :: HsDocContext -> [LHsTypeArg GhcPs] rnLHsTypeArgs doc args = mapFvRn (rnLHsTypeArg doc) args -------------- -rnTyKiContext :: RnTyKiEnv -> LHsContext GhcPs - -> RnM (LHsContext GhcRn, FreeVars) -rnTyKiContext env (L loc cxt) +rnTyKiContext :: RnTyKiEnv -> Maybe (LHsContext GhcPs) + -> RnM (Maybe (LHsContext GhcRn), FreeVars) +rnTyKiContext _ Nothing = return (Nothing, emptyFVs) +rnTyKiContext env (Just (L loc cxt)) = do { traceRn "rncontext" (ppr cxt) ; let env' = env { rtke_what = RnConstraint } ; (cxt', fvs) <- mapFvRn (rnLHsTyKi env') cxt - ; return (L loc cxt', fvs) } + ; return (Just $ L loc cxt', fvs) } -rnContext :: HsDocContext -> LHsContext GhcPs - -> RnM (LHsContext GhcRn, FreeVars) +rnContext :: HsDocContext -> Maybe (LHsContext GhcPs) + -> RnM (Maybe (LHsContext GhcRn), FreeVars) rnContext doc theta = rnTyKiContext (mkTyKiEnv doc TypeLevel RnConstraint) theta -------------- @@ -1890,8 +1900,9 @@ extractDataDefnKindVars :: HsDataDefn GhcPs -> FreeKiTyVars extractDataDefnKindVars (HsDataDefn { dd_kindSig = ksig }) = maybe [] extractHsTyRdrTyVars ksig -extract_lctxt :: LHsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars -extract_lctxt ctxt = extract_ltys (unLoc ctxt) +extract_lctxt :: Maybe (LHsContext GhcPs) -> FreeKiTyVars -> FreeKiTyVars +extract_lctxt Nothing = const [] +extract_lctxt (Just ctxt) = extract_ltys (unLoc ctxt) extract_scaled_ltys :: [HsScaled GhcPs (LHsType GhcPs)] -> FreeKiTyVars -> FreeKiTyVars diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index 622432bf4d..667c5d0eff 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/compiler/GHC/Rename/Module.hs @@ -1897,7 +1897,7 @@ rnDataDefn :: HsDocContext -> HsDataDefn GhcPs rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType , dd_ctxt = context, dd_cons = condecls , dd_kindSig = m_sig, dd_derivs = derivs }) - = do { checkTc (h98_style || null (unLoc context)) + = do { checkTc (h98_style || null (fromMaybeContext context)) (badGadtStupidTheta doc) ; (m_sig', sig_fvs) <- case m_sig of @@ -2338,8 +2338,8 @@ rnConDecl (ConDeclGADT { con_names = names rnMbContext :: HsDocContext -> Maybe (LHsContext GhcPs) -> RnM (Maybe (LHsContext GhcRn), FreeVars) rnMbContext _ Nothing = return (Nothing, emptyFVs) -rnMbContext doc (Just cxt) = do { (ctx',fvs) <- rnContext doc cxt - ; return (Just ctx',fvs) } +rnMbContext doc cxt = do { (ctx',fvs) <- rnContext doc cxt + ; return (ctx',fvs) } rnConDeclH98Details :: Name diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs index 4d072fff5f..7a536fcaf7 100644 --- a/compiler/GHC/Tc/Deriv.hs +++ b/compiler/GHC/Tc/Deriv.hs @@ -723,7 +723,7 @@ tcStandaloneDerivInstType ctxt (HsWC { hswc_body = deriv_ty@(L loc (HsSig { sig_bndrs = outer_bndrs , sig_body = deriv_ty_body }))}) | (theta, rho) <- splitLHsQualTy deriv_ty_body - , L _ [wc_pred] <- theta + , [wc_pred] <- fromMaybeContext theta , L wc_span (HsWildCardTy _) <- ignoreParens wc_pred = do dfun_ty <- tcHsClsInstType ctxt $ L loc $ HsSig { sig_ext = noExtField diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs index c63cbabdc1..caaa8b4894 100644 --- a/compiler/GHC/Tc/Gen/Bind.hs +++ b/compiler/GHC/Tc/Gen/Bind.hs @@ -1670,10 +1670,10 @@ decideGeneralisationPlan dflags lbinds closed sig_fn -- so we should apply the MR -- See Note [Partial type signatures and generalisation] partial_sig_mrs - = [ null theta + = [ null $ fromMaybeContext mtheta | TcIdSig (PartialSig { psig_hs_ty = hs_ty }) <- mapMaybe sig_fn (collectHsBindListBinders CollNoDictBinders lbinds) - , let (L _ theta, _) = splitLHsQualTy (hsSigWcType hs_ty) ] + , let (mtheta, _) = splitLHsQualTy (hsSigWcType hs_ty) ] has_partial_sigs = not (null partial_sig_mrs) diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs index 87da41b890..cc82f30dbc 100644 --- a/compiler/GHC/Tc/Gen/HsType.hs +++ b/compiler/GHC/Tc/Gen/HsType.hs @@ -53,7 +53,7 @@ module GHC.Tc.Gen.HsType ( tcHsLiftedTypeNC, tcHsOpenTypeNC, tcInferLHsTypeKind, tcInferLHsType, tcInferLHsTypeUnsaturated, tcCheckLHsType, - tcHsMbContext, tcHsContext, tcLHsPredType, + tcHsContext, tcLHsPredType, kindGeneralizeAll, kindGeneralizeSome, kindGeneralizeNone, @@ -1112,7 +1112,7 @@ tc_hs_type mode (HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind ; return (mkForAllTys tv_bndrs ty') } tc_hs_type mode (HsQualTy { hst_ctxt = ctxt, hst_body = rn_ty }) exp_kind - | null (unLoc ctxt) + | null (fromMaybeContext ctxt) = tc_lhs_type mode rn_ty exp_kind -- See Note [Body kind of a HsQualTy] @@ -1860,18 +1860,16 @@ checkExpectedKind hs_ty ty act_kind exp_kind n_to_inst = n_act_invis_bndrs - n_exp_invis_bndrs --------------------------- -tcHsMbContext :: Maybe (LHsContext GhcRn) -> TcM [PredType] -tcHsMbContext Nothing = return [] -tcHsMbContext (Just cxt) = tcHsContext cxt -tcHsContext :: LHsContext GhcRn -> TcM [PredType] +tcHsContext :: Maybe (LHsContext GhcRn) -> TcM [PredType] tcHsContext cxt = tc_hs_context typeLevelMode cxt tcLHsPredType :: LHsType GhcRn -> TcM PredType tcLHsPredType pred = tc_lhs_pred typeLevelMode pred -tc_hs_context :: TcTyMode -> LHsContext GhcRn -> TcM [PredType] -tc_hs_context mode ctxt = mapM (tc_lhs_pred mode) (unLoc ctxt) +tc_hs_context :: TcTyMode -> Maybe (LHsContext GhcRn) -> TcM [PredType] +tc_hs_context _ Nothing = return [] +tc_hs_context mode (Just ctxt) = mapM (tc_lhs_pred mode) (unLoc ctxt) tc_lhs_pred :: TcTyMode -> LHsType GhcRn -> TcM PredType tc_lhs_pred mode pred = tc_lhs_type mode pred constraintKind @@ -3775,7 +3773,7 @@ tcHsPartialSigType tcHsPartialSigType ctxt sig_ty | HsWC { hswc_ext = sig_wcs, hswc_body = sig_ty } <- sig_ty , L _ (HsSig{sig_bndrs = hs_outer_bndrs, sig_body = body_ty}) <- sig_ty - , (L _ hs_ctxt, hs_tau) <- splitLHsQualTy body_ty + , (hs_ctxt, hs_tau) <- splitLHsQualTy body_ty = addSigCtxt ctxt sig_ty $ do { mode <- mkHoleMode TypeLevel HM_Sig ; (outer_bndrs, (wcs, wcx, theta, tau)) @@ -3829,8 +3827,9 @@ tcHsPartialSigType ctxt sig_ty ; traceTc "tcHsPartialSigType" (ppr tv_prs) ; return (wcs, wcx, tv_prs, theta, tau) } -tcPartialContext :: TcTyMode -> HsContext GhcRn -> TcM (TcThetaType, Maybe TcType) -tcPartialContext mode hs_theta +tcPartialContext :: TcTyMode -> Maybe (LHsContext GhcRn) -> TcM (TcThetaType, Maybe TcType) +tcPartialContext _ Nothing = return ([], Nothing) +tcPartialContext mode (Just (L _ hs_theta)) | Just (hs_theta1, hs_ctxt_last) <- snocView hs_theta , L wc_loc ty@(HsWildCardTy _) <- ignoreParens hs_ctxt_last = do { wc_tv_ty <- setSrcSpan wc_loc $ diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs index 6d6a74c65d..45dbc96d8f 100644 --- a/compiler/GHC/Tc/Gen/Sig.hs +++ b/compiler/GHC/Tc/Gen/Sig.hs @@ -286,8 +286,8 @@ no_anon_wc_ty lty = go lty HsForAllTy { hst_tele = tele , hst_body = ty } -> no_anon_wc_tele tele && go ty - HsQualTy { hst_ctxt = L _ ctxt - , hst_body = ty } -> gos ctxt && go ty + HsQualTy { hst_ctxt = ctxt + , hst_body = ty } -> gos (fromMaybeContext ctxt) && go ty HsSpliceTy _ (HsSpliced _ _ (HsSplicedTy ty)) -> go $ L noSrcSpan ty HsSpliceTy{} -> True HsTyLit{} -> True diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs index 45d38fd87d..e1da82d3bb 100644 --- a/compiler/GHC/Tc/TyCl.hs +++ b/compiler/GHC/Tc/TyCl.hs @@ -1622,7 +1622,7 @@ kcConDecl new_or_data tc_res_kind (ConDeclH98 = addErrCtxt (dataConCtxt [name]) $ discardResult $ bindExplicitTKBndrs_Tv ex_tvs $ - do { _ <- tcHsMbContext ex_ctxt + do { _ <- tcHsContext ex_ctxt ; kcConH98Args new_or_data tc_res_kind args -- We don't need to check the telescope here, -- because that's done in tcConDecl @@ -1638,7 +1638,7 @@ kcConDecl new_or_data discardResult $ bindOuterSigTKBndrs_Tv outer_bndrs $ -- Why "_Tv"? See Note [Using TyVarTvs for kind-checking GADTs] - do { _ <- tcHsMbContext cxt + do { _ <- tcHsContext cxt ; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty) ; con_res_kind <- newOpenTypeKind ; _ <- tcCheckLHsType res_ty (TheKind con_res_kind) @@ -2325,7 +2325,7 @@ tcTyClDecl1 _parent roles_info * * ********************************************************************* -} -tcClassDecl1 :: RolesInfo -> Name -> LHsContext GhcRn +tcClassDecl1 :: RolesInfo -> Name -> Maybe (LHsContext GhcRn) -> LHsBinds GhcRn -> [LHsFunDep GhcRn] -> [LSig GhcRn] -> [LFamilyDecl GhcRn] -> [LTyFamDefltDecl GhcRn] -> TcM Class @@ -3210,11 +3210,12 @@ that 'a' must have that kind, and to bring 'k' into scope. -} dataDeclChecks :: Name -> NewOrData - -> LHsContext GhcRn -> [LConDecl GhcRn] + -> Maybe (LHsContext GhcRn) -> [LConDecl GhcRn] -> TcM Bool -dataDeclChecks tc_name new_or_data (L _ stupid_theta) cons - = do { -- Check that we don't use GADT syntax in H98 world - gadtSyntax_ok <- xoptM LangExt.GADTSyntax +dataDeclChecks tc_name new_or_data 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 ; checkTc (gadtSyntax_ok || not gadt_syntax) (badGadtDecl tc_name) @@ -3296,7 +3297,7 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map ; (tclvl, wanted, (exp_tvbndrs, (ctxt, arg_tys, field_lbls, stricts))) <- pushLevelAndSolveEqualitiesX "tcConDecl:H98" $ tcExplicitTKBndrs explicit_tkv_nms $ - do { ctxt <- tcHsMbContext hs_ctxt + do { ctxt <- tcHsContext hs_ctxt ; let exp_kind = getArgExpKind new_or_data res_kind ; btys <- tcConH98Args exp_kind hs_args ; field_lbls <- lookupConstructorFields name @@ -3382,7 +3383,7 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map ; (tclvl, wanted, (outer_bndrs, (ctxt, arg_tys, res_ty, field_lbls, stricts))) <- pushLevelAndSolveEqualitiesX "tcConDecl:GADT" $ tcOuterTKBndrs skol_info outer_hs_bndrs $ - do { ctxt <- tcHsMbContext cxt + do { ctxt <- tcHsContext cxt ; (res_ty, res_kind) <- tcInferLHsTypeKind hs_res_ty -- See Note [GADT return kinds] diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs index 2fb7c58101..657e1bffe7 100644 --- a/compiler/GHC/Tc/TyCl/Instance.hs +++ b/compiler/GHC/Tc/TyCl/Instance.hs @@ -857,7 +857,7 @@ TyVarEnv will simply be empty, and there is nothing to worry about. ----------------------- tcDataFamInstHeader :: AssocInstInfo -> TyCon -> HsOuterFamEqnTyVarBndrs GhcRn - -> LexicalFixity -> LHsContext GhcRn + -> LexicalFixity -> Maybe (LHsContext GhcRn) -> HsTyPats GhcRn -> Maybe (LHsKind GhcRn) -> NewOrData -> TcM ([TyVar], [Type], Kind, ThetaType) diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs index e78dac205d..dc10c6fed5 100644 --- a/compiler/GHC/ThToHs.hs +++ b/compiler/GHC/ThToHs.hs @@ -239,7 +239,7 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs) ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_ND = DataType, dd_cType = Nothing - , dd_ctxt = ctxt' + , dd_ctxt = Just ctxt' , dd_kindSig = ksig' , dd_cons = cons', dd_derivs = derivs' } ; returnJustL $ TyClD noExtField $ @@ -255,7 +255,7 @@ cvtDec (NewtypeD ctxt tc tvs ksig constr derivs) ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_ND = NewType, dd_cType = Nothing - , dd_ctxt = ctxt' + , dd_ctxt = Just ctxt' , dd_kindSig = ksig' , dd_cons = [con'] , dd_derivs = derivs' } @@ -275,7 +275,7 @@ cvtDec (ClassD ctxt cl tvs fds decs) $$ (Outputable.ppr adts')) ; returnJustL $ TyClD noExtField $ ClassDecl { tcdCExt = NoLayoutInfo - , tcdCtxt = cxt', tcdLName = tc', tcdTyVars = tvs' + , tcdCtxt = Just cxt', tcdLName = tc', tcdTyVars = tvs' , tcdFixity = Prefix , tcdFDs = fds', tcdSigs = Hs.mkClassOpSigs sigs' , tcdMeths = binds' @@ -325,7 +325,7 @@ cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs) ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_ND = DataType, dd_cType = Nothing - , dd_ctxt = ctxt' + , dd_ctxt = Just ctxt' , dd_kindSig = ksig' , dd_cons = cons', dd_derivs = derivs' } @@ -346,7 +346,7 @@ cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs) ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_ND = NewType, dd_cType = Nothing - , dd_ctxt = ctxt' + , dd_ctxt = Just ctxt' , dd_kindSig = ksig' , dd_cons = [con'], dd_derivs = derivs' } ; returnJustL $ InstD noExtField $ DataFamInstD @@ -1787,14 +1787,14 @@ cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty)) | null univs, null reqs = do { l <- getL ; ty' <- cvtType (ForallT exis provs ty) ; return $ L l $ mkHsImplicitSigType - $ L l (HsQualTy { hst_ctxt = L l [] + $ L l (HsQualTy { hst_ctxt = Nothing , hst_xqual = noExtField , hst_body = ty' }) } | null reqs = do { l <- getL ; univs' <- cvtTvs univs ; ty' <- cvtType (ForallT exis provs ty) ; let forTy = mkHsExplicitSigType univs' $ L l cxtTy - cxtTy = HsQualTy { hst_ctxt = L l [] + cxtTy = HsQualTy { hst_ctxt = Nothing , hst_xqual = noExtField , hst_body = ty' } ; return $ L l forTy } @@ -1880,7 +1880,7 @@ mkHsQualTy :: TH.Cxt mkHsQualTy ctxt loc ctxt' ty | null ctxt = ty | otherwise = L loc $ HsQualTy { hst_xqual = noExtField - , hst_ctxt = ctxt' + , hst_ctxt = Just ctxt' , hst_body = ty } mkHsOuterFamEqnTyVarBndrs :: Maybe [LHsTyVarBndr () GhcPs] -> HsOuterFamEqnTyVarBndrs GhcPs diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs index 453b963028..0df44e8016 100644 --- a/compiler/Language/Haskell/Syntax/Decls.hs +++ b/compiler/Language/Haskell/Syntax/Decls.hs @@ -436,7 +436,7 @@ data TyClDecl pass , tcdDataDefn :: HsDataDefn pass } | ClassDecl { tcdCExt :: XClassDecl pass, -- ^ Post renamer, FVs - tcdCtxt :: LHsContext pass, -- ^ Context... + tcdCtxt :: Maybe (LHsContext pass), -- ^ Context... tcdLName :: LIdP pass, -- ^ Name of the class tcdTyVars :: LHsQTyVars pass, -- ^ Class type variables tcdFixity :: LexicalFixity, -- ^ Fixity used in the declaration @@ -891,7 +891,7 @@ data HsDataDefn pass -- The payload of a data type defn -- @ HsDataDefn { dd_ext :: XCHsDataDefn pass, dd_ND :: NewOrData, - dd_ctxt :: LHsContext pass, -- ^ Context + dd_ctxt :: Maybe (LHsContext pass), -- ^ Context dd_cType :: Maybe (XRec pass CType), dd_kindSig:: Maybe (LHsKind pass), -- ^ Optional kind signature. diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs index 0427fd65f3..f0114403d8 100644 --- a/compiler/Language/Haskell/Syntax/Type.hs +++ b/compiler/Language/Haskell/Syntax/Type.hs @@ -736,7 +736,7 @@ data HsType pass | HsQualTy -- See Note [HsType binders] { hst_xqual :: XQualTy pass - , hst_ctxt :: LHsContext pass -- Context C => blah + , hst_ctxt :: Maybe (LHsContext pass) -- Context C => blah , hst_body :: LHsType pass } | HsTyVar (XTyVar pass) diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr index 2d9cede53c..e0f5a33d69 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr @@ -16,8 +16,7 @@ (ClassDecl (VirtualBraces (3)) - ({ } - []) + (Nothing) ({ T17544.hs:5:7-8 } (Unqual {OccName: C1})) @@ -80,8 +79,7 @@ (ClassDecl (VirtualBraces (3)) - ({ } - []) + (Nothing) ({ T17544.hs:9:7-8 } (Unqual {OccName: C2})) @@ -141,8 +139,7 @@ (ClassDecl (VirtualBraces (3)) - ({ } - []) + (Nothing) ({ T17544.hs:13:7-8 } (Unqual {OccName: C3})) @@ -205,8 +202,7 @@ (ClassDecl (VirtualBraces (3)) - ({ } - []) + (Nothing) ({ T17544.hs:17:7-8 } (Unqual {OccName: C4})) @@ -293,8 +289,7 @@ (NoExtField) (ClassDecl (ExplicitBraces) - ({ } - []) + (Nothing) ({ T17544.hs:22:7-8 } (Unqual {OccName: C5})) @@ -389,8 +384,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ T17544.hs:25:5-18 } @@ -431,8 +425,7 @@ (NoExtField) (ClassDecl (ExplicitBraces) - ({ } - []) + (Nothing) ({ T17544.hs:28:7-8 } (Unqual {OccName: C6})) @@ -527,8 +520,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ T17544.hs:31:5-18 } @@ -569,8 +561,7 @@ (NoExtField) (ClassDecl (ExplicitBraces) - ({ } - []) + (Nothing) ({ T17544.hs:34:7-8 } (Unqual {OccName: C7})) @@ -665,8 +656,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ T17544.hs:37:5-18 } @@ -707,8 +697,7 @@ (NoExtField) (ClassDecl (ExplicitBraces) - ({ } - []) + (Nothing) ({ T17544.hs:40:7-8 } (Unqual {OccName: C8})) @@ -803,8 +792,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ T17544.hs:43:5-18 } @@ -845,8 +833,7 @@ (NoExtField) (ClassDecl (ExplicitBraces) - ({ } - []) + (Nothing) ({ T17544.hs:46:7-8 } (Unqual {OccName: C9})) @@ -941,8 +928,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ T17544.hs:49:5-18 } @@ -983,8 +969,7 @@ (NoExtField) (ClassDecl (ExplicitBraces) - ({ } - []) + (Nothing) ({ T17544.hs:52:7-9 } (Unqual {OccName: C10})) @@ -1079,8 +1064,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ T17544.hs:55:5-20 } 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 b8cb9eedf2..2ebdf9dec9 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr @@ -25,8 +25,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ T17544_kw.hs:16:9-20 } @@ -69,8 +68,7 @@ (HsDataDefn (NoExtField) (NewType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ T17544_kw.hs:19:9-26 } @@ -111,8 +109,7 @@ (ClassDecl (VirtualBraces (5)) - ({ } - []) + (Nothing) ({ T17544_kw.hs:21:7-9 } (Unqual {OccName: Cls})) diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr index 262d01fc4f..f19d67a1b2 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr @@ -37,8 +37,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ DumpParsedAst.hs:7:14-17 } @@ -243,8 +242,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ DumpParsedAst.hs:14:21-29 } diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr index 61c89188c2..57d4f3fcf7 100644 --- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr @@ -73,8 +73,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ DumpRenamedAst.hs:9:14-17 } @@ -328,8 +327,7 @@ (HsDataDefn (NoExtField) (NewType) - ({ } - []) + (Nothing) (Nothing) (Just ({ DumpRenamedAst.hs:18:42-60 } @@ -488,8 +486,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ DumpRenamedAst.hs:21:21-29 } diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr index cee8ecdbf9..516850592c 100644 --- a/testsuite/tests/parser/should_compile/T14189.stderr +++ b/testsuite/tests/parser/should_compile/T14189.stderr @@ -27,8 +27,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ T14189.hs:6:15-20 } diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr index ae19f0a174..91f85727f6 100644 --- a/testsuite/tests/parser/should_compile/T15323.stderr +++ b/testsuite/tests/parser/should_compile/T15323.stderr @@ -31,8 +31,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ T15323.hs:6:5-54 } diff --git a/testsuite/tests/printer/T18791.stderr b/testsuite/tests/printer/T18791.stderr index af6d93019c..c944f648dc 100644 --- a/testsuite/tests/printer/T18791.stderr +++ b/testsuite/tests/printer/T18791.stderr @@ -25,8 +25,7 @@ (HsDataDefn (NoExtField) (DataType) - ({ } - []) + (Nothing) (Nothing) (Nothing) [({ T18791.hs:5:3-17 } diff --git a/utils/haddock b/utils/haddock index d1b7f181b6..8241d9e700 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit d1b7f181b60ba3ac191183f1512e66793d28ac08 +Subproject commit 8241d9e700e043b86b609c334494c4632848389f -- cgit v1.2.1