Commit be5d74ca authored by Moritz Angermann's avatar Moritz Angermann Committed by Marge Bot

[Sized Cmm] properly retain sizes.

This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int#  with
Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us
with properly sized primitives in the codegenerator instead of pretending
they are all full machine words.

This came up when implementing darwinpcs for arm64.  The darwinpcs reqires
us to pack function argugments in excess of registers on the stack.  While
most procedure call standards (pcs) assume arguments are just passed in
8 byte slots; and thus the caller does not know the exact signature to make
the call, darwinpcs requires us to adhere to the prototype, and thus have
the correct sizes.  If we specify CInt in the FFI call, it should correspond
to the C int, and not just be Word sized, when it's only half the size.

This does change the expected output of T16402 but the new result is no
less correct as it eliminates the narrowing (instead of the `and` as was
previously done).

Bumps the array, bytestring, text, and binary submodules.
Co-Authored-By: Ben Gamari's avatarBen Gamari <ben@well-typed.com>

Metric Increase:
    T13701
    T14697
parent 2ed3e6c0
......@@ -336,7 +336,7 @@ basicKnownKeyNames
-- FFI primitive types that are not wired-in.
stablePtrTyConName, ptrTyConName, funPtrTyConName,
int8TyConName, int16TyConName, int32TyConName, int64TyConName,
word16TyConName, word32TyConName, word64TyConName,
word8TyConName, word16TyConName, word32TyConName, word64TyConName,
-- Others
otherwiseIdName, inlineIdName,
......@@ -1463,7 +1463,8 @@ int32TyConName = tcQual gHC_INT (fsLit "Int32") int32TyConKey
int64TyConName = tcQual gHC_INT (fsLit "Int64") int64TyConKey
-- Word module
word16TyConName, word32TyConName, word64TyConName :: Name
word8TyConName, word16TyConName, word32TyConName, word64TyConName :: Name
word8TyConName = tcQual gHC_WORD (fsLit "Word8") word8TyConKey
word16TyConName = tcQual gHC_WORD (fsLit "Word16") word16TyConKey
word32TyConName = tcQual gHC_WORD (fsLit "Word32") word32TyConKey
word64TyConName = tcQual gHC_WORD (fsLit "Word64") word64TyConKey
......
......@@ -55,7 +55,7 @@ module GHC.Builtin.Types (
wordTyCon, wordDataCon, wordTyConName, wordTy,
-- * Word8
word8TyCon, word8DataCon, word8TyConName, word8Ty,
word8TyCon, word8DataCon, word8Ty,
-- * List
listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
......@@ -251,7 +251,6 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they
, floatTyCon
, intTyCon
, wordTyCon
, word8TyCon
, listTyCon
, orderingTyCon
, maybeTyCon
......@@ -354,10 +353,9 @@ nothingDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Nothing")
justDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Just")
justDataConKey justDataCon
wordTyConName, wordDataConName, word8TyConName, word8DataConName :: Name
wordTyConName, wordDataConName, word8DataConName :: Name
wordTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Word") wordTyConKey wordTyCon
wordDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "W#") wordDataConKey wordDataCon
word8TyConName = mkWiredInTyConName UserSyntax gHC_WORD (fsLit "Word8") word8TyConKey word8TyCon
word8DataConName = mkWiredInDataConName UserSyntax gHC_WORD (fsLit "W8#") word8DataConKey word8DataCon
floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name
......@@ -1641,7 +1639,7 @@ word8TyCon = pcTyCon word8TyConName
(NoSourceText, fsLit "HsWord8"))) []
[word8DataCon]
word8DataCon :: DataCon
word8DataCon = pcDataCon word8DataConName [] [wordPrimTy] word8TyCon
word8DataCon = pcDataCon word8DataConName [] [word8PrimTy] word8TyCon
floatTy :: Type
floatTy = mkTyConTy floatTyCon
......
......@@ -291,8 +291,8 @@ section "Int8#"
primtype Int8#
primop Int8Extend "extendInt8#" GenPrimOp Int8# -> Int#
primop Int8Narrow "narrowInt8#" GenPrimOp Int# -> Int8#
primop Int8ExtendOp "extendInt8#" GenPrimOp Int8# -> Int#
primop Int8NarrowOp "narrowInt8#" GenPrimOp Int# -> Int8#
primop Int8NegOp "negateInt8#" GenPrimOp Int8# -> Int8#
......@@ -332,8 +332,8 @@ section "Word8#"
primtype Word8#
primop Word8Extend "extendWord8#" GenPrimOp Word8# -> Word#
primop Word8Narrow "narrowWord8#" GenPrimOp Word# -> Word8#
primop Word8ExtendOp "extendWord8#" GenPrimOp Word8# -> Word#
primop Word8NarrowOp "narrowWord8#" GenPrimOp Word# -> Word8#
primop Word8NotOp "notWord8#" GenPrimOp Word8# -> Word8#
......@@ -373,8 +373,8 @@ section "Int16#"
primtype Int16#
primop Int16Extend "extendInt16#" GenPrimOp Int16# -> Int#
primop Int16Narrow "narrowInt16#" GenPrimOp Int# -> Int16#
primop Int16ExtendOp "extendInt16#" GenPrimOp Int16# -> Int#
primop Int16NarrowOp "narrowInt16#" GenPrimOp Int# -> Int16#
primop Int16NegOp "negateInt16#" GenPrimOp Int16# -> Int16#
......@@ -414,8 +414,8 @@ section "Word16#"
primtype Word16#
primop Word16Extend "extendWord16#" GenPrimOp Word16# -> Word#
primop Word16Narrow "narrowWord16#" GenPrimOp Word# -> Word16#
primop Word16ExtendOp "extendWord16#" GenPrimOp Word16# -> Word#
primop Word16NarrowOp "narrowWord16#" GenPrimOp Word# -> Word16#
primop Word16NotOp "notWord16#" GenPrimOp Word16# -> Word16#
......@@ -448,6 +448,26 @@ primop Word16LeOp "leWord16#" Compare Word16# -> Word16# -> Int#
primop Word16LtOp "ltWord16#" Compare Word16# -> Word16# -> Int#
primop Word16NeOp "neWord16#" Compare Word16# -> Word16# -> Int#
------------------------------------------------------------------------
section "Int32#"
{Operations on 32-bit integers.}
------------------------------------------------------------------------
primtype Int32#
primop Int32ExtendOp "extendInt32#" GenPrimOp Int32# -> Int#
primop Int32NarrowOp "narrowInt32#" GenPrimOp Int# -> Int32#
------------------------------------------------------------------------
section "Word32#"
{Operations on 32-bit unsigned integers.}
------------------------------------------------------------------------
primtype Word32#
primop Word32ExtendOp "extendWord32#" GenPrimOp Word32# -> Word#
primop Word32NarrowOp "narrowWord32#" GenPrimOp Word# -> Word32#
#if WORD_SIZE_IN_BITS < 64
------------------------------------------------------------------------
section "Int64#"
......
......@@ -464,6 +464,12 @@ assembleI platform i = case i of
literal (LitNumber nt i) = case nt of
LitNumInt -> int (fromIntegral i)
LitNumWord -> int (fromIntegral i)
LitNumInt8 -> int8 (fromIntegral i)
LitNumWord8 -> int8 (fromIntegral i)
LitNumInt16 -> int16 (fromIntegral i)
LitNumWord16 -> int16 (fromIntegral i)
LitNumInt32 -> int32 (fromIntegral i)
LitNumWord32 -> int32 (fromIntegral i)
LitNumInt64 -> int64 (fromIntegral i)
LitNumWord64 -> int64 (fromIntegral i)
LitNumInteger -> panic "GHC.ByteCode.Asm.literal: LitNumInteger"
......@@ -478,6 +484,9 @@ assembleI platform i = case i of
float = words . mkLitF
double = words . mkLitD platform
int = words . mkLitI
int8 = words . mkLitI64 platform
int16 = words . mkLitI64 platform
int32 = words . mkLitI64 platform
int64 = words . mkLitI64 platform
words ws = lit (map BCONPtrWord ws)
word w = words [w]
......
......@@ -228,6 +228,12 @@ data CmmStatic
| CmmFileEmbed FilePath
-- ^ an embedded binary file
instance Outputable CmmStatic where
ppr (CmmStaticLit lit) = text "CmmStaticLit" <+> ppr lit
ppr (CmmUninitialised n) = text "CmmUninitialised" <+> ppr n
ppr (CmmString _) = text "CmmString"
ppr (CmmFileEmbed fp) = text "CmmFileEmbed" <+> text fp
-- Static data before SRT generation
data GenCmmStatics (rawOnly :: Bool) where
CmmStatics
......
......@@ -39,6 +39,7 @@ import GHC.Cmm.CLabel
import GHC.Cmm.MachOp
import GHC.Cmm.Type
import GHC.Utils.Panic (panic)
import GHC.Utils.Outputable
import GHC.Types.Unique
import Data.Set (Set)
......@@ -210,6 +211,16 @@ data CmmLit
-- of bytes used
deriving Eq
instance Outputable CmmLit where
ppr (CmmInt n w) = text "CmmInt" <+> ppr n <+> ppr w
ppr (CmmFloat n w) = text "CmmFloat" <+> text (show n) <+> ppr w
ppr (CmmVec xs) = text "CmmVec" <+> ppr xs
ppr (CmmLabel _) = text "CmmLabel"
ppr (CmmLabelOff _ _) = text "CmmLabelOff"
ppr (CmmLabelDiffOff _ _ _ _) = text "CmmLabelDiffOff"
ppr (CmmBlock blk) = text "CmmBlock" <+> ppr blk
ppr CmmHighStackMark = text "CmmHighStackMark"
cmmExprType :: Platform -> CmmExpr -> CmmType
cmmExprType platform = \case
(CmmLit lit) -> cmmLitType platform lit
......
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE CPP, MagicHash #-}
-----------------------------------------------------------------------------
--
......@@ -38,9 +38,17 @@ import Data.Word
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import GHC.Exts
import GHC.Exts hiding (extendWord8#)
import GHC.Word
#if MIN_VERSION_base(4,16,0)
import GHC.Base (extendWord8#)
#else
extendWord8# :: Word# -> Word#
extendWord8# w = w
{-# INLINE extendWord8# #-}
#endif
-- -----------------------------------------------------------------------------
-- Converting floating-point literals to integrals for printing
......@@ -103,7 +111,7 @@ pprASCII str
-- we know that the Chars we create are in the ASCII range
-- so we bypass the check in "chr"
chr' :: Word8 -> Char
chr' (W8# w#) = C# (chr# (word2Int# w#))
chr' (W8# w#) = C# (chr# (word2Int# (extendWord8# w#)))
octal :: Word8 -> String
octal w = [ chr' (ord0 + (w `unsafeShiftR` 6) .&. 0x07)
......
......@@ -159,8 +159,14 @@ pprWordArray platform is_ro lbl ds
-- See Note [StgWord alignment]
, pprAlignment (wordWidth platform)
, text "= {" ]
$$ nest 8 (commafy (pprStatics platform ds))
$$ nest 8 (commafy (staticLitsToWords platform $ toLits ds))
$$ text "};"
where
toLits :: [CmmStatic] -> [CmmLit]
toLits = map f
where
f (CmmStaticLit lit) = lit
f static = pprPanic "pprWordArray: Unexpected literal" (pprStatic platform static)
pprAlignment :: Width -> SDoc
pprAlignment words =
......@@ -501,59 +507,69 @@ pprLit1 platform lit = case lit of
-- ---------------------------------------------------------------------------
-- Static data
pprStatics :: Platform -> [CmmStatic] -> [SDoc]
pprStatics platform = pprStatics'
-- | Produce a list of word sized literals encoding the given list of 'CmmLit's.
staticLitsToWords :: Platform -> [CmmLit] -> [SDoc]
staticLitsToWords platform = go . foldMap decomposeMultiWord
where
pprStatics' = \case
[] -> []
(CmmStaticLit (CmmFloat f W32) : rest)
-- odd numbers of floats are padded to a word by mkVirtHeapOffsetsWithPadding
| wordWidth platform == W64, CmmStaticLit (CmmInt 0 W32) : rest' <- rest
-> pprLit1 platform (floatToWord platform f) : pprStatics' rest'
-- adjacent floats aren't padded but combined into a single word
| wordWidth platform == W64, CmmStaticLit (CmmFloat g W32) : rest' <- rest
-> pprLit1 platform (floatPairToWord platform f g) : pprStatics' rest'
| wordWidth platform == W32
-> pprLit1 platform (floatToWord platform f) : pprStatics' rest
| otherwise
-> pprPanic "pprStatics: float" (vcat (map ppr' rest))
where ppr' (CmmStaticLit l) = ppr (cmmLitType platform l)
ppr' _other = text "bad static!"
(CmmStaticLit (CmmFloat f W64) : rest)
-> map (pprLit1 platform) (doubleToWords platform f) ++ pprStatics' rest
(CmmStaticLit (CmmInt i W64) : rest)
| wordWidth platform == W32
-> case platformByteOrder platform of
BigEndian -> pprStatics' (CmmStaticLit (CmmInt q W32) :
CmmStaticLit (CmmInt r W32) : rest)
LittleEndian -> pprStatics' (CmmStaticLit (CmmInt r W32) :
CmmStaticLit (CmmInt q W32) : rest)
where r = i .&. 0xffffffff
q = i `shiftR` 32
(CmmStaticLit (CmmInt a W32) : CmmStaticLit (CmmInt b W32) : rest)
| wordWidth platform == W64
-> case platformByteOrder platform of
BigEndian -> pprStatics' (CmmStaticLit (CmmInt ((shiftL a 32) .|. b) W64) : rest)
LittleEndian -> pprStatics' (CmmStaticLit (CmmInt ((shiftL b 32) .|. a) W64) : rest)
(CmmStaticLit (CmmInt a W16) : CmmStaticLit (CmmInt b W16) : rest)
| wordWidth platform == W32
-> case platformByteOrder platform of
BigEndian -> pprStatics' (CmmStaticLit (CmmInt ((shiftL a 16) .|. b) W32) : rest)
LittleEndian -> pprStatics' (CmmStaticLit (CmmInt ((shiftL b 16) .|. a) W32) : rest)
(CmmStaticLit (CmmInt _ w) : _)
| w /= wordWidth platform
-> pprPanic "pprStatics: cannot emit a non-word-sized static literal" (ppr w)
(CmmStaticLit lit : rest)
-> pprLit1 platform lit : pprStatics' rest
(other : _)
-> pprPanic "pprStatics: other" (pprStatic platform other)
-- rem_bytes is how many bytes remain in the word we are currently filling.
-- accum is the word we are filling.
go :: [CmmLit] -> [SDoc]
go [] = []
go lits@(lit : _)
| Just _ <- isSubWordLit lit
= goSubWord wordWidthBytes 0 lits
go (lit : rest)
= pprLit1 platform lit : go rest
goSubWord :: Int -> Integer -> [CmmLit] -> [SDoc]
goSubWord rem_bytes accum (lit : rest)
| Just (bytes, w) <- isSubWordLit lit
, rem_bytes >= widthInBytes w
= let accum' =
case platformByteOrder platform of
BigEndian -> (accum `shiftL` widthInBits w) .|. bytes
LittleEndian -> (accum `shiftL` widthInBits w) .|. byteSwap w bytes
in goSubWord (rem_bytes - widthInBytes w) accum' rest
goSubWord rem_bytes accum rest
= pprWord (byteSwap (wordWidth platform) $ accum `shiftL` (8*rem_bytes)) : go rest
-- Decompose multi-word or floating-point literals into multiple
-- single-word (or smaller) literals.
decomposeMultiWord :: CmmLit -> [CmmLit]
decomposeMultiWord (CmmFloat n W64)
-- This will produce a W64 integer, which will then be broken up further
-- on the next iteration on 32-bit platforms.
= [doubleToWord64 n]
decomposeMultiWord (CmmFloat n W32)
= [floatToWord32 n]
decomposeMultiWord (CmmInt n W64)
| W32 <- wordWidth platform
= [CmmInt hi W32, CmmInt lo W32]
where
hi = n `shiftR` 32
lo = n .&. 0xffffffff
decomposeMultiWord lit = [lit]
-- Decompose a sub-word-sized literal into the integer value and its
-- (sub-word-sized) width.
isSubWordLit :: CmmLit -> Maybe (Integer, Width)
isSubWordLit lit =
case lit of
CmmInt n w
| w < wordWidth platform -> Just (n, w)
_ -> Nothing
wordWidthBytes = widthInBytes $ wordWidth platform
pprWord :: Integer -> SDoc
pprWord n = pprHexVal platform n (wordWidth platform)
byteSwap :: Width -> Integer -> Integer
byteSwap width n = foldl' f 0 bytes
where
f acc m = (acc `shiftL` 8) .|. m
bytes = [ byte i | i <- [0..widthInBytes width - 1] ]
byte i = (n `shiftR` (i*8)) .&. 0xff
pprStatic :: Platform -> CmmStatic -> SDoc
pprStatic platform s = case s of
......@@ -1252,69 +1268,30 @@ pprStringInCStyle s = doubleQuotes (text (concatMap charToC (BS.unpack s)))
-- This is a hack to turn the floating point numbers into ints that we
-- can safely initialise to static locations.
castFloatToWord32Array :: STUArray s Int Float -> ST s (STUArray s Int Word32)
castFloatToWord32Array = U.castSTUArray
castDoubleToWord64Array :: STUArray s Int Double -> ST s (STUArray s Int Word64)
castDoubleToWord64Array = U.castSTUArray
floatToWord :: Platform -> Rational -> CmmLit
floatToWord platform r
= runST (do
floatToWord32 :: Rational -> CmmLit
floatToWord32 r
= runST $ do
arr <- newArray_ ((0::Int),0)
writeArray arr 0 (fromRational r)
arr' <- castFloatToWord32Array arr
w32 <- readArray arr' 0
return (CmmInt (toInteger w32 `shiftL` wo) (wordWidth platform))
)
where wo | wordWidth platform == W64
, BigEndian <- platformByteOrder platform
= 32
| otherwise
= 0
floatPairToWord :: Platform -> Rational -> Rational -> CmmLit
floatPairToWord platform r1 r2
= runST (do
arr <- newArray_ ((0::Int),1)
writeArray arr 0 (fromRational r1)
writeArray arr 1 (fromRational r2)
arr' <- castFloatToWord32Array arr
w32_1 <- readArray arr' 0
w32_2 <- readArray arr' 1
return (pprWord32Pair w32_1 w32_2)
)
where pprWord32Pair w32_1 w32_2
| BigEndian <- platformByteOrder platform =
CmmInt ((shiftL i1 32) .|. i2) W64
| otherwise =
CmmInt ((shiftL i2 32) .|. i1) W64
where i1 = toInteger w32_1
i2 = toInteger w32_2
doubleToWords :: Platform -> Rational -> [CmmLit]
doubleToWords platform r
= runST (do
return (CmmInt (toInteger w32) W32)
where
castFloatToWord32Array :: STUArray s Int Float -> ST s (STUArray s Int Word32)
castFloatToWord32Array = U.castSTUArray
doubleToWord64 :: Rational -> CmmLit
doubleToWord64 r
= runST $ do
arr <- newArray_ ((0::Int),1)
writeArray arr 0 (fromRational r)
arr' <- castDoubleToWord64Array arr
w64 <- readArray arr' 0
return (pprWord64 w64)
)
where targetWidth = wordWidth platform
pprWord64 w64
| targetWidth == W64 =
[ CmmInt (toInteger w64) targetWidth ]
| targetWidth == W32 =
[ CmmInt (toInteger targetW1) targetWidth
, CmmInt (toInteger targetW2) targetWidth
]
| otherwise = panic "doubleToWords.pprWord64"
where (targetW1, targetW2) = case platformByteOrder platform of
BigEndian -> (wHi, wLo)
LittleEndian -> (wLo, wHi)
wHi = w64 `shiftR` 32
wLo = w64 .&. 0xFFFFffff
return $ CmmInt (toInteger w64) W64
where
castDoubleToWord64Array :: STUArray s Int Double -> ST s (STUArray s Int Word64)
castDoubleToWord64Array = U.castSTUArray
-- ---------------------------------------------------------------------------
-- Utils
......
......@@ -29,6 +29,7 @@ module GHC.Core (
mkIntLit, mkIntLitWrap,
mkWordLit, mkWordLitWrap,
mkWord8Lit,
mkWord64LitWord64, mkInt64LitInt64,
mkCharLit, mkStringLit,
mkFloatLit, mkFloatLitFloat,
......@@ -1997,6 +1998,9 @@ mkWordLit platform w = Lit (mkLitWord platform w)
mkWordLitWrap :: Platform -> Integer -> Expr b
mkWordLitWrap platform w = Lit (mkLitWordWrap platform w)
mkWord8Lit :: Integer -> Expr b
mkWord8Lit w = Lit (mkLitWord8 w)
mkWord64LitWord64 :: Word64 -> Expr b
mkWord64LitWord64 w = Lit (mkLitWord64 (toInteger w))
......
......@@ -198,6 +198,46 @@ primOpRules nm = \case
SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord shiftRightLogical ]
-- coercions
Int8ExtendOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ]
Int16ExtendOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ]
Int32ExtendOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ]
Int8NarrowOp -> mkPrimOpRule nm 1 [ liftLit narrowInt8Lit
, subsumedByPrimOp Int8NarrowOp
, narrowSubsumesAnd AndIOp Int8NarrowOp 8 ]
Int16NarrowOp -> mkPrimOpRule nm 1 [ liftLit narrowInt16Lit
, subsumedByPrimOp Int8NarrowOp
, subsumedByPrimOp Int16NarrowOp
, narrowSubsumesAnd AndIOp Int16NarrowOp 16 ]
Int32NarrowOp -> mkPrimOpRule nm 1 [ liftLit narrowInt32Lit
, subsumedByPrimOp Int8NarrowOp
, subsumedByPrimOp Int16NarrowOp
, subsumedByPrimOp Int32NarrowOp
, narrowSubsumesAnd AndIOp Int32NarrowOp 32 ]
Word8ExtendOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit
, extendNarrowPassthrough Word8NarrowOp 0xFF
]
Word16ExtendOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit
, extendNarrowPassthrough Word16NarrowOp 0xFFFF
]
Word32ExtendOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit
, extendNarrowPassthrough Word32NarrowOp 0xFFFFFFFF
]
Word8NarrowOp -> mkPrimOpRule nm 1 [ liftLit narrowWord8Lit
, subsumedByPrimOp Word8NarrowOp
, narrowSubsumesAnd AndOp Word8NarrowOp 8 ]
Word16NarrowOp -> mkPrimOpRule nm 1 [ liftLit narrowWord16Lit
, subsumedByPrimOp Word8NarrowOp
, subsumedByPrimOp Word16NarrowOp
, narrowSubsumesAnd AndOp Word16NarrowOp 16 ]
Word32NarrowOp -> mkPrimOpRule nm 1 [ liftLit narrowWord32Lit
, subsumedByPrimOp Word8NarrowOp
, subsumedByPrimOp Word16NarrowOp
, subsumedByPrimOp Word32NarrowOp
, narrowSubsumesAnd AndOp Word32NarrowOp 32 ]
WordToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform wordToIntLit
, inversePrimOp IntToWordOp ]
IntToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform intToWordLit
......@@ -625,8 +665,14 @@ isMinBound :: Platform -> Literal -> Bool
isMinBound _ (LitChar c) = c == minBound
isMinBound platform (LitNumber nt i) = case nt of
LitNumInt -> i == platformMinInt platform
LitNumInt8 -> i == toInteger (minBound :: Int8)
LitNumInt16 -> i == toInteger (minBound :: Int16)
LitNumInt32 -> i == toInteger (minBound :: Int32)
LitNumInt64 -> i == toInteger (minBound :: Int64)
LitNumWord -> i == 0
LitNumWord8 -> i == 0
LitNumWord16 -> i == 0
LitNumWord32 -> i == 0
LitNumWord64 -> i == 0
LitNumNatural -> i == 0
LitNumInteger -> False
......@@ -636,8 +682,14 @@ isMaxBound :: Platform -> Literal -> Bool
isMaxBound _ (LitChar c) = c == maxBound
isMaxBound platform (LitNumber nt i) = case nt of
LitNumInt -> i == platformMaxInt platform
LitNumInt8 -> i == toInteger (maxBound :: Int8)
LitNumInt16 -> i == toInteger (maxBound :: Int16)
LitNumInt32 -> i == toInteger (maxBound :: Int32)
LitNumInt64 -> i == toInteger (maxBound :: Int64)
LitNumWord -> i == platformMaxWord platform
LitNumWord8 -> i == toInteger (maxBound :: Word8)
LitNumWord16 -> i == toInteger (maxBound :: Word16)
LitNumWord32 -> i == toInteger (maxBound :: Word32)
LitNumWord64 -> i == toInteger (maxBound :: Word64)
LitNumNatural -> False
LitNumInteger -> False
......@@ -697,6 +749,13 @@ subsumedByPrimOp primop = do
matchPrimOpId primop primop_id
return e
-- | Transform `extendWordN (narrowWordN x)` into `x .&. 0xFF..FF`
extendNarrowPassthrough :: PrimOp -> Integer -> RuleM CoreExpr
extendNarrowPassthrough narrow_primop n = do
[Var primop_id `App` x] <- getArgs
matchPrimOpId narrow_primop primop_id
return (Var (mkPrimOpId AndOp) `App` x `App` Lit (LitNumber LitNumWord n))
-- | narrow subsumes bitwise `and` with full mask (cf #16402):
--
-- narrowN (x .&. m)
......
......@@ -1387,6 +1387,12 @@ primRepToFFIType platform r
VoidRep -> FFIVoid
IntRep -> signed_word
WordRep -> unsigned_word
Int8Rep -> FFISInt8
Word8Rep -> FFIUInt8
Int16Rep -> FFISInt16
Word16Rep -> FFIUInt16
Int32Rep -> FFISInt32
Word32Rep -> FFIUInt32
Int64Rep -> FFISInt64
Word64Rep -> FFIUInt64
AddrRep -> FFIPointer
......@@ -1405,6 +1411,12 @@ mkDummyLiteral platform pr
= case pr of
IntRep -> mkLitInt platform 0
WordRep -> mkLitWord platform 0
Int8Rep -> mkLitInt8 0
Word8Rep -> mkLitWord8 0
Int16Rep -> mkLitInt16 0
Word16Rep -> mkLitWord16 0
Int32Rep -> mkLitInt32 0
Word32Rep -> mkLitWord32 0