-- The default iteration limit is a bit too low for the definitions
-- in this module.
{-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-}

-----------------------------------------------------------------------------
--
-- Cmm optimisation
--
-- (c) The University of Glasgow 2006
--
-----------------------------------------------------------------------------

module CmmOpt (
        constantFoldNode,
        constantFoldExpr,
        cmmMachOpFold,
        cmmMachOpFoldM
 ) where

import GhcPrelude

import CmmUtils
import Cmm
import DynFlags
import Util

import Outputable
import Platform

import Data.Bits
import Data.Maybe


constantFoldNode :: DynFlags -> CmmNode e x -> CmmNode e x
constantFoldNode :: DynFlags -> CmmNode e x -> CmmNode e x
constantFoldNode dflags :: DynFlags
dflags = (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
forall e x. (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
mapExp (DynFlags -> CmmExpr -> CmmExpr
constantFoldExpr DynFlags
dflags)

constantFoldExpr :: DynFlags -> CmmExpr -> CmmExpr
constantFoldExpr :: DynFlags -> CmmExpr -> CmmExpr
constantFoldExpr dflags :: DynFlags
dflags = (CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
wrapRecExp CmmExpr -> CmmExpr
f
  where f :: CmmExpr -> CmmExpr
f (CmmMachOp op :: MachOp
op args :: [CmmExpr]
args) = DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags MachOp
op [CmmExpr]
args
        f (CmmRegOff r :: CmmReg
r 0) = CmmReg -> CmmExpr
CmmReg CmmReg
r
        f e :: CmmExpr
e = CmmExpr
e

-- -----------------------------------------------------------------------------
-- MachOp constant folder

-- Now, try to constant-fold the MachOps.  The arguments have already
-- been optimized and folded.

cmmMachOpFold
    :: DynFlags
    -> MachOp       -- The operation from an CmmMachOp
    -> [CmmExpr]    -- The optimized arguments
    -> CmmExpr

cmmMachOpFold :: DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold dflags :: DynFlags
dflags op :: MachOp
op args :: [CmmExpr]
args = CmmExpr -> Maybe CmmExpr -> CmmExpr
forall a. a -> Maybe a -> a
fromMaybe (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
op [CmmExpr]
args) (DynFlags -> MachOp -> [CmmExpr] -> Maybe CmmExpr
cmmMachOpFoldM DynFlags
dflags MachOp
op [CmmExpr]
args)

-- Returns Nothing if no changes, useful for Hoopl, also reduces
-- allocation!
cmmMachOpFoldM
    :: DynFlags
    -> MachOp
    -> [CmmExpr]
    -> Maybe CmmExpr

cmmMachOpFoldM :: DynFlags -> MachOp -> [CmmExpr] -> Maybe CmmExpr
cmmMachOpFoldM _ op :: MachOp
op [CmmLit (CmmInt x :: Integer
x rep :: Width
rep)]
  = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ case MachOp
op of
      MO_S_Neg _ -> CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (-Integer
x) Width
rep)
      MO_Not _   -> CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer -> Integer
forall a. Bits a => a -> a
complement Integer
x) Width
rep)

        -- these are interesting: we must first narrow to the
        -- "from" type, in order to truncate to the correct size.
        -- The final narrow/widen to the destination type
        -- is implicit in the CmmLit.
      MO_SF_Conv _from :: Width
_from to :: Width
to -> CmmLit -> CmmExpr
CmmLit (Rational -> Width -> CmmLit
CmmFloat (Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
x) Width
to)
      MO_SS_Conv  from :: Width
from to :: Width
to -> CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Width -> Integer -> Integer
narrowS Width
from Integer
x) Width
to)
      MO_UU_Conv  from :: Width
from to :: Width
to -> CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Width -> Integer -> Integer
narrowU Width
from Integer
x) Width
to)

      _ -> String -> CmmExpr
forall a. String -> a
panic (String -> CmmExpr) -> String -> CmmExpr
forall a b. (a -> b) -> a -> b
$ "cmmMachOpFoldM: unknown unary op: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ MachOp -> String
forall a. Show a => a -> String
show MachOp
op


-- Eliminate conversion NOPs
cmmMachOpFoldM _ (MO_SS_Conv rep1 :: Width
rep1 rep2 :: Width
rep2) [x :: CmmExpr
x] | Width
rep1 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
rep2 = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x
cmmMachOpFoldM _ (MO_UU_Conv rep1 :: Width
rep1 rep2 :: Width
rep2) [x :: CmmExpr
x] | Width
rep1 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
rep2 = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x

-- Eliminate nested conversions where possible
cmmMachOpFoldM dflags :: DynFlags
dflags conv_outer :: MachOp
conv_outer [CmmMachOp conv_inner :: MachOp
conv_inner [x :: CmmExpr
x]]
  | Just (rep1 :: Width
rep1,rep2 :: Width
rep2,signed1 :: Bool
signed1) <- MachOp -> Maybe (Width, Width, Bool)
isIntConversion MachOp
conv_inner,
    Just (_,   rep3 :: Width
rep3,signed2 :: Bool
signed2) <- MachOp -> Maybe (Width, Width, Bool)
isIntConversion MachOp
conv_outer
  = case () of
        -- widen then narrow to the same size is a nop
      _ | Width
rep1 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
rep2 Bool -> Bool -> Bool
&& Width
rep1 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
rep3 -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x
        -- Widen then narrow to different size: collapse to single conversion
        -- but remember to use the signedness from the widening, just in case
        -- the final conversion is a widen.
        | Width
rep1 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
rep2 Bool -> Bool -> Bool
&& Width
rep2 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
rep3 ->
            CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags (Bool -> Width -> Width -> MachOp
intconv Bool
signed1 Width
rep1 Width
rep3) [CmmExpr
x]
        -- Nested widenings: collapse if the signedness is the same
        | Width
rep1 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
rep2 Bool -> Bool -> Bool
&& Width
rep2 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
rep3 Bool -> Bool -> Bool
&& Bool
signed1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
signed2 ->
            CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags (Bool -> Width -> Width -> MachOp
intconv Bool
signed1 Width
rep1 Width
rep3) [CmmExpr
x]
        -- Nested narrowings: collapse
        | Width
rep1 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
rep2 Bool -> Bool -> Bool
&& Width
rep2 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
rep3 ->
            CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags (Width -> Width -> MachOp
MO_UU_Conv Width
rep1 Width
rep3) [CmmExpr
x]
        | Bool
otherwise ->
            Maybe CmmExpr
forall a. Maybe a
Nothing
  where
        isIntConversion :: MachOp -> Maybe (Width, Width, Bool)
isIntConversion (MO_UU_Conv rep1 :: Width
rep1 rep2 :: Width
rep2)
          = (Width, Width, Bool) -> Maybe (Width, Width, Bool)
forall a. a -> Maybe a
Just (Width
rep1,Width
rep2,Bool
False)
        isIntConversion (MO_SS_Conv rep1 :: Width
rep1 rep2 :: Width
rep2)
          = (Width, Width, Bool) -> Maybe (Width, Width, Bool)
forall a. a -> Maybe a
Just (Width
rep1,Width
rep2,Bool
True)
        isIntConversion _ = Maybe (Width, Width, Bool)
forall a. Maybe a
Nothing

        intconv :: Bool -> Width -> Width -> MachOp
intconv True  = Width -> Width -> MachOp
MO_SS_Conv
        intconv False = Width -> Width -> MachOp
MO_UU_Conv

-- ToDo: a narrow of a load can be collapsed into a narrow load, right?
-- but what if the architecture only supports word-sized loads, should
-- we do the transformation anyway?

cmmMachOpFoldM dflags :: DynFlags
dflags mop :: MachOp
mop [CmmLit (CmmInt x :: Integer
x xrep :: Width
xrep), CmmLit (CmmInt y :: Integer
y _)]
  = case MachOp
mop of
        -- for comparisons: don't forget to narrow the arguments before
        -- comparing, since they might be out of range.
        MO_Eq _   -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_u Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
y_u then 1 else 0) (DynFlags -> Width
wordWidth DynFlags
dflags))
        MO_Ne _   -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_u Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
y_u then 1 else 0) (DynFlags -> Width
wordWidth DynFlags
dflags))

        MO_U_Gt _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_u Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>  Integer
y_u then 1 else 0) (DynFlags -> Width
wordWidth DynFlags
dflags))
        MO_U_Ge _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_u Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
y_u then 1 else 0) (DynFlags -> Width
wordWidth DynFlags
dflags))
        MO_U_Lt _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_u Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<  Integer
y_u then 1 else 0) (DynFlags -> Width
wordWidth DynFlags
dflags))
        MO_U_Le _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_u Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
y_u then 1 else 0) (DynFlags -> Width
wordWidth DynFlags
dflags))

        MO_S_Gt _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>  Integer
y_s then 1 else 0) (DynFlags -> Width
wordWidth DynFlags
dflags))
        MO_S_Ge _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
y_s then 1 else 0) (DynFlags -> Width
wordWidth DynFlags
dflags))
        MO_S_Lt _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<  Integer
y_s then 1 else 0) (DynFlags -> Width
wordWidth DynFlags
dflags))
        MO_S_Le _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
y_s then 1 else 0) (DynFlags -> Width
wordWidth DynFlags
dflags))

        MO_Add r :: Width
r -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y) Width
r)
        MO_Sub r :: Width
r -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y) Width
r)
        MO_Mul r :: Width
r -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y) Width
r)
        MO_U_Quot r :: Width
r | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x_u Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
y_u) Width
r)
        MO_U_Rem  r :: Width
r | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x_u Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem`  Integer
y_u) Width
r)
        MO_S_Quot r :: Width
r | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
y) Width
r)
        MO_S_Rem  r :: Width
r | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
y) Width
r)

        MO_And   r :: Width
r -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
y) Width
r)
        MO_Or    r :: Width
r -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
y) Width
r)
        MO_Xor   r :: Width
r -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
y) Width
r)

        MO_Shl   r :: Width
r -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y) Width
r)
        MO_U_Shr r :: Width
r -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x_u Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y) Width
r)
        MO_S_Shr r :: Width
r -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y) Width
r)

        _          -> Maybe CmmExpr
forall a. Maybe a
Nothing

   where
        x_u :: Integer
x_u = Width -> Integer -> Integer
narrowU Width
xrep Integer
x
        y_u :: Integer
y_u = Width -> Integer -> Integer
narrowU Width
xrep Integer
y
        x_s :: Integer
x_s = Width -> Integer -> Integer
narrowS Width
xrep Integer
x
        y_s :: Integer
y_s = Width -> Integer -> Integer
narrowS Width
xrep Integer
y


-- When possible, shift the constants to the right-hand side, so that we
-- can match for strength reductions.  Note that the code generator will
-- also assume that constants have been shifted to the right when
-- possible.

cmmMachOpFoldM dflags :: DynFlags
dflags op :: MachOp
op [x :: CmmExpr
x@(CmmLit _), y :: CmmExpr
y]
   | Bool -> Bool
not (CmmExpr -> Bool
isLit CmmExpr
y) Bool -> Bool -> Bool
&& MachOp -> Bool
isCommutableMachOp MachOp
op
   = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags MachOp
op [CmmExpr
y, CmmExpr
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
-- opportunities for constant folding when the expression is
-- right-associated.
--
-- ToDo: this appears to introduce a quadratic behaviour due to the
-- nested cmmMachOpFold.  Can we fix this?
--
-- Why do we check isLit arg1?  If arg1 is a lit, it means that arg2
-- is also a lit (otherwise arg1 would be on the right).  If we
-- put arg1 on the left of the rearranged expression, we'll get into a
-- loop:  (x1+x2)+x3 => x1+(x2+x3)  => (x2+x3)+x1 => x2+(x3+x1) ...
--
-- Also don't do it if arg1 is PicBaseReg, so that we don't separate the
-- PicBaseReg from the corresponding label (or label difference).
--
cmmMachOpFoldM dflags :: DynFlags
dflags mop1 :: MachOp
mop1 [CmmMachOp mop2 :: MachOp
mop2 [arg1 :: CmmExpr
arg1,arg2 :: CmmExpr
arg2], arg3 :: CmmExpr
arg3]
   | MachOp
mop2 MachOp -> MachOp -> Bool
`associates_with` MachOp
mop1
     Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmExpr -> Bool
isLit CmmExpr
arg1) Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmExpr -> Bool
isPicReg CmmExpr
arg1)
   = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags MachOp
mop2 [CmmExpr
arg1, DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags MachOp
mop1 [CmmExpr
arg2,CmmExpr
arg3]])
   where
     MO_Add{} associates_with :: MachOp -> MachOp -> Bool
`associates_with` MO_Sub{} = Bool
True
     mop1 :: MachOp
mop1 `associates_with` mop2 :: MachOp
mop2 =
        MachOp
mop1 MachOp -> MachOp -> Bool
forall a. Eq a => a -> a -> Bool
== MachOp
mop2 Bool -> Bool -> Bool
&& MachOp -> Bool
isAssociativeMachOp MachOp
mop1

-- special case: (a - b) + c  ==>  a + (c - b)
cmmMachOpFoldM dflags :: DynFlags
dflags mop1 :: MachOp
mop1@(MO_Add{}) [CmmMachOp mop2 :: MachOp
mop2@(MO_Sub{}) [arg1 :: CmmExpr
arg1,arg2 :: CmmExpr
arg2], arg3 :: CmmExpr
arg3]
   | Bool -> Bool
not (CmmExpr -> Bool
isLit CmmExpr
arg1) Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmExpr -> Bool
isPicReg CmmExpr
arg1)
   = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags MachOp
mop1 [CmmExpr
arg1, DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags MachOp
mop2 [CmmExpr
arg3,CmmExpr
arg2]])

-- special case: (PicBaseReg + lit) + N  ==>  PicBaseReg + (lit+N)
--
-- this is better because lit+N is a single link-time constant (e.g. a
-- CmmLabelOff), so the right-hand expression needs only one
-- instruction, whereas the left needs two.  This happens when pointer
-- tagging gives us label+offset, and PIC turns the label into
-- PicBaseReg + label.
--
cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op :: MachOp
op@MO_Add{} [pic :: CmmExpr
pic, CmmLit lit :: CmmLit
lit]
                          , CmmLit (CmmInt n :: Integer
n rep :: Width
rep) ]
  | CmmExpr -> Bool
isPicReg CmmExpr
pic
  = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
op [CmmExpr
pic, CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> Int -> CmmLit
cmmOffsetLit CmmLit
lit Int
off ]
  where off :: Int
off = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Integer -> Integer
narrowS Width
rep Integer
n)

-- Make a RegOff if we can
cmmMachOpFoldM _ (MO_Add _) [CmmReg reg :: CmmReg
reg, CmmLit (CmmInt n :: Integer
n rep :: Width
rep)]
  = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmReg -> Int -> CmmExpr
cmmRegOff CmmReg
reg (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Integer -> Integer
narrowS Width
rep Integer
n))
cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg :: CmmReg
reg off :: Int
off, CmmLit (CmmInt n :: Integer
n rep :: Width
rep)]
  = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmReg -> Int -> CmmExpr
cmmRegOff CmmReg
reg (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Integer -> Integer
narrowS Width
rep Integer
n))
cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg :: CmmReg
reg, CmmLit (CmmInt n :: Integer
n rep :: Width
rep)]
  = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmReg -> Int -> CmmExpr
cmmRegOff CmmReg
reg (- Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Integer -> Integer
narrowS Width
rep Integer
n))
cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg :: CmmReg
reg off :: Int
off, CmmLit (CmmInt n :: Integer
n rep :: Width
rep)]
  = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmReg -> Int -> CmmExpr
cmmRegOff CmmReg
reg (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Integer -> Integer
narrowS Width
rep Integer
n))

-- Fold label(+/-)offset into a CmmLit where possible

cmmMachOpFoldM _ (MO_Add _) [CmmLit lit :: CmmLit
lit, CmmLit (CmmInt i :: Integer
i rep :: Width
rep)]
  = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (CmmLit -> Int -> CmmLit
cmmOffsetLit CmmLit
lit (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Integer -> Integer
narrowU Width
rep Integer
i)))
cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i :: Integer
i rep :: Width
rep), CmmLit lit :: CmmLit
lit]
  = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (CmmLit -> Int -> CmmLit
cmmOffsetLit CmmLit
lit (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Integer -> Integer
narrowU Width
rep Integer
i)))
cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit :: CmmLit
lit, CmmLit (CmmInt i :: Integer
i rep :: Width
rep)]
  = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (CmmLit -> Int -> CmmLit
cmmOffsetLit CmmLit
lit (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Integer
forall a. Num a => a -> a
negate (Width -> Integer -> Integer
narrowU Width
rep Integer
i))))


-- Comparison of literal with widened operand: perform the comparison
-- at the smaller width, as long as the literal is within range.

-- We can't do the reverse trick, when the operand is narrowed:
-- narrowing throws away bits from the operand, there's no way to do
-- the same comparison at the larger size.

cmmMachOpFoldM dflags :: DynFlags
dflags cmp :: MachOp
cmp [CmmMachOp conv :: MachOp
conv [x :: CmmExpr
x], CmmLit (CmmInt i :: Integer
i _)]
  |     -- powerPC NCG has a TODO for I8/I16 comparisons, so don't try
    Platform -> Arch
platformArch (DynFlags -> Platform
targetPlatform DynFlags
dflags) Arch -> [Arch] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Arch
ArchX86, Arch
ArchX86_64],
        -- if the operand is widened:
    Just (rep :: Width
rep, signed :: Bool
signed, narrow_fn :: Width -> Integer -> Integer
narrow_fn) <- MachOp -> Maybe (Width, Bool, Width -> Integer -> Integer)
maybe_conversion MachOp
conv,
        -- and this is a comparison operation:
    Just narrow_cmp :: MachOp
narrow_cmp <- MachOp -> Width -> Bool -> Maybe MachOp
maybe_comparison MachOp
cmp Width
rep Bool
signed,
        -- and the literal fits in the smaller size:
    Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Width -> Integer -> Integer
narrow_fn Width
rep Integer
i
        -- then we can do the comparison at the smaller size
  = CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags MachOp
narrow_cmp [CmmExpr
x, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
i Width
rep)])
 where
    maybe_conversion :: MachOp -> Maybe (Width, Bool, Width -> Integer -> Integer)
maybe_conversion (MO_UU_Conv from :: Width
from to :: Width
to)
        | Width
to Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
from
        = (Width, Bool, Width -> Integer -> Integer)
-> Maybe (Width, Bool, Width -> Integer -> Integer)
forall a. a -> Maybe a
Just (Width
from, Bool
False, Width -> Integer -> Integer
narrowU)
    maybe_conversion (MO_SS_Conv from :: Width
from to :: Width
to)
        | Width
to Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
from
        = (Width, Bool, Width -> Integer -> Integer)
-> Maybe (Width, Bool, Width -> Integer -> Integer)
forall a. a -> Maybe a
Just (Width
from, Bool
True, Width -> Integer -> Integer
narrowS)

        -- don't attempt to apply this optimisation when the source
        -- is a float; see #1916
    maybe_conversion _ = Maybe (Width, Bool, Width -> Integer -> Integer)
forall a. Maybe a
Nothing

        -- careful (#2080): if the original comparison was signed, but
        -- we were doing an unsigned widen, then we must do an
        -- unsigned comparison at the smaller size.
    maybe_comparison :: MachOp -> Width -> Bool -> Maybe MachOp
maybe_comparison (MO_U_Gt _) rep :: Width
rep _     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Gt Width
rep)
    maybe_comparison (MO_U_Ge _) rep :: Width
rep _     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Ge Width
rep)
    maybe_comparison (MO_U_Lt _) rep :: Width
rep _     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Lt Width
rep)
    maybe_comparison (MO_U_Le _) rep :: Width
rep _     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Le Width
rep)
    maybe_comparison (MO_Eq   _) rep :: Width
rep _     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Eq   Width
rep)
    maybe_comparison (MO_S_Gt _) rep :: Width
rep True  = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Gt Width
rep)
    maybe_comparison (MO_S_Ge _) rep :: Width
rep True  = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Ge Width
rep)
    maybe_comparison (MO_S_Lt _) rep :: Width
rep True  = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Lt Width
rep)
    maybe_comparison (MO_S_Le _) rep :: Width
rep True  = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Le Width
rep)
    maybe_comparison (MO_S_Gt _) rep :: Width
rep False = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Gt Width
rep)
    maybe_comparison (MO_S_Ge _) rep :: Width
rep False = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Ge Width
rep)
    maybe_comparison (MO_S_Lt _) rep :: Width
rep False = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Lt Width
rep)
    maybe_comparison (MO_S_Le _) rep :: Width
rep False = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Le Width
rep)
    maybe_comparison _ _ _ = Maybe MachOp
forall a. Maybe a
Nothing

-- We can often do something with constants of 0 and 1 ...
-- See Note [Comparison operators]

cmmMachOpFoldM dflags :: DynFlags
dflags mop :: MachOp
mop [x :: CmmExpr
x, y :: CmmExpr
y@(CmmLit (CmmInt 0 _))]
  = case MachOp
mop of
        -- Arithmetic
        MO_Add   _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x   -- x + 0 = x
        MO_Sub   _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x   -- x - 0 = x
        MO_Mul   _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
y   -- x * 0 = 0

        -- Logical operations
        MO_And   _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
y   -- x &     0 = 0
        MO_Or    _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x   -- x |     0 = x
        MO_Xor   _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x   -- x `xor` 0 = x

        -- Shifts
        MO_Shl   _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x   -- x << 0 = x
        MO_S_Shr _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x   -- ditto shift-right
        MO_U_Shr _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x

        -- Comparisons; these ones are trickier
        -- See Note [Comparison operators]
        MO_Ne    _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x                -- (x > y) != 0  =  x > y
        MO_Eq    _ | Just x' :: CmmExpr
x' <- CmmExpr -> Maybe CmmExpr
maybeInvertCmmExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x'  -- (x > y) == 0  =  x <= y
        MO_U_Gt  _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x                -- (x > y) > 0   =  x > y
        MO_S_Gt  _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x                -- ditto
        MO_U_Lt  _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
zero             -- (x > y) < 0  =  0
        MO_S_Lt  _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
zero
        MO_U_Ge  _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
one              -- (x > y) >= 0  =  1
        MO_S_Ge  _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
one

        MO_U_Le  _ | Just x' :: CmmExpr
x' <- CmmExpr -> Maybe CmmExpr
maybeInvertCmmExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x'  -- (x > y) <= 0  =  x <= y
        MO_S_Le  _ | Just x' :: CmmExpr
x' <- CmmExpr -> Maybe CmmExpr
maybeInvertCmmExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x'
        _ -> Maybe CmmExpr
forall a. Maybe a
Nothing
  where
    zero :: CmmExpr
zero = CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt 0 (DynFlags -> Width
wordWidth DynFlags
dflags))
    one :: CmmExpr
one  = CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt 1 (DynFlags -> Width
wordWidth DynFlags
dflags))

cmmMachOpFoldM dflags :: DynFlags
dflags mop :: MachOp
mop [x :: CmmExpr
x, (CmmLit (CmmInt 1 rep :: Width
rep))]
  = case MachOp
mop of
        -- Arithmetic: x*1 = x, etc
        MO_Mul    _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x
        MO_S_Quot _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x
        MO_U_Quot _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x
        MO_S_Rem  _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt 0 Width
rep)
        MO_U_Rem  _ -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt 0 Width
rep)

        -- Comparisons; trickier
        -- See Note [Comparison operators]
        MO_Ne    _ | Just x' :: CmmExpr
x' <- CmmExpr -> Maybe CmmExpr
maybeInvertCmmExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x'  -- (x>y) != 1  =  x<=y
        MO_Eq    _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x                -- (x>y) == 1  =  x>y
        MO_U_Lt  _ | Just x' :: CmmExpr
x' <- CmmExpr -> Maybe CmmExpr
maybeInvertCmmExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x'  -- (x>y) < 1   =  x<=y
        MO_S_Lt  _ | Just x' :: CmmExpr
x' <- CmmExpr -> Maybe CmmExpr
maybeInvertCmmExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x'  -- ditto
        MO_U_Gt  _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
zero             -- (x>y) > 1   = 0
        MO_S_Gt  _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
zero
        MO_U_Le  _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
one              -- (x>y) <= 1  = 1
        MO_S_Le  _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
one
        MO_U_Ge  _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x                -- (x>y) >= 1  = x>y
        MO_S_Ge  _ | CmmExpr -> Bool
isComparisonExpr CmmExpr
x -> CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
x
        _ -> Maybe CmmExpr
forall a. Maybe a
Nothing
  where
    zero :: CmmExpr
zero = CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt 0 (DynFlags -> Width
wordWidth DynFlags
dflags))
    one :: CmmExpr
one  = CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt 1 (DynFlags -> Width
wordWidth DynFlags
dflags))

-- Now look for multiplication/division by powers of 2 (integers).

cmmMachOpFoldM dflags :: DynFlags
dflags mop :: MachOp
mop [x :: CmmExpr
x, (CmmLit (CmmInt n :: Integer
n _))]
  = case MachOp
mop of
        MO_Mul rep :: Width
rep
           | Just p :: Integer
p <- Integer -> Maybe Integer
exactLog2 Integer
n ->
                 CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags (Width -> MachOp
MO_Shl Width
rep) [CmmExpr
x, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
p Width
rep)])
        MO_U_Quot rep :: Width
rep
           | Just p :: Integer
p <- Integer -> Maybe Integer
exactLog2 Integer
n ->
                 CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags (Width -> MachOp
MO_U_Shr Width
rep) [CmmExpr
x, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
p Width
rep)])
        MO_U_Rem rep :: Width
rep
           | Just _ <- Integer -> Maybe Integer
exactLog2 Integer
n ->
                 CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags (Width -> MachOp
MO_And Width
rep) [CmmExpr
x, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1) Width
rep)])
        MO_S_Quot rep :: Width
rep
           | Just p :: Integer
p <- Integer -> Maybe Integer
exactLog2 Integer
n,
             CmmReg _ <- CmmExpr
x ->   -- We duplicate x in signedQuotRemHelper, hence require
                                -- it is a reg.  FIXME: remove this restriction.
                CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags (Width -> MachOp
MO_S_Shr Width
rep)
                  [Width -> Integer -> CmmExpr
signedQuotRemHelper Width
rep Integer
p, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
p Width
rep)])
        MO_S_Rem rep :: Width
rep
           | Just p :: Integer
p <- Integer -> Maybe Integer
exactLog2 Integer
n,
             CmmReg _ <- CmmExpr
x ->   -- We duplicate x in signedQuotRemHelper, hence require
                                -- it is a reg.  FIXME: remove this restriction.
                -- 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.
                CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just (DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags (Width -> MachOp
MO_Sub Width
rep)
                    [CmmExpr
x, DynFlags -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold DynFlags
dflags (Width -> MachOp
MO_And Width
rep)
                      [Width -> Integer -> CmmExpr
signedQuotRemHelper Width
rep Integer
p, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (- Integer
n) Width
rep)]])
        _ -> Maybe CmmExpr
forall a. Maybe a
Nothing
  where
    -- In contrast with unsigned integers, for signed ones
    -- shift right is not the same as quot, because it rounds
    -- to minus infinity, whereas quot rounds toward zero.
    -- To fix this up, we add one less than the divisor to the
    -- dividend if it is a negative number.
    --
    -- to avoid a test/jump, we use the following sequence:
    --      x1 = x >> word_size-1  (all 1s if -ve, all 0s if +ve)
    --      x2 = y & (divisor-1)
    --      result = x + x2
    -- this could be done a bit more simply using conditional moves,
    -- but we're processor independent here.
    --
    -- we optimise the divide by 2 case slightly, generating
    --      x1 = x >> word_size-1  (unsigned)
    --      return = x + x1
    signedQuotRemHelper :: Width -> Integer -> CmmExpr
    signedQuotRemHelper :: Width -> Integer -> CmmExpr
signedQuotRemHelper rep :: Width
rep p :: Integer
p = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
rep) [CmmExpr
x, CmmExpr
x2]
      where
        bits :: Integer
bits = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Int
widthInBits Width
rep) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1
        shr :: MachOp
shr = if Integer
p Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then Width -> MachOp
MO_U_Shr Width
rep else Width -> MachOp
MO_S_Shr Width
rep
        x1 :: CmmExpr
x1 = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
shr [CmmExpr
x, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
bits Width
rep)]
        x2 :: CmmExpr
x2 = if Integer
p Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then CmmExpr
x1 else
             MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_And Width
rep) [CmmExpr
x1, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1) Width
rep)]

-- ToDo (#7116): optimise floating-point multiplication, e.g. x*2.0 -> x+x
-- Unfortunately this needs a unique supply because x might not be a
-- register.  See #2253 (program 6) for an example.


-- Anything else is just too hard.

cmmMachOpFoldM _ _ _ = Maybe CmmExpr
forall a. Maybe a
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

isPicReg :: CmmExpr -> Bool
isPicReg :: CmmExpr -> Bool
isPicReg (CmmReg (CmmGlobal PicBaseReg)) = Bool
True
isPicReg _ = Bool
False