[Git][ghc/ghc][master] EPA: preserve comments in data decls
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon May 6 23:55:52 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
46328a49 by Alan Zimmerman at 2024-05-06T19:55:05-04:00
EPA: preserve comments in data decls
Closes #24771
- - - - -
6 changed files:
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- testsuite/tests/printer/Makefile
- testsuite/tests/printer/Test24755.hs
- + testsuite/tests/printer/Test24771.hs
- testsuite/tests/printer/all.T
Changes:
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2486,9 +2486,8 @@ forall :: { Located ([AddEpAnn], Maybe [LHsTyVarBndr Specificity GhcPs]) }
| {- empty -} { noLoc ([], Nothing) }
constr_stuff :: { Located (LocatedN RdrName, HsConDeclH98Details GhcPs) }
- : infixtype {% fmap (reLoc. (fmap (\b -> (dataConBuilderCon b,
- dataConBuilderDetails b))))
- (runPV $1) }
+ : infixtype {% do { b <- runPV $1
+ ; return (sL1 b (dataConBuilderCon b, dataConBuilderDetails b)) }}
| '(#' usum_constr '#)' {% let (t, tag, arity) = $2 in pure (sLL $1 $3 $ mkUnboxedSumCon t tag arity)}
usum_constr :: { (LHsType GhcPs, Int, Int) } -- constructor for the data decls SumN#
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -236,7 +236,8 @@ mkTyData loc' is_type_data new_or_data cType (L _ (mcxt, tycl_hdr))
; let anns' = annsIn Semi.<> ann
; data_cons <- checkNewOrData loc' (unLoc tc) is_type_data new_or_data data_cons
; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv
- ; let loc = EpAnn (spanAsAnchor loc') noAnn cs
+ ; !cs' <- getCommentsFor loc'
+ ; let loc = EpAnn (spanAsAnchor loc') noAnn (cs' Semi.<> cs)
; return (L loc (DataDecl { tcdDExt = anns',
tcdLName = tc, tcdTyVars = tyvars,
tcdFixity = fixity,
@@ -2065,25 +2066,26 @@ instance DisambTD (HsType GhcPs) where
return (L (addCommentsToEpAnn l cs) ty)
mkUnpackednessPV = addUnpackednessP
-dataConBuilderCon :: DataConBuilder -> LocatedN RdrName
-dataConBuilderCon (PrefixDataConBuilder _ dc) = dc
-dataConBuilderCon (InfixDataConBuilder _ dc _) = dc
+dataConBuilderCon :: LocatedA DataConBuilder -> LocatedN RdrName
+dataConBuilderCon (L _ (PrefixDataConBuilder _ dc)) = dc
+dataConBuilderCon (L _ (InfixDataConBuilder _ dc _)) = dc
-dataConBuilderDetails :: DataConBuilder -> HsConDeclH98Details GhcPs
+dataConBuilderDetails :: LocatedA DataConBuilder -> HsConDeclH98Details GhcPs
-- Detect when the record syntax is used:
-- data T = MkT { ... }
-dataConBuilderDetails (PrefixDataConBuilder flds _)
+dataConBuilderDetails (L _ (PrefixDataConBuilder flds _))
| [L (EpAnn anc _ cs) (HsRecTy an fields)] <- toList flds
= RecCon (L (EpAnn anc an cs) fields)
-- Normal prefix constructor, e.g. data T = MkT A B C
-dataConBuilderDetails (PrefixDataConBuilder flds _)
+dataConBuilderDetails (L _ (PrefixDataConBuilder flds _))
= PrefixCon noTypeArgs (map hsLinear (toList flds))
-- Infix constructor, e.g. data T = Int :! Bool
-dataConBuilderDetails (InfixDataConBuilder lhs _ rhs)
- = InfixCon (hsLinear lhs) (hsLinear rhs)
+dataConBuilderDetails (L (EpAnn _ _ csl) (InfixDataConBuilder (L (EpAnn anc ann csll) lhs) _ rhs))
+ = InfixCon (hsLinear (L (EpAnn anc ann (csl Semi.<> csll)) lhs)) (hsLinear rhs)
+
instance DisambTD DataConBuilder where
mkHsAppTyHeadPV = tyToDataConBuilder
=====================================
testsuite/tests/printer/Makefile
=====================================
@@ -866,3 +866,8 @@ Test24755:
Test24753:
$(CHECK_PPR) $(LIBDIR) Test24753.hs
$(CHECK_EXACT) $(LIBDIR) Test24753.hs
+
+.PHONY: Test24771
+Test24771:
+ $(CHECK_PPR) $(LIBDIR) Test24771.hs
+ $(CHECK_EXACT) $(LIBDIR) Test24771.hs
=====================================
testsuite/tests/printer/Test24755.hs
=====================================
@@ -3,6 +3,6 @@
module Test24755 where
class
- a -- Before operator
- :+
- b -- After operator
+ a -- c1
+ :+ -- c2
+ b -- c3
=====================================
testsuite/tests/printer/Test24771.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeOperators #-}
+module Test24771 where
+
+data Foo
+ = Int -- c1
+ :* -- c2
+ String -- c3
=====================================
testsuite/tests/printer/all.T
=====================================
@@ -206,3 +206,4 @@ test('Test24749', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24749'])
test('Test24754', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24754'])
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'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/46328a49d988143111ab530d7907b9426b58311a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/46328a49d988143111ab530d7907b9426b58311a
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/20240506/b48115de/attachment-0001.html>
More information about the ghc-commits
mailing list