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

19 files changed, 110 insertions, 105 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)