[Git][ghc/ghc][master] EPA: Do not extend declaration range for trailine zero len semi
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Mar 27 11:29:53 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
0acfe391 by Alan Zimmerman at 2024-03-27T07:29:27-04:00
EPA: Do not extend declaration range for trailine zero len semi
The lexer inserts virtual semicolons having zero width.
Do not use them to extend the list span of items in a list.
- - - - -
4 changed files:
- compiler/GHC/Parser.y
- testsuite/tests/printer/Makefile
- + testsuite/tests/printer/PprLetIn.hs
- testsuite/tests/printer/all.T
Changes:
=====================================
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]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
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
=====================================
testsuite/tests/printer/PprLetIn.hs
=====================================
@@ -0,0 +1,5 @@
+module PprLetIn where
+
+ff = let
+ x = 1
+ in 4
=====================================
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'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0acfe391583d77a72051d505f05fab0ada056c49
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0acfe391583d77a72051d505f05fab0ada056c49
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/20240327/543147d0/attachment-0001.html>
More information about the ghc-commits
mailing list