{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE PatternSynonyms #-}
module GHC.Cmm.Opt (
constantFoldNode,
constantFoldExpr,
cmmMachOpFold,
cmmMachOpFoldM,
Opt, runOpt
) where
import GHC.Prelude
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Utils
import GHC.Cmm
import GHC.Cmm.Config
import GHC.Types.Unique.DSM
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Platform
import Data.Maybe
import Data.Word
import GHC.Exts (oneShot)
import Control.Monad
constantFoldNode :: CmmNode e x -> Opt (CmmNode e x)
constantFoldNode :: forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> Opt (CmmNode e x)
constantFoldNode (CmmUnsafeForeignCall (PrimTarget CallishMachOp
op) [CmmFormal]
res [CmmActual]
args)
= (CmmActual -> Opt CmmActual) -> [CmmActual] -> Opt [CmmActual]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse CmmActual -> Opt CmmActual
constantFoldExprOpt [CmmActual]
args Opt [CmmActual]
-> ([CmmActual] -> Opt (CmmNode e x)) -> Opt (CmmNode e x)
forall a b. Opt a -> (a -> Opt b) -> Opt b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CallishMachOp
-> [CmmFormal] -> [CmmActual] -> Opt (CmmNode 'Open 'Open)
cmmCallishMachOpFold CallishMachOp
op [CmmFormal]
res
constantFoldNode CmmNode e x
node
= (CmmActual -> Opt CmmActual) -> CmmNode e x -> Opt (CmmNode e x)
forall (e :: Extensibility) (x :: Extensibility).
(CmmActual -> Opt CmmActual) -> CmmNode e x -> Opt (CmmNode e x)
mapExpOpt CmmActual -> Opt CmmActual
constantFoldExprOpt CmmNode e x
node
constantFoldExprOpt :: CmmExpr -> Opt CmmExpr
constantFoldExprOpt :: CmmActual -> Opt CmmActual
constantFoldExprOpt CmmActual
e = (CmmActual -> Opt CmmActual) -> CmmActual -> Opt CmmActual
wrapRecExpOpt CmmActual -> Opt CmmActual
f CmmActual
e
where
f :: CmmActual -> Opt CmmActual
f (CmmMachOp MachOp
op [CmmActual]
args)
= do
cfg <- Opt CmmConfig
getConfig
case cmmMachOpFold (cmmPlatform cfg) op args of
CmmMachOp MachOp
op' [CmmActual]
args' -> CmmActual -> Maybe CmmActual -> CmmActual
forall a. a -> Maybe a -> a
fromMaybe (MachOp -> [CmmActual] -> CmmActual
CmmMachOp MachOp
op' [CmmActual]
args') (Maybe CmmActual -> CmmActual)
-> Opt (Maybe CmmActual) -> Opt CmmActual
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmmConfig -> MachOp -> [CmmActual] -> Opt (Maybe CmmActual)
cmmMachOpFoldOptM CmmConfig
cfg MachOp
op' [CmmActual]
args'
CmmActual
e -> CmmActual -> Opt CmmActual
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmmActual
e
f (CmmRegOff CmmReg
r Int
0) = CmmActual -> Opt CmmActual
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CmmReg -> CmmActual
CmmReg CmmReg
r)
f CmmActual
e = CmmActual -> Opt CmmActual
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmmActual
e
constantFoldExpr :: Platform -> CmmExpr -> CmmExpr
constantFoldExpr :: Platform -> CmmActual -> CmmActual
constantFoldExpr Platform
platform = (CmmActual -> CmmActual) -> CmmActual -> CmmActual
wrapRecExp CmmActual -> CmmActual
f
where f :: CmmActual -> CmmActual
f (CmmMachOp MachOp
op [CmmActual]
args) = Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform MachOp
op [CmmActual]
args
f (CmmRegOff CmmReg
r Int
0) = CmmReg -> CmmActual
CmmReg CmmReg
r
f CmmActual
e = CmmActual
e
cmmMachOpFold
:: Platform
-> MachOp
-> [CmmExpr]
-> CmmExpr
cmmMachOpFold :: Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform MachOp
op [CmmActual]
args = CmmActual -> Maybe CmmActual -> CmmActual
forall a. a -> Maybe a -> a
fromMaybe (MachOp -> [CmmActual] -> CmmActual
CmmMachOp MachOp
op [CmmActual]
args) (Platform -> MachOp -> [CmmActual] -> Maybe CmmActual
cmmMachOpFoldM Platform
platform MachOp
op [CmmActual]
args)
cmmMachOpFoldM
:: Platform
-> MachOp
-> [CmmExpr]
-> Maybe CmmExpr
cmmMachOpFoldM :: Platform -> MachOp -> [CmmActual] -> Maybe CmmActual
cmmMachOpFoldM Platform
_ (MO_V_Broadcast Int
lg Width
_w) [CmmActual]
exprs =
case [CmmActual]
exprs of
[CmmLit CmmLit
l] -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit ([CmmLit] -> CmmLit
CmmVec ([CmmLit] -> CmmLit) -> [CmmLit] -> CmmLit
forall a b. (a -> b) -> a -> b
$ Int -> CmmLit -> [CmmLit]
forall a. Int -> a -> [a]
replicate Int
lg CmmLit
l)
[CmmActual]
_ -> Maybe CmmActual
forall a. Maybe a
Nothing
cmmMachOpFoldM Platform
_ (MO_VF_Broadcast Int
lg Width
_w) [CmmActual]
exprs =
case [CmmActual]
exprs of
[CmmLit CmmLit
l] -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit ([CmmLit] -> CmmLit
CmmVec ([CmmLit] -> CmmLit) -> [CmmLit] -> CmmLit
forall a b. (a -> b) -> a -> b
$ Int -> CmmLit -> [CmmLit]
forall a. Int -> a -> [a]
replicate Int
lg CmmLit
l)
[CmmActual]
_ -> Maybe CmmActual
forall a. Maybe a
Nothing
cmmMachOpFoldM Platform
_ MachOp
op [CmmLit (CmmInt Integer
x Width
rep)]
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! case MachOp
op of
MO_S_Neg Width
_ -> CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (-Integer
x) Width
rep)
MO_Not Width
_ -> CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer -> Integer
forall a. Bits a => a -> a
complement Integer
x) Width
rep)
MO_SF_Round Width
_frm Width
to -> CmmLit -> CmmActual
CmmLit (Rational -> Width -> CmmLit
CmmFloat (Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
x) Width
to)
MO_SS_Conv Width
from Width
to -> CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Width -> Integer -> Integer
narrowS Width
from Integer
x) Width
to)
MO_UU_Conv Width
from Width
to -> CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Width -> Integer -> Integer
narrowU Width
from Integer
x) Width
to)
MO_XX_Conv Width
from Width
to -> CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Width -> Integer -> Integer
narrowS Width
from Integer
x) Width
to)
MachOp
_ -> String -> CmmActual
forall a. HasCallStack => String -> a
panic (String -> CmmActual) -> String -> CmmActual
forall a b. (a -> b) -> a -> b
$ String
"cmmMachOpFoldM: unknown unary op: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ MachOp -> String
forall a. Show a => a -> String
show MachOp
op
cmmMachOpFoldM Platform
_ MachOp
op [CmmActual
_shiftee, CmmLit (CmmInt Integer
shift Width
_)]
| Just Width
width <- MachOp -> Maybe Width
isShift MachOp
op
, Integer
shift Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Int
widthInBits Width
width)
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
0 Width
width)
where
isShift :: MachOp -> Maybe Width
isShift (MO_Shl Width
w) = Width -> Maybe Width
forall a. a -> Maybe a
Just Width
w
isShift (MO_U_Shr Width
w) = Width -> Maybe Width
forall a. a -> Maybe a
Just Width
w
isShift (MO_S_Shr Width
w) = Width -> Maybe Width
forall a. a -> Maybe a
Just Width
w
isShift MachOp
_ = Maybe Width
forall a. Maybe a
Nothing
cmmMachOpFoldM Platform
_ (MO_SS_Conv Width
rep1 Width
rep2) [CmmActual
x] | Width
rep1 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
rep2 = CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
cmmMachOpFoldM Platform
_ (MO_UU_Conv Width
rep1 Width
rep2) [CmmActual
x] | Width
rep1 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
rep2 = CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
cmmMachOpFoldM Platform
_ (MO_XX_Conv Width
rep1 Width
rep2) [CmmActual
x] | Width
rep1 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
rep2 = CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
cmmMachOpFoldM Platform
platform MachOp
conv_outer [CmmMachOp MachOp
conv_inner [CmmActual
x]]
| Just (Width
rep1,Width
rep2,Bool
signed1) <- MachOp -> Maybe (Width, Width, Bool)
isIntConversion MachOp
conv_inner,
Just (Width
_, Width
rep3,Bool
signed2) <- MachOp -> Maybe (Width, Width, Bool)
isIntConversion MachOp
conv_outer
= case () of
()
_ | 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 -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
| 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 ->
CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Bool -> Width -> Width -> MachOp
intconv Bool
signed1 Width
rep1 Width
rep3) [CmmActual
x]
| 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 ->
CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Bool -> Width -> Width -> MachOp
intconv Bool
signed1 Width
rep1 Width
rep3) [CmmActual
x]
| 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 ->
CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> Width -> MachOp
MO_UU_Conv Width
rep1 Width
rep3) [CmmActual
x]
| Bool
otherwise ->
Maybe CmmActual
forall a. Maybe a
Nothing
where
isIntConversion :: MachOp -> Maybe (Width, Width, Bool)
isIntConversion (MO_UU_Conv Width
rep1 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 Width
rep1 Width
rep2)
= (Width, Width, Bool) -> Maybe (Width, Width, Bool)
forall a. a -> Maybe a
Just (Width
rep1,Width
rep2,Bool
True)
isIntConversion MachOp
_ = Maybe (Width, Width, Bool)
forall a. Maybe a
Nothing
intconv :: Bool -> Width -> Width -> MachOp
intconv Bool
True = Width -> Width -> MachOp
MO_SS_Conv
intconv Bool
False = Width -> Width -> MachOp
MO_UU_Conv
cmmMachOpFoldM Platform
platform MachOp
mop [CmmLit (CmmInt Integer
x Width
xrep), CmmLit (CmmInt Integer
y Width
_)]
= case MachOp
mop of
MO_Eq Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_u Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
y_u then Integer
1 else Integer
0) (Platform -> Width
wordWidth Platform
platform))
MO_Ne Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_u Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
y_u then Integer
1 else Integer
0) (Platform -> Width
wordWidth Platform
platform))
MO_U_Gt Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_u Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
y_u then Integer
1 else Integer
0) (Platform -> Width
wordWidth Platform
platform))
MO_U_Ge Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_u Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
y_u then Integer
1 else Integer
0) (Platform -> Width
wordWidth Platform
platform))
MO_U_Lt Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_u Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
y_u then Integer
1 else Integer
0) (Platform -> Width
wordWidth Platform
platform))
MO_U_Le Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_u Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
y_u then Integer
1 else Integer
0) (Platform -> Width
wordWidth Platform
platform))
MO_S_Gt Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
y_s then Integer
1 else Integer
0) (Platform -> Width
wordWidth Platform
platform))
MO_S_Ge Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
y_s then Integer
1 else Integer
0) (Platform -> Width
wordWidth Platform
platform))
MO_S_Lt Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
y_s then Integer
1 else Integer
0) (Platform -> Width
wordWidth Platform
platform))
MO_S_Le Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (if Integer
x_s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
y_s then Integer
1 else Integer
0) (Platform -> Width
wordWidth Platform
platform))
MO_Add Width
r -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y) Width
r)
MO_Sub Width
r -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y) Width
r)
MO_Mul Width
r -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y) Width
r)
MO_U_Quot Width
r | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
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 Width
r | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
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 Width
r | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x_s Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
y_s) Width
r)
MO_S_Rem Width
r | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x_s Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
y_s) Width
r)
MO_And Width
r -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
y) Width
r)
MO_Or Width
r -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
y) Width
r)
MO_Xor Width
r -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
y) Width
r)
MO_Shl Width
r -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
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 Width
r -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
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 Width
r -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
x_s 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)
MachOp
_ -> Maybe CmmActual
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
cmmMachOpFoldM Platform
platform MachOp
op [x :: CmmActual
x@(CmmLit CmmLit
_), CmmActual
y]
| Bool -> Bool
not (CmmActual -> Bool
isLit CmmActual
y) Bool -> Bool -> Bool
&& MachOp -> Bool
isCommutableMachOp MachOp
op
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! (Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform MachOp
op [CmmActual
y, CmmActual
x])
cmmMachOpFoldM Platform
platform MachOp
mop1 [CmmMachOp MachOp
mop2 [CmmActual
arg1,CmmActual
arg2], CmmActual
arg3]
| MachOp
mop2 MachOp -> MachOp -> Bool
`associates_with` MachOp
mop1
Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmActual -> Bool
isLit CmmActual
arg1) Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmActual -> Bool
isPicReg CmmActual
arg1)
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! (Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform MachOp
mop2 [CmmActual
arg1, Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform MachOp
mop1 [CmmActual
arg2,CmmActual
arg3]])
where
MO_Add{} associates_with :: MachOp -> MachOp -> Bool
`associates_with` MO_Sub{} = Bool
True
MachOp
mop1 `associates_with` MachOp
mop2 =
MachOp
mop1 MachOp -> MachOp -> Bool
forall a. Eq a => a -> a -> Bool
== MachOp
mop2 Bool -> Bool -> Bool
&& MachOp -> Bool
isAssociativeMachOp MachOp
mop1
cmmMachOpFoldM Platform
platform mop1 :: MachOp
mop1@(MO_Add{}) [CmmMachOp mop2 :: MachOp
mop2@(MO_Sub{}) [CmmActual
arg1,CmmActual
arg2], CmmActual
arg3]
| Bool -> Bool
not (CmmActual -> Bool
isLit CmmActual
arg1) Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmActual -> Bool
isPicReg CmmActual
arg1)
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! (Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform MachOp
mop1 [CmmActual
arg1, Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform MachOp
mop2 [CmmActual
arg3,CmmActual
arg2]])
cmmMachOpFoldM Platform
_ MO_Add{} [ CmmMachOp op :: MachOp
op@MO_Add{} [CmmActual
pic, CmmLit CmmLit
lit]
, CmmLit (CmmInt Integer
n Width
rep) ]
| CmmActual -> Bool
isPicReg CmmActual
pic
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! MachOp -> [CmmActual] -> CmmActual
CmmMachOp MachOp
op [CmmActual
pic, CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
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)
cmmMachOpFoldM Platform
_ (MO_Add Width
_) [CmmReg CmmReg
reg, CmmLit (CmmInt Integer
n Width
rep)]
| Width -> Bool
validOffsetRep Width
rep
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmReg -> Int -> CmmActual
cmmRegOff CmmReg
reg (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Integer -> Integer
narrowS Width
rep Integer
n))
cmmMachOpFoldM Platform
_ (MO_Add Width
_) [CmmRegOff CmmReg
reg Int
off, CmmLit (CmmInt Integer
n Width
rep)]
| Width -> Bool
validOffsetRep Width
rep
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmReg -> Int -> CmmActual
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 Platform
_ (MO_Sub Width
_) [CmmReg CmmReg
reg, CmmLit (CmmInt Integer
n Width
rep)]
| Width -> Bool
validOffsetRep Width
rep
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmReg -> Int -> CmmActual
cmmRegOff CmmReg
reg (- Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Integer -> Integer
narrowS Width
rep Integer
n))
cmmMachOpFoldM Platform
_ (MO_Sub Width
_) [CmmRegOff CmmReg
reg Int
off, CmmLit (CmmInt Integer
n Width
rep)]
| Width -> Bool
validOffsetRep Width
rep
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmReg -> Int -> CmmActual
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 Platform
_ (MO_Add Width
_) [CmmLit CmmLit
lit, CmmLit (CmmInt Integer
i Width
rep)]
| Width -> Bool
validOffsetRep Width
rep
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
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 Platform
_ (MO_Add Width
_) [CmmLit (CmmInt Integer
i Width
rep), CmmLit CmmLit
lit]
| Width -> Bool
validOffsetRep Width
rep
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
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 Platform
_ (MO_Sub Width
_) [CmmLit CmmLit
lit, CmmLit (CmmInt Integer
i Width
rep)]
| Width -> Bool
validOffsetRep Width
rep
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
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))))
cmmMachOpFoldM Platform
platform MachOp
cmp [CmmMachOp MachOp
conv [CmmActual
x], CmmLit (CmmInt Integer
i Width
_)]
|
Platform -> Arch
platformArch Platform
platform Arch -> [Arch] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Arch
ArchX86, Arch
ArchX86_64],
Just (Width
rep, Bool
signed, Width -> Integer -> Integer
narrow_fn) <- MachOp -> Maybe (Width, Bool, Width -> Integer -> Integer)
maybe_conversion MachOp
conv,
Just MachOp
narrow_cmp <- MachOp -> Width -> Bool -> Maybe MachOp
maybe_comparison MachOp
cmp Width
rep Bool
signed,
Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Width -> Integer -> Integer
narrow_fn Width
rep Integer
i
= CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! (Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform MachOp
narrow_cmp [CmmActual
x, CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
i Width
rep)])
where
maybe_conversion :: MachOp -> Maybe (Width, Bool, Width -> Integer -> Integer)
maybe_conversion (MO_UU_Conv Width
from 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 Width
from 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)
maybe_conversion MachOp
_ = Maybe (Width, Bool, Width -> Integer -> Integer)
forall a. Maybe a
Nothing
maybe_comparison :: MachOp -> Width -> Bool -> Maybe MachOp
maybe_comparison (MO_U_Gt Width
_) Width
rep Bool
_ = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Gt Width
rep)
maybe_comparison (MO_U_Ge Width
_) Width
rep Bool
_ = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Ge Width
rep)
maybe_comparison (MO_U_Lt Width
_) Width
rep Bool
_ = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Lt Width
rep)
maybe_comparison (MO_U_Le Width
_) Width
rep Bool
_ = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Le Width
rep)
maybe_comparison (MO_Eq Width
_) Width
rep Bool
_ = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Eq Width
rep)
maybe_comparison (MO_S_Gt Width
_) Width
rep Bool
True = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Gt Width
rep)
maybe_comparison (MO_S_Ge Width
_) Width
rep Bool
True = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Ge Width
rep)
maybe_comparison (MO_S_Lt Width
_) Width
rep Bool
True = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Lt Width
rep)
maybe_comparison (MO_S_Le Width
_) Width
rep Bool
True = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Le Width
rep)
maybe_comparison (MO_S_Gt Width
_) Width
rep Bool
False = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Gt Width
rep)
maybe_comparison (MO_S_Ge Width
_) Width
rep Bool
False = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Ge Width
rep)
maybe_comparison (MO_S_Lt Width
_) Width
rep Bool
False = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Lt Width
rep)
maybe_comparison (MO_S_Le Width
_) Width
rep Bool
False = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Le Width
rep)
maybe_comparison MachOp
_ Width
_ Bool
_ = Maybe MachOp
forall a. Maybe a
Nothing
cmmMachOpFoldM Platform
platform MachOp
mop [CmmActual
x, y :: CmmActual
y@(CmmLit (CmmInt Integer
0 Width
_))]
= case MachOp
mop of
MO_Add Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_Sub Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_Mul Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
y
MO_And Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
y
MO_Or Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_Xor Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_Shl Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_S_Shr Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_U_Shr Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_Ne Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_Eq Width
_ | Just CmmActual
x' <- CmmActual -> Maybe CmmActual
maybeInvertCmmExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x'
MO_U_Gt Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_S_Gt Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_U_Lt Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
zero
MO_S_Lt Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
zero
MO_U_Ge Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
one
MO_S_Ge Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
one
MO_U_Le Width
_ | Just CmmActual
x' <- CmmActual -> Maybe CmmActual
maybeInvertCmmExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x'
MO_S_Le Width
_ | Just CmmActual
x' <- CmmActual -> Maybe CmmActual
maybeInvertCmmExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x'
MachOp
_ -> Maybe CmmActual
forall a. Maybe a
Nothing
where
zero :: CmmActual
zero = CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
0 (Platform -> Width
wordWidth Platform
platform))
one :: CmmActual
one = CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
1 (Platform -> Width
wordWidth Platform
platform))
cmmMachOpFoldM Platform
platform MachOp
mop [CmmActual
x, (CmmLit (CmmInt Integer
1 Width
rep))]
= case MachOp
mop of
MO_Mul Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_S_Quot Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_U_Quot Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_S_Rem Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
MO_U_Rem Width
_ -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
MO_Ne Width
_ | Just CmmActual
x' <- CmmActual -> Maybe CmmActual
maybeInvertCmmExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x'
MO_Eq Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_U_Lt Width
_ | Just CmmActual
x' <- CmmActual -> Maybe CmmActual
maybeInvertCmmExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x'
MO_S_Lt Width
_ | Just CmmActual
x' <- CmmActual -> Maybe CmmActual
maybeInvertCmmExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x'
MO_U_Gt Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
zero
MO_S_Gt Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
zero
MO_U_Le Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
one
MO_S_Le Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
one
MO_U_Ge Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MO_S_Ge Width
_ | CmmActual -> Bool
isComparisonExpr CmmActual
x -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just CmmActual
x
MachOp
_ -> Maybe CmmActual
forall a. Maybe a
Nothing
where
zero :: CmmActual
zero = CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
0 (Platform -> Width
wordWidth Platform
platform))
one :: CmmActual
one = CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
1 (Platform -> Width
wordWidth Platform
platform))
cmmMachOpFoldM Platform
platform MachOp
mop [CmmActual
x, (CmmLit (CmmInt Integer
n Width
_))]
= case MachOp
mop of
MO_Mul Width
rep
| Just Integer
p <- Integer -> Maybe Integer
exactLog2 Integer
n ->
CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! (Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_Shl Width
rep) [CmmActual
x, CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
p (Width -> CmmLit) -> Width -> CmmLit
forall a b. (a -> b) -> a -> b
$ Platform -> Width
wordWidth Platform
platform)])
MO_U_Quot Width
rep
| Just Integer
p <- Integer -> Maybe Integer
exactLog2 Integer
n ->
CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! (Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_U_Shr Width
rep) [CmmActual
x, CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
p (Width -> CmmLit) -> Width -> CmmLit
forall a b. (a -> b) -> a -> b
$ Platform -> Width
wordWidth Platform
platform)])
MO_U_Rem Width
rep
| Just Integer
_ <- Integer -> Maybe Integer
exactLog2 Integer
n ->
CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! (Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_And Width
rep) [CmmActual
x, CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Width
rep)])
MO_S_Quot Width
rep
| Just Integer
p <- Integer -> Maybe Integer
exactLog2 Integer
n,
CmmReg CmmReg
_ <- CmmActual
x ->
CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! (Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_S_Shr Width
rep)
[Platform -> Integer -> CmmActual -> Width -> Integer -> CmmActual
signedQuotRemHelper Platform
platform Integer
n CmmActual
x Width
rep Integer
p, CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
p (Width -> CmmLit) -> Width -> CmmLit
forall a b. (a -> b) -> a -> b
$ Platform -> Width
wordWidth Platform
platform)])
MO_S_Rem Width
rep
| Just Integer
p <- Integer -> Maybe Integer
exactLog2 Integer
n,
CmmReg CmmReg
_ <- CmmActual
x ->
CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual) -> CmmActual -> Maybe CmmActual
forall a b. (a -> b) -> a -> b
$! (Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_Sub Width
rep)
[CmmActual
x, Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_And Width
rep)
[Platform -> Integer -> CmmActual -> Width -> Integer -> CmmActual
signedQuotRemHelper Platform
platform Integer
n CmmActual
x Width
rep Integer
p, CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (- Integer
n) Width
rep)]])
MachOp
_ -> Maybe CmmActual
forall a. Maybe a
Nothing
cmmMachOpFoldM Platform
_ MachOp
_ [CmmActual]
_ = Maybe CmmActual
forall a. Maybe a
Nothing
validOffsetRep :: Width -> Bool
validOffsetRep :: Width -> Bool
validOffsetRep Width
rep = Width -> Int
widthInBits Width
rep Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int
forall a. HasCallStack => a
undefined :: Int)
isPicReg :: CmmExpr -> Bool
isPicReg :: CmmActual -> Bool
isPicReg (CmmReg (CmmGlobal (GlobalRegUse GlobalReg
PicBaseReg CmmType
_))) = Bool
True
isPicReg CmmActual
_ = Bool
False
canOptimizeDivision :: CmmConfig -> Width -> Bool
canOptimizeDivision :: CmmConfig -> Width -> Bool
canOptimizeDivision CmmConfig
cfg Width
rep = CmmConfig -> Bool
cmmOptConstDivision CmmConfig
cfg Bool -> Bool -> Bool
&&
(Width
rep Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Platform -> Width
wordWidth Platform
platform Bool -> Bool -> Bool
|| (Width
rep Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Platform -> Width
wordWidth Platform
platform Bool -> Bool -> Bool
&& CmmConfig -> Bool
cmmAllowMul2 CmmConfig
cfg))
where platform :: Platform
platform = CmmConfig -> Platform
cmmPlatform CmmConfig
cfg
cmmCallishMachOpFold :: CallishMachOp -> [CmmFormal] -> [CmmActual] -> Opt (CmmNode O O)
cmmCallishMachOpFold :: CallishMachOp
-> [CmmFormal] -> [CmmActual] -> Opt (CmmNode 'Open 'Open)
cmmCallishMachOpFold CallishMachOp
op [CmmFormal]
res [CmmActual]
args =
CmmNode 'Open 'Open
-> Maybe (CmmNode 'Open 'Open) -> CmmNode 'Open 'Open
forall a. a -> Maybe a -> a
fromMaybe (ForeignTarget -> [CmmFormal] -> [CmmActual] -> CmmNode 'Open 'Open
CmmUnsafeForeignCall (CallishMachOp -> ForeignTarget
PrimTarget CallishMachOp
op) [CmmFormal]
res [CmmActual]
args) (Maybe (CmmNode 'Open 'Open) -> CmmNode 'Open 'Open)
-> Opt (Maybe (CmmNode 'Open 'Open)) -> Opt (CmmNode 'Open 'Open)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Opt CmmConfig
getConfig Opt CmmConfig
-> (CmmConfig -> Opt (Maybe (CmmNode 'Open 'Open)))
-> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. Opt a -> (a -> Opt b) -> Opt b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CmmConfig
cfg -> CmmConfig
-> CallishMachOp
-> [CmmFormal]
-> [CmmActual]
-> Opt (Maybe (CmmNode 'Open 'Open))
cmmCallishMachOpFoldM CmmConfig
cfg CallishMachOp
op [CmmFormal]
res [CmmActual]
args)
cmmCallishMachOpFoldM :: CmmConfig -> CallishMachOp -> [CmmFormal] -> [CmmActual] -> Opt (Maybe (CmmNode O O))
cmmCallishMachOpFoldM :: CmmConfig
-> CallishMachOp
-> [CmmFormal]
-> [CmmActual]
-> Opt (Maybe (CmmNode 'Open 'Open))
cmmCallishMachOpFoldM CmmConfig
cfg CallishMachOp
op [CmmFormal]
res [x :: CmmActual
x@(CmmLit CmmLit
_),CmmActual
y]
| CallishMachOp -> Bool
isCommutableCallishMachOp CallishMachOp
op Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmActual -> Bool
isLit CmmActual
y) = CmmConfig
-> CallishMachOp
-> [CmmFormal]
-> [CmmActual]
-> Opt (Maybe (CmmNode 'Open 'Open))
cmmCallishMachOpFoldM CmmConfig
cfg CallishMachOp
op [CmmFormal]
res [CmmActual
y,CmmActual
x]
cmmCallishMachOpFoldM CmmConfig
_ CallishMachOp
op [CmmFormal]
res [CmmLit (CmmInt Integer
x Width
_), CmmLit (CmmInt Integer
y Width
_)]
= case CallishMachOp
op of
MO_S_Mul2 Width
rep
| [CmmFormal
rHiNeeded,CmmFormal
rHi,CmmFormal
rLo] <- [CmmFormal]
res -> do
let resSz :: Int
resSz = Width -> Int
widthInBits Width
rep
resVal :: Integer
resVal = (Width -> Integer -> Integer
narrowS Width
rep Integer
x) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Width -> Integer -> Integer
narrowS Width
rep Integer
y)
high :: Integer
high = Integer
resVal Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
resSz
low :: Integer
low = Width -> Integer -> Integer
narrowS Width
rep Integer
resVal
isHiNeeded :: Bool
isHiNeeded = Integer
high Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
low Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
resSz
isHiNeededVal :: Integer
isHiNeededVal = if Bool
isHiNeeded then Integer
1 else Integer
0
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rHiNeeded) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
isHiNeededVal Width
rep)
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rHi) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
high Width
rep)
Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open)))
-> (CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open))
-> CmmNode 'Open 'Open
-> Opt (Maybe (CmmNode 'Open 'Open))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open)
forall a. a -> Maybe a
Just (CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open)))
-> CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rLo) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
low Width
rep)
MO_U_Mul2 Width
rep
| [CmmFormal
rHi,CmmFormal
rLo] <- [CmmFormal]
res -> do
let resSz :: Int
resSz = Width -> Int
widthInBits Width
rep
resVal :: Integer
resVal = (Width -> Integer -> Integer
narrowU Width
rep Integer
x) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Width -> Integer -> Integer
narrowU Width
rep Integer
y)
high :: Integer
high = Integer
resVal Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
resSz
low :: Integer
low = Width -> Integer -> Integer
narrowU Width
rep Integer
resVal
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rHi) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
high Width
rep)
Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open)))
-> (CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open))
-> CmmNode 'Open 'Open
-> Opt (Maybe (CmmNode 'Open 'Open))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open)
forall a. a -> Maybe a
Just (CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open)))
-> CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rLo) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
low Width
rep)
MO_S_QuotRem Width
rep
| [CmmFormal
rQuot, CmmFormal
rRem] <- [CmmFormal]
res,
Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 -> do
let (Integer
q,Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem (Width -> Integer -> Integer
narrowS Width
rep Integer
x) (Width -> Integer -> Integer
narrowS Width
rep Integer
y)
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rQuot) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
q Width
rep)
Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open)))
-> (CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open))
-> CmmNode 'Open 'Open
-> Opt (Maybe (CmmNode 'Open 'Open))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open)
forall a. a -> Maybe a
Just (CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open)))
-> CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rRem) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
r Width
rep)
MO_U_QuotRem Width
rep
| [CmmFormal
rQuot, CmmFormal
rRem] <- [CmmFormal]
res,
Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 -> do
let (Integer
q,Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem (Width -> Integer -> Integer
narrowU Width
rep Integer
x) (Width -> Integer -> Integer
narrowU Width
rep Integer
y)
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rQuot) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
q Width
rep)
Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open)))
-> (CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open))
-> CmmNode 'Open 'Open
-> Opt (Maybe (CmmNode 'Open 'Open))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open)
forall a. a -> Maybe a
Just (CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open)))
-> CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rRem) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
r Width
rep)
CallishMachOp
_ -> Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (CmmNode 'Open 'Open)
forall a. Maybe a
Nothing
cmmCallishMachOpFoldM CmmConfig
_ CallishMachOp
op [CmmFormal]
res [CmmActual
_, CmmLit (CmmInt Integer
0 Width
_)]
= case CallishMachOp
op of
MO_S_Mul2 Width
rep
| [CmmFormal
rHiNeeded, CmmFormal
rHi, CmmFormal
rLo] <- [CmmFormal]
res -> do
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rHiNeeded) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rHi) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open)))
-> (CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open))
-> CmmNode 'Open 'Open
-> Opt (Maybe (CmmNode 'Open 'Open))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open)
forall a. a -> Maybe a
Just (CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open)))
-> CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rLo) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
MO_U_Mul2 Width
rep
| [CmmFormal
rHi, CmmFormal
rLo] <- [CmmFormal]
res -> do
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rHi) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open)))
-> (CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open))
-> CmmNode 'Open 'Open
-> Opt (Maybe (CmmNode 'Open 'Open))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open)
forall a. a -> Maybe a
Just (CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open)))
-> CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rLo) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
CallishMachOp
_ -> Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (CmmNode 'Open 'Open)
forall a. Maybe a
Nothing
cmmCallishMachOpFoldM CmmConfig
_ CallishMachOp
op [CmmFormal]
res [CmmLit (CmmInt Integer
0 Width
_), CmmActual
_]
= case CallishMachOp
op of
MO_S_QuotRem Width
rep
| [CmmFormal
rQuot, CmmFormal
rRem] <- [CmmFormal]
res -> do
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rQuot) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open)))
-> (CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open))
-> CmmNode 'Open 'Open
-> Opt (Maybe (CmmNode 'Open 'Open))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open)
forall a. a -> Maybe a
Just (CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open)))
-> CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rRem) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
MO_U_QuotRem Width
rep
| [CmmFormal
rQuot,CmmFormal
rRem] <- [CmmFormal]
res -> do
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rQuot) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open)))
-> (CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open))
-> CmmNode 'Open 'Open
-> Opt (Maybe (CmmNode 'Open 'Open))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open)
forall a. a -> Maybe a
Just (CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open)))
-> CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rRem) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
CallishMachOp
_ -> Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (CmmNode 'Open 'Open)
forall a. Maybe a
Nothing
cmmCallishMachOpFoldM CmmConfig
cfg CallishMachOp
op [CmmFormal]
res [CmmActual
x, CmmLit (CmmInt Integer
1 Width
_)]
= case CallishMachOp
op of
MO_S_Mul2 Width
rep
| [CmmFormal
rHiNeeded, CmmFormal
rHi, CmmFormal
rLo] <- [CmmFormal]
res -> do
let platform :: Platform
platform = CmmConfig -> Platform
cmmPlatform CmmConfig
cfg
wordRep :: Width
wordRep = Platform -> Width
wordWidth Platform
platform
repInBits :: Integer
repInBits = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBits Width
rep
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rHiNeeded) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rHi) (Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_S_Shr Width
rep) [CmmActual
x, CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt (Integer
repInBits Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Width
wordRep])
Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open)))
-> (CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open))
-> CmmNode 'Open 'Open
-> Opt (Maybe (CmmNode 'Open 'Open))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open)
forall a. a -> Maybe a
Just (CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open)))
-> CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rLo) CmmActual
x
MO_U_Mul2 Width
rep
| [CmmFormal
rHi, CmmFormal
rLo] <- [CmmFormal]
res -> do
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rHi) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open)))
-> (CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open))
-> CmmNode 'Open 'Open
-> Opt (Maybe (CmmNode 'Open 'Open))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open)
forall a. a -> Maybe a
Just (CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open)))
-> CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rLo) CmmActual
x
MO_S_QuotRem Width
rep
| [CmmFormal
rQuot, CmmFormal
rRem] <- [CmmFormal]
res -> do
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rQuot) CmmActual
x
Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open)))
-> (CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open))
-> CmmNode 'Open 'Open
-> Opt (Maybe (CmmNode 'Open 'Open))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open)
forall a. a -> Maybe a
Just (CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open)))
-> CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rRem) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
MO_U_QuotRem Width
rep
| [CmmFormal
rQuot, CmmFormal
rRem] <- [CmmFormal]
res -> do
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rQuot) CmmActual
x
Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open)))
-> (CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open))
-> CmmNode 'Open 'Open
-> Opt (Maybe (CmmNode 'Open 'Open))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open)
forall a. a -> Maybe a
Just (CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open)))
-> CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rRem) (CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
rep)
CallishMachOp
_ -> Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (CmmNode 'Open 'Open)
forall a. Maybe a
Nothing
cmmCallishMachOpFoldM CmmConfig
cfg CallishMachOp
op [CmmFormal]
res [CmmActual
n, CmmLit (CmmInt Integer
d' Width
_)]
= case CallishMachOp
op of
MO_S_QuotRem Width
rep
| Just Integer
p <- Integer -> Maybe Integer
exactLog2 Integer
d,
[CmmFormal
rQuot,CmmFormal
rRem] <- [CmmFormal]
res -> do
n' <- CmmActual -> CmmType -> Opt CmmActual
intoRegister CmmActual
n (Width -> CmmType
cmmBits Width
rep)
prependNode $! CmmAssign (CmmLocal rQuot)
(cmmMachOpFold platform (MO_S_Shr rep)
[signedQuotRemHelper platform d n' rep p, CmmLit (CmmInt p $ wordWidth platform)])
pure . Just $! CmmAssign (CmmLocal rRem)
(cmmMachOpFold platform (MO_Sub rep)
[n', cmmMachOpFold platform (MO_And rep)
[signedQuotRemHelper platform d n' rep p, CmmLit (CmmInt (- d) rep)]])
| CmmConfig -> Width -> Bool
canOptimizeDivision CmmConfig
cfg Width
rep,
Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= (-Integer
1), Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0, Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
1,
[CmmFormal
rQuot,CmmFormal
rRem] <- [CmmFormal]
res -> do
n' <- CmmActual -> CmmType -> Opt CmmActual
intoRegister CmmActual
n (Width -> CmmType
cmmBits Width
rep)
q <- generateDivisionBySigned platform cfg rep n' d
q' <- intoRegister q (cmmBits rep)
prependNode $! CmmAssign (CmmLocal rQuot) q'
pure . Just $! CmmAssign (CmmLocal rRem) $ CmmMachOp (MO_Sub rep) [n', CmmMachOp (MO_Mul rep) [q', CmmLit $ CmmInt d rep]]
where
platform :: Platform
platform = CmmConfig -> Platform
cmmPlatform CmmConfig
cfg
d :: Integer
d = Width -> Integer -> Integer
narrowS Width
rep Integer
d'
MO_U_QuotRem Width
rep
| Just Integer
p <- Integer -> Maybe Integer
exactLog2 Integer
d,
[CmmFormal
rQuot,CmmFormal
rRem] <- [CmmFormal]
res -> do
CmmNode 'Open 'Open -> Opt ()
prependNode (CmmNode 'Open 'Open -> Opt ()) -> CmmNode 'Open 'Open -> Opt ()
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rQuot) (CmmActual -> CmmNode 'Open 'Open)
-> CmmActual -> CmmNode 'Open 'Open
forall a b. (a -> b) -> a -> b
$ MachOp -> [CmmActual] -> CmmActual
CmmMachOp (Width -> MachOp
MO_U_Shr Width
rep) [CmmActual
n, CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
p (Width -> CmmLit) -> Width -> CmmLit
forall a b. (a -> b) -> a -> b
$ Platform -> Width
wordWidth Platform
platform)]
Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open)))
-> (CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open))
-> CmmNode 'Open 'Open
-> Opt (Maybe (CmmNode 'Open 'Open))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode 'Open 'Open -> Maybe (CmmNode 'Open 'Open)
forall a. a -> Maybe a
Just (CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open)))
-> CmmNode 'Open 'Open -> Opt (Maybe (CmmNode 'Open 'Open))
forall a b. (a -> b) -> a -> b
$! CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign (CmmFormal -> CmmReg
CmmLocal CmmFormal
rRem) (CmmActual -> CmmNode 'Open 'Open)
-> CmmActual -> CmmNode 'Open 'Open
forall a b. (a -> b) -> a -> b
$ MachOp -> [CmmActual] -> CmmActual
CmmMachOp (Width -> MachOp
MO_And Width
rep) [CmmActual
n, CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Width
rep)]
| CmmConfig -> Width -> Bool
canOptimizeDivision CmmConfig
cfg Width
rep,
Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0, Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
1,
[CmmFormal
rQuot,CmmFormal
rRem] <- [CmmFormal]
res -> do
n' <- CmmActual -> CmmType -> Opt CmmActual
intoRegister CmmActual
n (Width -> CmmType
cmmBits Width
rep)
q <- generateDivisionByUnsigned platform cfg rep n' d
q' <- intoRegister q (cmmBits rep)
prependNode $! CmmAssign (CmmLocal rQuot) q'
pure . Just $! CmmAssign (CmmLocal rRem) $ CmmMachOp (MO_Sub rep) [n', CmmMachOp (MO_Mul rep) [q', CmmLit $ CmmInt d rep]]
where
platform :: Platform
platform = CmmConfig -> Platform
cmmPlatform CmmConfig
cfg
d :: Integer
d = Width -> Integer -> Integer
narrowU Width
rep Integer
d'
CallishMachOp
_ -> Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (CmmNode 'Open 'Open)
forall a. Maybe a
Nothing
cmmCallishMachOpFoldM CmmConfig
_ CallishMachOp
_ [CmmFormal]
_ [CmmActual]
_ = Maybe (CmmNode 'Open 'Open) -> Opt (Maybe (CmmNode 'Open 'Open))
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (CmmNode 'Open 'Open)
forall a. Maybe a
Nothing
cmmMachOpFoldOptM :: CmmConfig -> MachOp -> [CmmExpr] -> Opt (Maybe CmmExpr)
cmmMachOpFoldOptM :: CmmConfig -> MachOp -> [CmmActual] -> Opt (Maybe CmmActual)
cmmMachOpFoldOptM CmmConfig
cfg MachOp
op [CmmActual
n, CmmLit (CmmInt Integer
d' Width
_)] =
case MachOp
op of
MO_S_Quot Width
rep
| Just Integer
p <- Integer -> Maybe Integer
exactLog2 Integer
d -> do
n' <- CmmActual -> CmmType -> Opt CmmActual
intoRegister CmmActual
n (Width -> CmmType
cmmBits Width
rep)
pure . Just $! cmmMachOpFold platform (MO_S_Shr rep)
[ signedQuotRemHelper platform d n' rep p
, CmmLit (CmmInt p $ wordWidth platform)
]
| CmmConfig -> Width -> Bool
canOptimizeDivision CmmConfig
cfg Width
rep,
Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= (-Integer
1), Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0, Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
1 -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual)
-> Opt CmmActual -> Opt (Maybe CmmActual)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Platform
-> CmmConfig -> Width -> CmmActual -> Integer -> Opt CmmActual
generateDivisionBySigned Platform
platform CmmConfig
cfg Width
rep CmmActual
n Integer
d
where d :: Integer
d = Width -> Integer -> Integer
narrowS Width
rep Integer
d'
MO_S_Rem Width
rep
| Just Integer
p <- Integer -> Maybe Integer
exactLog2 Integer
d -> do
n' <- CmmActual -> CmmType -> Opt CmmActual
intoRegister CmmActual
n (Width -> CmmType
cmmBits Width
rep)
pure . Just $! cmmMachOpFold platform (MO_Sub rep)
[ n'
, cmmMachOpFold platform (MO_And rep)
[ signedQuotRemHelper platform d n' rep p
, CmmLit (CmmInt (- d) rep)
]
]
| CmmConfig -> Width -> Bool
canOptimizeDivision CmmConfig
cfg Width
rep,
Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= (-Integer
1), Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0, Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
1 -> do
n' <- CmmActual -> CmmType -> Opt CmmActual
intoRegister CmmActual
n (Width -> CmmType
cmmBits Width
rep)
q <- generateDivisionBySigned platform cfg rep n' d
pure . Just $! CmmMachOp (MO_Sub rep) [n', CmmMachOp (MO_Mul rep) [q, CmmLit $ CmmInt d rep]]
where d :: Integer
d = Width -> Integer -> Integer
narrowS Width
rep Integer
d'
MO_U_Quot Width
rep
| CmmConfig -> Width -> Bool
canOptimizeDivision CmmConfig
cfg Width
rep,
Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0, Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
1, Maybe Integer
Nothing <- Integer -> Maybe Integer
exactLog2 Integer
d -> CmmActual -> Maybe CmmActual
forall a. a -> Maybe a
Just (CmmActual -> Maybe CmmActual)
-> Opt CmmActual -> Opt (Maybe CmmActual)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Platform
-> CmmConfig -> Width -> CmmActual -> Integer -> Opt CmmActual
generateDivisionByUnsigned Platform
platform CmmConfig
cfg Width
rep CmmActual
n Integer
d
where d :: Integer
d = Width -> Integer -> Integer
narrowU Width
rep Integer
d'
MO_U_Rem Width
rep
| CmmConfig -> Width -> Bool
canOptimizeDivision CmmConfig
cfg Width
rep,
Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0, Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
1, Maybe Integer
Nothing <- Integer -> Maybe Integer
exactLog2 Integer
d -> do
n' <- CmmActual -> CmmType -> Opt CmmActual
intoRegister CmmActual
n (Width -> CmmType
cmmBits Width
rep)
q <- generateDivisionByUnsigned platform cfg rep n d
pure . Just $! CmmMachOp (MO_Sub rep) [n', CmmMachOp (MO_Mul rep) [q, CmmLit $ CmmInt d rep]]
where d :: Integer
d = Width -> Integer -> Integer
narrowU Width
rep Integer
d'
MachOp
_ -> Maybe CmmActual -> Opt (Maybe CmmActual)
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CmmActual
forall a. Maybe a
Nothing
where platform :: Platform
platform = CmmConfig -> Platform
cmmPlatform CmmConfig
cfg
cmmMachOpFoldOptM CmmConfig
_ MachOp
_ [CmmActual]
_ = Maybe CmmActual -> Opt (Maybe CmmActual)
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CmmActual
forall a. Maybe a
Nothing
intoRegister :: CmmExpr -> CmmType -> Opt CmmExpr
intoRegister :: CmmActual -> CmmType -> Opt CmmActual
intoRegister e :: CmmActual
e@(CmmReg CmmReg
_) CmmType
_ = CmmActual -> Opt CmmActual
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmmActual
e
intoRegister CmmActual
expr CmmType
ty = do
u <- Opt Unique
forall (m :: * -> *). MonadGetUnique m => m Unique
getUniqueM
let reg = Unique -> CmmType -> CmmFormal
LocalReg Unique
u CmmType
ty
CmmReg (CmmLocal reg) <$ prependNode (CmmAssign (CmmLocal reg) expr)
prependNode :: CmmNode O O -> Opt ()
prependNode :: CmmNode 'Open 'Open -> Opt ()
prependNode CmmNode 'Open 'Open
n = (CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], ()))
-> Opt ()
forall a.
(CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a
Opt ((CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], ()))
-> Opt ())
-> (CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], ()))
-> Opt ()
forall a b. (a -> b) -> a -> b
$ \CmmConfig
_ [CmmNode 'Open 'Open]
xs -> ([CmmNode 'Open 'Open], ()) -> UniqDSM ([CmmNode 'Open 'Open], ())
forall a. a -> UniqDSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CmmNode 'Open 'Open]
xs [CmmNode 'Open 'Open]
-> [CmmNode 'Open 'Open] -> [CmmNode 'Open 'Open]
forall a. [a] -> [a] -> [a]
++ [CmmNode 'Open 'Open
n], ())
signedQuotRemHelper :: Platform -> Integer -> CmmExpr -> Width -> Integer -> CmmExpr
signedQuotRemHelper :: Platform -> Integer -> CmmActual -> Width -> Integer -> CmmActual
signedQuotRemHelper Platform
platform Integer
n CmmActual
x Width
rep Integer
p = MachOp -> [CmmActual] -> CmmActual
CmmMachOp (Width -> MachOp
MO_Add Width
rep) [CmmActual
x, CmmActual
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
- Integer
1
shr :: MachOp
shr = if Integer
p Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Width -> MachOp
MO_U_Shr Width
rep else Width -> MachOp
MO_S_Shr Width
rep
x1 :: CmmActual
x1 = MachOp -> [CmmActual] -> CmmActual
CmmMachOp MachOp
shr [CmmActual
x, CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
bits (Width -> CmmLit) -> Width -> CmmLit
forall a b. (a -> b) -> a -> b
$ Platform -> Width
wordWidth Platform
platform)]
x2 :: CmmActual
x2 = if Integer
p Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then CmmActual
x1 else
MachOp -> [CmmActual] -> CmmActual
CmmMachOp (Width -> MachOp
MO_And Width
rep) [CmmActual
x1, CmmLit -> CmmActual
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) Width
rep)]
generateDivisionBySigned :: Platform -> CmmConfig -> Width -> CmmExpr -> Integer -> Opt CmmExpr
generateDivisionBySigned :: Platform
-> CmmConfig -> Width -> CmmActual -> Integer -> Opt CmmActual
generateDivisionBySigned Platform
_ CmmConfig
_ Width
_ CmmActual
_ Integer
0 = String -> Opt CmmActual
forall a. HasCallStack => String -> a
panic String
"generate signed division with 0"
generateDivisionBySigned Platform
_ CmmConfig
_ Width
_ CmmActual
_ Integer
1 = String -> Opt CmmActual
forall a. HasCallStack => String -> a
panic String
"generate signed division with 1"
generateDivisionBySigned Platform
_ CmmConfig
_ Width
_ CmmActual
_ (-1) = String -> Opt CmmActual
forall a. HasCallStack => String -> a
panic String
"generate signed division with -1"
generateDivisionBySigned Platform
_ CmmConfig
_ Width
_ CmmActual
_ Integer
d | Just Integer
_ <- Integer -> Maybe Integer
exactLog2 Integer
d = String -> Opt CmmActual
forall a. HasCallStack => String -> a
panic (String -> Opt CmmActual) -> String -> Opt CmmActual
forall a b. (a -> b) -> a -> b
$ String
"generate signed division with " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
d
generateDivisionBySigned Platform
platform CmmConfig
_cfg Width
rep CmmActual
n Integer
divisor = do
n' <- if Integer
sign Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then CmmActual -> Opt CmmActual
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmmActual
n else CmmActual -> CmmType -> Opt CmmActual
intoRegister CmmActual
n CmmType
resRep
(shift', qExpr) <- mul2 n'
let qExpr' = case Integer
sign of
Integer
1 -> MachOp -> [CmmActual] -> CmmActual
CmmMachOp (Width -> MachOp
MO_Add Width
rep) [CmmActual
qExpr, CmmActual
n']
-1 -> MachOp -> [CmmActual] -> CmmActual
CmmMachOp (Width -> MachOp
MO_Sub Width
rep) [CmmActual
qExpr, CmmActual
n']
Integer
_ -> CmmActual
qExpr
qExpr'' <- intoRegister (cmmMachOpFold platform (MO_S_Shr rep) [qExpr', CmmLit $ CmmInt shift' wordRep]) resRep
pure $! cmmMachOpFold platform
(MO_Add rep) [qExpr'', cmmMachOpFold platform (MO_U_Shr rep) [qExpr'', CmmLit $ CmmInt (toInteger $ widthInBits rep - 1) wordRep]]
where
resRep :: CmmType
resRep = Width -> CmmType
cmmBits Width
rep
wordRep :: Width
wordRep = Platform -> Width
wordWidth Platform
platform
(Integer
magic, Integer
sign, Integer
shift) = Width -> Integer -> (Integer, Integer, Integer)
divisionMagicS Width
rep Integer
divisor
mul2 :: CmmActual -> Opt (Integer, CmmActual)
mul2 CmmActual
n
| Width
rep Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Platform -> Width
wordWidth Platform
platform = do
(r1, r2, r3) <- (,,) (Unique -> Unique -> Unique -> (Unique, Unique, Unique))
-> Opt Unique -> Opt (Unique -> Unique -> (Unique, Unique, Unique))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Opt Unique
forall (m :: * -> *). MonadGetUnique m => m Unique
getUniqueM Opt (Unique -> Unique -> (Unique, Unique, Unique))
-> Opt Unique -> Opt (Unique -> (Unique, Unique, Unique))
forall a b. Opt (a -> b) -> Opt a -> Opt b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Opt Unique
forall (m :: * -> *). MonadGetUnique m => m Unique
getUniqueM Opt (Unique -> (Unique, Unique, Unique))
-> Opt Unique -> Opt (Unique, Unique, Unique)
forall a b. Opt (a -> b) -> Opt a -> Opt b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Opt Unique
forall (m :: * -> *). MonadGetUnique m => m Unique
getUniqueM
let rg1 = Unique -> CmmType -> CmmFormal
LocalReg Unique
r1 CmmType
resRep
resReg = Unique -> CmmType -> CmmFormal
LocalReg Unique
r2 CmmType
resRep
rg3 = Unique -> CmmType -> CmmFormal
LocalReg Unique
r3 CmmType
resRep
res <- CmmReg (CmmLocal resReg) <$ prependNode (CmmUnsafeForeignCall (PrimTarget (MO_S_Mul2 rep)) [rg1, resReg, rg3] [n, CmmLit $ CmmInt magic rep])
pure (shift, res)
| Bool
otherwise = (Integer, CmmActual) -> Opt (Integer, CmmActual)
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (if Integer
sign Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Integer
0 else Integer
shift, CmmActual
res)
where
wordRep :: Width
wordRep = Platform -> Width
wordWidth Platform
platform
res :: CmmActual
res = Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> Width -> MachOp
MO_SS_Conv Width
wordRep Width
rep)
[ Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_S_Shr Width
wordRep)
[ Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_Mul Width
wordRep)
[ Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> Width -> MachOp
MO_SS_Conv Width
rep Width
wordRep) [CmmActual
n]
, CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
magic Width
wordRep
]
, CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt ((if Integer
sign Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
shift else Integer
0) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBits Width
rep)) Width
wordRep
]
]
divisionMagicS :: Width -> Integer -> (Integer, Integer, Integer)
divisionMagicS :: Width -> Integer -> (Integer, Integer, Integer)
divisionMagicS Width
rep Integer
divisor = (Integer
magic, Integer
sign, Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wSz)
where
sign :: Integer
sign = if Integer
divisor Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0
then if Integer
magic Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Integer
1 else Integer
0
else if Integer
magic Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Integer
0 else -Integer
1
wSz :: Int
wSz = Width -> Int
widthInBits Width
rep
ad :: Integer
ad = Integer -> Integer
forall a. Num a => a -> a
abs Integer
divisor
t :: Integer
t = (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Int
wSz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ if Integer
divisor Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then Integer
0 else Integer
1
anc :: Integer
anc = Integer
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem Integer
t Integer
ad
go :: Int -> Int
go Int
p'
| Integer
twoP Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
anc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
ad Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem Integer
twoP Integer
ad) = Int
p'
| Bool
otherwise = Int -> Int
go (Int
p' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
where twoP :: Integer
twoP = Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
p'
p :: Int
p = Int -> Int
go Int
wSz
am :: Integer
am = (Integer
twoP Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
ad Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem Integer
twoP Integer
ad) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
ad
where twoP :: Integer
twoP = Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
p
magic :: Integer
magic = Width -> Integer -> Integer
narrowS Width
rep (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ if Integer
divisor Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then Integer
am else -Integer
am
generateDivisionByUnsigned :: Platform -> CmmConfig -> Width -> CmmExpr -> Integer -> Opt CmmExpr
generateDivisionByUnsigned :: Platform
-> CmmConfig -> Width -> CmmActual -> Integer -> Opt CmmActual
generateDivisionByUnsigned Platform
_ CmmConfig
_ Width
_ CmmActual
_ Integer
0 = String -> Opt CmmActual
forall a. HasCallStack => String -> a
panic String
"generate signed division with 0"
generateDivisionByUnsigned Platform
_ CmmConfig
_ Width
_ CmmActual
_ Integer
1 = String -> Opt CmmActual
forall a. HasCallStack => String -> a
panic String
"generate signed division with 1"
generateDivisionByUnsigned Platform
_ CmmConfig
_ Width
_ CmmActual
_ Integer
d | Just Integer
_ <- Integer -> Maybe Integer
exactLog2 Integer
d = String -> Opt CmmActual
forall a. HasCallStack => String -> a
panic (String -> Opt CmmActual) -> String -> Opt CmmActual
forall a b. (a -> b) -> a -> b
$ String
"generate signed division with " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
d
generateDivisionByUnsigned Platform
platform CmmConfig
cfg Width
rep CmmActual
n Integer
divisor = do
n' <- if Bool -> Bool
not Bool
needsAdd
then CmmActual -> Opt CmmActual
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CmmActual -> Opt CmmActual) -> CmmActual -> Opt CmmActual
forall a b. (a -> b) -> a -> b
$! Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_U_Shr Width
rep) [CmmActual
n, CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
preShift Width
wordRep]
else CmmActual -> CmmType -> Opt CmmActual
intoRegister CmmActual
n CmmType
resRep
(postShift', qExpr) <- mul2 n'
let qExpr' = if Bool
needsAdd
then Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_Add Width
rep)
[ Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_U_Shr Width
rep)
[ Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_Sub Width
rep) [CmmActual
n', CmmActual
qExpr]
, CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
1 Width
wordRep
]
, CmmActual
qExpr
]
else CmmActual
qExpr
finalShift = if Bool
needsAdd then Integer
postShift' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 else Integer
postShift'
pure $! cmmMachOpFold platform (MO_U_Shr rep) [qExpr', CmmLit $ CmmInt finalShift wordRep]
where
resRep :: CmmType
resRep = Width -> CmmType
cmmBits Width
rep
wordRep :: Width
wordRep = Platform -> Width
wordWidth Platform
platform
(Integer
preShift, Integer
magic, Bool
needsAdd, Integer
postShift) =
let withPre :: (Integer, Integer, Bool, Integer)
withPre = Width -> Bool -> Integer -> (Integer, Integer, Bool, Integer)
divisionMagicU Width
rep Bool
True Integer
divisor
noPre :: (Integer, Integer, Bool, Integer)
noPre = Width -> Bool -> Integer -> (Integer, Integer, Bool, Integer)
divisionMagicU Width
rep Bool
False Integer
divisor
in case ((Integer, Integer, Bool, Integer)
withPre, (Integer, Integer, Bool, Integer)
noPre) of
((Integer
_, Integer
_, Bool
False, Integer
_), (Integer
_, Integer
_, Bool
True, Integer
_)) -> (Integer, Integer, Bool, Integer)
withPre
((Integer, Integer, Bool, Integer),
(Integer, Integer, Bool, Integer))
_ -> (Integer, Integer, Bool, Integer)
noPre
mul2 :: CmmActual -> Opt (Integer, CmmActual)
mul2 CmmActual
n
| Width
rep Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Platform -> Width
wordWidth Platform
platform Bool -> Bool -> Bool
|| (CmmConfig -> Bool
cmmAllowMul2 CmmConfig
cfg Bool -> Bool -> Bool
&& Bool
needsAdd) = do
(r1, r2) <- (,) (Unique -> Unique -> (Unique, Unique))
-> Opt Unique -> Opt (Unique -> (Unique, Unique))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Opt Unique
forall (m :: * -> *). MonadGetUnique m => m Unique
getUniqueM Opt (Unique -> (Unique, Unique))
-> Opt Unique -> Opt (Unique, Unique)
forall a b. Opt (a -> b) -> Opt a -> Opt b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Opt Unique
forall (m :: * -> *). MonadGetUnique m => m Unique
getUniqueM
let rg1 = Unique -> CmmType -> CmmFormal
LocalReg Unique
r1 CmmType
resRep
resReg = Unique -> CmmType -> CmmFormal
LocalReg Unique
r2 CmmType
resRep
res <- CmmReg (CmmLocal resReg) <$ prependNode (CmmUnsafeForeignCall (PrimTarget (MO_U_Mul2 rep)) [resReg, rg1] [n, CmmLit $ CmmInt magic rep])
pure (postShift, res)
| Bool
otherwise = do
(Integer, CmmActual) -> Opt (Integer, CmmActual)
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (if Bool
needsAdd then Integer
postShift else Integer
0, CmmActual
res)
where
wordRep :: Width
wordRep = Platform -> Width
wordWidth Platform
platform
res :: CmmActual
res = Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> Width -> MachOp
MO_UU_Conv Width
wordRep Width
rep)
[ Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_U_Shr Width
wordRep)
[ Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> MachOp
MO_Mul Width
wordRep)
[ Platform -> MachOp -> [CmmActual] -> CmmActual
cmmMachOpFold Platform
platform (Width -> Width -> MachOp
MO_UU_Conv Width
rep Width
wordRep) [CmmActual
n]
, CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
magic Width
wordRep
]
, CmmLit -> CmmActual
CmmLit (CmmLit -> CmmActual) -> CmmLit -> CmmActual
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt ((if Bool
needsAdd then Integer
0 else Integer
postShift) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBits Width
rep)) Width
wordRep
]
]
divisionMagicU :: Width -> Bool -> Integer -> (Integer, Integer, Bool, Integer)
divisionMagicU :: Width -> Bool -> Integer -> (Integer, Integer, Bool, Integer)
divisionMagicU Width
rep Bool
doPreShift Integer
divisor = (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
zeros, Integer
magic, Bool
needsAdd, Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wSz)
where
wSz :: Int
wSz = Width -> Int
widthInBits Width
rep
zeros :: Int
zeros = if Bool
doPreShift then Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger @Word64 Integer
divisor else Int
0
d :: Integer
d = Integer
divisor Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
zeros
ones :: Integer
ones = ((Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
wSz) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
zeros
nc :: Integer
nc = Integer
ones Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem (Integer
ones Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
d) Integer
d
go :: Int -> Int
go Int
p'
| Integer
twoP Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
nc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem (Integer
twoP Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer
d) = Int
p'
| Bool
otherwise = Int -> Int
go (Int
p' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
where twoP :: Integer
twoP = Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
p'
p :: Int
p = Int -> Int
go Int
wSz
m :: Integer
m = (Integer
twoP Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem (Integer
twoP Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer
d) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
d
where twoP :: Integer
twoP = Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
p
needsAdd :: Bool
needsAdd = Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wSz)
magic :: Integer
magic = if Bool
needsAdd then Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
ones Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) else Integer
m
newtype Opt a = OptI { forall a.
Opt a
-> CmmConfig
-> [CmmNode 'Open 'Open]
-> UniqDSM ([CmmNode 'Open 'Open], a)
runOptI :: CmmConfig -> [CmmNode O O] -> UniqDSM ([CmmNode O O], a) }
pattern Opt :: (CmmConfig -> [CmmNode O O] -> UniqDSM ([CmmNode O O], a)) -> Opt a
pattern $mOpt :: forall {r} {a}.
Opt a
-> ((CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> r)
-> ((# #) -> r)
-> r
$bOpt :: forall a.
(CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a
Opt f <- OptI f
where Opt CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a)
f = (CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a
forall a.
(CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a
OptI ((CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a)
-> ((CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> CmmConfig
-> [CmmNode 'Open 'Open]
-> UniqDSM ([CmmNode 'Open 'Open], a))
-> (CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> CmmConfig
-> [CmmNode 'Open 'Open]
-> UniqDSM ([CmmNode 'Open 'Open], a)
forall a b. (a -> b) -> a -> b
oneShot ((CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a)
-> (CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a
forall a b. (a -> b) -> a -> b
$ \CmmConfig
cfg -> ([CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a)
forall a b. (a -> b) -> a -> b
oneShot (([CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> ([CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> [CmmNode 'Open 'Open]
-> UniqDSM ([CmmNode 'Open 'Open], a)
forall a b. (a -> b) -> a -> b
$ \[CmmNode 'Open 'Open]
out -> CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a)
f CmmConfig
cfg [CmmNode 'Open 'Open]
out
{-# COMPLETE Opt #-}
runOpt :: CmmConfig -> Opt a -> UniqDSM ([CmmNode O O], a)
runOpt :: forall a. CmmConfig -> Opt a -> UniqDSM ([CmmNode 'Open 'Open], a)
runOpt CmmConfig
cf (Opt CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a)
g) = CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a)
g CmmConfig
cf []
getConfig :: Opt CmmConfig
getConfig :: Opt CmmConfig
getConfig = (CmmConfig
-> [CmmNode 'Open 'Open]
-> UniqDSM ([CmmNode 'Open 'Open], CmmConfig))
-> Opt CmmConfig
forall a.
(CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a
Opt ((CmmConfig
-> [CmmNode 'Open 'Open]
-> UniqDSM ([CmmNode 'Open 'Open], CmmConfig))
-> Opt CmmConfig)
-> (CmmConfig
-> [CmmNode 'Open 'Open]
-> UniqDSM ([CmmNode 'Open 'Open], CmmConfig))
-> Opt CmmConfig
forall a b. (a -> b) -> a -> b
$ \CmmConfig
cf [CmmNode 'Open 'Open]
xs -> ([CmmNode 'Open 'Open], CmmConfig)
-> UniqDSM ([CmmNode 'Open 'Open], CmmConfig)
forall a. a -> UniqDSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CmmNode 'Open 'Open]
xs, CmmConfig
cf)
instance Functor Opt where
fmap :: forall a b. (a -> b) -> Opt a -> Opt b
fmap a -> b
f (Opt CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a)
g) = (CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], b))
-> Opt b
forall a.
(CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a
Opt ((CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], b))
-> Opt b)
-> (CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], b))
-> Opt b
forall a b. (a -> b) -> a -> b
$ \CmmConfig
cf [CmmNode 'Open 'Open]
xs -> (([CmmNode 'Open 'Open], a) -> ([CmmNode 'Open 'Open], b))
-> UniqDSM ([CmmNode 'Open 'Open], a)
-> UniqDSM ([CmmNode 'Open 'Open], b)
forall a b. (a -> b) -> UniqDSM a -> UniqDSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b)
-> ([CmmNode 'Open 'Open], a) -> ([CmmNode 'Open 'Open], b)
forall a b.
(a -> b)
-> ([CmmNode 'Open 'Open], a) -> ([CmmNode 'Open 'Open], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a)
g CmmConfig
cf [CmmNode 'Open 'Open]
xs)
instance Applicative Opt where
pure :: forall a. a -> Opt a
pure a
a = (CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a
forall a.
(CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a
Opt ((CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a)
-> (CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a
forall a b. (a -> b) -> a -> b
$ \CmmConfig
_ [CmmNode 'Open 'Open]
xs -> ([CmmNode 'Open 'Open], a) -> UniqDSM ([CmmNode 'Open 'Open], a)
forall a. a -> UniqDSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CmmNode 'Open 'Open]
xs, a
a)
Opt (a -> b)
ff <*> :: forall a b. Opt (a -> b) -> Opt a -> Opt b
<*> Opt a
fa = do
f <- Opt (a -> b)
ff
f <$> fa
instance Monad Opt where
Opt CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a)
g >>= :: forall a b. Opt a -> (a -> Opt b) -> Opt b
>>= a -> Opt b
f = (CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], b))
-> Opt b
forall a.
(CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a
Opt ((CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], b))
-> Opt b)
-> (CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], b))
-> Opt b
forall a b. (a -> b) -> a -> b
$ \CmmConfig
cf [CmmNode 'Open 'Open]
xs -> do
(ys, a) <- CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a)
g CmmConfig
cf [CmmNode 'Open 'Open]
xs
runOptI (f a) cf ys
instance MonadGetUnique Opt where
getUniqueM :: Opt Unique
getUniqueM = (CmmConfig
-> [CmmNode 'Open 'Open]
-> UniqDSM ([CmmNode 'Open 'Open], Unique))
-> Opt Unique
forall a.
(CmmConfig
-> [CmmNode 'Open 'Open] -> UniqDSM ([CmmNode 'Open 'Open], a))
-> Opt a
Opt ((CmmConfig
-> [CmmNode 'Open 'Open]
-> UniqDSM ([CmmNode 'Open 'Open], Unique))
-> Opt Unique)
-> (CmmConfig
-> [CmmNode 'Open 'Open]
-> UniqDSM ([CmmNode 'Open 'Open], Unique))
-> Opt Unique
forall a b. (a -> b) -> a -> b
$ \CmmConfig
_ [CmmNode 'Open 'Open]
xs -> ([CmmNode 'Open 'Open]
xs,) (Unique -> ([CmmNode 'Open 'Open], Unique))
-> UniqDSM Unique -> UniqDSM ([CmmNode 'Open 'Open], Unique)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UniqDSM Unique
getUniqueDSM
mapForeignTargetOpt :: (CmmExpr -> Opt CmmExpr) -> ForeignTarget -> Opt ForeignTarget
mapForeignTargetOpt :: (CmmActual -> Opt CmmActual) -> ForeignTarget -> Opt ForeignTarget
mapForeignTargetOpt CmmActual -> Opt CmmActual
exp (ForeignTarget CmmActual
e ForeignConvention
c) = (CmmActual -> ForeignConvention -> ForeignTarget)
-> ForeignConvention -> CmmActual -> ForeignTarget
forall a b c. (a -> b -> c) -> b -> a -> c
flip CmmActual -> ForeignConvention -> ForeignTarget
ForeignTarget ForeignConvention
c (CmmActual -> ForeignTarget) -> Opt CmmActual -> Opt ForeignTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmmActual -> Opt CmmActual
exp CmmActual
e
mapForeignTargetOpt CmmActual -> Opt CmmActual
_ m :: ForeignTarget
m@(PrimTarget CallishMachOp
_) = ForeignTarget -> Opt ForeignTarget
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForeignTarget
m
wrapRecExpOpt :: (CmmExpr -> Opt CmmExpr) -> CmmExpr -> Opt CmmExpr
wrapRecExpOpt :: (CmmActual -> Opt CmmActual) -> CmmActual -> Opt CmmActual
wrapRecExpOpt CmmActual -> Opt CmmActual
f (CmmMachOp MachOp
op [CmmActual]
es) = (CmmActual -> Opt CmmActual) -> [CmmActual] -> Opt [CmmActual]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((CmmActual -> Opt CmmActual) -> CmmActual -> Opt CmmActual
wrapRecExpOpt CmmActual -> Opt CmmActual
f) [CmmActual]
es Opt [CmmActual] -> ([CmmActual] -> Opt CmmActual) -> Opt CmmActual
forall a b. Opt a -> (a -> Opt b) -> Opt b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CmmActual -> Opt CmmActual
f (CmmActual -> Opt CmmActual)
-> ([CmmActual] -> CmmActual) -> [CmmActual] -> Opt CmmActual
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MachOp -> [CmmActual] -> CmmActual
CmmMachOp MachOp
op
wrapRecExpOpt CmmActual -> Opt CmmActual
f (CmmLoad CmmActual
addr CmmType
ty AlignmentSpec
align) = (CmmActual -> Opt CmmActual) -> CmmActual -> Opt CmmActual
wrapRecExpOpt CmmActual -> Opt CmmActual
f CmmActual
addr Opt CmmActual -> (CmmActual -> Opt CmmActual) -> Opt CmmActual
forall a b. Opt a -> (a -> Opt b) -> Opt b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CmmActual
newAddr -> CmmActual -> Opt CmmActual
f (CmmActual -> CmmType -> AlignmentSpec -> CmmActual
CmmLoad CmmActual
newAddr CmmType
ty AlignmentSpec
align)
wrapRecExpOpt CmmActual -> Opt CmmActual
f CmmActual
e = CmmActual -> Opt CmmActual
f CmmActual
e
mapExpOpt :: (CmmExpr -> Opt CmmExpr) -> CmmNode e x -> Opt (CmmNode e x)
mapExpOpt :: forall (e :: Extensibility) (x :: Extensibility).
(CmmActual -> Opt CmmActual) -> CmmNode e x -> Opt (CmmNode e x)
mapExpOpt CmmActual -> Opt CmmActual
_ f :: CmmNode e x
f@(CmmEntry{}) = CmmNode e x -> Opt (CmmNode e x)
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmmNode e x
f
mapExpOpt CmmActual -> Opt CmmActual
_ m :: CmmNode e x
m@(CmmComment FastString
_) = CmmNode e x -> Opt (CmmNode e x)
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmmNode e x
m
mapExpOpt CmmActual -> Opt CmmActual
_ m :: CmmNode e x
m@(CmmTick CmmTickish
_) = CmmNode e x -> Opt (CmmNode e x)
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmmNode e x
m
mapExpOpt CmmActual -> Opt CmmActual
f (CmmUnwind [(GlobalReg, Maybe CmmActual)]
regs) = [(GlobalReg, Maybe CmmActual)] -> CmmNode e x
[(GlobalReg, Maybe CmmActual)] -> CmmNode 'Open 'Open
CmmUnwind ([(GlobalReg, Maybe CmmActual)] -> CmmNode e x)
-> Opt [(GlobalReg, Maybe CmmActual)] -> Opt (CmmNode e x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((GlobalReg, Maybe CmmActual) -> Opt (GlobalReg, Maybe CmmActual))
-> [(GlobalReg, Maybe CmmActual)]
-> Opt [(GlobalReg, Maybe CmmActual)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Maybe CmmActual -> Opt (Maybe CmmActual))
-> (GlobalReg, Maybe CmmActual) -> Opt (GlobalReg, Maybe CmmActual)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (GlobalReg, a) -> f (GlobalReg, b)
traverse ((CmmActual -> Opt CmmActual)
-> Maybe CmmActual -> Opt (Maybe CmmActual)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse CmmActual -> Opt CmmActual
f)) [(GlobalReg, Maybe CmmActual)]
regs
mapExpOpt CmmActual -> Opt CmmActual
f (CmmAssign CmmReg
r CmmActual
e) = CmmReg -> CmmActual -> CmmNode 'Open 'Open
CmmAssign CmmReg
r (CmmActual -> CmmNode e x) -> Opt CmmActual -> Opt (CmmNode e x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmmActual -> Opt CmmActual
f CmmActual
e
mapExpOpt CmmActual -> Opt CmmActual
f (CmmStore CmmActual
addr CmmActual
e AlignmentSpec
align) = CmmActual -> CmmActual -> AlignmentSpec -> CmmNode e x
CmmActual -> CmmActual -> AlignmentSpec -> CmmNode 'Open 'Open
CmmStore (CmmActual -> CmmActual -> AlignmentSpec -> CmmNode e x)
-> Opt CmmActual -> Opt (CmmActual -> AlignmentSpec -> CmmNode e x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmmActual -> Opt CmmActual
f CmmActual
addr Opt (CmmActual -> AlignmentSpec -> CmmNode e x)
-> Opt CmmActual -> Opt (AlignmentSpec -> CmmNode e x)
forall a b. Opt (a -> b) -> Opt a -> Opt b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CmmActual -> Opt CmmActual
f CmmActual
e Opt (AlignmentSpec -> CmmNode e x)
-> Opt AlignmentSpec -> Opt (CmmNode e x)
forall a b. Opt (a -> b) -> Opt a -> Opt b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AlignmentSpec -> Opt AlignmentSpec
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AlignmentSpec
align
mapExpOpt CmmActual -> Opt CmmActual
f (CmmUnsafeForeignCall ForeignTarget
tgt [CmmFormal]
fs [CmmActual]
as) = ForeignTarget -> [CmmFormal] -> [CmmActual] -> CmmNode e x
ForeignTarget -> [CmmFormal] -> [CmmActual] -> CmmNode 'Open 'Open
CmmUnsafeForeignCall (ForeignTarget -> [CmmFormal] -> [CmmActual] -> CmmNode e x)
-> Opt ForeignTarget
-> Opt ([CmmFormal] -> [CmmActual] -> CmmNode e x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CmmActual -> Opt CmmActual) -> ForeignTarget -> Opt ForeignTarget
mapForeignTargetOpt CmmActual -> Opt CmmActual
f ForeignTarget
tgt Opt ([CmmFormal] -> [CmmActual] -> CmmNode e x)
-> Opt [CmmFormal] -> Opt ([CmmActual] -> CmmNode e x)
forall a b. Opt (a -> b) -> Opt a -> Opt b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [CmmFormal] -> Opt [CmmFormal]
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [CmmFormal]
fs Opt ([CmmActual] -> CmmNode e x)
-> Opt [CmmActual] -> Opt (CmmNode e x)
forall a b. Opt (a -> b) -> Opt a -> Opt b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CmmActual -> Opt CmmActual) -> [CmmActual] -> Opt [CmmActual]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse CmmActual -> Opt CmmActual
f [CmmActual]
as
mapExpOpt CmmActual -> Opt CmmActual
_ l :: CmmNode e x
l@(CmmBranch Label
_) = CmmNode e x -> Opt (CmmNode e x)
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmmNode e x
l
mapExpOpt CmmActual -> Opt CmmActual
f (CmmCondBranch CmmActual
e Label
ti Label
fi Maybe Bool
l) = CmmActual -> Opt CmmActual
f CmmActual
e Opt CmmActual
-> (CmmActual -> Opt (CmmNode e x)) -> Opt (CmmNode e x)
forall a b. Opt a -> (a -> Opt b) -> Opt b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CmmActual
newE -> CmmNode e x -> Opt (CmmNode e x)
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CmmActual -> Label -> Label -> Maybe Bool -> CmmNode 'Open 'Closed
CmmCondBranch CmmActual
newE Label
ti Label
fi Maybe Bool
l)
mapExpOpt CmmActual -> Opt CmmActual
f (CmmSwitch CmmActual
e SwitchTargets
ids) = (CmmActual -> SwitchTargets -> CmmNode e x)
-> SwitchTargets -> CmmActual -> CmmNode e x
forall a b c. (a -> b -> c) -> b -> a -> c
flip CmmActual -> SwitchTargets -> CmmNode e x
CmmActual -> SwitchTargets -> CmmNode 'Open 'Closed
CmmSwitch SwitchTargets
ids (CmmActual -> CmmNode e x) -> Opt CmmActual -> Opt (CmmNode e x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmmActual -> Opt CmmActual
f CmmActual
e
mapExpOpt CmmActual -> Opt CmmActual
f n :: CmmNode e x
n@CmmCall {cml_target :: CmmNode 'Open 'Closed -> CmmActual
cml_target=CmmActual
tgt} = CmmActual -> Opt CmmActual
f CmmActual
tgt Opt CmmActual
-> (CmmActual -> Opt (CmmNode e x)) -> Opt (CmmNode e x)
forall a b. Opt a -> (a -> Opt b) -> Opt b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CmmActual
newTgt -> CmmNode e x -> Opt (CmmNode e x)
forall a. a -> Opt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmmNode e x
n{cml_target = newTgt}
mapExpOpt CmmActual -> Opt CmmActual
f (CmmForeignCall ForeignTarget
tgt [CmmFormal]
fs [CmmActual]
as Label
succ Int
ret_args Int
updfr Bool
intrbl)
= do
newTgt <- (CmmActual -> Opt CmmActual) -> ForeignTarget -> Opt ForeignTarget
mapForeignTargetOpt CmmActual -> Opt CmmActual
f ForeignTarget
tgt
newAs <- traverse f as
pure $ CmmForeignCall newTgt fs newAs succ ret_args updfr intrbl