diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs index d4d4c45f31d86b3f944c29b1687cf4db638ab4be..2cc90955a5a384aecd6a944026e40bd720aae2da 100644 --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -418,7 +418,7 @@ type instance XXDotFieldOcc (GhcPass _) = DataConCantHappen type instance XPresent (GhcPass _) = NoExtField -type instance XMissing GhcPs = EpAnn EpaLocation +type instance XMissing GhcPs = EpAnn Bool -- True for empty last comma type instance XMissing GhcRn = NoExtField type instance XMissing GhcTc = Scaled Type diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index 6b7a6e6c5fca36601de7e416fc5a1781875099e3..8f54c6dafd4b00063c96675af7c2add70487323a 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -676,7 +676,7 @@ mkLHsVarTuple ids ext = mkLHsTupleExpr (map nlHsVar ids) ext nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs nlTuplePat pats box = noLocA (TuplePat noAnn pats box) -missingTupArg :: EpAnn EpaLocation -> HsTupArg GhcPs +missingTupArg :: EpAnn Bool -> HsTupArg GhcPs missingTupArg ann = Missing ann mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 10de6a12d499cc6e5b78828e4baded1c63b6a23f..13b7bd67d97217689632765012f2a3771a161eac 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -3119,7 +3119,7 @@ tup_exprs :: { forall b. DisambECP b => PV (SumOrTuple b) } ; return (Tuple (Right t : snd $2)) } } | commas tup_tail { $2 >>= \ $2 -> - do { let {cos = map (\ll -> (Left (EpAnn (anc $ rs ll) (srcSpan2e ll) emptyComments))) (fst $1) } + do { let {cos = map (\ll -> (Left (EpAnn (anc $ rs ll) True emptyComments))) (fst $1) } ; return (Tuple (cos ++ $2)) } } | texp bars { unECP $1 >>= \ $1 -> return $ @@ -3132,14 +3132,14 @@ tup_exprs :: { forall b. DisambECP b => PV (SumOrTuple b) } (map srcSpan2e $ fst $3)) } -- Always starts with commas; always follows an expr -commas_tup_tail :: { forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn EpaLocation) (LocatedA b)]) } +commas_tup_tail :: { forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn Bool) (LocatedA b)]) } commas_tup_tail : commas tup_tail { $2 >>= \ $2 -> - do { let {cos = map (\l -> (Left (EpAnn (anc $ rs l) (srcSpan2e l) emptyComments))) (tail $ fst $1) } + do { let {cos = map (\l -> (Left (EpAnn (anc $ rs l) True emptyComments))) (tail $ fst $1) } ; return ((head $ fst $1, cos ++ $2)) } } -- Always follows a comma -tup_tail :: { forall b. DisambECP b => PV [Either (EpAnn EpaLocation) (LocatedA b)] } +tup_tail :: { forall b. DisambECP b => PV [Either (EpAnn Bool) (LocatedA b)] } : texp commas_tup_tail { unECP $1 >>= \ $1 -> $2 >>= \ $2 -> do { t <- amsA $1 [AddCommaAnn (srcSpan2e $ fst $2)] diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index ddca8efe5d4637382ab3e612bd6241c7425f7e2e..3930a619fa281c1b5f414c5df0cd3c4af7f726f7 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -3149,7 +3149,7 @@ mkSumOrTupleExpr l boxity (Tuple es) anns = do cs <- getCommentsFor (locA l) return $ L l (ExplicitTuple (EpAnn (spanAsAnchor $ locA l) anns cs) (map toTupArg es) boxity) where - toTupArg :: Either (EpAnn EpaLocation) (LHsExpr GhcPs) -> HsTupArg GhcPs + toTupArg :: Either (EpAnn Bool) (LHsExpr GhcPs) -> HsTupArg GhcPs toTupArg (Left ann) = missingTupArg ann toTupArg (Right a) = Present noExtField a @@ -3176,7 +3176,7 @@ mkSumOrTuplePat l boxity (Tuple ps) anns = do cs <- getCommentsFor (locA l) return $ L l (PatBuilderPat (TuplePat (EpAnn (spanAsAnchor $ locA l) anns cs) ps' boxity)) where - toTupPat :: Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs)) -> PV (LPat GhcPs) + toTupPat :: Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs)) -> PV (LPat GhcPs) -- Ignore the element location so that the error message refers to the -- entire tuple. See #19504 (and the discussion) for details. toTupPat p = case p of diff --git a/compiler/GHC/Parser/Types.hs b/compiler/GHC/Parser/Types.hs index 779062bca82e0596b69dc4c730d8227e3ee965f6..bd8a3a6b866eaa0645c89b695a5d0671be34421a 100644 --- a/compiler/GHC/Parser/Types.hs +++ b/compiler/GHC/Parser/Types.hs @@ -29,7 +29,7 @@ import Language.Haskell.Syntax data SumOrTuple b = Sum ConTag Arity (LocatedA b) [EpaLocation] [EpaLocation] -- ^ Last two are the locations of the '|' before and after the payload - | Tuple [Either (EpAnn EpaLocation) (LocatedA b)] + | Tuple [Either (EpAnn Bool) (LocatedA b)] pprSumOrTuple :: Outputable b => Boxity -> SumOrTuple b -> SDoc pprSumOrTuple boxity = \case diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs index 37e6303b9a5af5c11edcf3f6ad11902e70ce95ea..738ce002e022c2c1271a955fbbc723688ea09e87 100644 --- a/utils/check-exact/ExactPrint.hs +++ b/utils/check-exact/ExactPrint.hs @@ -380,6 +380,10 @@ instance HasTrailing NameAnn where trailing a = nann_trailing a setTrailing a ts = a { nann_trailing = ts } +instance HasTrailing Bool where + trailing _ = [] + setTrailing a _ = a + -- --------------------------------------------------------------------- fromAnn' :: (HasEntry a) => a -> Entry diff --git a/utils/check-exact/Orphans.hs b/utils/check-exact/Orphans.hs index 4d5a50a96a724dcc8f15025a50e1c579398be0ad..faf92ef3a4be95c833ff099a2731925f6e556d4e 100644 --- a/utils/check-exact/Orphans.hs +++ b/utils/check-exact/Orphans.hs @@ -63,3 +63,6 @@ instance NoAnn EpAnnImportDecl where instance NoAnn AnnsModule where noAnn = AnnsModule [] [] Nothing + +instance NoAnn Bool where + noAnn = False