[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: ApiAnnotations; tweaks for ghc-exactprint update
Marge Bot
gitlab at gitlab.haskell.org
Sun Aug 9 19:37:18 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
e4f1b73a by Alan Zimmerman at 2020-08-07T23:58:10-04:00
ApiAnnotations; tweaks for ghc-exactprint update
Remove unused ApiAnns, add one for linear arrow.
Include API Annotations for trailing comma in export list.
- - - - -
8a665db6 by Ben Gamari at 2020-08-07T23:58:45-04:00
configure: Fix double-negation in ld merge-objects check
We want to only run the check if ld is gold.
Fixes the fix to #17962.
- - - - -
a11c9678 by Adam Sandberg Ericsson at 2020-08-09T11:32:25+02:00
hadrian: depend on boot compiler version #18001
- - - - -
95f1478b by Alan Zimmerman at 2020-08-09T15:37:09-04:00
Api Annotations : Adjust SrcSpans for prefix bang (!).
And prefix ~
(cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb)
- - - - -
090ca604 by Sylvain Henry at 2020-08-09T15:37:13-04:00
Avoid allocations in `splitAtList` (#18535)
As suspected by @simonpj in #18535, avoiding allocations in
`GHC.Utils.Misc.splitAtList` when there are no leftover arguments is
beneficial for performance:
On CI validate-x86_64-linux-deb9-hadrian:
T12227 -7%
T12545 -12.3%
T5030 -10%
T9872a -2%
T9872b -2.1%
T9872c -2.5%
Metric Decrease:
T12227
T12545
T5030
T9872a
T9872b
T9872c
- - - - -
10 changed files:
- aclocal.m4
- compiler/GHC.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Utils/Misc.hs
- hadrian/src/Builder.hs
- testsuite/tests/ghc-api/annotations/Makefile
- testsuite/tests/ghc-api/annotations/T10358.stdout
- utils/check-api-annotations/Main.hs
Changes:
=====================================
aclocal.m4
=====================================
@@ -2543,7 +2543,7 @@ AC_DEFUN([FIND_LD],[
# Sets $result to 0 if not affected, 1 otherwise
AC_DEFUN([CHECK_FOR_GOLD_T22266],[
AC_MSG_CHECKING([for ld.gold object merging bug (binutils 22266)])
- if ! $1 --version | grep -v -q "GNU gold"; then
+ if ! $1 --version | grep -q "GNU gold"; then
# Not gold
result=0
elif test "$cross_compiling" = "yes"; then
=====================================
compiler/GHC.hs
=====================================
@@ -248,7 +248,7 @@ module GHC (
srcSpanStartCol, srcSpanEndCol,
-- ** Located
- GenLocated(..), Located,
+ GenLocated(..), Located, RealLocated,
-- *** Constructing Located
noLoc, mkGeneralLocated,
@@ -274,7 +274,7 @@ module GHC (
parser,
-- * API Annotations
- ApiAnns(..),AnnKeywordId(..),AnnotationComment(..),
+ ApiAnns(..),AnnKeywordId(..),AnnotationComment(..), ApiAnnKey,
getAnnotation, getAndRemoveAnnotation,
getAnnotationComments, getAndRemoveAnnotationComments,
unicodeAnn,
=====================================
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/Annotation.hs
=====================================
@@ -259,6 +259,8 @@ data AnnKeywordId
| AnnLarrow -- ^ '<-'
| AnnLarrowU -- ^ '<-', unicode variant
| AnnLet
+ | AnnLolly -- ^ '#->'
+ | AnnLollyU -- ^ '#->', unicode variant
| AnnMdo
| AnnMinus -- ^ '-'
| AnnModule
@@ -291,8 +293,6 @@ data AnnKeywordId
| AnnStatic -- ^ 'static'
| AnnStock
| AnnThen
- | AnnThIdSplice -- ^ '$'
- | AnnThIdTySplice -- ^ '$$'
| AnnThTyQuote -- ^ double '''
| AnnTilde -- ^ '~'
| AnnType
@@ -364,6 +364,7 @@ unicodeAnn AnnOpenB = AnnOpenBU
unicodeAnn AnnCloseB = AnnCloseBU
unicodeAnn AnnOpenEQ = AnnOpenEQU
unicodeAnn AnnCloseQ = AnnCloseQU
+unicodeAnn AnnLolly = AnnLollyU
unicodeAnn ann = ann
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1201,13 +1201,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 = []
=====================================
compiler/GHC/Utils/Misc.hs
=====================================
@@ -774,12 +774,15 @@ dropList _ xs@[] = xs
dropList (_:xs) (_:ys) = dropList xs ys
+-- | Given two lists xs=x0..xn and ys=y0..ym, return `splitAt n ys`.
splitAtList :: [b] -> [a] -> ([a], [a])
-splitAtList [] xs = ([], xs)
-splitAtList _ xs@[] = (xs, xs)
-splitAtList (_:xs) (y:ys) = (y:ys', ys'')
- where
- (ys', ys'') = splitAtList xs ys
+splitAtList xs ys = go 0 xs ys
+ where
+ -- we are careful to avoid allocating when there are no leftover
+ -- arguments: in this case we can return "ys" directly (cf #18535)
+ go _ _ [] = (ys, []) -- len(ys) <= len(xs)
+ go n [] bs = (take n ys, bs) -- = splitAt n ys
+ go n (_:as) (_:bs) = go (n+1) as bs
-- drop from the end of a list
dropTail :: Int -> [a] -> [a]
=====================================
hadrian/src/Builder.hs
=====================================
@@ -30,6 +30,7 @@ import Hadrian.Utilities
import Base
import Context
import Oracles.Flag
+import Oracles.Setting (setting, Setting(..))
import Packages
-- | C compiler can be used in two different modes:
@@ -180,7 +181,11 @@ instance H.Builder Builder where
Autoreconf dir -> return [dir -/- "configure.ac"]
Configure dir -> return [dir -/- "configure"]
- Ghc _ Stage0 -> includesDependencies Stage0
+ Ghc _ Stage0 -> do
+ -- Read the boot GHC version here to make sure we rebuild when it
+ -- changes (#18001).
+ _bootGhcVersion <- setting GhcVersion
+ includesDependencies Stage0
Ghc _ stage -> do
root <- buildRoot
touchyPath <- programPath (vanillaContext Stage0 touchy)
=====================================
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)---
[
=====================================
utils/check-api-annotations/Main.hs
=====================================
@@ -5,7 +5,6 @@ import Data.List
import GHC
import GHC.Driver.Session
import GHC.Utils.Outputable
-import GHC.Parser.Annotation
import GHC.Types.SrcLoc
import System.Environment( getArgs )
import System.Exit
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/15932b2a8d418a5e6b13acd4fc20e34fde9844df...090ca60400e8ecdcc4b35b28cf60d662b760a714
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/15932b2a8d418a5e6b13acd4fc20e34fde9844df...090ca60400e8ecdcc4b35b28cf60d662b760a714
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/20200809/8eedee65/attachment-0001.html>
More information about the ghc-commits
mailing list