diff options
Diffstat (limited to 'compiler/GHC/Parser/PostProcess.hs')
| -rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 16 |
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 |