Commit 6d14c148 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by David Feuer

Improve code generation for conditionals

This patch in in preparation for the fix to Trac #13397

The code generator has a special case for
  case tagToEnum (a>#b) of
    False -> e1
    True  -> e2

but it was not doing nearly so well on
  case a>#b of
    DEFAULT -> e1
    1#      -> e2

This patch arranges to behave essentially identically in
both cases.  In due course we can eliminate the special
case for tagToEnum#, once we've completed Trac #13397.

The changes are:

* Make CmmSink swizzle the order of a conditional where necessary;
  see Note [Improving conditionals] in CmmSink

* Hack the general case of StgCmmExpr.cgCase so that it use
  NoGcInAlts for conditionals.  This doesn't seem right, but it's
  the same choice as the tagToEnum version. Without it, code size
  increases a lot (more heap checks).

  There's a loose end here.

* Add comments in CmmOpt.cmmMachOpFoldM
parent 193664d4
...@@ -284,48 +284,68 @@ cmmMachOpFoldM dflags cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)] ...@@ -284,48 +284,68 @@ cmmMachOpFoldM dflags cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)]
maybe_comparison _ _ _ = Nothing maybe_comparison _ _ _ = Nothing
-- We can often do something with constants of 0 and 1 ... -- We can often do something with constants of 0 and 1 ...
-- See Note [Comparison operators]
cmmMachOpFoldM dflags mop [x, y@(CmmLit (CmmInt 0 _))] cmmMachOpFoldM dflags mop [x, y@(CmmLit (CmmInt 0 _))]
= case mop of = case mop of
MO_Add _ -> Just x -- Arithmetic
MO_Sub _ -> Just x MO_Add _ -> Just x -- x + 0 = x
MO_Mul _ -> Just y MO_Sub _ -> Just x -- x - 0 = x
MO_And _ -> Just y MO_Mul _ -> Just y -- x * 0 = 0
MO_Or _ -> Just x
MO_Xor _ -> Just x -- Logical operations
MO_Shl _ -> Just x MO_And _ -> Just y -- x & 0 = 0
MO_S_Shr _ -> Just x MO_Or _ -> Just x -- x | 0 = x
MO_Xor _ -> Just x -- x `xor` 0 = x
-- Shifts
MO_Shl _ -> Just x -- x << 0 = x
MO_S_Shr _ -> Just x -- ditto shift-right
MO_U_Shr _ -> Just x MO_U_Shr _ -> Just x
MO_Ne _ | isComparisonExpr x -> Just x
MO_Eq _ | Just x' <- maybeInvertCmmExpr x -> Just x' -- Comparisons; these ones are trickier
MO_U_Gt _ | isComparisonExpr x -> Just x -- See Note [Comparison operators]
MO_S_Gt _ | isComparisonExpr x -> Just x MO_Ne _ | isComparisonExpr x -> Just x -- (x > y) != 0 = x > y
MO_U_Lt _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 (wordWidth dflags)) MO_Eq _ | Just x' <- maybeInvertCmmExpr x -> Just x' -- (x > y) == 0 = x <= y
MO_S_Lt _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 (wordWidth dflags)) MO_U_Gt _ | isComparisonExpr x -> Just x -- (x > y) > 0 = x > y
MO_U_Ge _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 (wordWidth dflags)) MO_S_Gt _ | isComparisonExpr x -> Just x -- ditto
MO_S_Ge _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 (wordWidth dflags)) MO_U_Lt _ | isComparisonExpr x -> Just zero -- (x > y) < 0 = 0
MO_U_Le _ | Just x' <- maybeInvertCmmExpr x -> Just x' MO_S_Lt _ | isComparisonExpr x -> Just zero
MO_U_Ge _ | isComparisonExpr x -> Just one -- (x > y) >= 0 = 1
MO_S_Ge _ | isComparisonExpr x -> Just one
MO_U_Le _ | Just x' <- maybeInvertCmmExpr x -> Just x' -- (x > y) <= 0 = x <= y
MO_S_Le _ | Just x' <- maybeInvertCmmExpr x -> Just x' MO_S_Le _ | Just x' <- maybeInvertCmmExpr x -> Just x'
_ -> Nothing _ -> Nothing
where
zero = CmmLit (CmmInt 0 (wordWidth dflags))
one = CmmLit (CmmInt 1 (wordWidth dflags))
cmmMachOpFoldM dflags mop [x, (CmmLit (CmmInt 1 rep))] cmmMachOpFoldM dflags mop [x, (CmmLit (CmmInt 1 rep))]
= case mop of = case mop of
-- Arithmetic: x*1 = x, etc
MO_Mul _ -> Just x MO_Mul _ -> Just x
MO_S_Quot _ -> Just x MO_S_Quot _ -> Just x
MO_U_Quot _ -> Just x MO_U_Quot _ -> Just x
MO_S_Rem _ -> Just $ CmmLit (CmmInt 0 rep) MO_S_Rem _ -> Just $ CmmLit (CmmInt 0 rep)
MO_U_Rem _ -> Just $ CmmLit (CmmInt 0 rep) MO_U_Rem _ -> Just $ CmmLit (CmmInt 0 rep)
MO_Ne _ | Just x' <- maybeInvertCmmExpr x -> Just x'
MO_Eq _ | isComparisonExpr x -> Just x -- Comparisons; trickier
MO_U_Lt _ | Just x' <- maybeInvertCmmExpr x -> Just x' -- See Note [Comparison operators]
MO_S_Lt _ | Just x' <- maybeInvertCmmExpr x -> Just x' MO_Ne _ | Just x' <- maybeInvertCmmExpr x -> Just x' -- (x>y) != 1 = x<=y
MO_U_Gt _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 (wordWidth dflags)) MO_Eq _ | isComparisonExpr x -> Just x -- (x>y) == 1 = x>y
MO_S_Gt _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 (wordWidth dflags)) MO_U_Lt _ | Just x' <- maybeInvertCmmExpr x -> Just x' -- (x>y) < 1 = x<=y
MO_U_Le _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 (wordWidth dflags)) MO_S_Lt _ | Just x' <- maybeInvertCmmExpr x -> Just x' -- ditto
MO_S_Le _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 (wordWidth dflags)) MO_U_Gt _ | isComparisonExpr x -> Just zero -- (x>y) > 1 = 0
MO_U_Ge _ | isComparisonExpr x -> Just x MO_S_Gt _ | isComparisonExpr x -> Just zero
MO_U_Le _ | isComparisonExpr x -> Just one -- (x>y) <= 1 = 1
MO_S_Le _ | isComparisonExpr x -> Just one
MO_U_Ge _ | isComparisonExpr x -> Just x -- (x>y) >= 1 = x>y
MO_S_Ge _ | isComparisonExpr x -> Just x MO_S_Ge _ | isComparisonExpr x -> Just x
_ -> Nothing _ -> Nothing
where
zero = CmmLit (CmmInt 0 (wordWidth dflags))
one = CmmLit (CmmInt 1 (wordWidth dflags))
-- Now look for multiplication/division by powers of 2 (integers). -- Now look for multiplication/division by powers of 2 (integers).
...@@ -376,6 +396,17 @@ cmmMachOpFoldM dflags mop [x, (CmmLit (CmmInt n _))] ...@@ -376,6 +396,17 @@ cmmMachOpFoldM dflags mop [x, (CmmLit (CmmInt n _))]
cmmMachOpFoldM _ _ _ = Nothing cmmMachOpFoldM _ _ _ = Nothing
{- Note [Comparison operators]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we have
CmmCondBranch ((x>#y) == 1) t f
we really want to convert to
CmmCondBranch (x>#y) t f
That's what the constant-folding operations on comparison operators do above.
-}
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Utils -- Utils
......
...@@ -378,6 +378,8 @@ dropAssignments dflags should_drop state assigs ...@@ -378,6 +378,8 @@ dropAssignments dflags should_drop state assigs
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Try to inline assignments into a node. -- Try to inline assignments into a node.
-- This also does constant folding for primpops, since
-- inlining opens up opportunities for doing so.
tryToInline tryToInline
:: DynFlags :: DynFlags
...@@ -432,14 +434,39 @@ tryToInline dflags live node assigs = go usages node [] assigs ...@@ -432,14 +434,39 @@ tryToInline dflags live node assigs = go usages node [] assigs
occurs_once = not l_live && l_usages == Just 1 occurs_once = not l_live && l_usages == Just 1
occurs_none = not l_live && l_usages == Nothing occurs_none = not l_live && l_usages == Nothing
inl_node = mapExpDeep inline node inl_node = case mapExpDeep inl_exp node of
-- mapExpDeep is where the inlining actually takes place! -- See Note [Improving conditionals]
where inline (CmmReg (CmmLocal l')) | l == l' = rhs CmmCondBranch (CmmMachOp (MO_Ne w) args)
inline (CmmRegOff (CmmLocal l') off) | l == l' ti fi l
-> CmmCondBranch (cmmMachOpFold dflags (MO_Eq w) args)
fi ti l
node' -> node'
inl_exp :: CmmExpr -> CmmExpr
-- inl_exp is where the inlining actually takes place!
inl_exp (CmmReg (CmmLocal l')) | l == l' = rhs
inl_exp (CmmRegOff (CmmLocal l') off) | l == l'
= cmmOffset dflags rhs off = cmmOffset dflags rhs off
-- re-constant fold after inlining -- re-constant fold after inlining
inline (CmmMachOp op args) = cmmMachOpFold dflags op args inl_exp (CmmMachOp op args) = cmmMachOpFold dflags op args
inline other = other inl_exp other = other
{- Note [Improving conditionals]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Given
CmmCondBranch ((a >## b) != 1) t f
where a,b, are Floats, the constant folder /cannot/ turn it into
CmmCondBranch (a <=## b) t f
because comparison on floats are not invertible
(see CmmMachOp.maybeInvertComparison).
What we want instead is simply to reverse the true/false branches thus
CmmCondBranch ((a >## b) != 1) t f
-->
CmmCondBranch (a >## b) f t
And we do that right here in tryToInline, just as we do cmmMachOpFold.
-}
-- Note [dependent assignments] -- Note [dependent assignments]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
...@@ -405,7 +405,7 @@ isLFReEntrant _ = False ...@@ -405,7 +405,7 @@ isLFReEntrant _ = False
lfClosureType :: LambdaFormInfo -> ClosureTypeInfo lfClosureType :: LambdaFormInfo -> ClosureTypeInfo
lfClosureType (LFReEntrant _ _ arity _ argd) = Fun arity argd lfClosureType (LFReEntrant _ _ arity _ argd) = Fun arity argd
lfClosureType (LFCon con) = Constr (dataConTagZ con) lfClosureType (LFCon con) = Constr (dataConTagZ con)
(dataConIdentity con) (dataConIdentity con)
lfClosureType (LFThunk _ _ _ is_sel _) = thunkClosureType is_sel lfClosureType (LFThunk _ _ _ is_sel _) = thunkClosureType is_sel
lfClosureType _ = panic "lfClosureType" lfClosureType _ = panic "lfClosureType"
......
...@@ -304,6 +304,7 @@ cgCase (StgOpApp (StgPrimOp op) args _) bndr (AlgAlt tycon) alts ...@@ -304,6 +304,7 @@ cgCase (StgOpApp (StgPrimOp op) args _) bndr (AlgAlt tycon) alts
; (mb_deflt, branches) <- cgAlgAltRhss (NoGcInAlts,AssignedDirectly) ; (mb_deflt, branches) <- cgAlgAltRhss (NoGcInAlts,AssignedDirectly)
(NonVoid bndr) alts (NonVoid bndr) alts
-- See Note [GC for conditionals]
; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1) ; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1)
; return AssignedDirectly ; return AssignedDirectly
} }
...@@ -469,7 +470,8 @@ cgCase scrut bndr alt_type alts ...@@ -469,7 +470,8 @@ cgCase scrut bndr alt_type alts
; let ret_bndrs = chooseReturnBndrs bndr alt_type alts ; let ret_bndrs = chooseReturnBndrs bndr alt_type alts
alt_regs = map (idToReg dflags) ret_bndrs alt_regs = map (idToReg dflags) ret_bndrs
; simple_scrut <- isSimpleScrut scrut alt_type ; simple_scrut <- isSimpleScrut scrut alt_type
; let do_gc | not simple_scrut = True ; let do_gc | is_cmp_op scrut = False -- See Note [GC for conditionals]
| not simple_scrut = True
| isSingleton alts = False | isSingleton alts = False
| up_hp_usg > 0 = False | up_hp_usg > 0 = False
| otherwise = True | otherwise = True
...@@ -484,11 +486,29 @@ cgCase scrut bndr alt_type alts ...@@ -484,11 +486,29 @@ cgCase scrut bndr alt_type alts
; _ <- bindArgsToRegs ret_bndrs ; _ <- bindArgsToRegs ret_bndrs
; cgAlts (gc_plan,ret_kind) (NonVoid bndr) alt_type alts ; cgAlts (gc_plan,ret_kind) (NonVoid bndr) alt_type alts
} }
where
is_cmp_op (StgOpApp (StgPrimOp op) _ _) = isComparisonPrimOp op
is_cmp_op _ = False
{- Note [GC for conditionals]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For boolean conditionals it seems that we have always done NoGcInAlts.
That is, we have always done the GC check before the conditional.
This is enshrined in the special case for
case tagToEnum# (a>b) of ...
See Note [case on bool]
It's odd, and it's flagrantly inconsistent with the rules described
Note [Compiling case expressions]. However, after eliminating the
tagToEnum# (Trac #13397) we will have:
case (a>b) of ...
Rather than make it behave quite differently, I am testing for a
comparison operator here in in the general case as well.
ToDo: figure out what the Right Rule should be.
{-
Note [scrut sequel] Note [scrut sequel]
~~~~~~~~~~~~~~~~~~~
The job of the scrutinee is to assign its value(s) to alt_regs. The job of the scrutinee is to assign its value(s) to alt_regs.
Additionally, if we plan to do a heap-check in the alternatives (see Additionally, if we plan to do a heap-check in the alternatives (see
Note [Compiling case expressions]), then we *must* retreat Hp to Note [Compiling case expressions]), then we *must* retreat Hp to
......
...@@ -22,7 +22,7 @@ module PrimOp ( ...@@ -22,7 +22,7 @@ module PrimOp (
primOpOkForSpeculation, primOpOkForSideEffects, primOpOkForSpeculation, primOpOkForSideEffects,
primOpIsCheap, primOpFixity, primOpIsCheap, primOpFixity,
getPrimOpResultInfo, PrimOpResultInfo(..), getPrimOpResultInfo, isComparisonPrimOp, PrimOpResultInfo(..),
PrimCall(..) PrimCall(..)
) where ) where
...@@ -552,6 +552,11 @@ primOpOcc op = case primOpInfo op of ...@@ -552,6 +552,11 @@ primOpOcc op = case primOpInfo op of
Compare occ _ -> occ Compare occ _ -> occ
GenPrimOp occ _ _ _ -> occ GenPrimOp occ _ _ _ -> occ
isComparisonPrimOp :: PrimOp -> Bool
isComparisonPrimOp op = case primOpInfo op of
Compare {} -> True
_ -> False
-- primOpSig is like primOpType but gives the result split apart: -- primOpSig is like primOpType but gives the result split apart:
-- (type variables, argument types, result type) -- (type variables, argument types, result type)
-- It also gives arity, strictness info -- It also gives arity, strictness info
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment