{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module GHC.CmmToAsm.Format (
Format(.., IntegerFormat),
ScalarFormat(..),
intFormat,
floatFormat,
isIntFormat,
isIntScalarFormat,
intScalarFormat,
isFloatFormat,
vecFormat,
isVecFormat,
cmmTypeFormat,
formatToWidth,
scalarWidth,
formatInBytes,
isFloatScalarFormat,
isFloatOrFloatVecFormat,
floatScalarFormat,
scalarFormatFormat,
VirtualRegWithFormat(..),
RegWithFormat(..),
takeVirtualRegs,
takeRealRegs,
)
where
import GHC.Prelude
import GHC.Cmm
import GHC.Platform.Reg ( Reg(..), RealReg, VirtualReg )
import GHC.Types.Unique ( Uniquable(..) )
import GHC.Types.Unique.Set
import GHC.Utils.Outputable
import GHC.Utils.Panic
data Format
= II8
| II16
| II32
| II64
| FF32
| FF64
| VecFormat !Length
!ScalarFormat
deriving (Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Format -> ShowS
showsPrec :: Int -> Format -> ShowS
$cshow :: Format -> String
show :: Format -> String
$cshowList :: [Format] -> ShowS
showList :: [Format] -> ShowS
Show, Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
/= :: Format -> Format -> Bool
Eq, Eq Format
Eq Format =>
(Format -> Format -> Ordering)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Format)
-> (Format -> Format -> Format)
-> Ord Format
Format -> Format -> Bool
Format -> Format -> Ordering
Format -> Format -> Format
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Format -> Format -> Ordering
compare :: Format -> Format -> Ordering
$c< :: Format -> Format -> Bool
< :: Format -> Format -> Bool
$c<= :: Format -> Format -> Bool
<= :: Format -> Format -> Bool
$c> :: Format -> Format -> Bool
> :: Format -> Format -> Bool
$c>= :: Format -> Format -> Bool
>= :: Format -> Format -> Bool
$cmax :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
min :: Format -> Format -> Format
Ord)
pattern IntegerFormat :: Format
pattern $mIntegerFormat :: forall {r}. Format -> ((# #) -> r) -> ((# #) -> r) -> r
IntegerFormat <- ( isIntegerFormat -> True )
{-# COMPLETE IntegerFormat, FF32, FF64, VecFormat #-}
isIntegerFormat :: Format -> Bool
isIntegerFormat :: Format -> Bool
isIntegerFormat = \case
Format
II8 -> Bool
True
Format
II16 -> Bool
True
Format
II32 -> Bool
True
Format
II64 -> Bool
True
Format
_ -> Bool
False
instance Outputable Format where
ppr :: Format -> SDoc
ppr Format
fmt = String -> SDoc
forall doc. IsLine doc => String -> doc
text (Format -> String
forall a. Show a => a -> String
show Format
fmt)
data ScalarFormat
= FmtInt8
| FmtInt16
| FmtInt32
| FmtInt64
| FmtFloat
| FmtDouble
deriving (Int -> ScalarFormat -> ShowS
[ScalarFormat] -> ShowS
ScalarFormat -> String
(Int -> ScalarFormat -> ShowS)
-> (ScalarFormat -> String)
-> ([ScalarFormat] -> ShowS)
-> Show ScalarFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScalarFormat -> ShowS
showsPrec :: Int -> ScalarFormat -> ShowS
$cshow :: ScalarFormat -> String
show :: ScalarFormat -> String
$cshowList :: [ScalarFormat] -> ShowS
showList :: [ScalarFormat] -> ShowS
Show, ScalarFormat -> ScalarFormat -> Bool
(ScalarFormat -> ScalarFormat -> Bool)
-> (ScalarFormat -> ScalarFormat -> Bool) -> Eq ScalarFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScalarFormat -> ScalarFormat -> Bool
== :: ScalarFormat -> ScalarFormat -> Bool
$c/= :: ScalarFormat -> ScalarFormat -> Bool
/= :: ScalarFormat -> ScalarFormat -> Bool
Eq, Eq ScalarFormat
Eq ScalarFormat =>
(ScalarFormat -> ScalarFormat -> Ordering)
-> (ScalarFormat -> ScalarFormat -> Bool)
-> (ScalarFormat -> ScalarFormat -> Bool)
-> (ScalarFormat -> ScalarFormat -> Bool)
-> (ScalarFormat -> ScalarFormat -> Bool)
-> (ScalarFormat -> ScalarFormat -> ScalarFormat)
-> (ScalarFormat -> ScalarFormat -> ScalarFormat)
-> Ord ScalarFormat
ScalarFormat -> ScalarFormat -> Bool
ScalarFormat -> ScalarFormat -> Ordering
ScalarFormat -> ScalarFormat -> ScalarFormat
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScalarFormat -> ScalarFormat -> Ordering
compare :: ScalarFormat -> ScalarFormat -> Ordering
$c< :: ScalarFormat -> ScalarFormat -> Bool
< :: ScalarFormat -> ScalarFormat -> Bool
$c<= :: ScalarFormat -> ScalarFormat -> Bool
<= :: ScalarFormat -> ScalarFormat -> Bool
$c> :: ScalarFormat -> ScalarFormat -> Bool
> :: ScalarFormat -> ScalarFormat -> Bool
$c>= :: ScalarFormat -> ScalarFormat -> Bool
>= :: ScalarFormat -> ScalarFormat -> Bool
$cmax :: ScalarFormat -> ScalarFormat -> ScalarFormat
max :: ScalarFormat -> ScalarFormat -> ScalarFormat
$cmin :: ScalarFormat -> ScalarFormat -> ScalarFormat
min :: ScalarFormat -> ScalarFormat -> ScalarFormat
Ord)
scalarFormatFormat :: ScalarFormat -> Format
scalarFormatFormat :: ScalarFormat -> Format
scalarFormatFormat = \case
ScalarFormat
FmtInt8 -> Format
II8
ScalarFormat
FmtInt16 -> Format
II16
ScalarFormat
FmtInt32 -> Format
II32
ScalarFormat
FmtInt64 -> Format
II64
ScalarFormat
FmtFloat -> Format
FF32
ScalarFormat
FmtDouble -> Format
FF64
isFloatScalarFormat :: ScalarFormat -> Bool
isFloatScalarFormat :: ScalarFormat -> Bool
isFloatScalarFormat = \case
ScalarFormat
FmtFloat -> Bool
True
ScalarFormat
FmtDouble -> Bool
True
ScalarFormat
_ -> Bool
False
isFloatOrFloatVecFormat :: Format -> Bool
isFloatOrFloatVecFormat :: Format -> Bool
isFloatOrFloatVecFormat = \case
VecFormat Int
_ ScalarFormat
sFmt -> ScalarFormat -> Bool
isFloatScalarFormat ScalarFormat
sFmt
Format
fmt -> Format -> Bool
isFloatFormat Format
fmt
floatScalarFormat :: Width -> ScalarFormat
floatScalarFormat :: Width -> ScalarFormat
floatScalarFormat Width
W32 = ScalarFormat
FmtFloat
floatScalarFormat Width
W64 = ScalarFormat
FmtDouble
floatScalarFormat Width
w = String -> SDoc -> ScalarFormat
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"floatScalarFormat" (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)
isIntScalarFormat :: ScalarFormat -> Bool
isIntScalarFormat :: ScalarFormat -> Bool
isIntScalarFormat = Bool -> Bool
not (Bool -> Bool) -> (ScalarFormat -> Bool) -> ScalarFormat -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarFormat -> Bool
isFloatScalarFormat
intScalarFormat :: Width -> ScalarFormat
intScalarFormat :: Width -> ScalarFormat
intScalarFormat = \case
Width
W8 -> ScalarFormat
FmtInt8
Width
W16 -> ScalarFormat
FmtInt16
Width
W32 -> ScalarFormat
FmtInt32
Width
W64 -> ScalarFormat
FmtInt64
Width
w -> String -> SDoc -> ScalarFormat
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"intScalarFormat" (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)
intFormat :: Width -> Format
intFormat :: Width -> Format
intFormat Width
width
= case Width
width of
Width
W8 -> Format
II8
Width
W16 -> Format
II16
Width
W32 -> Format
II32
Width
W64 -> Format
II64
Width
other -> String -> Format
forall a. HasCallStack => String -> a
sorry (String -> Format) -> String -> Format
forall a b. (a -> b) -> a -> b
$ String
"The native code generator cannot " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"produce code for Format.intFormat " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
other
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\tConsider using the llvm backend with -fllvm"
isIntFormat :: Format -> Bool
isIntFormat :: Format -> Bool
isIntFormat Format
format =
case Format
format of
Format
II8 -> Bool
True
Format
II16 -> Bool
True
Format
II32 -> Bool
True
Format
II64 -> Bool
True
Format
_ -> Bool
False
floatFormat :: Width -> Format
floatFormat :: Width -> Format
floatFormat Width
width
= case Width
width of
Width
W32 -> Format
FF32
Width
W64 -> Format
FF64
Width
other -> String -> SDoc -> Format
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Format.floatFormat" (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
other)
isFloatFormat :: Format -> Bool
isFloatFormat :: Format -> Bool
isFloatFormat Format
format
= case Format
format of
Format
FF32 -> Bool
True
Format
FF64 -> Bool
True
Format
_ -> Bool
False
vecFormat :: CmmType -> Format
vecFormat :: CmmType -> Format
vecFormat CmmType
ty =
let l :: Int
l = CmmType -> Int
vecLength CmmType
ty
elemTy :: CmmType
elemTy = CmmType -> CmmType
vecElemType CmmType
ty
in if CmmType -> Bool
isFloatType CmmType
elemTy
then case CmmType -> Width
typeWidth CmmType
elemTy of
Width
W32 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtFloat
Width
W64 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtDouble
Width
_ -> String -> SDoc -> Format
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Incorrect vector element width" (CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmType
elemTy)
else case CmmType -> Width
typeWidth CmmType
elemTy of
Width
W8 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt8
Width
W16 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt16
Width
W32 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt32
Width
W64 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt64
Width
_ -> String -> SDoc -> Format
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Incorrect vector element width" (CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmType
elemTy)
isVecFormat :: Format -> Bool
isVecFormat :: Format -> Bool
isVecFormat (VecFormat {}) = Bool
True
isVecFormat Format
_ = Bool
False
cmmTypeFormat :: CmmType -> Format
cmmTypeFormat :: CmmType -> Format
cmmTypeFormat CmmType
ty
| CmmType -> Bool
isFloatType CmmType
ty = Width -> Format
floatFormat (CmmType -> Width
typeWidth CmmType
ty)
| CmmType -> Bool
isVecType CmmType
ty = CmmType -> Format
vecFormat CmmType
ty
| Bool
otherwise = Width -> Format
intFormat (CmmType -> Width
typeWidth CmmType
ty)
formatToWidth :: Format -> Width
formatToWidth :: Format -> Width
formatToWidth Format
format
= case Format
format of
Format
II8 -> Width
W8
Format
II16 -> Width
W16
Format
II32 -> Width
W32
Format
II64 -> Width
W64
Format
FF32 -> Width
W32
Format
FF64 -> Width
W64
VecFormat Int
l ScalarFormat
s ->
Int -> Width
widthFromBytes (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Width -> Int
widthInBytes (ScalarFormat -> Width
scalarWidth ScalarFormat
s))
scalarWidth :: ScalarFormat -> Width
scalarWidth :: ScalarFormat -> Width
scalarWidth = \case
ScalarFormat
FmtInt8 -> Width
W8
ScalarFormat
FmtInt16 -> Width
W16
ScalarFormat
FmtInt32 -> Width
W32
ScalarFormat
FmtInt64 -> Width
W64
ScalarFormat
FmtFloat -> Width
W32
ScalarFormat
FmtDouble -> Width
W64
formatInBytes :: Format -> Int
formatInBytes :: Format -> Int
formatInBytes = Width -> Int
widthInBytes (Width -> Int) -> (Format -> Width) -> Format -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Width
formatToWidth
data VirtualRegWithFormat
= VirtualRegWithFormat
{ VirtualRegWithFormat -> VirtualReg
virtualRegWithFormat_reg :: {-# UNPACK #-} !VirtualReg
, VirtualRegWithFormat -> Format
virtualRegWithFormat_format :: !Format
}
data RegWithFormat
= RegWithFormat
{ RegWithFormat -> Reg
regWithFormat_reg :: {-# UNPACK #-} !Reg
, RegWithFormat -> Format
regWithFormat_format :: !Format
}
instance Show RegWithFormat where
show :: RegWithFormat -> String
show (RegWithFormat Reg
reg Format
fmt) = Reg -> String
forall a. Show a => a -> String
show Reg
reg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Format -> String
forall a. Show a => a -> String
show Format
fmt
instance Uniquable RegWithFormat where
getUnique :: RegWithFormat -> Unique
getUnique = Reg -> Unique
forall a. Uniquable a => a -> Unique
getUnique (Reg -> Unique)
-> (RegWithFormat -> Reg) -> RegWithFormat -> Unique
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegWithFormat -> Reg
regWithFormat_reg
instance Outputable VirtualRegWithFormat where
ppr :: VirtualRegWithFormat -> SDoc
ppr (VirtualRegWithFormat VirtualReg
reg Format
fmt) = VirtualReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr VirtualReg
reg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Format -> SDoc
forall a. Outputable a => a -> SDoc
ppr Format
fmt
instance Outputable RegWithFormat where
ppr :: RegWithFormat -> SDoc
ppr (RegWithFormat Reg
reg Format
fmt) = Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
reg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Format -> SDoc
forall a. Outputable a => a -> SDoc
ppr Format
fmt
takeVirtualRegs :: UniqSet RegWithFormat -> UniqSet VirtualReg
takeVirtualRegs :: UniqSet RegWithFormat -> UniqSet VirtualReg
takeVirtualRegs = (RegWithFormat -> Maybe VirtualReg)
-> UniqSet RegWithFormat -> UniqSet VirtualReg
forall a b. (a -> Maybe b) -> UniqSet a -> UniqSet b
mapMaybeUniqSet_sameUnique ((RegWithFormat -> Maybe VirtualReg)
-> UniqSet RegWithFormat -> UniqSet VirtualReg)
-> (RegWithFormat -> Maybe VirtualReg)
-> UniqSet RegWithFormat
-> UniqSet VirtualReg
forall a b. (a -> b) -> a -> b
$
\ case { RegWithFormat { regWithFormat_reg :: RegWithFormat -> Reg
regWithFormat_reg = RegVirtual VirtualReg
vr } -> VirtualReg -> Maybe VirtualReg
forall a. a -> Maybe a
Just VirtualReg
vr; RegWithFormat
_ -> Maybe VirtualReg
forall a. Maybe a
Nothing }
takeRealRegs :: UniqSet RegWithFormat -> UniqSet RealReg
takeRealRegs :: UniqSet RegWithFormat -> UniqSet RealReg
takeRealRegs = (RegWithFormat -> Maybe RealReg)
-> UniqSet RegWithFormat -> UniqSet RealReg
forall a b. (a -> Maybe b) -> UniqSet a -> UniqSet b
mapMaybeUniqSet_sameUnique ((RegWithFormat -> Maybe RealReg)
-> UniqSet RegWithFormat -> UniqSet RealReg)
-> (RegWithFormat -> Maybe RealReg)
-> UniqSet RegWithFormat
-> UniqSet RealReg
forall a b. (a -> b) -> a -> b
$
\ case { RegWithFormat { regWithFormat_reg :: RegWithFormat -> Reg
regWithFormat_reg = RegReal RealReg
rr } -> RealReg -> Maybe RealReg
forall a. a -> Maybe a
Just RealReg
rr; RegWithFormat
_ -> Maybe RealReg
forall a. Maybe a
Nothing }