summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2021-02-21 21:16:24 +0000
committerAlan Zimmerman <alan.zimm@gmail.com>2021-02-28 12:46:19 +0000
commit09947ecee1bdc450ce561543f68bee6765122fb5 (patch)
tree960d25ad941ce1ef14ca3ba1581a041708685f9b
parent035d983dfa217bf8784b86e78d6024a3ca1a3f4f (diff)
downloadhaskell-wip/az/maybecontext.tar.gz
Wrap LHsContext in Maybe in the GHC ASTwip/az/maybecontext
If the context is missing it is captured as Nothing, rather than putting a noLoc in the ParsedSource. Updates haddock submodule
-rw-r--r--compiler/GHC/Hs/Decls.hs18
-rw-r--r--compiler/GHC/Hs/Type.hs52
-rw-r--r--compiler/GHC/HsToCore/Quote.hs9
-rw-r--r--compiler/GHC/Iface/Ext/Ast.hs4
-rw-r--r--compiler/GHC/Parser.y2
-rw-r--r--compiler/GHC/Parser/Errors/Ppr.hs2
-rw-r--r--compiler/GHC/Parser/PostProcess.hs5
-rw-r--r--compiler/GHC/Parser/PostProcess/Haddock.hs6
-rw-r--r--compiler/GHC/Rename/HsType.hs37
-rw-r--r--compiler/GHC/Rename/Module.hs6
-rw-r--r--compiler/GHC/Tc/Deriv.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Bind.hs4
-rw-r--r--compiler/GHC/Tc/Gen/HsType.hs21
-rw-r--r--compiler/GHC/Tc/Gen/Sig.hs4
-rw-r--r--compiler/GHC/Tc/TyCl.hs19
-rw-r--r--compiler/GHC/Tc/TyCl/Instance.hs2
-rw-r--r--compiler/GHC/ThToHs.hs16
-rw-r--r--compiler/Language/Haskell/Syntax/Decls.hs4
-rw-r--r--compiler/Language/Haskell/Syntax/Type.hs2
-rw-r--r--testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr48
-rw-r--r--testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr9
-rw-r--r--testsuite/tests/parser/should_compile/DumpParsedAst.stderr6
-rw-r--r--testsuite/tests/parser/should_compile/DumpRenamedAst.stderr9
-rw-r--r--testsuite/tests/parser/should_compile/T14189.stderr3
-rw-r--r--testsuite/tests/parser/should_compile/T15323.stderr3
-rw-r--r--testsuite/tests/printer/T18791.stderr3
m---------utils/haddock0
27 files changed, 137 insertions, 159 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 <tvs>. 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))
- ({ <no location info> }
- [])
+ (Nothing)
({ T17544.hs:5:7-8 }
(Unqual
{OccName: C1}))
@@ -80,8 +79,7 @@
(ClassDecl
(VirtualBraces
(3))
- ({ <no location info> }
- [])
+ (Nothing)
({ T17544.hs:9:7-8 }
(Unqual
{OccName: C2}))
@@ -141,8 +139,7 @@
(ClassDecl
(VirtualBraces
(3))
- ({ <no location info> }
- [])
+ (Nothing)
({ T17544.hs:13:7-8 }
(Unqual
{OccName: C3}))
@@ -205,8 +202,7 @@
(ClassDecl
(VirtualBraces
(3))
- ({ <no location info> }
- [])
+ (Nothing)
({ T17544.hs:17:7-8 }
(Unqual
{OccName: C4}))
@@ -293,8 +289,7 @@
(NoExtField)
(ClassDecl
(ExplicitBraces)
- ({ <no location info> }
- [])
+ (Nothing)
({ T17544.hs:22:7-8 }
(Unqual
{OccName: C5}))
@@ -389,8 +384,7 @@
(HsDataDefn
(NoExtField)
(DataType)
- ({ <no location info> }
- [])
+ (Nothing)
(Nothing)
(Nothing)
[({ T17544.hs:25:5-18 }
@@ -431,8 +425,7 @@
(NoExtField)
(ClassDecl
(ExplicitBraces)
- ({ <no location info> }
- [])
+ (Nothing)
({ T17544.hs:28:7-8 }
(Unqual
{OccName: C6}))
@@ -527,8 +520,7 @@
(HsDataDefn
(NoExtField)
(DataType)
- ({ <no location info> }
- [])
+ (Nothing)
(Nothing)
(Nothing)
[({ T17544.hs:31:5-18 }
@@ -569,8 +561,7 @@
(NoExtField)
(ClassDecl
(ExplicitBraces)
- ({ <no location info> }
- [])
+ (Nothing)
({ T17544.hs:34:7-8 }
(Unqual
{OccName: C7}))
@@ -665,8 +656,7 @@
(HsDataDefn
(NoExtField)
(DataType)
- ({ <no location info> }
- [])
+ (Nothing)
(Nothing)
(Nothing)
[({ T17544.hs:37:5-18 }
@@ -707,8 +697,7 @@
(NoExtField)
(ClassDecl
(ExplicitBraces)
- ({ <no location info> }
- [])
+ (Nothing)
({ T17544.hs:40:7-8 }
(Unqual
{OccName: C8}))
@@ -803,8 +792,7 @@
(HsDataDefn
(NoExtField)
(DataType)
- ({ <no location info> }
- [])
+ (Nothing)
(Nothing)
(Nothing)
[({ T17544.hs:43:5-18 }
@@ -845,8 +833,7 @@
(NoExtField)
(ClassDecl
(ExplicitBraces)
- ({ <no location info> }
- [])
+ (Nothing)
({ T17544.hs:46:7-8 }
(Unqual
{OccName: C9}))
@@ -941,8 +928,7 @@
(HsDataDefn
(NoExtField)
(DataType)
- ({ <no location info> }
- [])
+ (Nothing)
(Nothing)
(Nothing)
[({ T17544.hs:49:5-18 }
@@ -983,8 +969,7 @@
(NoExtField)
(ClassDecl
(ExplicitBraces)
- ({ <no location info> }
- [])
+ (Nothing)
({ T17544.hs:52:7-9 }
(Unqual
{OccName: C10}))
@@ -1079,8 +1064,7 @@
(HsDataDefn
(NoExtField)
(DataType)
- ({ <no location info> }
- [])
+ (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)
- ({ <no location info> }
- [])
+ (Nothing)
(Nothing)
(Nothing)
[({ T17544_kw.hs:16:9-20 }
@@ -69,8 +68,7 @@
(HsDataDefn
(NoExtField)
(NewType)
- ({ <no location info> }
- [])
+ (Nothing)
(Nothing)
(Nothing)
[({ T17544_kw.hs:19:9-26 }
@@ -111,8 +109,7 @@
(ClassDecl
(VirtualBraces
(5))
- ({ <no location info> }
- [])
+ (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)
- ({ <no location info> }
- [])
+ (Nothing)
(Nothing)
(Nothing)
[({ DumpParsedAst.hs:7:14-17 }
@@ -243,8 +242,7 @@
(HsDataDefn
(NoExtField)
(DataType)
- ({ <no location info> }
- [])
+ (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)
- ({ <no location info> }
- [])
+ (Nothing)
(Nothing)
(Nothing)
[({ DumpRenamedAst.hs:9:14-17 }
@@ -328,8 +327,7 @@
(HsDataDefn
(NoExtField)
(NewType)
- ({ <no location info> }
- [])
+ (Nothing)
(Nothing)
(Just
({ DumpRenamedAst.hs:18:42-60 }
@@ -488,8 +486,7 @@
(HsDataDefn
(NoExtField)
(DataType)
- ({ <no location info> }
- [])
+ (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)
- ({ <no location info> }
- [])
+ (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)
- ({ <no location info> }
- [])
+ (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)
- ({ <no location info> }
- [])
+ (Nothing)
(Nothing)
(Nothing)
[({ T18791.hs:5:3-17 }
diff --git a/utils/haddock b/utils/haddock
-Subproject d1b7f181b60ba3ac191183f1512e66793d28ac0
+Subproject 8241d9e700e043b86b609c334494c4632848389