Merge remote-tracking branch 'origin/master'

1 files changed, 12 insertions, 4 deletions

diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 81082534e9..c39cc478af 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -746,8 +746,7 @@ mkGadtDecl loc names ty annsIn = do
        let (anns, cs, arg_types, res_type) = splitHsFunType body_ty
        return (PrefixConGADT arg_types, res_type, anns, cs)
 
-  let an = case outer_bndrs of
-        _                -> EpAnn (spanAsAnchor loc) (annsIn ++ annsa) (cs Semi.<> csa)
+  let an = EpAnn (spanAsAnchor loc) (annsIn ++ annsa) (cs Semi.<> csa)
 
   pure $ L l ConDeclGADT
                      { con_g_ext  = an
@@ -1977,9 +1976,10 @@ instance DisambTD DataConBuilder where
     addFatalError $ mkPlainErrorMsgEnvelope l_at $
                       (PsErrUnexpectedKindAppInDataCon (unLoc lhs) (unLoc ki))
 
-  mkHsOpTyPV _ lhs tc rhs = do
+  mkHsOpTyPV prom lhs tc rhs = do
       check_no_ops (unLoc rhs)  -- check the RHS because parsing type operators is right-associative
       data_con <- eitherToP $ tyConToDataCon tc
+      checkNotPromotedDataCon prom data_con
       return $ L l (InfixDataConBuilder lhs data_con rhs)
     where
       l = combineLocsA lhs rhs
@@ -2001,8 +2001,9 @@ instance DisambTD DataConBuilder where
          return constr_stuff
 
 tyToDataConBuilder :: LHsType GhcPs -> PV (LocatedA DataConBuilder)
-tyToDataConBuilder (L l (HsTyVar _ NotPromoted v)) = do
+tyToDataConBuilder (L l (HsTyVar _ prom v)) = do
   data_con <- eitherToP $ tyConToDataCon v
+  checkNotPromotedDataCon prom data_con
   return $ L l (PrefixDataConBuilder nilOL data_con)
 tyToDataConBuilder (L l (HsTupleTy _ HsBoxedOrConstraintTuple ts)) = do
   let data_con = L (l2l l) (getRdrName (tupleDataCon Boxed (length ts)))
@@ -2011,6 +2012,13 @@ tyToDataConBuilder t =
   addFatalError $ mkPlainErrorMsgEnvelope (getLocA t) $
                     (PsErrInvalidDataCon (unLoc t))
 
+-- | Rejects declarations such as @data T = 'MkT@ (note the leading tick).
+checkNotPromotedDataCon :: PromotionFlag -> LocatedN RdrName -> PV ()
+checkNotPromotedDataCon NotPromoted _ = return ()
+checkNotPromotedDataCon IsPromoted (L l name) =
+  addError $ mkPlainErrorMsgEnvelope (locA l) $
+    PsErrIllegalPromotionQuoteDataCon name
+
 {- Note [Ambiguous syntactic categories]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 There are places in the grammar where we do not know whether we are parsing an