[Git][ghc/ghc][wip/az/T24533-missing-comments-2] EPA: Address more 9.10.1-alpha1 regressions from recent changes

Alan Zimmerman (@alanz) gitlab at gitlab.haskell.org
Sun Mar 17 20:18:59 UTC 2024



Alan Zimmerman pushed to branch wip/az/T24533-missing-comments-2 at Glasgow Haskell Compiler / GHC


Commits:
77aeba3c by Alan Zimmerman at 2024-03-17T20:02:20+00:00
EPA: Address more 9.10.1-alpha1 regressions from recent changes

Closes #24533
Hopefully for good this time

- - - - -


5 changed files:

- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/printer/Test24533.hs
- testsuite/tests/printer/Test24533.stdout


Changes:

=====================================
compiler/GHC/Parser.y
=====================================
@@ -1237,12 +1237,12 @@ topdecl_cs : topdecl {% commentsPA $1 }
 
 -----------------------------------------------------------------------------
 topdecl :: { LHsDecl GhcPs }
-        : cl_decl                               { sL1a $1 (TyClD noExtField (unLoc $1)) }
-        | ty_decl                               { sL1a $1 (TyClD noExtField (unLoc $1)) }
-        | standalone_kind_sig                   { sL1a $1 (KindSigD noExtField (unLoc $1)) }
-        | inst_decl                             { sL1a $1 (InstD noExtField (unLoc $1)) }
-        | stand_alone_deriving                  { sL1a $1 (DerivD noExtField (unLoc $1)) }
-        | role_annot                            { sL1a $1 (RoleAnnotD noExtField (unLoc $1)) }
+        : cl_decl                               { L (getLoc $1) (TyClD noExtField (unLoc $1)) }
+        | ty_decl                               { L (getLoc $1) (TyClD noExtField (unLoc $1)) }
+        | standalone_kind_sig                   { L (getLoc $1) (KindSigD noExtField (unLoc $1)) }
+        | inst_decl                             { L (getLoc $1) (InstD noExtField (unLoc $1)) }
+        | stand_alone_deriving                  { L (getLoc $1) (DerivD noExtField (unLoc $1)) }
+        | role_annot                            { L (getLoc $1) (RoleAnnotD noExtField (unLoc $1)) }
         | 'default' '(' comma_types0 ')'        {% amsA' (sLL $1 $>
                                                     (DefD noExtField (DefaultDecl [mj AnnDefault $1,mop $2,mcp $4] $3))) }
         | 'foreign' fdecl                       {% amsA' (sLL $1 $> ((snd $ unLoc $2) (mj AnnForeign $1:(fst $ unLoc $2)))) }


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -943,11 +943,13 @@ checkTyVars pp_what equals_or_where tc tparms
         -- Keep around an action for adjusting the annotations of extra parens
     chkParens :: [AddEpAnn] -> [AddEpAnn] -> HsBndrVis GhcPs -> LHsType GhcPs
               -> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-    chkParens ops cps bvis (L l (HsParTy _ ty))
+    chkParens ops cps bvis (L l (HsParTy _ (L lt  ty)))
       = let
           (o,c) = mkParensEpAnn (realSrcSpan $ locA l)
+          lcs = epAnnComments l
+          lt' = setCommentsEpAnn lt lcs
         in
-          chkParens (o:ops) (c:cps) bvis ty
+          chkParens (o:ops) (c:cps) bvis (L lt' ty)
     chkParens ops cps bvis ty = chk ops cps bvis ty
 
         -- Check that the name space is correct!


=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -212,7 +212,10 @@
              (EpaComments
               []))
             (HsTupleTy
-             (AnnParen AnnParens (EpaSpan { DumpSemis.hs:9:11 }) (EpaSpan { DumpSemis.hs:9:12 }))
+             (AnnParen
+              AnnParens
+              (EpaSpan { DumpSemis.hs:9:11 })
+              (EpaSpan { DumpSemis.hs:9:12 }))
              (HsBoxedOrConstraintTuple)
              []))))))))))
   ,(L
@@ -498,7 +501,10 @@
              (EpaComments
               []))
             (HsTupleTy
-             (AnnParen AnnParens (EpaSpan { DumpSemis.hs:14:11 }) (EpaSpan { DumpSemis.hs:14:12 }))
+             (AnnParen
+              AnnParens
+              (EpaSpan { DumpSemis.hs:14:11 })
+              (EpaSpan { DumpSemis.hs:14:12 }))
              (HsBoxedOrConstraintTuple)
              []))))))))))
   ,(L
@@ -747,7 +753,10 @@
              (EpaComments
               []))
             (HsTupleTy
-             (AnnParen AnnParens (EpaSpan { DumpSemis.hs:21:11 }) (EpaSpan { DumpSemis.hs:21:12 }))
+             (AnnParen
+              AnnParens
+              (EpaSpan { DumpSemis.hs:21:11 })
+              (EpaSpan { DumpSemis.hs:21:12 }))
              (HsBoxedOrConstraintTuple)
              []))))))))))
   ,(L


=====================================
testsuite/tests/printer/Test24533.hs
=====================================
@@ -6,3 +6,9 @@ instance
     Read b
   ) =>
   Read (a, b)
+
+class Foo (a :: Type {- Weird -})
+
+instance Eq Foo where
+  -- Weird
+  Foo == Foo = True


=====================================
testsuite/tests/printer/Test24533.stdout
=====================================
@@ -13,8 +13,8 @@
      []
      (Just
       ((,)
-       { Test24533.hs:9:1 }
-       { Test24533.hs:8:13 })))
+       { Test24533.hs:15:1 }
+       { Test24533.hs:14:16-19 })))
     (EpaCommentsBalanced
      [(L
        (EpaSpan
@@ -273,6 +273,323 @@
        []
        []
        []
+       (Nothing)))))
+  ,(L
+    (EpAnn
+     (EpaSpan { Test24533.hs:10:1-33 })
+     (AnnListItem
+      [])
+     (EpaComments
+      []))
+    (TyClD
+     (NoExtField)
+     (ClassDecl
+      ((,,)
+       [(AddEpAnn AnnClass (EpaSpan { Test24533.hs:10:1-5 }))]
+       (EpNoLayout)
+       (NoAnnSortKey))
+      (Nothing)
+      (L
+       (EpAnn
+        (EpaSpan { Test24533.hs:10:7-9 })
+        (NameAnnTrailing
+         [])
+        (EpaComments
+         []))
+       (Unqual
+        {OccName: Foo}))
+      (HsQTvs
+       (NoExtField)
+       [(L
+         (EpAnn
+          (EpaSpan { Test24533.hs:10:11-33 })
+          (AnnListItem
+           [])
+          (EpaComments
+           [(L
+             (EpaSpan
+              { Test24533.hs:10:22-32 })
+             (EpaComment
+              (EpaBlockComment
+               "{- Weird -}")
+              { Test24533.hs:10:17-20 }))]))
+         (KindedTyVar
+          [(AddEpAnn AnnOpenP (EpaSpan { Test24533.hs:10:11 }))
+          ,(AddEpAnn AnnCloseP (EpaSpan { Test24533.hs:10:33 }))
+          ,(AddEpAnn AnnDcolon (EpaSpan { Test24533.hs:10:14-15 }))]
+          (HsBndrRequired
+           (NoExtField))
+          (L
+           (EpAnn
+            (EpaSpan { Test24533.hs:10:12 })
+            (NameAnnTrailing
+             [])
+            (EpaComments
+             []))
+           (Unqual
+            {OccName: a}))
+          (L
+           (EpAnn
+            (EpaSpan { Test24533.hs:10:17-20 })
+            (AnnListItem
+             [])
+            (EpaComments
+             []))
+           (HsTyVar
+            []
+            (NotPromoted)
+            (L
+             (EpAnn
+              (EpaSpan { Test24533.hs:10:17-20 })
+              (NameAnnTrailing
+               [])
+              (EpaComments
+               []))
+             (Unqual
+              {OccName: Type}))))))])
+      (Prefix)
+      []
+      []
+      {Bag(LocatedA (HsBind GhcPs)):
+       []}
+      []
+      []
+      [])))
+  ,(L
+    (EpAnn
+     (EpaSpan { Test24533.hs:(12,1)-(14,19) })
+     (AnnListItem
+      [])
+     (EpaComments
+      [(L
+        (EpaSpan
+         { Test24533.hs:13:3-10 })
+        (EpaComment
+         (EpaLineComment
+          "-- Weird")
+         { Test24533.hs:12:17-21 }))]))
+    (InstD
+     (NoExtField)
+     (ClsInstD
+      (NoExtField)
+      (ClsInstDecl
+       ((,,)
+        (Nothing)
+        [(AddEpAnn AnnInstance (EpaSpan { Test24533.hs:12:1-8 }))
+        ,(AddEpAnn AnnWhere (EpaSpan { Test24533.hs:12:17-21 }))]
+        (NoAnnSortKey))
+       (L
+        (EpAnn
+         (EpaSpan { Test24533.hs:12:10-15 })
+         (AnnListItem
+          [])
+         (EpaComments
+          []))
+        (HsSig
+         (NoExtField)
+         (HsOuterImplicit
+          (NoExtField))
+         (L
+          (EpAnn
+           (EpaSpan { Test24533.hs:12:10-15 })
+           (AnnListItem
+            [])
+           (EpaComments
+            []))
+          (HsAppTy
+           (NoExtField)
+           (L
+            (EpAnn
+             (EpaSpan { Test24533.hs:12:10-11 })
+             (AnnListItem
+              [])
+             (EpaComments
+              []))
+            (HsTyVar
+             []
+             (NotPromoted)
+             (L
+              (EpAnn
+               (EpaSpan { Test24533.hs:12:10-11 })
+               (NameAnnTrailing
+                [])
+               (EpaComments
+                []))
+              (Unqual
+               {OccName: Eq}))))
+           (L
+            (EpAnn
+             (EpaSpan { Test24533.hs:12:13-15 })
+             (AnnListItem
+              [])
+             (EpaComments
+              []))
+            (HsTyVar
+             []
+             (NotPromoted)
+             (L
+              (EpAnn
+               (EpaSpan { Test24533.hs:12:13-15 })
+               (NameAnnTrailing
+                [])
+               (EpaComments
+                []))
+              (Unqual
+               {OccName: Foo}))))))))
+       {Bag(LocatedA (HsBind GhcPs)):
+        [(L
+          (EpAnn
+           (EpaSpan { Test24533.hs:14:3-19 })
+           (AnnListItem
+            [])
+           (EpaComments
+            []))
+          (FunBind
+           (NoExtField)
+           (L
+            (EpAnn
+             (EpaSpan { Test24533.hs:14:7-8 })
+             (NameAnnTrailing
+              [])
+             (EpaComments
+              []))
+            (Unqual
+             {OccName: ==}))
+           (MG
+            (FromSource)
+            (L
+             (EpAnn
+              (EpaSpan { Test24533.hs:14:3-19 })
+              (AnnList
+               (Nothing)
+               (Nothing)
+               (Nothing)
+               []
+               [])
+              (EpaComments
+               []))
+             [(L
+               (EpAnn
+                (EpaSpan { Test24533.hs:14:3-19 })
+                (AnnListItem
+                 [])
+                (EpaComments
+                 []))
+               (Match
+                []
+                (FunRhs
+                 (L
+                  (EpAnn
+                   (EpaSpan { Test24533.hs:14:7-8 })
+                   (NameAnnTrailing
+                    [])
+                   (EpaComments
+                    []))
+                  (Unqual
+                   {OccName: ==}))
+                 (Infix)
+                 (NoSrcStrict))
+                [(L
+                  (EpAnn
+                   (EpaSpan { Test24533.hs:14:3-5 })
+                   (AnnListItem
+                    [])
+                   (EpaComments
+                    []))
+                  (VisPat
+                   (NoExtField)
+                   (L
+                    (EpAnn
+                     (EpaSpan { Test24533.hs:14:3-5 })
+                     (AnnListItem
+                      [])
+                     (EpaComments
+                      []))
+                    (ConPat
+                     []
+                     (L
+                      (EpAnn
+                       (EpaSpan { Test24533.hs:14:3-5 })
+                       (NameAnnTrailing
+                        [])
+                       (EpaComments
+                        []))
+                      (Unqual
+                       {OccName: Foo}))
+                     (PrefixCon
+                      []
+                      [])))))
+                ,(L
+                  (EpAnn
+                   (EpaSpan { Test24533.hs:14:10-12 })
+                   (AnnListItem
+                    [])
+                   (EpaComments
+                    []))
+                  (VisPat
+                   (NoExtField)
+                   (L
+                    (EpAnn
+                     (EpaSpan { Test24533.hs:14:10-12 })
+                     (AnnListItem
+                      [])
+                     (EpaComments
+                      []))
+                    (ConPat
+                     []
+                     (L
+                      (EpAnn
+                       (EpaSpan { Test24533.hs:14:10-12 })
+                       (NameAnnTrailing
+                        [])
+                       (EpaComments
+                        []))
+                      (Unqual
+                       {OccName: Foo}))
+                     (PrefixCon
+                      []
+                      [])))))]
+                (GRHSs
+                 (EpaComments
+                  [])
+                 [(L
+                   (EpAnn
+                    (EpaSpan { Test24533.hs:14:14-19 })
+                    (NoEpAnns)
+                    (EpaComments
+                     []))
+                   (GRHS
+                    (EpAnn
+                     (EpaSpan { Test24533.hs:14:14-19 })
+                     (GrhsAnn
+                      (Nothing)
+                      (AddEpAnn AnnEqual (EpaSpan { Test24533.hs:14:14 })))
+                     (EpaComments
+                      []))
+                    []
+                    (L
+                     (EpAnn
+                      (EpaSpan { Test24533.hs:14:16-19 })
+                      (AnnListItem
+                       [])
+                      (EpaComments
+                       []))
+                     (HsVar
+                      (NoExtField)
+                      (L
+                       (EpAnn
+                        (EpaSpan { Test24533.hs:14:16-19 })
+                        (NameAnnTrailing
+                         [])
+                        (EpaComments
+                         []))
+                       (Unqual
+                        {OccName: True}))))))]
+                 (EmptyLocalBinds
+                  (NoExtField)))))]))))]}
+       []
+       []
+       []
        (Nothing)))))]))
 
 
@@ -291,8 +608,8 @@
      []
      (Just
       ((,)
-       { Test24533.ppr.hs:3:41 }
-       { Test24533.ppr.hs:3:40 })))
+       { Test24533.ppr.hs:6:20 }
+       { Test24533.ppr.hs:6:16-19 })))
     (EpaCommentsBalanced
      [(L
        (EpaSpan
@@ -545,4 +862,311 @@
        []
        []
        []
-       (Nothing)))))]))
\ No newline at end of file
+       (Nothing)))))
+  ,(L
+    (EpAnn
+     (EpaSpan { Test24533.ppr.hs:4:1-21 })
+     (AnnListItem
+      [])
+     (EpaComments
+      []))
+    (TyClD
+     (NoExtField)
+     (ClassDecl
+      ((,,)
+       [(AddEpAnn AnnClass (EpaSpan { Test24533.ppr.hs:4:1-5 }))]
+       (EpNoLayout)
+       (NoAnnSortKey))
+      (Nothing)
+      (L
+       (EpAnn
+        (EpaSpan { Test24533.ppr.hs:4:7-9 })
+        (NameAnnTrailing
+         [])
+        (EpaComments
+         []))
+       (Unqual
+        {OccName: Foo}))
+      (HsQTvs
+       (NoExtField)
+       [(L
+         (EpAnn
+          (EpaSpan { Test24533.ppr.hs:4:11-21 })
+          (AnnListItem
+           [])
+          (EpaComments
+           []))
+         (KindedTyVar
+          [(AddEpAnn AnnOpenP (EpaSpan { Test24533.ppr.hs:4:11 }))
+          ,(AddEpAnn AnnCloseP (EpaSpan { Test24533.ppr.hs:4:21 }))
+          ,(AddEpAnn AnnDcolon (EpaSpan { Test24533.ppr.hs:4:14-15 }))]
+          (HsBndrRequired
+           (NoExtField))
+          (L
+           (EpAnn
+            (EpaSpan { Test24533.ppr.hs:4:12 })
+            (NameAnnTrailing
+             [])
+            (EpaComments
+             []))
+           (Unqual
+            {OccName: a}))
+          (L
+           (EpAnn
+            (EpaSpan { Test24533.ppr.hs:4:17-20 })
+            (AnnListItem
+             [])
+            (EpaComments
+             []))
+           (HsTyVar
+            []
+            (NotPromoted)
+            (L
+             (EpAnn
+              (EpaSpan { Test24533.ppr.hs:4:17-20 })
+              (NameAnnTrailing
+               [])
+              (EpaComments
+               []))
+             (Unqual
+              {OccName: Type}))))))])
+      (Prefix)
+      []
+      []
+      {Bag(LocatedA (HsBind GhcPs)):
+       []}
+      []
+      []
+      [])))
+  ,(L
+    (EpAnn
+     (EpaSpan { Test24533.ppr.hs:(5,1)-(6,19) })
+     (AnnListItem
+      [])
+     (EpaComments
+      []))
+    (InstD
+     (NoExtField)
+     (ClsInstD
+      (NoExtField)
+      (ClsInstDecl
+       ((,,)
+        (Nothing)
+        [(AddEpAnn AnnInstance (EpaSpan { Test24533.ppr.hs:5:1-8 }))
+        ,(AddEpAnn AnnWhere (EpaSpan { Test24533.ppr.hs:5:17-21 }))]
+        (NoAnnSortKey))
+       (L
+        (EpAnn
+         (EpaSpan { Test24533.ppr.hs:5:10-15 })
+         (AnnListItem
+          [])
+         (EpaComments
+          []))
+        (HsSig
+         (NoExtField)
+         (HsOuterImplicit
+          (NoExtField))
+         (L
+          (EpAnn
+           (EpaSpan { Test24533.ppr.hs:5:10-15 })
+           (AnnListItem
+            [])
+           (EpaComments
+            []))
+          (HsAppTy
+           (NoExtField)
+           (L
+            (EpAnn
+             (EpaSpan { Test24533.ppr.hs:5:10-11 })
+             (AnnListItem
+              [])
+             (EpaComments
+              []))
+            (HsTyVar
+             []
+             (NotPromoted)
+             (L
+              (EpAnn
+               (EpaSpan { Test24533.ppr.hs:5:10-11 })
+               (NameAnnTrailing
+                [])
+               (EpaComments
+                []))
+              (Unqual
+               {OccName: Eq}))))
+           (L
+            (EpAnn
+             (EpaSpan { Test24533.ppr.hs:5:13-15 })
+             (AnnListItem
+              [])
+             (EpaComments
+              []))
+            (HsTyVar
+             []
+             (NotPromoted)
+             (L
+              (EpAnn
+               (EpaSpan { Test24533.ppr.hs:5:13-15 })
+               (NameAnnTrailing
+                [])
+               (EpaComments
+                []))
+              (Unqual
+               {OccName: Foo}))))))))
+       {Bag(LocatedA (HsBind GhcPs)):
+        [(L
+          (EpAnn
+           (EpaSpan { Test24533.ppr.hs:6:3-19 })
+           (AnnListItem
+            [])
+           (EpaComments
+            []))
+          (FunBind
+           (NoExtField)
+           (L
+            (EpAnn
+             (EpaSpan { Test24533.ppr.hs:6:7-8 })
+             (NameAnnTrailing
+              [])
+             (EpaComments
+              []))
+            (Unqual
+             {OccName: ==}))
+           (MG
+            (FromSource)
+            (L
+             (EpAnn
+              (EpaSpan { Test24533.ppr.hs:6:3-19 })
+              (AnnList
+               (Nothing)
+               (Nothing)
+               (Nothing)
+               []
+               [])
+              (EpaComments
+               []))
+             [(L
+               (EpAnn
+                (EpaSpan { Test24533.ppr.hs:6:3-19 })
+                (AnnListItem
+                 [])
+                (EpaComments
+                 []))
+               (Match
+                []
+                (FunRhs
+                 (L
+                  (EpAnn
+                   (EpaSpan { Test24533.ppr.hs:6:7-8 })
+                   (NameAnnTrailing
+                    [])
+                   (EpaComments
+                    []))
+                  (Unqual
+                   {OccName: ==}))
+                 (Infix)
+                 (NoSrcStrict))
+                [(L
+                  (EpAnn
+                   (EpaSpan { Test24533.ppr.hs:6:3-5 })
+                   (AnnListItem
+                    [])
+                   (EpaComments
+                    []))
+                  (VisPat
+                   (NoExtField)
+                   (L
+                    (EpAnn
+                     (EpaSpan { Test24533.ppr.hs:6:3-5 })
+                     (AnnListItem
+                      [])
+                     (EpaComments
+                      []))
+                    (ConPat
+                     []
+                     (L
+                      (EpAnn
+                       (EpaSpan { Test24533.ppr.hs:6:3-5 })
+                       (NameAnnTrailing
+                        [])
+                       (EpaComments
+                        []))
+                      (Unqual
+                       {OccName: Foo}))
+                     (PrefixCon
+                      []
+                      [])))))
+                ,(L
+                  (EpAnn
+                   (EpaSpan { Test24533.ppr.hs:6:10-12 })
+                   (AnnListItem
+                    [])
+                   (EpaComments
+                    []))
+                  (VisPat
+                   (NoExtField)
+                   (L
+                    (EpAnn
+                     (EpaSpan { Test24533.ppr.hs:6:10-12 })
+                     (AnnListItem
+                      [])
+                     (EpaComments
+                      []))
+                    (ConPat
+                     []
+                     (L
+                      (EpAnn
+                       (EpaSpan { Test24533.ppr.hs:6:10-12 })
+                       (NameAnnTrailing
+                        [])
+                       (EpaComments
+                        []))
+                      (Unqual
+                       {OccName: Foo}))
+                     (PrefixCon
+                      []
+                      [])))))]
+                (GRHSs
+                 (EpaComments
+                  [])
+                 [(L
+                   (EpAnn
+                    (EpaSpan { Test24533.ppr.hs:6:14-19 })
+                    (NoEpAnns)
+                    (EpaComments
+                     []))
+                   (GRHS
+                    (EpAnn
+                     (EpaSpan { Test24533.ppr.hs:6:14-19 })
+                     (GrhsAnn
+                      (Nothing)
+                      (AddEpAnn AnnEqual (EpaSpan { Test24533.ppr.hs:6:14 })))
+                     (EpaComments
+                      []))
+                    []
+                    (L
+                     (EpAnn
+                      (EpaSpan { Test24533.ppr.hs:6:16-19 })
+                      (AnnListItem
+                       [])
+                      (EpaComments
+                       []))
+                     (HsVar
+                      (NoExtField)
+                      (L
+                       (EpAnn
+                        (EpaSpan { Test24533.ppr.hs:6:16-19 })
+                        (NameAnnTrailing
+                         [])
+                        (EpaComments
+                         []))
+                       (Unqual
+                        {OccName: True}))))))]
+                 (EmptyLocalBinds
+                  (NoExtField)))))]))))]}
+       []
+       []
+       []
+       (Nothing)))))]))
+
+



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77aeba3c35a0f741a9f06a96888a2197fd04e07e
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/20240317/8b8bb05a/attachment-0001.html>


More information about the ghc-commits mailing list