module GHC.CmmToAsm.Format (
Format(..),
intFormat,
floatFormat,
isIntFormat,
isFloatFormat,
cmmTypeFormat,
formatToWidth,
formatInBytes
)
where
import GHC.Prelude
import GHC.Cmm
import GHC.Utils.Outputable
import GHC.Utils.Panic
data Format
= II8
| II16
| II32
| II64
| FF32
| FF64
deriving (Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show, Format -> Format -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq)
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 -> forall a. String -> a
sorry forall a b. (a -> b) -> a -> b
$ String
"The native code generator cannot " forall a. [a] -> [a] -> [a]
++
String
"produce code for Format.intFormat " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Width
other
forall a. [a] -> [a] -> [a]
++ String
"\n\tConsider using the llvm backend with -fllvm"
floatFormat :: Width -> Format
floatFormat :: Width -> Format
floatFormat Width
width
= case Width
width of
Width
W32 -> Format
FF32
Width
W64 -> Format
FF64
Width
other -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Format.floatFormat" (forall a. Outputable a => a -> SDoc
ppr Width
other)
isIntFormat :: Format -> Bool
isIntFormat :: Format -> Bool
isIntFormat = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Bool
isFloatFormat
isFloatFormat :: Format -> Bool
isFloatFormat :: Format -> Bool
isFloatFormat Format
format
= case Format
format of
Format
FF32 -> Bool
True
Format
FF64 -> Bool
True
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)
| 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
formatInBytes :: Format -> Int
formatInBytes :: Format -> Int
formatInBytes = Width -> Int
widthInBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Width
formatToWidth