[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: StgToCmm: Use CmmRegOff smart constructor
Marge Bot
gitlab at gitlab.haskell.org
Thu Jul 16 11:13:57 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
51dbfa52 by Ben Gamari at 2020-07-15T04:05:34-04:00
StgToCmm: Use CmmRegOff smart constructor
Previously we would generate expressions of the form
`CmmRegOff BaseReg 0`. This should do no harm (and really should be
handled by the NCG anyways) but it's better to just generate a plain
`CmmReg`.
- - - - -
ae11bdfd by Ben Gamari at 2020-07-15T04:06:08-04:00
testsuite: Add regression test for #17744
Test due to @monoidal.
- - - - -
b5991f01 by Ben Gamari at 2020-07-15T23:55:23-04:00
rts: Add --copying-gc flag to reverse effect of --nonmoving-gc
Fixes #18281.
- - - - -
f02edd80 by Krzysztof Gogolewski at 2020-07-16T07:13:51-04:00
Remove {-# CORE #-} pragma (part of #18048)
This pragma has no effect since 2011.
It was introduced for External Core, which no longer exists.
Updates haddock submodule.
- - - - -
19 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/StgToCmm/CgUtils.hs
- compiler/GHC/Tc/Gen/Expr.hs
- docs/users_guide/runtime_control.rst
- rts/RtsFlags.c
- testsuite/tests/ghc-api/annotations/T10313.stdout
- testsuite/tests/ghc-api/annotations/Test10313.hs
- testsuite/tests/ghc-api/annotations/stringSource.hs
- testsuite/tests/printer/Ppr009.hs
- + testsuite/tests/simplCore/should_run/T17744.hs
- + testsuite/tests/simplCore/should_run/T17744.stdout
- + testsuite/tests/simplCore/should_run/T17744A.hs
- testsuite/tests/simplCore/should_run/all.T
- utils/haddock
Changes:
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -829,14 +829,6 @@ data HsPragE p
SourceText -- Note [Pragma source text] in GHC.Types.Basic
StringLiteral -- "set cost centre" SCC pragma
- -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{-\# CORE'@,
- -- 'GHC.Parser.Annotation.AnnVal', 'GHC.Parser.Annotation.AnnClose' @'\#-}'@
-
- -- For details on above see note [Api annotations] in GHC.Parser.Annotation
- | HsPragCore (XCoreAnn p)
- SourceText -- Note [Pragma source text] in GHC.Types.Basic
- StringLiteral -- hdaume: core annotation
-
-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
-- 'GHC.Parser.Annotation.AnnOpen' @'{-\# GENERATED'@,
-- 'GHC.Parser.Annotation.AnnVal','GHC.Parser.Annotation.AnnVal',
@@ -1399,9 +1391,6 @@ isAtomicHsExpr (XExpr x)
isAtomicHsExpr _ = False
instance Outputable (HsPragE (GhcPass p)) where
- ppr (HsPragCore _ stc (StringLiteral sta s)) =
- pprWithSourceText stc (text "{-# CORE")
- <+> pprWithSourceText sta (doubleQuotes $ ftext s) <+> text "#-}"
ppr (HsPragSCC _ st (StringLiteral stl lbl)) =
pprWithSourceText st (text "{-# SCC")
-- no doublequotes if stl empty, for the case where the SCC was written
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -820,8 +820,6 @@ ds_prag_expr (HsPragSCC _ _ cc) expr = do
Tick (ProfNote (mkUserCC nm mod_name (getLoc expr) flavour) count True)
<$> dsLExpr expr
else dsLExpr expr
-ds_prag_expr (HsPragCore _ _ _) expr
- = dsLExpr expr
ds_prag_expr (HsPragTick _ _ _ _) expr = do
dflags <- getDynFlags
if gopt Opt_Hpc dflags
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -1570,7 +1570,6 @@ repE (HsUnboundVar _ uv) = do
sname <- repNameS occ
repUnboundVar sname
repE (XExpr (HsExpanded _ b)) = repE b
-repE e@(HsPragE _ HsPragCore {} _) = notHandled "Core annotations" (ppr e)
repE e@(HsPragE _ HsPragSCC {} _) = notHandled "Cost centres" (ppr e)
repE e@(HsPragE _ HsPragTick {} _) = notHandled "Tick Pragma" (ppr e)
repE e = notHandled "Expression form" (ppr e)
=====================================
compiler/GHC/Parser.y
=====================================
@@ -521,7 +521,6 @@ are the most common patterns, rewritten as regular expressions for clarity:
'{-# SPECIALISE_INLINE' { L _ (ITspec_inline_prag _ _) }
'{-# SOURCE' { L _ (ITsource_prag _) }
'{-# RULES' { L _ (ITrules_prag _) }
- '{-# CORE' { L _ (ITcore_prag _) } -- hdaume: annotated core
'{-# SCC' { L _ (ITscc_prag _)}
'{-# GENERATED' { L _ (ITgenerated_prag _) }
'{-# DEPRECATED' { L _ (ITdeprecated_prag _) }
@@ -2695,7 +2694,7 @@ optSemi :: { ([Located Token],Bool) }
{- Note [Pragmas and operator fixity]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-'prag_e' is an expression pragma, such as {-# SCC ... #-}, {-# CORE ... #-}, or
+'prag_e' is an expression pragma, such as {-# SCC ... #-} or
{-# GENERATED ... #-}.
It must be used with care, or else #15730 happens. Consider this infix
@@ -2764,11 +2763,6 @@ prag_e :: { Located ([AddAnn], HsPragE GhcPs) }
(getINT $7, getINT $9))
((getINTEGERs $3, getINTEGERs $5),
(getINTEGERs $7, getINTEGERs $9) )) }
- | '{-# CORE' STRING '#-}'
- { sLL $1 $> $
- ([mo $1,mj AnnVal $2,mc $3],
- HsPragCore noExtField (getCORE_PRAGs $1) (getStringLiteral $2)) }
-
fexp :: { ECP }
: fexp aexp { ECP $
superFunArg $
@@ -3915,7 +3909,6 @@ getWARNING_PRAGs (L _ (ITwarning_prag src)) = src
getDEPRECATED_PRAGs (L _ (ITdeprecated_prag src)) = src
getSCC_PRAGs (L _ (ITscc_prag src)) = src
getGENERATED_PRAGs (L _ (ITgenerated_prag src)) = src
-getCORE_PRAGs (L _ (ITcore_prag src)) = src
getUNPACK_PRAGs (L _ (ITunpack_prag src)) = src
getNOUNPACK_PRAGs (L _ (ITnounpack_prag src)) = src
getANN_PRAGs (L _ (ITann_prag src)) = src
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -743,7 +743,6 @@ data Token
| ITcolumn_prag SourceText -- not usually produced, see 'UsePosPragsBit'
| ITscc_prag SourceText
| ITgenerated_prag SourceText
- | ITcore_prag SourceText -- hdaume: core annotations
| ITunpack_prag SourceText
| ITnounpack_prag SourceText
| ITann_prag SourceText
@@ -3230,7 +3229,6 @@ oneWordPrags = Map.fromList [
("deprecated", strtoken (\s -> ITdeprecated_prag (SourceText s))),
("scc", strtoken (\s -> ITscc_prag (SourceText s))),
("generated", strtoken (\s -> ITgenerated_prag (SourceText s))),
- ("core", strtoken (\s -> ITcore_prag (SourceText s))),
("unpack", strtoken (\s -> ITunpack_prag (SourceText s))),
("nounpack", strtoken (\s -> ITnounpack_prag (SourceText s))),
("ann", strtoken (\s -> ITann_prag (SourceText s))),
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -242,7 +242,6 @@ rnExpr (HsPragE x prag expr)
where
rn_prag :: HsPragE GhcPs -> HsPragE GhcRn
rn_prag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann
- rn_prag (HsPragCore x1 src lbl) = HsPragCore x1 src lbl
rn_prag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo
rnExpr (HsLam x matches)
=====================================
compiler/GHC/StgToCmm/CgUtils.hs
=====================================
@@ -121,7 +121,7 @@ regTableOffset dflags n =
get_Regtable_addr_from_offset :: DynFlags -> Int -> CmmExpr
get_Regtable_addr_from_offset dflags offset =
if haveRegBase (targetPlatform dflags)
- then CmmRegOff baseReg offset
+ then cmmRegOff baseReg offset
else regTableOffset dflags offset
-- | Fixup global registers so that they assign to locations within the
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -1091,7 +1091,6 @@ tcExpr other _ = pprPanic "tcLExpr" (ppr other)
tcExprPrag :: HsPragE GhcRn -> HsPragE GhcTc
tcExprPrag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann
-tcExprPrag (HsPragCore x1 src lbl) = HsPragCore x1 src lbl
tcExprPrag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo
=====================================
docs/users_guide/runtime_control.rst
=====================================
@@ -373,10 +373,19 @@ collection. Hopefully, you won't need any of these in normal operation,
but there are several things that can be tweaked for maximum
performance.
+.. rts-flag:: --copying-gc
+ :default: on
+ :since: 8.10.2
+ :reverse: --nonmoving-gc
+
+ Uses the generational copying garbage collector for all generations.
+ This is the default.
+
.. rts-flag:: --nonmoving-gc
:default: off
:since: 8.10.1
+ :reverse: --copying-gc
.. index::
single: concurrent mark and sweep
=====================================
rts/RtsFlags.c
=====================================
@@ -292,6 +292,12 @@ usage_text[] = {
" -? Prints this message and exits; the program is not executed",
" --info Print information about the RTS used by this program",
"",
+" --nonmoving-gc",
+" Selects the non-moving mark-and-sweep garbage collector to",
+" manage the oldest generation.",
+" --copying-gc",
+" Selects the copying garbage collector to manage all generations.",
+"",
" -K<size> Sets the maximum stack size (default: 80% of the heap)",
" Egs: -K32k -K512k -K8M",
" -ki<size> Sets the initial thread stack size (default 1k) Egs: -ki4k -ki2m",
@@ -939,6 +945,11 @@ error = true;
printRtsInfo(rtsConfig);
stg_exit(0);
}
+ else if (strequal("copying-gc",
+ &rts_argv[arg][2])) {
+ OPTION_SAFE;
+ RtsFlags.GcFlags.useNonmoving = false;
+ }
else if (strequal("nonmoving-gc",
&rts_argv[arg][2])) {
OPTION_SAFE;
=====================================
testsuite/tests/ghc-api/annotations/T10313.stdout
=====================================
@@ -10,8 +10,5 @@
([c], [(SourceText "foo\x63", fooc), (SourceText "b\x61r", bar)]),
([r], [(SourceText "foo1\x67", foo1g)]),
([s, t], [(SourceText "a\x62", ab)]),
- ([c, o],
- [(SourceText "Strict Bitstream stre\x61m",
- Strict Bitstream stream)]),
([s, c], [(SourceText "foo\x64", food)]),
([t, p], [(SourceText "foob\x61r", foobar)])]
=====================================
testsuite/tests/ghc-api/annotations/Test10313.hs
=====================================
@@ -28,8 +28,7 @@ foreign import prim unsafe "a\x62" a :: IO Int
{-# INLINE strictStream #-}
strictStream (Bitstream l v)
- = {-# CORE "Strict Bitstream stre\x61m" #-}
- S.concatMap stream (GV.stream v)
+ = S.concatMap stream (GV.stream v)
`S.sized`
Exact l
=====================================
testsuite/tests/ghc-api/annotations/stringSource.hs
=====================================
@@ -84,7 +84,6 @@ testOneFile libdir fileName = do
doHsExpr _ = []
doPragE :: HsPragE GhcPs -> [(String,[Located (SourceText,FastString)])]
- doPragE (HsPragCore _ src ss) = [("co",[conv (noLoc ss)])]
doPragE (HsPragSCC _ src ss) = [("sc",[conv (noLoc ss)])]
doPragE (HsPragTick _ src (ss,_,_) _ss2) = [("tp",[conv (noLoc ss)])]
=====================================
testsuite/tests/printer/Ppr009.hs
=====================================
@@ -3,7 +3,6 @@ module Ppr009 where
{-# INLINE strictStream #-}
strictStream (Bitstream l v)
- = {-# CORE "Strict Bitstream stream" #-}
- S.concatMap stream (GV.stream v)
+ = S.concatMap stream (GV.stream v)
`S.sized`
Exact l
=====================================
testsuite/tests/simplCore/should_run/T17744.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import T17744A
+
+main :: IO ()
+main = print $ completeResults $ feed "f" $ parse uriScheme
+
+uriScheme :: Format (Parser LeftBiasedLocal) Maybe
+uriScheme = satisfy_ mytake
+
+ipV4address :: Format (Parser LeftBiasedLocal) Maybe
+ipV4address = satisfy_ mytake2
=====================================
testsuite/tests/simplCore/should_run/T17744.stdout
=====================================
@@ -0,0 +1 @@
+1
=====================================
testsuite/tests/simplCore/should_run/T17744A.hs
=====================================
@@ -0,0 +1,91 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, UndecidableInstances #-}
+
+module T17744A where
+
+import Control.Applicative
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as ByteString
+
+
+data Parser t r where
+ Failure :: Parser t r
+ Result :: ByteString -> r -> Parser t r
+ Delay :: Parser t r -> (ByteString -> Parser t r) -> Parser t r
+
+instance Functor (Parser t) where
+ fmap f (Result s r) = Result s (f r)
+ fmap f p = apply (fmap f) p
+
+instance Applicative (Parser t) where
+ pure = return
+
+instance Monad (Parser t) where
+ return = Result mempty
+ Result s r >>= f = feed s (f r)
+ p >>= f = apply (>>= f) p
+
+data LeftBiasedLocal
+
+instance Alternative (Parser LeftBiasedLocal)
+
+instance (Alternative (Parser t)) => LookAheadParsing (Parser t)
+
+class Alternative m => Parsing m where
+ unexpected :: m a
+
+instance (Alternative (Parser t)) => Parsing (Parser t) where
+ unexpected = undefined
+
+class Parsing m => LookAheadParsing m
+
+class LookAheadParsing m => InputParsing m where
+ takex :: m ByteString
+
+class (Parsing m, InputParsing m) => InputCharParsing m
+
+feed :: ByteString -> Parser t r -> Parser t r
+feed s (Result s' r) = Result (mappend s' s) r
+feed s (Delay _ f) = f s
+
+completeResults :: Parser t r -> Int
+completeResults (Result _ _) = 1
+completeResults _ = 0
+
+
+apply :: (Parser t r -> Parser t r') -> Parser t r -> Parser t r'
+apply _ Failure = Failure
+apply g (Delay e f) = Delay (g e) (g . f)
+apply f p = Delay (f p) (\s-> f $ feed s p)
+
+
+instance (Alternative (Parser t )) =>
+ InputParsing (Parser t ) where
+ takex = p
+ where p = Delay Failure f
+ f s = if ByteString.null s then p else
+ case ByteString.splitAt 1 s of
+ (first, rest) -> Result rest first
+
+
+instance (LookAheadParsing (Parser t)) => InputCharParsing (Parser t) where
+
+data Format m n = Format {
+ parse :: m ByteString,
+ serialize :: n ()
+ }
+
+mytake :: (InputParsing m, Alternative n) => Format m n
+mytake = Format{
+ parse = takex,
+ serialize = pure ()
+ }
+
+mytake2 :: (InputCharParsing m, Alternative n) => Format m n
+mytake2 = mytake
+
+satisfy_ :: (Parsing m, Monad m) => Format m n -> Format m n
+satisfy_ f = Format{
+ parse = parse f >>= pure,
+ serialize = undefined
+ }
+
=====================================
testsuite/tests/simplCore/should_run/all.T
=====================================
@@ -91,3 +91,4 @@ test('T16066', exit_code(1), compile_and_run, ['-O1'])
test('T17206', exit_code(1), compile_and_run, [''])
test('T17151', [], multimod_compile_and_run, ['T17151', ''])
test('T18012', normal, compile_and_run, [''])
+test('T17744', normal, compile_and_run, [''])
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit 075067254fc30ef56bad67ac65dd3c5f4101f8fa
+Subproject commit 22b42eab6ec6b3b321b6d54041b7b3a6e54af3c9
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed714af2a35797b6fbbfa7948ee5862184063013...f02edd8079113c1ea7af47d5585f0d5f9fed599b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed714af2a35797b6fbbfa7948ee5862184063013...f02edd8079113c1ea7af47d5585f0d5f9fed599b
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/20200716/ccb438e1/attachment-0001.html>
More information about the ghc-commits
mailing list