diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index f3f38f3cea8b614eaf149b8be7d3de3d7929bbd0..dc43689132f6cbbb54b3fb8c3248687b87bbfaaa 100644 --- a/compiler/GHC/Parser.y +++ b/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# diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 4b057cd1f812adfd88e0bf08213c8743c65d5df7..6b77345edc101b1b1059f9ed667ec642b0b971fb 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/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 diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile index e55e969fc59b674ab7f0e190132736e796e22fd8..c9ef4a04312aa51ca3bd5388623bbebaa5626f53 100644 --- a/testsuite/tests/printer/Makefile +++ b/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 diff --git a/testsuite/tests/printer/Test24755.hs b/testsuite/tests/printer/Test24755.hs index f93f8610f1c332cd74fb3aeb9cd066799299b310..d8e0a3bd94a5586121671a6da0aa0cb2c2c9bdbe 100644 --- a/testsuite/tests/printer/Test24755.hs +++ b/testsuite/tests/printer/Test24755.hs @@ -3,6 +3,6 @@ module Test24755 where class - a -- Before operator - :+ - b -- After operator + a -- c1 + :+ -- c2 + b -- c3 diff --git a/testsuite/tests/printer/Test24771.hs b/testsuite/tests/printer/Test24771.hs new file mode 100644 index 0000000000000000000000000000000000000000..59ab2549eddd2b5a6c8f6542f053082312c87501 --- /dev/null +++ b/testsuite/tests/printer/Test24771.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +module Test24771 where + +data Foo + = Int -- c1 + :* -- c2 + String -- c3 diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T index a7feccb09b9343db3607523bd333c60b2354ff0a..efdc37b01ec3cc83f0e97a2aeec2d95ccb0c5f37 100644 --- a/testsuite/tests/printer/all.T +++ b/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'])