module GHC.CmmToAsm.X86.Cond (
        Cond(..),
        condToUnsigned,
        maybeFlipCond,
        maybeInvertCond
)

where

import GHC.Prelude

data Cond
        = ALWAYS        -- What's really used? ToDo
        | EQQ           -- je/jz -> zf = 1
        | GE            -- jge
        | GEU           -- ae
        | GTT           -- jg
        | GU            -- ja
        | LE            -- jle
        | LEU           -- jbe
        | LTT           -- jl
        | LU            -- jb
        | NE            -- jne
        | NEG           -- js
        | POS           -- jns
        | CARRY         -- jc
        | OFLO          -- jo
        | PARITY        -- jp
        | NOTPARITY     -- jnp
        deriving Cond -> Cond -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cond -> Cond -> Bool
$c/= :: Cond -> Cond -> Bool
== :: Cond -> Cond -> Bool
$c== :: Cond -> Cond -> Bool
Eq

condToUnsigned :: Cond -> Cond
condToUnsigned :: Cond -> Cond
condToUnsigned Cond
GTT = Cond
GU
condToUnsigned Cond
LTT = Cond
LU
condToUnsigned Cond
GE  = Cond
GEU
condToUnsigned Cond
LE  = Cond
LEU
condToUnsigned Cond
x   = Cond
x

-- | @maybeFlipCond c@ returns @Just c'@ if it is possible to flip the
-- arguments to the conditional @c@, and the new condition should be @c'@.
maybeFlipCond :: Cond -> Maybe Cond
maybeFlipCond :: Cond -> Maybe Cond
maybeFlipCond Cond
cond  = case Cond
cond of
        Cond
EQQ   -> forall a. a -> Maybe a
Just Cond
EQQ
        Cond
NE    -> forall a. a -> Maybe a
Just Cond
NE
        Cond
LU    -> forall a. a -> Maybe a
Just Cond
GU
        Cond
GU    -> forall a. a -> Maybe a
Just Cond
LU
        Cond
LEU   -> forall a. a -> Maybe a
Just Cond
GEU
        Cond
GEU   -> forall a. a -> Maybe a
Just Cond
LEU
        Cond
LTT   -> forall a. a -> Maybe a
Just Cond
GTT
        Cond
GTT   -> forall a. a -> Maybe a
Just Cond
LTT
        Cond
LE    -> forall a. a -> Maybe a
Just Cond
GE
        Cond
GE    -> forall a. a -> Maybe a
Just Cond
LE
        Cond
_other -> forall a. Maybe a
Nothing

-- | If we apply @maybeInvertCond@ to the condition of a jump we turn
-- jumps taken into jumps not taken and vice versa.
--
-- Careful! If the used comparison and the conditional jump
-- don't match the above behaviour will NOT hold.
-- When used for FP comparisons this does not consider unordered
-- numbers.
-- Also inverting twice might return a synonym for the original condition.
maybeInvertCond :: Cond -> Maybe Cond
maybeInvertCond :: Cond -> Maybe Cond
maybeInvertCond Cond
cond  = case Cond
cond of
        Cond
ALWAYS  -> forall a. Maybe a
Nothing
        Cond
EQQ     -> forall a. a -> Maybe a
Just Cond
NE
        Cond
NE      -> forall a. a -> Maybe a
Just Cond
EQQ

        Cond
NEG     -> forall a. a -> Maybe a
Just Cond
POS
        Cond
POS     -> forall a. a -> Maybe a
Just Cond
NEG

        Cond
GEU     -> forall a. a -> Maybe a
Just Cond
LU
        Cond
LU      -> forall a. a -> Maybe a
Just Cond
GEU

        Cond
GE      -> forall a. a -> Maybe a
Just Cond
LTT
        Cond
LTT     -> forall a. a -> Maybe a
Just Cond
GE

        Cond
GTT     -> forall a. a -> Maybe a
Just Cond
LE
        Cond
LE      -> forall a. a -> Maybe a
Just Cond
GTT

        Cond
GU      -> forall a. a -> Maybe a
Just Cond
LEU
        Cond
LEU     -> forall a. a -> Maybe a
Just Cond
GU

        --GEU "==" NOTCARRY, they are synonyms
        --at the assembly level
        Cond
CARRY   -> forall a. a -> Maybe a
Just Cond
GEU

        Cond
OFLO    -> forall a. Maybe a
Nothing

        Cond
PARITY  -> forall a. a -> Maybe a
Just Cond
NOTPARITY
        Cond
NOTPARITY -> forall a. a -> Maybe a
Just Cond
PARITY