diff options
| author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2020-08-21 00:39:20 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-08-24 00:32:31 -0400 |
| commit | 364258e0ad25bc95e69745554f5ca831ce80baf8 (patch) | |
| tree | 98a2acff606fdc2fe644b2a6302f1b0f7aac0bc0 /compiler | |
| parent | d8f61182c3bdd1b6121c83be632b4941b907de88 (diff) | |
| download | haskell-364258e0ad25bc95e69745554f5ca831ce80baf8.tar.gz | |
Fix types in silly shifts (#18589)
Patch written by Simon. I have only added a testcase.
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Core/Opt/ConstantFold.hs | 22 |
1 files changed, 13 insertions, 9 deletions
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index 94d469a515..8c44a5d72d 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/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) |