module GHC.Cmm.Type
    ( CmmType   -- Abstract
    , b8, b16, b32, b64, b128, b256, b512, f32, f64, bWord, bHalfWord, gcWord
    , cInt
    , cmmBits, cmmFloat
    , typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood
    , isFloatType, isGcPtrType, isBitsType
    , isWordAny, isWord32, isWord64
    , isFloat64, isFloat32

    , Width(..)
    , widthInBits, widthInBytes, widthInLog, widthFromBytes
    , wordWidth, halfWordWidth, cIntWidth
    , halfWordMask
    , narrowU, narrowS
    , rEP_CostCentreStack_mem_alloc
    , rEP_CostCentreStack_scc_count
    , rEP_StgEntCounter_allocs
    , rEP_StgEntCounter_allocd

    , ForeignHint(..)

    , Length
    , vec, vec2, vec4, vec8, vec16
    , vec2f64, vec2b64, vec4f32, vec4b32, vec8b16, vec16b8
    , cmmVec
    , vecLength, vecElemType
    , isVecType

    , DoAlignSanitisation
   )
where


import GHC.Prelude

import GHC.Platform
import GHC.Utils.Outputable
import GHC.Utils.Panic

import Data.Word
import Data.Int

-----------------------------------------------------------------------------
--              CmmType
-----------------------------------------------------------------------------

  -- NOTE: CmmType is an abstract type, not exported from this
  --       module so you can easily change its representation
  --
  -- However Width is exported in a concrete way,
  -- and is used extensively in pattern-matching

data CmmType    -- The important one!
  = CmmType CmmCat !Width
  deriving Int -> CmmType -> ShowS
[CmmType] -> ShowS
CmmType -> String
(Int -> CmmType -> ShowS)
-> (CmmType -> String) -> ([CmmType] -> ShowS) -> Show CmmType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CmmType -> ShowS
showsPrec :: Int -> CmmType -> ShowS
$cshow :: CmmType -> String
show :: CmmType -> String
$cshowList :: [CmmType] -> ShowS
showList :: [CmmType] -> ShowS
Show

data CmmCat                -- "Category" (not exported)
   = GcPtrCat              -- GC pointer
   | BitsCat               -- Non-pointer
   | FloatCat              -- Float
   | VecCat Length CmmCat  -- Vector
   deriving( CmmCat -> CmmCat -> Bool
(CmmCat -> CmmCat -> Bool)
-> (CmmCat -> CmmCat -> Bool) -> Eq CmmCat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmmCat -> CmmCat -> Bool
== :: CmmCat -> CmmCat -> Bool
$c/= :: CmmCat -> CmmCat -> Bool
/= :: CmmCat -> CmmCat -> Bool
Eq, Int -> CmmCat -> ShowS
[CmmCat] -> ShowS
CmmCat -> String
(Int -> CmmCat -> ShowS)
-> (CmmCat -> String) -> ([CmmCat] -> ShowS) -> Show CmmCat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CmmCat -> ShowS
showsPrec :: Int -> CmmCat -> ShowS
$cshow :: CmmCat -> String
show :: CmmCat -> String
$cshowList :: [CmmCat] -> ShowS
showList :: [CmmCat] -> ShowS
Show )
        -- See Note [Signed vs unsigned] at the end

instance Outputable CmmType where
  ppr :: CmmType -> SDoc
ppr (CmmType CmmCat
cat Width
wid) = CmmCat -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmCat
cat SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Width -> Int
widthInBits Width
wid)

instance Outputable CmmCat where
  ppr :: CmmCat -> SDoc
ppr CmmCat
FloatCat       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"F"
  ppr CmmCat
GcPtrCat       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"P"
  ppr CmmCat
BitsCat        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"I"
  ppr (VecCat Int
n CmmCat
cat) = CmmCat -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmCat
cat SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"x" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"V"

-- Why is CmmType stratified?  For native code generation,
-- most of the time you just want to know what sort of register
-- to put the thing in, and for this you need to know how
-- many bits thing has, and whether it goes in a floating-point
-- register.  By contrast, the distinction between GcPtr and
-- GcNonPtr is of interest to only a few parts of the code generator.

-------- Equality on CmmType --------------
-- CmmType is *not* an instance of Eq; sometimes we care about the
-- Gc/NonGc distinction, and sometimes we don't
-- So we use an explicit function to force you to think about it
cmmEqType :: CmmType -> CmmType -> Bool -- Exact equality
cmmEqType :: CmmType -> CmmType -> Bool
cmmEqType (CmmType CmmCat
c1 Width
w1) (CmmType CmmCat
c2 Width
w2) = CmmCat
c1CmmCat -> CmmCat -> Bool
forall a. Eq a => a -> a -> Bool
==CmmCat
c2 Bool -> Bool -> Bool
&& Width
w1Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
==Width
w2

cmmEqType_ignoring_ptrhood :: CmmType -> CmmType -> Bool
  -- This equality is temporary; used in CmmLint
  -- but the RTS files are not yet well-typed wrt pointers
cmmEqType_ignoring_ptrhood :: CmmType -> CmmType -> Bool
cmmEqType_ignoring_ptrhood (CmmType CmmCat
c1 Width
w1) (CmmType CmmCat
c2 Width
w2)
   = CmmCat
c1 CmmCat -> CmmCat -> Bool
`weak_eq` CmmCat
c2 Bool -> Bool -> Bool
&& Width
w1Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
==Width
w2
   where
     weak_eq :: CmmCat -> CmmCat -> Bool
     CmmCat
FloatCat         weak_eq :: CmmCat -> CmmCat -> Bool
`weak_eq` CmmCat
FloatCat         = Bool
True
     CmmCat
FloatCat         `weak_eq` CmmCat
_other           = Bool
False
     CmmCat
_other           `weak_eq` CmmCat
FloatCat         = Bool
False
     (VecCat Int
l1 CmmCat
cat1) `weak_eq` (VecCat Int
l2 CmmCat
cat2) = Int
l1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l2
                                                   Bool -> Bool -> Bool
&& CmmCat
cat1 CmmCat -> CmmCat -> Bool
`weak_eq` CmmCat
cat2
     (VecCat {})      `weak_eq` CmmCat
_other           = Bool
False
     CmmCat
_other           `weak_eq` (VecCat {})      = Bool
False
     CmmCat
_word1           `weak_eq` CmmCat
_word2           = Bool
True        -- Ignores GcPtr

--- Simple operations on CmmType -----
typeWidth :: CmmType -> Width
typeWidth :: CmmType -> Width
typeWidth (CmmType CmmCat
_ Width
w) = Width
w

cmmBits, cmmFloat :: Width -> CmmType
cmmBits :: Width -> CmmType
cmmBits  = CmmCat -> Width -> CmmType
CmmType CmmCat
BitsCat
cmmFloat :: Width -> CmmType
cmmFloat = CmmCat -> Width -> CmmType
CmmType CmmCat
FloatCat

-------- Common CmmTypes ------------
-- Floats and words of specific widths
b8, b16, b32, b64, b128, b256, b512, f32, f64 :: CmmType
b8 :: CmmType
b8     = Width -> CmmType
cmmBits Width
W8
b16 :: CmmType
b16    = Width -> CmmType
cmmBits Width
W16
b32 :: CmmType
b32    = Width -> CmmType
cmmBits Width
W32
b64 :: CmmType
b64    = Width -> CmmType
cmmBits Width
W64
b128 :: CmmType
b128   = Width -> CmmType
cmmBits Width
W128
b256 :: CmmType
b256   = Width -> CmmType
cmmBits Width
W256
b512 :: CmmType
b512   = Width -> CmmType
cmmBits Width
W512
f32 :: CmmType
f32    = Width -> CmmType
cmmFloat Width
W32
f64 :: CmmType
f64    = Width -> CmmType
cmmFloat Width
W64

-- CmmTypes of native word widths
bWord :: Platform -> CmmType
bWord :: Platform -> CmmType
bWord Platform
platform = Width -> CmmType
cmmBits (Platform -> Width
wordWidth Platform
platform)

bHalfWord :: Platform -> CmmType
bHalfWord :: Platform -> CmmType
bHalfWord Platform
platform = Width -> CmmType
cmmBits (Platform -> Width
halfWordWidth Platform
platform)

gcWord :: Platform -> CmmType
gcWord :: Platform -> CmmType
gcWord Platform
platform = CmmCat -> Width -> CmmType
CmmType CmmCat
GcPtrCat (Platform -> Width
wordWidth Platform
platform)

cInt :: Platform -> CmmType
cInt :: Platform -> CmmType
cInt Platform
platform = Width -> CmmType
cmmBits (Platform -> Width
cIntWidth Platform
platform)

------------ Predicates ----------------
isFloatType, isGcPtrType, isBitsType :: CmmType -> Bool
isFloatType :: CmmType -> Bool
isFloatType (CmmType CmmCat
FloatCat    Width
_) = Bool
True
isFloatType CmmType
_other                  = Bool
False

isGcPtrType :: CmmType -> Bool
isGcPtrType (CmmType CmmCat
GcPtrCat Width
_) = Bool
True
isGcPtrType CmmType
_other               = Bool
False

isBitsType :: CmmType -> Bool
isBitsType (CmmType CmmCat
BitsCat Width
_) = Bool
True
isBitsType CmmType
_                   = Bool
False

isWordAny, isWord32, isWord64,
  isFloat32, isFloat64 :: CmmType -> Bool
-- isWord64 is true of 64-bit non-floats (both gc-ptrs and otherwise)
-- isFloat32 and 64 are obvious

isWordAny :: CmmType -> Bool
isWordAny (CmmType CmmCat
BitsCat  Width
_) = Bool
True
isWordAny (CmmType CmmCat
GcPtrCat Width
_) = Bool
True
isWordAny CmmType
_other               = Bool
False

isWord64 :: CmmType -> Bool
isWord64 (CmmType CmmCat
BitsCat  Width
W64) = Bool
True
isWord64 (CmmType CmmCat
GcPtrCat Width
W64) = Bool
True
isWord64 CmmType
_other                 = Bool
False

isWord32 :: CmmType -> Bool
isWord32 (CmmType CmmCat
BitsCat  Width
W32) = Bool
True
isWord32 (CmmType CmmCat
GcPtrCat Width
W32) = Bool
True
isWord32 CmmType
_other                 = Bool
False

isFloat32 :: CmmType -> Bool
isFloat32 (CmmType CmmCat
FloatCat Width
W32) = Bool
True
isFloat32 CmmType
_other                 = Bool
False

isFloat64 :: CmmType -> Bool
isFloat64 (CmmType CmmCat
FloatCat Width
W64) = Bool
True
isFloat64 CmmType
_other                 = Bool
False

-----------------------------------------------------------------------------
--              Width
-----------------------------------------------------------------------------

data Width
  = W8
  | W16
  | W32
  | W64
  | W128
  | W256
  | W512
  deriving (Width -> Width -> Bool
(Width -> Width -> Bool) -> (Width -> Width -> Bool) -> Eq Width
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Width -> Width -> Bool
== :: Width -> Width -> Bool
$c/= :: Width -> Width -> Bool
/= :: Width -> Width -> Bool
Eq, Eq Width
Eq Width =>
(Width -> Width -> Ordering)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Width)
-> (Width -> Width -> Width)
-> Ord Width
Width -> Width -> Bool
Width -> Width -> Ordering
Width -> Width -> Width
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 :: Width -> Width -> Ordering
compare :: Width -> Width -> Ordering
$c< :: Width -> Width -> Bool
< :: Width -> Width -> Bool
$c<= :: Width -> Width -> Bool
<= :: Width -> Width -> Bool
$c> :: Width -> Width -> Bool
> :: Width -> Width -> Bool
$c>= :: Width -> Width -> Bool
>= :: Width -> Width -> Bool
$cmax :: Width -> Width -> Width
max :: Width -> Width -> Width
$cmin :: Width -> Width -> Width
min :: Width -> Width -> Width
Ord, Int -> Width -> ShowS
[Width] -> ShowS
Width -> String
(Int -> Width -> ShowS)
-> (Width -> String) -> ([Width] -> ShowS) -> Show Width
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Width -> ShowS
showsPrec :: Int -> Width -> ShowS
$cshow :: Width -> String
show :: Width -> String
$cshowList :: [Width] -> ShowS
showList :: [Width] -> ShowS
Show)

instance Outputable Width where
   ppr :: Width -> SDoc
ppr Width
rep = String -> SDoc
forall doc. IsLine doc => String -> doc
text (Width -> String
forall a. Show a => a -> String
show Width
rep)

-------- Common Widths  ------------

-- | The width of the current platform's word size.
wordWidth :: Platform -> Width
wordWidth :: Platform -> Width
wordWidth Platform
platform = case Platform -> PlatformWordSize
platformWordSize Platform
platform of
 PlatformWordSize
PW4 -> Width
W32
 PlatformWordSize
PW8 -> Width
W64

-- | The width of the current platform's half-word size.
halfWordWidth :: Platform -> Width
halfWordWidth :: Platform -> Width
halfWordWidth Platform
platform = case Platform -> PlatformWordSize
platformWordSize Platform
platform of
 PlatformWordSize
PW4 -> Width
W16
 PlatformWordSize
PW8 -> Width
W32

-- | A bit-mask for the lower half-word of current platform.
halfWordMask :: Platform -> Integer
halfWordMask :: Platform -> Integer
halfWordMask Platform
platform = case Platform -> PlatformWordSize
platformWordSize Platform
platform of
 PlatformWordSize
PW4 -> Integer
0xFFFF
 PlatformWordSize
PW8 -> Integer
0xFFFFFFFF

-- cIntRep is the Width for a C-language 'int'
cIntWidth :: Platform -> Width
cIntWidth :: Platform -> Width
cIntWidth Platform
platform = case PlatformConstants -> Int
pc_CINT_SIZE (Platform -> PlatformConstants
platformConstants Platform
platform) of
                   Int
4 -> Width
W32
                   Int
8 -> Width
W64
                   Int
s -> String -> Width
forall a. HasCallStack => String -> a
panic (String
"cIntWidth: Unknown cINT_SIZE: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s)

-- | A width in bits.
widthInBits :: Width -> Int
widthInBits :: Width -> Int
widthInBits Width
W8   = Int
8
widthInBits Width
W16  = Int
16
widthInBits Width
W32  = Int
32
widthInBits Width
W64  = Int
64
widthInBits Width
W128 = Int
128
widthInBits Width
W256 = Int
256
widthInBits Width
W512 = Int
512

-- | A width in bytes.
--
-- > widthFromBytes (widthInBytes w) === w
widthInBytes :: Width -> Int
widthInBytes :: Width -> Int
widthInBytes Width
W8   = Int
1
widthInBytes Width
W16  = Int
2
widthInBytes Width
W32  = Int
4
widthInBytes Width
W64  = Int
8
widthInBytes Width
W128 = Int
16
widthInBytes Width
W256 = Int
32
widthInBytes Width
W512 = Int
64


-- | *Partial* A width from the number of bytes.
widthFromBytes :: Int -> Width
widthFromBytes :: Int -> Width
widthFromBytes Int
1  = Width
W8
widthFromBytes Int
2  = Width
W16
widthFromBytes Int
4  = Width
W32
widthFromBytes Int
8  = Width
W64
widthFromBytes Int
16 = Width
W128
widthFromBytes Int
32 = Width
W256
widthFromBytes Int
64 = Width
W512

widthFromBytes Int
n  = String -> SDoc -> Width
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"no width for given number of bytes" (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n)

-- | log_2 of the width in bytes, useful for generating shifts.
widthInLog :: Width -> Int
widthInLog :: Width -> Int
widthInLog Width
W8   = Int
0
widthInLog Width
W16  = Int
1
widthInLog Width
W32  = Int
2
widthInLog Width
W64  = Int
3
widthInLog Width
W128 = Int
4
widthInLog Width
W256 = Int
5
widthInLog Width
W512 = Int
6


-- widening / narrowing

-- | Narrow a signed or unsigned value to the given width. The result will
-- reside in @[0, +2^width)@.
--
-- >>> narrowU W8 256    == 256
-- >>> narrowU W8 255    == 255
-- >>> narrowU W8 128    == 128
-- >>> narrowU W8 127    == 127
-- >>> narrowU W8 0      == 0
-- >>> narrowU W8 (-127) == 129
-- >>> narrowU W8 (-128) == 128
-- >>> narrowU W8 (-129) == 127
-- >>> narrowU W8 (-255) == 1
-- >>> narrowU W8 (-256) == 0
--
narrowU :: Width -> Integer -> Integer
narrowU :: Width -> Integer -> Integer
narrowU Width
W8  Integer
x = Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Word8)
narrowU Width
W16 Integer
x = Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Word16)
narrowU Width
W32 Integer
x = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Word32)
narrowU Width
W64 Integer
x = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Word64)
narrowU Width
_ Integer
_ = String -> Integer
forall a. HasCallStack => String -> a
panic String
"narrowTo"

-- | Narrow a signed value to the given width. The result will reside
-- in @[-2^(width-1), +2^(width-1))@.
--
-- >>> narrowS W8 256    == 0
-- >>> narrowS W8 255    == -1
-- >>> narrowS W8 128    == -128
-- >>> narrowS W8 127    == 127
-- >>> narrowS W8 0      == 0
-- >>> narrowS W8 (-127) == -127
-- >>> narrowS W8 (-128) == -128
-- >>> narrowS W8 (-129) == 127
-- >>> narrowS W8 (-255) == 1
-- >>> narrowS W8 (-256) == 0
--
narrowS :: Width -> Integer -> Integer
narrowS :: Width -> Integer -> Integer
narrowS Width
W8  Integer
x = Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Int8)
narrowS Width
W16 Integer
x = Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Int16)
narrowS Width
W32 Integer
x = Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Int32)
narrowS Width
W64 Integer
x = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Int64)
narrowS Width
_ Integer
_ = String -> Integer
forall a. HasCallStack => String -> a
panic String
"narrowTo"

-----------------------------------------------------------------------------
--              SIMD
-----------------------------------------------------------------------------

type Length = Int

vec :: Length -> CmmType -> CmmType
vec :: Int -> CmmType -> CmmType
vec Int
l (CmmType CmmCat
cat Width
w) = CmmCat -> Width -> CmmType
CmmType (Int -> CmmCat -> CmmCat
VecCat Int
l CmmCat
cat) Width
vecw
  where
    vecw :: Width
    vecw :: Width
vecw = Int -> Width
widthFromBytes (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
*Width -> Int
widthInBytes Width
w)

vec2, vec4, vec8, vec16 :: CmmType -> CmmType
vec2 :: CmmType -> CmmType
vec2  = Int -> CmmType -> CmmType
vec Int
2
vec4 :: CmmType -> CmmType
vec4  = Int -> CmmType -> CmmType
vec Int
4
vec8 :: CmmType -> CmmType
vec8  = Int -> CmmType -> CmmType
vec Int
8
vec16 :: CmmType -> CmmType
vec16 = Int -> CmmType -> CmmType
vec Int
16

vec2f64, vec2b64, vec4f32, vec4b32, vec8b16, vec16b8 :: CmmType
vec2f64 :: CmmType
vec2f64 = Int -> CmmType -> CmmType
vec Int
2 CmmType
f64
vec2b64 :: CmmType
vec2b64 = Int -> CmmType -> CmmType
vec Int
2 CmmType
b64
vec4f32 :: CmmType
vec4f32 = Int -> CmmType -> CmmType
vec Int
4 CmmType
f32
vec4b32 :: CmmType
vec4b32 = Int -> CmmType -> CmmType
vec Int
4 CmmType
b32
vec8b16 :: CmmType
vec8b16 = Int -> CmmType -> CmmType
vec Int
8 CmmType
b16
vec16b8 :: CmmType
vec16b8 = Int -> CmmType -> CmmType
vec Int
16 CmmType
b8

cmmVec :: Int -> CmmType -> CmmType
cmmVec :: Int -> CmmType -> CmmType
cmmVec Int
n (CmmType CmmCat
cat Width
w) =
    CmmCat -> Width -> CmmType
CmmType (Int -> CmmCat -> CmmCat
VecCat Int
n CmmCat
cat) (Int -> Width
widthFromBytes (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Width -> Int
widthInBytes Width
w))

vecLength :: CmmType -> Length
vecLength :: CmmType -> Int
vecLength (CmmType (VecCat Int
l CmmCat
_) Width
_) = Int
l
vecLength CmmType
_                        = String -> Int
forall a. HasCallStack => String -> a
panic String
"vecLength: not a vector"

vecElemType :: CmmType -> CmmType
vecElemType :: CmmType -> CmmType
vecElemType (CmmType (VecCat Int
l CmmCat
cat) Width
w) = CmmCat -> Width -> CmmType
CmmType CmmCat
cat Width
scalw
  where
    scalw :: Width
    scalw :: Width
scalw = Int -> Width
widthFromBytes (Width -> Int
widthInBytes Width
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
l)
vecElemType CmmType
_ = String -> CmmType
forall a. HasCallStack => String -> a
panic String
"vecElemType: not a vector"

isVecType :: CmmType -> Bool
isVecType :: CmmType -> Bool
isVecType (CmmType (VecCat {}) Width
_) = Bool
True
isVecType CmmType
_                       = Bool
False

-------------------------------------------------------------------------
-- Hints

-- Hints are extra type information we attach to the arguments and
-- results of a foreign call, where more type information is sometimes
-- needed by the ABI to make the correct kind of call.
--
-- See Note [Signed vs unsigned] for one case where this is used.

data ForeignHint
  = NoHint | AddrHint | SignedHint
  deriving( ForeignHint -> ForeignHint -> Bool
(ForeignHint -> ForeignHint -> Bool)
-> (ForeignHint -> ForeignHint -> Bool) -> Eq ForeignHint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForeignHint -> ForeignHint -> Bool
== :: ForeignHint -> ForeignHint -> Bool
$c/= :: ForeignHint -> ForeignHint -> Bool
/= :: ForeignHint -> ForeignHint -> Bool
Eq )
        -- Used to give extra per-argument or per-result
        -- information needed by foreign calling conventions

instance Outputable ForeignHint where
  ppr :: ForeignHint -> SDoc
ppr ForeignHint
NoHint     = SDoc
forall doc. IsOutput doc => doc
empty
  ppr ForeignHint
SignedHint = SDoc -> SDoc
quotes(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"signed")
--  ppr AddrHint   = quotes(text "address")
-- Temp Jan08
  ppr ForeignHint
AddrHint   = (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PtrHint")


-------------------------------------------------------------------------

-- These don't really belong here, but I don't know where is best to
-- put them.

rEP_CostCentreStack_mem_alloc :: Platform -> CmmType
rEP_CostCentreStack_mem_alloc :: Platform -> CmmType
rEP_CostCentreStack_mem_alloc Platform
platform
    = Width -> CmmType
cmmBits (Int -> Width
widthFromBytes (PlatformConstants -> Int
pc_REP_CostCentreStack_mem_alloc PlatformConstants
pc))
    where pc :: PlatformConstants
pc = Platform -> PlatformConstants
platformConstants Platform
platform

rEP_CostCentreStack_scc_count :: Platform -> CmmType
rEP_CostCentreStack_scc_count :: Platform -> CmmType
rEP_CostCentreStack_scc_count Platform
platform
    = Width -> CmmType
cmmBits (Int -> Width
widthFromBytes (PlatformConstants -> Int
pc_REP_CostCentreStack_scc_count PlatformConstants
pc))
    where pc :: PlatformConstants
pc = Platform -> PlatformConstants
platformConstants Platform
platform

rEP_StgEntCounter_allocs :: Platform -> CmmType
rEP_StgEntCounter_allocs :: Platform -> CmmType
rEP_StgEntCounter_allocs Platform
platform
    = Width -> CmmType
cmmBits (Int -> Width
widthFromBytes (PlatformConstants -> Int
pc_REP_StgEntCounter_allocs PlatformConstants
pc))
    where pc :: PlatformConstants
pc = Platform -> PlatformConstants
platformConstants Platform
platform

rEP_StgEntCounter_allocd :: Platform -> CmmType
rEP_StgEntCounter_allocd :: Platform -> CmmType
rEP_StgEntCounter_allocd Platform
platform
    = Width -> CmmType
cmmBits (Int -> Width
widthFromBytes (PlatformConstants -> Int
pc_REP_StgEntCounter_allocd PlatformConstants
pc))
    where pc :: PlatformConstants
pc = Platform -> PlatformConstants
platformConstants Platform
platform

-------------------------------------------------------------------------
{-      Note [Signed vs unsigned]
        ~~~~~~~~~~~~~~~~~~~~~~~~~
Should a CmmType include a signed vs. unsigned distinction?

This is very much like a "hint" in C-- terminology: it isn't necessary
in order to generate correct code, but it might be useful in that the
compiler can generate better code if it has access to higher-level
hints about data.  This is important at call boundaries, because the
definition of a function is not visible at all of its call sites, so
the compiler cannot infer the hints.

Here in Cmm, we're taking a slightly different approach.  We include
the int vs. float hint in the CmmType, because (a) the majority of
platforms have a strong distinction between float and int registers,
and (b) we don't want to do any heavyweight hint-inference in the
native code backend in order to get good code.  We're treating the
hint more like a type: our Cmm is always completely consistent with
respect to hints.  All coercions between float and int are explicit.

What about the signed vs. unsigned hint?  This information might be
useful if we want to keep sub-word-sized values in word-size
registers, which we must do if we only have word-sized registers.

On such a system, there are two straightforward conventions for
representing sub-word-sized values:

(a) Leave the upper bits undefined.  Comparison operations must
    sign- or zero-extend both operands before comparing them,
    depending on whether the comparison is signed or unsigned.

(b) Always keep the values sign- or zero-extended as appropriate.
    Arithmetic operations must narrow the result to the appropriate
    size.

A clever compiler might not use either (a) or (b) exclusively, instead
it would attempt to minimize the coercions by analysis: the same kind
of analysis that propagates hints around.  In Cmm we don't want to
have to do this, so we plump for having richer types and keeping the
type information consistent.

If signed/unsigned hints are missing from CmmType, then the only
choice we have is (a), because we don't know whether the result of an
operation should be sign- or zero-extended.

Many architectures have extending load operations, which work well
with (b).  To make use of them with (a), you need to know whether the
value is going to be sign- or zero-extended by an enclosing comparison
(for example), which involves knowing above the context.  This is
doable but more complex.

Further complicating the issue is foreign calls: a foreign calling
convention can specify that signed 8-bit quantities are passed as
sign-extended 32 bit quantities, for example (this is the case on the
PowerPC).  So we *do* need sign information on foreign call arguments.

Pros for adding signed vs. unsigned to CmmType:

  - It would let us use convention (b) above, and get easier
    code generation for extending loads.

  - Less information required on foreign calls.

  - MachOp type would be simpler

Cons:

  - More complexity

  - What is the CmmType for a VanillaReg?  Currently it is
    always wordRep, but now we have to decide whether it is
    signed or unsigned.  The same VanillaReg can thus have
    different CmmType in different parts of the program.

  - Extra coercions cluttering up expressions.

Currently for GHC, the foreign call point is moot, because we do our
own promotion of sub-word-sized values to word-sized values.  The Int8
type is represented by an Int# which is kept sign-extended at all times
(this is slightly naughty, because we're making assumptions about the
C calling convention rather early on in the compiler).  However, given
this, the cons outweigh the pros.

-}

-- | is @-falignment-sanitisation@ enabled?
type DoAlignSanitisation = Bool