[Git][ghc/ghc][ghc-9.10] 4 commits: EPA: Fix range for GADT decl with sig only

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Thu May 9 17:15:11 UTC 2024



Ben Gamari pushed to branch ghc-9.10 at Glasgow Haskell Compiler / GHC


Commits:
255f44e7 by Alan Zimmerman at 2024-05-08T20:07:57+01:00
EPA: Fix range for GADT decl with sig only

Closes #24714

(cherry picked from commit d5bea4d6bce785b1d09f1b8faad7451af23b728d)

- - - - -
ea1bca98 by Alan Zimmerman at 2024-05-08T20:36:04+01:00
EPA: Preserve comments for pattern synonym sig

Closes #24749

(cherry picked from commit bf3d4db0894233ec72f092a4a34bce9ed4ff4e21)

- - - - -
2cb0fb44 by Alan Zimmerman at 2024-05-08T20:36:33+01:00
EPA: Widen stmtslist to include last semicolon

Closes #24754

(cherry picked from commit 7eab4e019205cfced90f06242a9afa23dfcaa70b)

- - - - -
776fa6e1 by Alan Zimmerman at 2024-05-08T20:49:33+01:00
EPA: Keep comments in a CaseAlt match

The comments now live in the surrounding location, not inside the
Match. Make sure we keep them.

Closes #24707

(cherry picked from commit e916fc9215e66b15c7e2387cc087a9d1cc57bf77)

- - - - -


8 changed files:

- compiler/GHC/Parser.y
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- + testsuite/tests/printer/CaseAltComments.hs
- + testsuite/tests/printer/DataDeclShort.hs
- testsuite/tests/printer/Makefile
- + testsuite/tests/printer/Test24749.hs
- + testsuite/tests/printer/Test24754.hs
- testsuite/tests/printer/all.T


Changes:

=====================================
compiler/GHC/Parser.y
=====================================
@@ -1303,7 +1303,7 @@ ty_decl :: { LTyClDecl GhcPs }
         | type_data_or_newtype capi_ctype tycl_hdr opt_kind_sig
                  gadt_constrlist
                  maybe_derivings
-            {% mkTyData (comb4 $1 $3 $5 $6) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3
+            {% mkTyData (comb5 $1 $3 $4 $5 $6) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3
                             (snd $ unLoc $4) (snd $ unLoc $5)
                             (fmap reverse $6)
                             ((fstOf3 $ unLoc $1)++(fst $ unLoc $4)++(fst $ unLoc $5)) }
@@ -2652,7 +2652,7 @@ sigdecl :: { LHsDecl GhcPs }
                                     (Fixity fixText fixPrec (unLoc $1)))))
                    }}
 
-        | pattern_synonym_sig   { sL1a $1 . SigD noExtField . unLoc $ $1 }
+        | pattern_synonym_sig   { L (getLoc $1) . SigD noExtField . unLoc $ $1 }
 
         | '{-# COMPLETE' qcon_list opt_tyconsig  '#-}'
                 {% let (dcolon, tc) = $3
@@ -3341,7 +3341,7 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs
 
 alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) }
         : PATS alt_rhs { $2 >>= \ $2 ->
-                         acsA (sLLAsl $1 $> ()) (\loc cs -> L (locA loc)
+                         amsA' (sLLAsl $1 $>
                                          (Match { m_ext = []
                                                 , m_ctxt = CaseAlt -- for \case and \cases, this will be changed during post-processing
                                                 , m_pats = $1
@@ -3443,7 +3443,7 @@ stmts :: { forall b. DisambECP b => PV (Located (OrdList AddEpAnn,[LStmt GhcPs (
                              [] -> return (sLZ $1 $> ((fst $ unLoc $1) `snocOL` (mj AnnSemi $2),snd $ unLoc $1))
                              (h:t) -> do
                                { h' <- addTrailingSemiA h (gl $2)
-                               ; return $ sL1 $1 (fst $ unLoc $1,h':t) }}
+                               ; return $ sLZ $1 $> (fst $ unLoc $1,h':t) }}
         | stmt                   { $1 >>= \ $1 ->
                                    return $ sL1 $1 (nilOL,[$1]) }
         | {- empty -}            { return $ noLoc (nilOL,[]) }


=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -856,7 +856,7 @@
                    (EpaSpan { DumpSemis.hs:22:10-30 })
                    (AnnList
                     (Just
-                     (EpaSpan { DumpSemis.hs:22:12-25 }))
+                     (EpaSpan { DumpSemis.hs:22:12-28 }))
                     (Just
                      (AddEpAnn AnnOpenC (EpaSpan { DumpSemis.hs:22:10 })))
                     (Just


=====================================
testsuite/tests/printer/CaseAltComments.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE PatternGuards #-}
+module CaseAltComments where
+
+nfCom = case expr of
+      x :*: y  -- comment
+         | x' <= y'  -> x' :*: y'
+      _ -> blah


=====================================
testsuite/tests/printer/DataDeclShort.hs
=====================================
@@ -0,0 +1,8 @@
+module DataDeclShort where
+
+data GenericOptions
+  :: fieldLabelModifier
+  -> tagSingleConstructors
+  -> Type
+
+x = 1


=====================================
testsuite/tests/printer/Makefile
=====================================
@@ -856,3 +856,18 @@ Test24753:
 Test24771:
 	$(CHECK_PPR)   $(LIBDIR) Test24771.hs
 	$(CHECK_EXACT) $(LIBDIR) Test24771.hs
+
+.PHONY: DataDeclShort
+DataDeclShort:
+	$(CHECK_PPR)   $(LIBDIR) DataDeclShort.hs
+	$(CHECK_EXACT) $(LIBDIR) DataDeclShort.hs
+
+.PHONY: Test24749
+Test24749:
+	$(CHECK_PPR)   $(LIBDIR) Test24749.hs
+	$(CHECK_EXACT) $(LIBDIR) Test24749.hs
+
+.PHONY: Test24754
+Test24754:
+	$(CHECK_PPR)   $(LIBDIR) Test24754.hs
+	$(CHECK_EXACT) $(LIBDIR) Test24754.hs


=====================================
testsuite/tests/printer/Test24749.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE PatternSynonyms #-}
+module Test24749 where
+
+-- c0
+pattern (:|) ::
+  -- c1
+  a ->
+  -- c2
+  a ->
+  -- c3
+  Domino a


=====================================
testsuite/tests/printer/Test24754.hs
=====================================
@@ -0,0 +1,4 @@
+module Test24754 where
+
+eh1  =  try (do return r;) <|> (do
+                return r)


=====================================
testsuite/tests/printer/all.T
=====================================
@@ -203,3 +203,7 @@ test('Test24748', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24748'])
 test('Test24755', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24755'])
 test('Test24753', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24753'])
 test('Test24771', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24771'])
+test('DataDeclShort', [ignore_stderr, req_ppr_deps], makefile_test, ['DataDeclShort'])
+test('Test24749', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24749'])
+test('Test24754', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24754'])
+test('CaseAltComments', [ignore_stderr, req_ppr_deps], makefile_test, ['CaseAltComments'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5f453687549b700acf84a0cefed0efd7e274224...776fa6e1722bf1f084ae7cff7ef99c8d10b2ea74

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5f453687549b700acf84a0cefed0efd7e274224...776fa6e1722bf1f084ae7cff7ef99c8d10b2ea74
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/20240509/1931acb9/attachment-0001.html>


More information about the ghc-commits mailing list