[Git][ghc/ghc][master] 2 commits: EPA: Remove some unused functions

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Oct 30 23:15:43 UTC 2024



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


Commits:
b349fd1b by Alan Zimmerman at 2024-10-30T19:15:04-04:00
EPA: Remove some unused functions

- - - - -
f859d61c by Alan Zimmerman at 2024-10-30T19:15:04-04:00
EPA: use explicit vertical bar token for ExplicitSum / SumPat

- - - - -


6 changed files:

- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Types.hs
- utils/check-exact/ExactPrint.hs


Changes:

=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -419,8 +419,8 @@ arrowToHsExpr = expandHsArrow (HsVar noExtField)
 data AnnExplicitSum
   = AnnExplicitSum {
       aesOpen       :: EpaLocation,
-      aesBarsBefore :: [EpaLocation],
-      aesBarsAfter  :: [EpaLocation],
+      aesBarsBefore :: [EpToken "|"],
+      aesBarsAfter  :: [EpToken "|"],
       aesClose      :: EpaLocation
       } deriving Data
 


=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -273,8 +273,8 @@ discarded inside tcMatchPats, where we know if visible pattern retained or erase
 
 data EpAnnSumPat = EpAnnSumPat
       { sumPatParens      :: (EpaLocation, EpaLocation)
-      , sumPatVbarsBefore :: [EpaLocation]
-      , sumPatVbarsAfter  :: [EpaLocation]
+      , sumPatVbarsBefore :: [EpToken "|"]
+      , sumPatVbarsAfter  :: [EpToken "|"]
       } deriving Data
 
 instance NoAnn EpAnnSumPat where


=====================================
compiler/GHC/Parser.y
=====================================
@@ -3280,13 +3280,11 @@ tup_exprs :: { forall b. DisambECP b => PV (SumOrTuple b) }
                       ; return (Tuple (cos ++ $2)) } }
 
            | texp bars   { unECP $1 >>= \ $1 -> return $
-                            (Sum 1  (snd $2 + 1) $1 [] (map srcSpan2e $ fst $2)) }
+                            (Sum 1  (snd $2 + 1) $1 [] (fst $2)) }
 
            | bars texp bars0
                 { unECP $2 >>= \ $2 -> return $
-                  (Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2
-                    (map srcSpan2e $ fst $1)
-                    (map srcSpan2e $ fst $3)) }
+                  (Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2 (fst $1) (fst $3)) }
 
 -- Always starts with commas; always follows an expr
 commas_tup_tail :: { forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn Bool) (LocatedA b)]) }
@@ -3827,7 +3825,7 @@ ntgtycon :: { LocatedN RdrName }  -- A "general" qualified tycon, excluding unit
                                       ; amsr (sLL $1 $> n) (NameAnnCommas (NameParensHash (epTok $1) (epTok $3)) (map srcSpan2e (fst $2)) []) }}
         | '(#' bars '#)'        {% do { requireLTPuns PEP_SumSyntaxType $1 $>
                                       ; amsr (sLL $1 $> $ (getRdrName (sumTyCon (snd $2 + 1))))
-                                       (NameAnnBars (epTok $1, epTok $3) (map srcSpan2e (fst $2)) []) } }
+                                       (NameAnnBars (epTok $1, epTok $3) (fst $2) []) } }
         | '(' '->' ')'          {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)
                                        (NameAnnRArrow  (Just $ epTok $1) (epUniTok $2) (Just $ epTok $3) []) }
 
@@ -4160,13 +4158,13 @@ commas :: { ([SrcSpan],Int) }   -- One or more commas
         : commas ','             { ((fst $1)++[gl $2],snd $1 + 1) }
         | ','                    { ([gl $1],1) }
 
-bars0 :: { ([SrcSpan],Int) }     -- Zero or more bars
+bars0 :: { ([EpToken "|"],Int) }     -- Zero or more bars
         : bars                   { $1 }
         |                        { ([], 0) }
 
-bars :: { ([SrcSpan],Int) }     -- One or more bars
-        : bars '|'               { ((fst $1)++[gl $2],snd $1 + 1) }
-        | '|'                    { ([gl $1],1) }
+bars :: { ([EpToken "|"],Int) }     -- One or more bars
+        : bars '|'               { ((fst $1)++[epTok $2],snd $1 + 1) }
+        | '|'                    { ([epTok $1],1) }
 
 {
 happyError :: P a


=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -66,7 +66,6 @@ module GHC.Parser.Annotation (
   srcSpan2e, realSrcSpan,
 
   -- ** Building up annotations
-  reAnnL, reAnnC,
   addAnnsA, widenSpanL, widenSpanT, widenAnchorT, widenAnchorS,
   widenLocatedAnL,
   listLocation,
@@ -94,7 +93,6 @@ module GHC.Parser.Annotation (
   noComments, comment, addCommentsToEpAnn, setCommentsEpAnn,
   transferAnnsA, transferAnnsOnlyA, transferCommentsOnlyA,
   transferPriorCommentsA, transferFollowingA,
-  commentsOnlyA, removeCommentsA,
 
   placeholderRealSpan,
   ) where
@@ -610,7 +608,7 @@ data NameAnn
   -- | Used for @(# | | #)@
   | NameAnnBars {
       nann_parensh   :: (EpToken "(#", EpToken "#)"),
-      nann_bars      :: [EpaLocation],
+      nann_bars      :: [EpToken "|"],
       nann_trailing  :: [TrailingAnn]
       }
   -- | Used for @()@, @(##)@, @[]@
@@ -929,12 +927,6 @@ srcSpan2e :: SrcSpan -> EpaLocation
 srcSpan2e ss@(RealSrcSpan _ _) = EpaSpan ss
 srcSpan2e span = EpaSpan (RealSrcSpan (realSrcSpan span) Strict.Nothing)
 
-reAnnC :: AnnContext -> EpAnnComments -> Located a -> LocatedC a
-reAnnC anns cs (L l a) = L (EpAnn (spanAsAnchor l) anns cs) a
-
-reAnnL :: ann -> EpAnnComments -> Located e -> GenLocated (EpAnn ann) e
-reAnnL anns cs (L l a) = L (EpAnn (spanAsAnchor l) anns cs) a
-
 getLocAnn :: Located a  -> SrcSpanAnnA
 getLocAnn (L l _) = noAnnSrcSpan l
 
@@ -1094,16 +1086,6 @@ transferPriorCommentsA (EpAnn a1 an1 cs1) (EpAnn a2 an2 cs2)
     cs1' = setFollowingComments emptyComments fc
     cs2' = setPriorComments cs2 (priorComments cs2 <> pc)
 
-
--- | Remove the exact print annotations payload, leaving only the
--- anchor and comments.
-commentsOnlyA :: NoAnn ann => EpAnn ann -> EpAnn ann
-commentsOnlyA (EpAnn a _ cs) = EpAnn a noAnn cs
-
--- | Remove the comments, leaving the exact print annotations payload
-removeCommentsA :: EpAnn ann -> EpAnn ann
-removeCommentsA (EpAnn a an _) = EpAnn a an emptyComments
-
 -- ---------------------------------------------------------------------
 -- Semigroup instances, to allow easy combination of annotation elements
 -- ---------------------------------------------------------------------


=====================================
compiler/GHC/Parser/Types.hs
=====================================
@@ -27,7 +27,7 @@ import GHC.Parser.Annotation
 import Language.Haskell.Syntax
 
 data SumOrTuple b
-  = Sum ConTag Arity (LocatedA b) [EpaLocation] [EpaLocation]
+  = Sum ConTag Arity (LocatedA b) [EpToken "|"] [EpToken "|"]
   -- ^ Last two are the locations of the '|' before and after the payload
   | Tuple [Either (EpAnn Bool) (LocatedA b)]
 


=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -1036,8 +1036,8 @@ lsnd k parent = fmap (\new -> (fst parent, new))
 -- data AnnExplicitSum
 --   = AnnExplicitSum {
 --       aesOpen       :: EpaLocation,
---       aesBarsBefore :: [EpaLocation],
---       aesBarsAfter  :: [EpaLocation],
+--       aesBarsBefore :: [EpToken "|"],
+--       aesBarsAfter  :: [EpToken "|"],
 --       aesClose      :: EpaLocation
 --       } deriving Data
 
@@ -1045,11 +1045,11 @@ laesOpen :: Lens AnnExplicitSum EpaLocation
 laesOpen k parent = fmap (\new -> parent { aesOpen = new })
                          (k (aesOpen parent))
 
-laesBarsBefore :: Lens AnnExplicitSum [EpaLocation]
+laesBarsBefore :: Lens AnnExplicitSum [EpToken "|"]
 laesBarsBefore k parent = fmap (\new -> parent { aesBarsBefore = new })
                                (k (aesBarsBefore parent))
 
-laesBarsAfter :: Lens AnnExplicitSum [EpaLocation]
+laesBarsAfter :: Lens AnnExplicitSum [EpToken "|"]
 laesBarsAfter k parent = fmap (\new -> parent { aesBarsAfter = new })
                                (k (aesBarsAfter parent))
 
@@ -1215,19 +1215,19 @@ lga_sep k parent = fmap (\new -> parent { ga_sep = new })
 -- ---------------------------------------------------------------------
 -- data EpAnnSumPat = EpAnnSumPat
 --       { sumPatParens      :: (EpaLocation, EpaLocation)
---       , sumPatVbarsBefore :: [EpaLocation]
---       , sumPatVbarsAfter  :: [EpaLocation]
+--       , sumPatVbarsBefore :: [EpToken "|"]
+--       , sumPatVbarsAfter  :: [EpToken "|"]
 --       } deriving Data
 
 lsumPatParens :: Lens EpAnnSumPat (EpaLocation, EpaLocation)
 lsumPatParens k parent = fmap (\new -> parent { sumPatParens = new })
                               (k (sumPatParens parent))
 
-lsumPatVbarsBefore :: Lens EpAnnSumPat [EpaLocation]
+lsumPatVbarsBefore :: Lens EpAnnSumPat [EpToken "|"]
 lsumPatVbarsBefore k parent = fmap (\new -> parent { sumPatVbarsBefore = new })
                               (k (sumPatVbarsBefore parent))
 
-lsumPatVbarsAfter :: Lens EpAnnSumPat [EpaLocation]
+lsumPatVbarsAfter :: Lens EpAnnSumPat [EpToken "|"]
 lsumPatVbarsAfter k parent = fmap (\new -> parent { sumPatVbarsAfter = new })
                               (k (sumPatVbarsAfter parent))
 
@@ -2985,9 +2985,9 @@ instance ExactPrint (HsExpr GhcPs) where
 
   exact (ExplicitSum an alt arity expr) = do
     an0 <- markLensFun an laesOpen (\loc -> printStringAtAA loc "(#")
-    an1 <- markLensFun an0 laesBarsBefore (\locs -> mapM (\l -> printStringAtAA l "|") locs)
+    an1 <- markLensFun an0 laesBarsBefore (\locs -> mapM markEpToken locs)
     expr' <- markAnnotated expr
-    an2 <- markLensFun an1 laesBarsAfter (\locs -> mapM (\l -> printStringAtAA l "|") locs)
+    an2 <- markLensFun an1 laesBarsAfter (\locs -> mapM markEpToken locs)
     an3 <- markLensFun an2 laesClose (\loc -> printStringAtAA loc "#)")
     return (ExplicitSum an3 alt arity expr')
 
@@ -4191,7 +4191,7 @@ instance ExactPrint (LocatedN RdrName) where
           return (NameAnnCommas a1 commas' t)
         NameAnnBars (o,c) bars t -> do
           o' <- markEpToken o
-          bars' <- forM bars (\loc -> printStringAtAAC NoCaptureComments loc "|")
+          bars' <- mapM markEpToken bars
           c' <- markEpToken c
           return (NameAnnBars (o',c') bars' t)
         NameAnnOnly a t -> do
@@ -4684,9 +4684,9 @@ instance ExactPrint (Pat GhcPs) where
 
   exact (SumPat an pat alt arity) = do
     an0 <- markLensFun an (lsumPatParens . lfst) (\loc -> printStringAtAA loc "(#")
-    an1 <- markLensFun an0 lsumPatVbarsBefore (\locs -> mapM (\l -> printStringAtAA l "|") locs)
+    an1 <- markLensFun an0 lsumPatVbarsBefore (\locs -> mapM markEpToken locs)
     pat' <- markAnnotated pat
-    an2 <- markLensFun an1 lsumPatVbarsAfter (\locs -> mapM (\l -> printStringAtAA l "|") locs)
+    an2 <- markLensFun an1 lsumPatVbarsAfter (\locs -> mapM markEpToken locs)
     an3 <- markLensFun an2 (lsumPatParens . lsnd)  (\loc -> printStringAtAA loc "#)")
     return (SumPat an3 pat' alt arity)
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d7cd7feac0878087c1210ece4974490ba3e5b85...f859d61c4832b16ae3b4dd14aad5cb41b0051de3

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d7cd7feac0878087c1210ece4974490ba3e5b85...f859d61c4832b16ae3b4dd14aad5cb41b0051de3
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/20241030/d5031dda/attachment-0001.html>


More information about the ghc-commits mailing list