summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndreas Klebinger <klebinger.andreas@gmx.at>2020-12-01 13:01:00 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-12-08 22:43:21 -0500
commit59f2249b4f4f3b1a5f2d0bc1b2923e0652b7de8f (patch)
tree023b7ca6fc4e5699f23041f2dc4b9bce0fb9dd3e
parentaef44d7fbef92159960daf73c53dbc3c8d21ecbf (diff)
downloadhaskell-59f2249b4f4f3b1a5f2d0bc1b2923e0652b7de8f.tar.gz
GHC.Cmm.Opt: Be stricter in results.
Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with.
-rw-r--r--compiler/GHC/Cmm/Opt.hs102
1 files changed, 51 insertions, 51 deletions
diff --git a/compiler/GHC/Cmm/Opt.hs b/compiler/GHC/Cmm/Opt.hs
index fc75e1901e..d9e7c4885a 100644
--- a/compiler/GHC/Cmm/Opt.hs
+++ b/compiler/GHC/Cmm/Opt.hs
@@ -58,7 +58,7 @@ cmmMachOpFoldM
-> Maybe CmmExpr
cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)]
- = Just $ case op of
+ = Just $! case op of
MO_S_Neg _ -> CmmLit (CmmInt (-x) rep)
MO_Not _ -> CmmLit (CmmInt (complement x) rep)
@@ -90,13 +90,13 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]]
-- but remember to use the signedness from the widening, just in case
-- the final conversion is a widen.
| rep1 < rep2 && rep2 > rep3 ->
- Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x]
+ Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x]
-- Nested widenings: collapse if the signedness is the same
| rep1 < rep2 && rep2 < rep3 && signed1 == signed2 ->
- Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x]
+ Just $! cmmMachOpFold platform (intconv signed1 rep1 rep3) [x]
-- Nested narrowings: collapse
| rep1 > rep2 && rep2 > rep3 ->
- Just $ cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x]
+ Just $! cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x]
| otherwise ->
Nothing
where
@@ -117,34 +117,34 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
= case mop of
-- for comparisons: don't forget to narrow the arguments before
-- comparing, since they might be out of range.
- MO_Eq _ -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform))
- MO_Ne _ -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform))
-
- MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform))
- MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform))
- MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform))
- MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform))
-
- MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform))
- MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform))
- MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform))
- MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform))
-
- MO_Add r -> Just $ CmmLit (CmmInt (x + y) r)
- MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r)
- MO_Mul r -> Just $ CmmLit (CmmInt (x * y) r)
- MO_U_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `quot` y_u) r)
- MO_U_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `rem` y_u) r)
- MO_S_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x `quot` y) r)
- MO_S_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x `rem` y) r)
-
- MO_And r -> Just $ CmmLit (CmmInt (x .&. y) r)
- MO_Or r -> Just $ CmmLit (CmmInt (x .|. y) r)
- MO_Xor r -> Just $ CmmLit (CmmInt (x `xor` y) r)
-
- MO_Shl r -> Just $ CmmLit (CmmInt (x `shiftL` fromIntegral y) r)
- MO_U_Shr r -> Just $ CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)
- MO_S_Shr r -> Just $ CmmLit (CmmInt (x `shiftR` fromIntegral y) r)
+ MO_Eq _ -> Just $! CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth platform))
+ MO_Ne _ -> Just $! CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth platform))
+
+ MO_U_Gt _ -> Just $! CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth platform))
+ MO_U_Ge _ -> Just $! CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth platform))
+ MO_U_Lt _ -> Just $! CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth platform))
+ MO_U_Le _ -> Just $! CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth platform))
+
+ MO_S_Gt _ -> Just $! CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth platform))
+ MO_S_Ge _ -> Just $! CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth platform))
+ MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform))
+ MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform))
+
+ MO_Add r -> Just $! CmmLit (CmmInt (x + y) r)
+ MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r)
+ MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r)
+ MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r)
+ MO_U_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem` y_u) r)
+ MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x `quot` y) r)
+ MO_S_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x `rem` y) r)
+
+ MO_And r -> Just $! CmmLit (CmmInt (x .&. y) r)
+ MO_Or r -> Just $! CmmLit (CmmInt (x .|. y) r)
+ MO_Xor r -> Just $! CmmLit (CmmInt (x `xor` y) r)
+
+ MO_Shl r -> Just $! CmmLit (CmmInt (x `shiftL` fromIntegral y) r)
+ MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)
+ MO_S_Shr r -> Just $! CmmLit (CmmInt (x `shiftR` fromIntegral y) r)
_ -> Nothing
@@ -162,7 +162,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
cmmMachOpFoldM platform op [x@(CmmLit _), y]
| not (isLit y) && isCommutableMachOp op
- = Just (cmmMachOpFold platform op [y, x])
+ = Just $! (cmmMachOpFold platform op [y, x])
-- Turn (a+b)+c into a+(b+c) where possible. Because literals are
-- moved to the right, it is more likely that we will find
@@ -183,7 +183,7 @@ cmmMachOpFoldM platform op [x@(CmmLit _), y]
cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
| mop2 `associates_with` mop1
&& not (isLit arg1) && not (isPicReg arg1)
- = Just (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]])
+ = Just $! (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]])
where
MO_Add{} `associates_with` MO_Sub{} = True
mop1 `associates_with` mop2 =
@@ -192,7 +192,7 @@ cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
-- special case: (a - b) + c ==> a + (c - b)
cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3]
| not (isLit arg1) && not (isPicReg arg1)
- = Just (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]])
+ = Just $! (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]])
-- special case: (PicBaseReg + lit) + N ==> PicBaseReg + (lit+N)
--
@@ -205,27 +205,27 @@ cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2],
cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op@MO_Add{} [pic, CmmLit lit]
, CmmLit (CmmInt n rep) ]
| isPicReg pic
- = Just $ CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ]
+ = Just $! CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ]
where off = fromIntegral (narrowS rep n)
-- Make a RegOff if we can
cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
- = Just $ cmmRegOff reg (fromIntegral (narrowS rep n))
+ = Just $! cmmRegOff reg (fromIntegral (narrowS rep n))
cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
- = Just $ cmmRegOff reg (off + fromIntegral (narrowS rep n))
+ = Just $! cmmRegOff reg (off + fromIntegral (narrowS rep n))
cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)]
- = Just $ cmmRegOff reg (- fromIntegral (narrowS rep n))
+ = Just $! cmmRegOff reg (- fromIntegral (narrowS rep n))
cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
- = Just $ cmmRegOff reg (off - fromIntegral (narrowS rep n))
+ = Just $! cmmRegOff reg (off - fromIntegral (narrowS rep n))
-- Fold label(+/-)offset into a CmmLit where possible
cmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)]
- = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i)))
+ = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i)))
cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit]
- = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i)))
+ = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i)))
cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)]
- = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i))))
+ = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i))))
-- Comparison of literal with widened operand: perform the comparison
@@ -245,7 +245,7 @@ cmmMachOpFoldM platform cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)]
-- and the literal fits in the smaller size:
i == narrow_fn rep i
-- then we can do the comparison at the smaller size
- = Just (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)])
+ = Just $! (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)])
where
maybe_conversion (MO_UU_Conv from to)
| to > from
@@ -320,8 +320,8 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt 1 rep))]
MO_Mul _ -> Just x
MO_S_Quot _ -> Just x
MO_U_Quot _ -> Just x
- MO_S_Rem _ -> Just $ CmmLit (CmmInt 0 rep)
- MO_U_Rem _ -> Just $ CmmLit (CmmInt 0 rep)
+ MO_S_Rem _ -> Just $! CmmLit (CmmInt 0 rep)
+ MO_U_Rem _ -> Just $! CmmLit (CmmInt 0 rep)
-- Comparisons; trickier
-- See Note [Comparison operators]
@@ -346,18 +346,18 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))]
= case mop of
MO_Mul rep
| Just p <- exactLog2 n ->
- Just (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)])
+ Just $! (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)])
MO_U_Quot rep
| Just p <- exactLog2 n ->
- Just (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)])
+ Just $! (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)])
MO_U_Rem rep
| Just _ <- exactLog2 n ->
- Just (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)])
+ Just $! (cmmMachOpFold platform (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)])
MO_S_Quot rep
| Just p <- exactLog2 n,
CmmReg _ <- x -> -- We duplicate x in signedQuotRemHelper, hence require
-- it is a reg. FIXME: remove this restriction.
- Just (cmmMachOpFold platform (MO_S_Shr rep)
+ Just $! (cmmMachOpFold platform (MO_S_Shr rep)
[signedQuotRemHelper rep p, CmmLit (CmmInt p rep)])
MO_S_Rem rep
| Just p <- exactLog2 n,
@@ -366,7 +366,7 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))]
-- We replace (x `rem` 2^p) by (x - (x `quot` 2^p) * 2^p).
-- Moreover, we fuse MO_S_Shr (last operation of MO_S_Quot)
-- and MO_S_Shl (multiplication by 2^p) into a single MO_And operation.
- Just (cmmMachOpFold platform (MO_Sub rep)
+ Just $! (cmmMachOpFold platform (MO_Sub rep)
[x, cmmMachOpFold platform (MO_And rep)
[signedQuotRemHelper rep p, CmmLit (CmmInt (- n) rep)]])
_ -> Nothing