[Git][ghc/ghc][master] EPA: empty tup_tail has noAnn

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
d2733a05 by Alan Zimmerman at 2023-11-22T21:13:05-05:00
EPA: empty tup_tail has noAnn

In Parser.y, the tup_tail rule had the following option
          | {- empty -} %shift   { return [Left noAnn] }

Once this works through PostProcess.hs, it means we add an extra
Missing constructor if the last item was a comma.

Change the annotation type to a Bool to indicate this, and use the
EpAnn Anchor for the print location for the others.

- - - - -


7 changed files:

- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/Types.hs
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Orphans.hs


Changes:

=====================================
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
 


=====================================
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


=====================================
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)]


=====================================
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


=====================================
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


=====================================
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


=====================================
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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2733a055584964eb4a1d3a4764de4d678ffa313

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2733a055584964eb4a1d3a4764de4d678ffa313
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20231122/0be87aa6/attachment-0001.html>