[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Fix types in silly shifts (#18589)
Marge Bot
gitlab at gitlab.haskell.org
Mon Aug 24 05:34:18 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
364258e0 by Krzysztof Gogolewski at 2020-08-24T00:32:31-04:00
Fix types in silly shifts (#18589)
Patch written by Simon. I have only added a testcase.
- - - - -
b1eb38a0 by Sylvain Henry at 2020-08-24T00:33:13-04:00
Perf: make SDoc monad one-shot (#18202)
With validate-x86_64-linux-deb9-hadrian:
T1969 -3.4% (threshold: +/-1%)
T3294 -3.3% (threshold: +/-1%)
T12707 -1.4% (threshold: +/-1%)
Additionally with validate-x86_64-linux-deb9-unreg-hadrian:
T4801 -2.4% (threshold: +/-2%)
T13035 -1.4% (threshold: +/-1%)
T13379 -2.4% (threshold: +/-2%)
ManyAlternatives -2.5% (threshold: +/-2%)
ManyConstructors -3.0% (threshold: +/-2%)
Metric Decrease:
T12707
T1969
T3294
ManyAlternatives
ManyConstructors
T13035
T13379
T4801
- - - - -
71b2eacb by Krzysztof Gogolewski at 2020-08-24T01:34:09-04:00
Add a test for #18397
The bug was fixed by !3421.
- - - - -
fe9ab297 by Sylvain Henry at 2020-08-24T01:34:11-04:00
Avoid roundtrip through SDoc
As found by @monoidal on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3885#note_295126
- - - - -
7 changed files:
- compiler/GHC/CmmToAsm/Dwarf.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Utils/Outputable.hs
- + testsuite/tests/codeGen/should_compile/T18397.hs
- testsuite/tests/codeGen/should_compile/all.T
- + testsuite/tests/simplCore/should_compile/T18589.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/CmmToAsm/Dwarf.hs
=====================================
@@ -179,9 +179,7 @@ procToDwarf config prc
= DwarfSubprogram { dwChildren = map blockToDwarf (dblBlocks prc)
, dwName = case dblSourceTick prc of
Just s at SourceNote{} -> sourceName s
- _otherwise -> renderWithContext defaultSDocContext
- $ withPprStyle defaultDumpStyle
- $ ppr (dblLabel prc)
+ _otherwise -> show (dblLabel prc)
, dwLabel = dblCLabel prc
, dwParent = fmap mkAsmTempDieLabel
$ mfilter goodParent
=====================================
compiler/GHC/Core/Opt/ConstantFold.hs
=====================================
@@ -143,11 +143,11 @@ primOpRules nm = \case
, inversePrimOp NotIOp ]
IntNegOp -> mkPrimOpRule nm 1 [ unaryLit negOp
, inversePrimOp IntNegOp ]
- ISllOp -> mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL)
+ ISllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumInt (const Bits.shiftL)
, rightIdentityPlatform zeroi ]
- ISraOp -> mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftR)
+ ISraOp -> mkPrimOpRule nm 2 [ shiftRule LitNumInt (const Bits.shiftR)
, rightIdentityPlatform zeroi ]
- ISrlOp -> mkPrimOpRule nm 2 [ shiftRule shiftRightLogical
+ ISrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumInt shiftRightLogical
, rightIdentityPlatform zeroi ]
-- Word operations
@@ -189,8 +189,8 @@ primOpRules nm = \case
, equalArgs >> retLit zerow ]
NotOp -> mkPrimOpRule nm 1 [ unaryLit complementOp
, inversePrimOp NotOp ]
- SllOp -> mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) ]
- SrlOp -> mkPrimOpRule nm 2 [ shiftRule shiftRightLogical ]
+ SllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord (const Bits.shiftL) ]
+ SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord shiftRightLogical ]
-- coercions
Word2IntOp -> mkPrimOpRule nm 1 [ liftLitPlatform word2IntLit
@@ -477,12 +477,14 @@ wordOpC2 op env (LitNumber LitNumWord w1) (LitNumber LitNumWord w2) =
wordCResult (roPlatform env) (fromInteger w1 `op` fromInteger w2)
wordOpC2 _ _ _ _ = Nothing
-shiftRule :: (Platform -> Integer -> Int -> Integer) -> RuleM CoreExpr
+shiftRule :: LitNumType -- Type of the result, either LitNumInt or LitNumWord
+ -> (Platform -> Integer -> Int -> Integer)
+ -> RuleM CoreExpr
-- Shifts take an Int; hence third arg of op is Int
-- Used for shift primops
--- ISllOp, ISraOp, ISrlOp :: Word# -> Int# -> Word#
+-- ISllOp, ISraOp, ISrlOp :: Int# -> Int# -> Int#
-- SllOp, SrlOp :: Word# -> Int# -> Word#
-shiftRule shift_op
+shiftRule lit_num_ty shift_op
= do { platform <- getPlatform
; [e1, Lit (LitNumber LitNumInt shift_len)] <- getArgs
; case e1 of
@@ -490,7 +492,9 @@ shiftRule shift_op
-> return e1
-- See Note [Guarding against silly shifts]
| shift_len < 0 || shift_len > toInteger (platformWordSizeInBits platform)
- -> return $ Lit $ mkLitNumberWrap platform LitNumInt 0
+ -> return $ Lit $ mkLitNumberWrap platform lit_num_ty 0
+ -- Be sure to use lit_num_ty here, so we get a correctly typed zero
+ -- of type Int# or Word# resp. See #18589
-- Do the shift at type Integer, but shift length is Int
Lit (LitNumber nt x)
=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PatternSynonyms #-}
{-
(c) The University of Glasgow 2006-2012
@@ -121,6 +122,7 @@ import qualified Data.List.NonEmpty as NEL
import GHC.Fingerprint
import GHC.Show ( showMultiLineString )
import GHC.Utils.Exception
+import GHC.Exts (oneShot)
{-
************************************************************************
@@ -304,7 +306,17 @@ code (either C or assembly), or generating interface files.
-- To display an 'SDoc', use 'printSDoc', 'printSDocLn', 'bufLeftRenderSDoc',
-- or 'renderWithContext'. Avoid calling 'runSDoc' directly as it breaks the
-- abstraction layer.
-newtype SDoc = SDoc { runSDoc :: SDocContext -> Doc }
+newtype SDoc = SDoc' (SDocContext -> Doc)
+
+-- See Note [The one-shot state monad trick] in GHC.Utils.Monad
+{-# COMPLETE SDoc #-}
+pattern SDoc :: (SDocContext -> Doc) -> SDoc
+pattern SDoc m <- SDoc' m
+ where
+ SDoc m = SDoc' (oneShot m)
+
+runSDoc :: SDoc -> (SDocContext -> Doc)
+runSDoc (SDoc m) = m
data SDocContext = SDC
{ sdocStyle :: !PprStyle
=====================================
testsuite/tests/codeGen/should_compile/T18397.hs
=====================================
@@ -0,0 +1,20 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE UnboxedTuples #-}
+module T18397 where
+
+import GHC.Exts
+import GHC.ST
+
+data MutableArray s a = MutableArray (MutableArray# s a)
+
+runArray#
+ :: (forall s. ST s (MutableArray s a))
+ -> Array# a
+runArray# m = case runRW# $ \s ->
+ case unST m s of { (# s', MutableArray mary# #) ->
+ unsafeFreezeArray# mary# s'} of (# _, ary# #) -> ary#
+
+unST :: ST s a -> State# s -> (# State# s, a #)
+unST (ST f) = f
+
=====================================
testsuite/tests/codeGen/should_compile/all.T
=====================================
@@ -91,7 +91,11 @@ test('T17648', normal, makefile_test, [])
test('T17904', normal, compile, ['-O'])
test('T18227A', normal, compile, [''])
test('T18227B', normal, compile, [''])
+
+# runRW#-related
test('T18291', normal, compile, ['-O0'])
+test('T18397', normal, compile, ['-O0'])
+
test('T15570',
when(unregisterised(), skip),
compile, ['-Wno-overflowed-literals'])
=====================================
testsuite/tests/simplCore/should_compile/T18589.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE MagicHash #-}
+module T18589 where
+
+import GHC.Prim
+
+-- See Note [Guarding against silly shifts]
+-- Make sure that a silly shift is optimized correctly
+f1 x = uncheckedIShiftL# x -1#
+f2 x = uncheckedIShiftRA# x -1#
+f3 x = uncheckedIShiftRL# x -1#
+f4 x = uncheckedShiftL# x -1#
+f5 x = uncheckedShiftRL# x -1#
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -332,3 +332,4 @@ test('T18328', [ only_ways(['optasm']), grep_errmsg(r'Arity=') ], compile, ['-dd
test('T18347', normal, compile, ['-dcore-lint -O'])
test('T18355', [ grep_errmsg(r'OneShot') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
test('T18399', normal, compile, ['-dcore-lint -O'])
+test('T18589', normal, compile, ['-dcore-lint -O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eecaa756bb60f151a94a633d20c99993f5e7595a...fe9ab297d215d12fc467786e538ac1cd89c4a8a1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eecaa756bb60f151a94a633d20c99993f5e7595a...fe9ab297d215d12fc467786e538ac1cd89c4a8a1
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/20200824/31a574de/attachment-0001.html>
More information about the ghc-commits
mailing list