diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 30b8b28ea098f310f1482ba3e149079587b9db54..6337a645a9a235339c99d0087664cead70139985 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -1438,10 +1438,10 @@ ty_fam_inst_eqns :: { Located [LTyFamInstEqn GhcPs] }
h' <- addTrailingSemiA h (gl $2)
return (sLL $1 $> ($3 : h' : t)) }
| ty_fam_inst_eqns ';' {% case unLoc $1 of
- [] -> return (sLL $1 $> (unLoc $1))
+ [] -> return (sLZ $1 $> (unLoc $1))
(h:t) -> do
h' <- addTrailingSemiA h (gl $2)
- return (sLL $1 $> (h':t)) }
+ return (sLZ $1 $> (h':t)) }
| ty_fam_inst_eqn { sLL $1 $> [$1] }
| {- empty -} { noLoc [] }
@@ -1719,12 +1719,12 @@ decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed
return (sLL $1 $> (fst $ unLoc $1
, snocOL hs t' `appOL` unitOL $3)) }
| decls_cls ';' {% if isNilOL (snd $ unLoc $1)
- then return (sLL $1 $> ( (fst $ unLoc $1) ++ (mz AnnSemi $2)
+ then return (sLZ $1 $> ( (fst $ unLoc $1) ++ (mz AnnSemi $2)
,snd $ unLoc $1))
else case (snd $ unLoc $1) of
SnocOL hs t -> do
t' <- addTrailingSemiA t (gl $2)
- return (sLL $1 $> (fst $ unLoc $1
+ return (sLZ $1 $> (fst $ unLoc $1
, snocOL hs t')) }
| decl_cls { sL1 $1 ([], unitOL $1) }
| {- empty -} { noLoc ([],nilOL) }
@@ -1765,12 +1765,12 @@ decls_inst :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed
return (sLL $1 $> (fst $ unLoc $1
, snocOL hs t' `appOL` unLoc $3)) }
| decls_inst ';' {% if isNilOL (snd $ unLoc $1)
- then return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2)
+ then return (sLZ $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2)
,snd $ unLoc $1))
else case (snd $ unLoc $1) of
SnocOL hs t -> do
t' <- addTrailingSemiA t (gl $2)
- return (sLL $1 $> (fst $ unLoc $1
+ return (sLZ $1 $> (fst $ unLoc $1
, snocOL hs t')) }
| decl_inst { sL1 $1 ([],unLoc $1) }
| {- empty -} { noLoc ([],nilOL) }
@@ -1806,12 +1806,12 @@ decls :: { Located ([AddEpAnn], OrdList (LHsDecl GhcPs)) }
return (rest `seq` this `seq` these `seq`
(sLL $1 $> (fst $ unLoc $1, these))) }
| decls ';' {% if isNilOL (snd $ unLoc $1)
- then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemiA $2)
+ then return (sLZ $1 $> (((fst $ unLoc $1) ++ (msemiA $2)
,snd $ unLoc $1)))
else case (snd $ unLoc $1) of
SnocOL hs t -> do
t' <- addTrailingSemiA t (gl $2)
- return (sLL $1 $> (fst $ unLoc $1
+ return (sLZ $1 $> (fst $ unLoc $1
, snocOL hs t')) }
| decl { sL1 $1 ([], unitOL $1) }
| {- empty -} { noLoc ([],nilOL) }
@@ -3334,11 +3334,11 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs
return (sLL $1 $> (fst $ unLoc $1,$3 : h' : t)) }
| alts1(PATS) ';' { $1 >>= \ $1 ->
case snd $ unLoc $1 of
- [] -> return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2)
+ [] -> return (sLZ $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2)
,[]))
(h:t) -> do
h' <- addTrailingSemiA h (gl $2)
- return (sLL $1 $> (fst $ unLoc $1, h' : t)) }
+ return (sLZ $1 $> (fst $ unLoc $1, h' : t)) }
| alt(PATS) { $1 >>= \ $1 -> return $ sL1 $1 ([],[$1]) }
alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) }
@@ -3442,7 +3442,7 @@ stmts :: { forall b. DisambECP b => PV (Located (OrdList AddEpAnn,[LStmt GhcPs (
| stmts ';' { $1 >>= \ $1 ->
case (snd $ unLoc $1) of
- [] -> return (sLL $1 $> ((fst $ unLoc $1) `snocOL` (mj AnnSemi $2),snd $ unLoc $1))
+ [] -> 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) }}
@@ -3552,7 +3552,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed
| dbinds ';' {% case unLoc $1 of
(h:t) -> do
h' <- addTrailingSemiA h (gl $2)
- return (sLL $1 $> (h':t)) }
+ return (sLZ $1 $> (h':t)) }
| dbind { let this = $1 in this `seq` (sL1 $1 [this]) }
-- | {- empty -} { [] }
@@ -4195,6 +4195,12 @@ sLLAsl :: (HasLoc a) => [a] -> Located b -> c -> Located c
sLLAsl [] = sL1
sLLAsl (!x:_) = sLL x
+{-# INLINE sLZ #-}
+sLZ :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c
+sLZ !x !y = if isZeroWidthSpan (getHasLoc y)
+ then sL (getHasLoc x)
+ else sL (comb2 x y)
+
{- Note [Adding location info]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile
index 15b4500872ecf5ed1fe0cb810da0a45425797885..c8e7cde7c589a8d2b92c23e87699140d114ae018 100644
--- a/testsuite/tests/printer/Makefile
+++ b/testsuite/tests/printer/Makefile
@@ -821,3 +821,8 @@ AnnotationNoListTuplePuns:
Test24533:
$(CHECK_PPR) $(LIBDIR) Test24533.hs
$(CHECK_EXACT) $(LIBDIR) Test24533.hs
+
+.PHONY: PprLetIn
+PprLetIn:
+ $(CHECK_PPR) $(LIBDIR) PprLetIn.hs
+ $(CHECK_EXACT) $(LIBDIR) PprLetIn.hs
diff --git a/testsuite/tests/printer/PprLetIn.hs b/testsuite/tests/printer/PprLetIn.hs
new file mode 100644
index 0000000000000000000000000000000000000000..ce5595933983ba31f6546e0bcdaec210b83acc91
--- /dev/null
+++ b/testsuite/tests/printer/PprLetIn.hs
@@ -0,0 +1,5 @@
+module PprLetIn where
+
+ff = let
+ x = 1
+ in 4
diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T
index 7217ec8bd9f1fba71ef8b0dadc3d644ba95e0fdc..19b070c971002e5f852e12429fd67bee8c4b8fe0 100644
--- a/testsuite/tests/printer/all.T
+++ b/testsuite/tests/printer/all.T
@@ -197,3 +197,4 @@ test('Test23885', [ignore_stderr, req_ppr_deps], makefile_test, ['Test23885'])
test('ListTuplePuns', extra_files(['ListTuplePuns.hs']), ghci_script, ['ListTuplePuns.script'])
test('AnnotationNoListTuplePuns', [ignore_stderr, req_ppr_deps], makefile_test, ['AnnotationNoListTuplePuns'])
test('Test24533', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24533'])
+test('PprLetIn', [ignore_stderr, req_ppr_deps], makefile_test, ['PprLetIn'])