[Git][ghc/ghc][wip/az/ghc-9.0-anns] 2 commits: Include API Annotations for trailing comma in export list
Alan Zimmerman
gitlab at gitlab.haskell.org
Sat Aug 8 18:10:34 UTC 2020
Alan Zimmerman pushed to branch wip/az/ghc-9.0-anns at Glasgow Haskell Compiler / GHC
Commits:
59984655 by Alan Zimmerman at 2020-08-06T08:35:44+01:00
Include API Annotations for trailing comma in export list
- - - - -
8dbee2c5 by Alan Zimmerman at 2020-08-08T19:10:03+01:00
Api Annotations : Adjust SrsSpans for prefix bang (!).
And prefix ~
- - - - -
4 changed files:
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- testsuite/tests/ghc-api/annotations/Makefile
- testsuite/tests/ghc-api/annotations/T10358.stdout
Changes:
=====================================
compiler/GHC/Parser.y
=====================================
@@ -863,17 +863,17 @@ header_top_importdecls :: { [LImportDecl GhcPs] }
-- The Export List
maybeexports :: { (Maybe (Located [LIE GhcPs])) }
- : '(' exportlist ')' {% amsL (comb2 $1 $>) [mop $1,mcp $3] >>
- return (Just (sLL $1 $> (fromOL $2))) }
+ : '(' exportlist ')' {% amsL (comb2 $1 $>) ([mop $1,mcp $3] ++ (fst $2)) >>
+ return (Just (sLL $1 $> (fromOL $ snd $2))) }
| {- empty -} { Nothing }
-exportlist :: { OrdList (LIE GhcPs) }
- : exportlist1 { $1 }
- | {- empty -} { nilOL }
+exportlist :: { ([AddAnn], OrdList (LIE GhcPs)) }
+ : exportlist1 { ([], $1) }
+ | {- empty -} { ([], nilOL) }
-- trailing comma:
- | exportlist1 ',' { $1 }
- | ',' { nilOL }
+ | exportlist1 ',' { ([mj AnnComma $2], $1) }
+ | ',' { ([mj AnnComma $1], nilOL) }
exportlist1 :: { OrdList (LIE GhcPs) }
: exportlist1 ',' export
@@ -1019,11 +1019,11 @@ maybeimpspec :: { Located (Maybe (Bool, Located [LIE GhcPs])) }
impspec :: { Located (Bool, Located [LIE GhcPs]) }
: '(' exportlist ')' {% ams (sLL $1 $> (False,
- sLL $1 $> $ fromOL $2))
- [mop $1,mcp $3] }
+ sLL $1 $> $ fromOL (snd $2)))
+ ([mop $1,mcp $3] ++ (fst $2)) }
| 'hiding' '(' exportlist ')' {% ams (sLL $1 $> (True,
- sLL $1 $> $ fromOL $3))
- [mj AnnHiding $1,mop $2,mcp $4] }
+ sLL $1 $> $ fromOL (snd $3)))
+ ([mj AnnHiding $1,mop $2,mcp $4] ++ (fst $3)) }
-----------------------------------------------------------------------------
-- Fixity Declarations
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1231,13 +1231,14 @@ makeFunBind fn ms
checkPatBind :: LPat GhcPs
-> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
-> P ([AddAnn],HsBind GhcPs)
-checkPatBind lhs (L match_span (_,grhss))
+checkPatBind lhs (L rhs_span (_,grhss))
| BangPat _ p <- unLoc lhs
, VarPat _ v <- unLoc p
= return ([], makeFunBind v [L match_span (m v)])
where
+ match_span = combineSrcSpans (getLoc lhs) rhs_span
m v = Match { m_ext = noExtField
- , m_ctxt = FunRhs { mc_fun = L (getLoc lhs) (unLoc v)
+ , m_ctxt = FunRhs { mc_fun = v
, mc_fixity = Prefix
, mc_strictness = SrcStrict }
, m_pats = []
@@ -1373,19 +1374,24 @@ pBangTy lt@(L l1 _) xs =
Nothing -> (False, lt, pure (), xs)
Just (l2, anns, prag, unpk, xs') ->
let bl = combineSrcSpans l1 l2
- bt = addUnpackedness (prag, unpk) lt
- in (True, L bl bt, addAnnsAt bl anns, xs')
+ (anns2, bt) = addUnpackedness (prag, unpk) lt
+ in (True, L bl bt, addAnnsAt bl (anns ++ anns2), xs')
mkBangTy :: SrcStrictness -> LHsType GhcPs -> HsType GhcPs
mkBangTy strictness =
HsBangTy noExtField (HsSrcBang NoSourceText NoSrcUnpack strictness)
-addUnpackedness :: (SourceText, SrcUnpackedness) -> LHsType GhcPs -> HsType GhcPs
-addUnpackedness (prag, unpk) (L _ (HsBangTy x bang t))
+addUnpackedness :: (SourceText, SrcUnpackedness) -> LHsType GhcPs -> ([AddAnn], HsType GhcPs)
+addUnpackedness (prag, unpk) (L l (HsBangTy x bang t))
| HsSrcBang NoSourceText NoSrcUnpack strictness <- bang
- = HsBangTy x (HsSrcBang prag unpk strictness) t
+ = let
+ anns = case strictness of
+ SrcLazy -> [AddAnn AnnTilde (srcSpanFirstCharacter l)]
+ SrcStrict -> [AddAnn AnnBang (srcSpanFirstCharacter l)]
+ NoSrcStrict -> []
+ in (anns, HsBangTy x (HsSrcBang prag unpk strictness) t)
addUnpackedness (prag, unpk) t
- = HsBangTy noExtField (HsSrcBang prag unpk NoSrcStrict) t
+ = ([], HsBangTy noExtField (HsSrcBang prag unpk NoSrcStrict) t)
-- | Merge a /reversed/ and /non-empty/ soup of operators and operands
-- into a type.
=====================================
testsuite/tests/ghc-api/annotations/Makefile
=====================================
@@ -39,7 +39,8 @@ listcomps:
.PHONY: T10358
T10358:
- $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10358.hs
+ # Ignore result code, we have an unattached (superfluous) AnnBang
+ - $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10358.hs
.PHONY: T10396
T10396:
=====================================
testsuite/tests/ghc-api/annotations/T10358.stdout
=====================================
@@ -1,5 +1,5 @@
---Unattached Annotation Problems (should be empty list)---
-[]
+[(AnnBang, Test10358.hs:5:19)]
---Ann before enclosing span problem (should be empty list)---
[
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f31cb332f644f3ff3b45aba35b3d8d252885c67a...8dbee2c578b1f642d45561be3f416119863e01eb
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f31cb332f644f3ff3b45aba35b3d8d252885c67a...8dbee2c578b1f642d45561be3f416119863e01eb
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/20200808/39f9ea6d/attachment-0001.html>
More information about the ghc-commits
mailing list