diff options
Diffstat (limited to 'compiler/GHC/Types/Literal.hs')
| -rw-r--r-- | compiler/GHC/Types/Literal.hs | 211 |
1 files changed, 199 insertions, 12 deletions
diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs index 461f4ac70a..a5c855a4fa 100644 --- a/compiler/GHC/Types/Literal.hs +++ b/compiler/GHC/Types/Literal.hs @@ -17,6 +17,12 @@ module GHC.Types.Literal -- ** Creating Literals , mkLitInt, mkLitIntWrap, mkLitIntWrapC, mkLitIntUnchecked , mkLitWord, mkLitWordWrap, mkLitWordWrapC + , mkLitInt8, mkLitInt8Wrap + , mkLitWord8, mkLitWord8Wrap + , mkLitInt16, mkLitInt16Wrap + , mkLitWord16, mkLitWord16Wrap + , mkLitInt32, mkLitInt32Wrap + , mkLitWord32, mkLitWord32Wrap , mkLitInt64, mkLitInt64Wrap , mkLitWord64, mkLitWord64Wrap , mkLitFloat, mkLitDouble @@ -40,9 +46,13 @@ module GHC.Types.Literal -- ** Coercions , wordToIntLit, intToWordLit - , narrowLit , narrow8IntLit, narrow16IntLit, narrow32IntLit , narrow8WordLit, narrow16WordLit, narrow32WordLit + , narrowInt8Lit, narrowInt16Lit, narrowInt32Lit + , narrowWord8Lit, narrowWord16Lit, narrowWord32Lit + , extendIntLit, extendWordLit + , int8Lit, int16Lit, int32Lit + , word8Lit, word16Lit, word32Lit , charToIntLit, intToCharLit , floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit , nullAddrLit, rubbishLit, floatToDoubleLit, doubleToFloatLit @@ -152,8 +162,14 @@ data LitNumType = LitNumInteger -- ^ @Integer@ (see Note [BigNum literals]) | LitNumNatural -- ^ @Natural@ (see Note [BigNum literals]) | LitNumInt -- ^ @Int#@ - according to target machine + | LitNumInt8 -- ^ @Int8#@ - exactly 8 bits + | LitNumInt16 -- ^ @Int16#@ - exactly 16 bits + | LitNumInt32 -- ^ @Int32#@ - exactly 32 bits | LitNumInt64 -- ^ @Int64#@ - exactly 64 bits | LitNumWord -- ^ @Word#@ - according to target machine + | LitNumWord8 -- ^ @Word8#@ - exactly 8 bits + | LitNumWord16 -- ^ @Word16#@ - exactly 16 bits + | LitNumWord32 -- ^ @Word32#@ - exactly 32 bits | LitNumWord64 -- ^ @Word64#@ - exactly 64 bits deriving (Data,Enum,Eq,Ord) @@ -163,8 +179,14 @@ litNumIsSigned nt = case nt of LitNumInteger -> True LitNumNatural -> False LitNumInt -> True + LitNumInt8 -> True + LitNumInt16 -> True + LitNumInt32 -> True LitNumInt64 -> True LitNumWord -> False + LitNumWord8 -> False + LitNumWord16 -> False + LitNumWord32 -> False LitNumWord64 -> False {- @@ -290,6 +312,12 @@ wrapLitNumber platform v@(LitNumber nt i) = case nt of LitNumWord -> case platformWordSize platform of PW4 -> LitNumber nt (toInteger (fromIntegral i :: Word32)) PW8 -> LitNumber nt (toInteger (fromIntegral i :: Word64)) + LitNumInt8 -> LitNumber nt (toInteger (fromIntegral i :: Int8)) + LitNumWord8 -> LitNumber nt (toInteger (fromIntegral i :: Word8)) + LitNumInt16 -> LitNumber nt (toInteger (fromIntegral i :: Int16)) + LitNumWord16 -> LitNumber nt (toInteger (fromIntegral i :: Word16)) + LitNumInt32 -> LitNumber nt (toInteger (fromIntegral i :: Int32)) + LitNumWord32 -> LitNumber nt (toInteger (fromIntegral i :: Word32)) LitNumInt64 -> LitNumber nt (toInteger (fromIntegral i :: Int64)) LitNumWord64 -> LitNumber nt (toInteger (fromIntegral i :: Word64)) LitNumInteger -> v @@ -305,7 +333,13 @@ litNumCheckRange :: Platform -> LitNumType -> Integer -> Bool litNumCheckRange platform nt i = case nt of LitNumInt -> platformInIntRange platform i LitNumWord -> platformInWordRange platform i + LitNumInt8 -> inInt8Range i + LitNumInt16 -> inInt16Range i + LitNumInt32 -> inInt32Range i LitNumInt64 -> inInt64Range i + LitNumWord8 -> inWord8Range i + LitNumWord16 -> inWord16Range i + LitNumWord32 -> inWord32Range i LitNumWord64 -> inWord64Range i LitNumNatural -> i >= 0 LitNumInteger -> True @@ -364,6 +398,84 @@ mkLitWordWrapC platform i = (n, i /= i') where n@(LitNumber _ i') = mkLitWordWrap platform i +-- | Creates a 'Literal' of type @Int8#@ +mkLitInt8 :: Integer -> Literal +mkLitInt8 x = ASSERT2( inInt8Range x, integer x ) (mkLitInt8Unchecked x) + +-- | Creates a 'Literal' of type @Int8#@. +-- If the argument is out of the range, it is wrapped. +mkLitInt8Wrap :: Platform -> Integer -> Literal +mkLitInt8Wrap platform i = wrapLitNumber platform $ mkLitInt8Unchecked i + +-- | Creates a 'Literal' of type @Int8#@ without checking its range. +mkLitInt8Unchecked :: Integer -> Literal +mkLitInt8Unchecked i = LitNumber LitNumInt8 i + +-- | Creates a 'Literal' of type @Word8#@ +mkLitWord8 :: Integer -> Literal +mkLitWord8 x = ASSERT2( inWord8Range x, integer x ) (mkLitWord8Unchecked x) + +-- | Creates a 'Literal' of type @Word8#@. +-- If the argument is out of the range, it is wrapped. +mkLitWord8Wrap :: Platform -> Integer -> Literal +mkLitWord8Wrap platform i = wrapLitNumber platform $ mkLitWord8Unchecked i + +-- | Creates a 'Literal' of type @Word8#@ without checking its range. +mkLitWord8Unchecked :: Integer -> Literal +mkLitWord8Unchecked i = LitNumber LitNumWord8 i + +-- | Creates a 'Literal' of type @Int16#@ +mkLitInt16 :: Integer -> Literal +mkLitInt16 x = ASSERT2( inInt16Range x, integer x ) (mkLitInt16Unchecked x) + +-- | Creates a 'Literal' of type @Int16#@. +-- If the argument is out of the range, it is wrapped. +mkLitInt16Wrap :: Platform -> Integer -> Literal +mkLitInt16Wrap platform i = wrapLitNumber platform $ mkLitInt16Unchecked i + +-- | Creates a 'Literal' of type @Int16#@ without checking its range. +mkLitInt16Unchecked :: Integer -> Literal +mkLitInt16Unchecked i = LitNumber LitNumInt16 i + +-- | Creates a 'Literal' of type @Word16#@ +mkLitWord16 :: Integer -> Literal +mkLitWord16 x = ASSERT2( inWord16Range x, integer x ) (mkLitWord16Unchecked x) + +-- | Creates a 'Literal' of type @Word16#@. +-- If the argument is out of the range, it is wrapped. +mkLitWord16Wrap :: Platform -> Integer -> Literal +mkLitWord16Wrap platform i = wrapLitNumber platform $ mkLitWord16Unchecked i + +-- | Creates a 'Literal' of type @Word16#@ without checking its range. +mkLitWord16Unchecked :: Integer -> Literal +mkLitWord16Unchecked i = LitNumber LitNumWord16 i + +-- | Creates a 'Literal' of type @Int32#@ +mkLitInt32 :: Integer -> Literal +mkLitInt32 x = ASSERT2( inInt32Range x, integer x ) (mkLitInt32Unchecked x) + +-- | Creates a 'Literal' of type @Int32#@. +-- If the argument is out of the range, it is wrapped. +mkLitInt32Wrap :: Platform -> Integer -> Literal +mkLitInt32Wrap platform i = wrapLitNumber platform $ mkLitInt32Unchecked i + +-- | Creates a 'Literal' of type @Int32#@ without checking its range. +mkLitInt32Unchecked :: Integer -> Literal +mkLitInt32Unchecked i = LitNumber LitNumInt32 i + +-- | Creates a 'Literal' of type @Word32#@ +mkLitWord32 :: Integer -> Literal +mkLitWord32 x = ASSERT2( inWord32Range x, integer x ) (mkLitWord32Unchecked x) + +-- | Creates a 'Literal' of type @Word32#@. +-- If the argument is out of the range, it is wrapped. +mkLitWord32Wrap :: Platform -> Integer -> Literal +mkLitWord32Wrap platform i = wrapLitNumber platform $ mkLitWord32Unchecked i + +-- | Creates a 'Literal' of type @Word32#@ without checking its range. +mkLitWord32Unchecked :: Integer -> Literal +mkLitWord32Unchecked i = LitNumber LitNumWord32 i + -- | Creates a 'Literal' of type @Int64#@ mkLitInt64 :: Integer -> Literal mkLitInt64 x = ASSERT2( inInt64Range x, integer x ) (mkLitInt64Unchecked x) @@ -418,7 +530,20 @@ mkLitNatural x = ASSERT2( inNaturalRange x, integer x ) inNaturalRange :: Integer -> Bool inNaturalRange x = x >= 0 -inInt64Range, inWord64Range :: Integer -> Bool +inInt8Range, inWord8Range, inInt16Range, inWord16Range :: Integer -> Bool +inInt32Range, inWord32Range, inInt64Range, inWord64Range :: Integer -> Bool +inInt8Range x = x >= toInteger (minBound :: Int8) && + x <= toInteger (maxBound :: Int8) +inWord8Range x = x >= toInteger (minBound :: Word8) && + x <= toInteger (maxBound :: Word8) +inInt16Range x = x >= toInteger (minBound :: Int16) && + x <= toInteger (maxBound :: Int16) +inWord16Range x = x >= toInteger (minBound :: Word16) && + x <= toInteger (maxBound :: Word16) +inInt32Range x = x >= toInteger (minBound :: Int32) && + x <= toInteger (maxBound :: Int32) +inWord32Range x = x >= toInteger (minBound :: Word32) && + x <= toInteger (maxBound :: Word32) inInt64Range x = x >= toInteger (minBound :: Int64) && x <= toInteger (maxBound :: Int64) inWord64Range x = x >= toInteger (minBound :: Word64) && @@ -466,6 +591,8 @@ mapLitValue _ _ l = pprPanic "mapLitValue" (ppr l) narrow8IntLit, narrow16IntLit, narrow32IntLit, narrow8WordLit, narrow16WordLit, narrow32WordLit, + int8Lit, int16Lit, int32Lit, + word8Lit, word16Lit, word32Lit, charToIntLit, intToCharLit, floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit, floatToDoubleLit, doubleToFloatLit @@ -489,16 +616,46 @@ intToWordLit platform (LitNumber LitNumInt i) intToWordLit _ l = pprPanic "intToWordLit" (ppr l) -- | Narrow a literal number (unchecked result range) -narrowLit :: forall a. Integral a => Proxy a -> Literal -> Literal -narrowLit _ (LitNumber nt i) = LitNumber nt (toInteger (fromInteger i :: a)) -narrowLit _ l = pprPanic "narrowLit" (ppr l) - -narrow8IntLit = narrowLit (Proxy :: Proxy Int8) -narrow16IntLit = narrowLit (Proxy :: Proxy Int16) -narrow32IntLit = narrowLit (Proxy :: Proxy Int32) -narrow8WordLit = narrowLit (Proxy :: Proxy Word8) -narrow16WordLit = narrowLit (Proxy :: Proxy Word16) -narrow32WordLit = narrowLit (Proxy :: Proxy Word32) +narrowLit' :: forall a. Integral a => Proxy a -> LitNumType -> Literal -> Literal +narrowLit' _ nt' (LitNumber _ i) = LitNumber nt' (toInteger (fromInteger i :: a)) +narrowLit' _ _ l = pprPanic "narrowLit" (ppr l) + +narrow8IntLit = narrowLit' (Proxy :: Proxy Int8) LitNumInt +narrow16IntLit = narrowLit' (Proxy :: Proxy Int16) LitNumInt +narrow32IntLit = narrowLit' (Proxy :: Proxy Int32) LitNumInt +narrow8WordLit = narrowLit' (Proxy :: Proxy Word8) LitNumWord +narrow16WordLit = narrowLit' (Proxy :: Proxy Word16) LitNumWord +narrow32WordLit = narrowLit' (Proxy :: Proxy Word32) LitNumWord + +narrowInt8Lit, narrowInt16Lit, narrowInt32Lit, + narrowWord8Lit, narrowWord16Lit, narrowWord32Lit :: Literal -> Literal +narrowInt8Lit = narrowLit' (Proxy :: Proxy Int8) LitNumInt8 +narrowInt16Lit = narrowLit' (Proxy :: Proxy Int16) LitNumInt16 +narrowInt32Lit = narrowLit' (Proxy :: Proxy Int32) LitNumInt32 +narrowWord8Lit = narrowLit' (Proxy :: Proxy Word8) LitNumWord8 +narrowWord16Lit = narrowLit' (Proxy :: Proxy Word16) LitNumWord16 +narrowWord32Lit = narrowLit' (Proxy :: Proxy Word32) LitNumWord32 + +-- | Extend a fixed-width literal (e.g. 'Int16#') to a word-sized literal (e.g. +-- 'Int#'). +extendWordLit, extendIntLit :: Platform -> Literal -> Literal +extendWordLit platform (LitNumber _nt i) = mkLitWord platform i +extendWordLit _platform l = pprPanic "extendWordLit" (ppr l) +extendIntLit platform (LitNumber _nt i) = mkLitInt platform i +extendIntLit _platform l = pprPanic "extendIntLit" (ppr l) + +int8Lit (LitNumber _ i) = mkLitInt8 i +int8Lit l = pprPanic "int8Lit" (ppr l) +int16Lit (LitNumber _ i) = mkLitInt16 i +int16Lit l = pprPanic "int16Lit" (ppr l) +int32Lit (LitNumber _ i) = mkLitInt32 i +int32Lit l = pprPanic "int32Lit" (ppr l) +word8Lit (LitNumber _ i) = mkLitWord8 i +word8Lit l = pprPanic "word8Lit" (ppr l) +word16Lit (LitNumber _ i) = mkLitWord16 i +word16Lit l = pprPanic "word16Lit" (ppr l) +word32Lit (LitNumber _ i) = mkLitWord32 i +word32Lit l = pprPanic "word32Lit" (ppr l) charToIntLit (LitChar c) = mkLitIntUnchecked (toInteger (ord c)) charToIntLit l = pprPanic "charToIntLit" (ppr l) @@ -572,8 +729,14 @@ litIsTrivial (LitNumber nt _) = case nt of LitNumInteger -> False LitNumNatural -> False LitNumInt -> True + LitNumInt8 -> True + LitNumInt16 -> True + LitNumInt32 -> True LitNumInt64 -> True LitNumWord -> True + LitNumWord8 -> True + LitNumWord16 -> True + LitNumWord32 -> True LitNumWord64 -> True litIsTrivial _ = True @@ -585,8 +748,14 @@ litIsDupable platform x = case x of LitNumInteger -> platformInIntRange platform i LitNumNatural -> platformInWordRange platform i LitNumInt -> True + LitNumInt8 -> True + LitNumInt16 -> True + LitNumInt32 -> True LitNumInt64 -> True LitNumWord -> True + LitNumWord8 -> True + LitNumWord16 -> True + LitNumWord32 -> True LitNumWord64 -> True (LitString _) -> False _ -> True @@ -601,8 +770,14 @@ litIsLifted (LitNumber nt _) = case nt of LitNumInteger -> True LitNumNatural -> True LitNumInt -> False + LitNumInt8 -> False + LitNumInt16 -> False + LitNumInt32 -> False LitNumInt64 -> False LitNumWord -> False + LitNumWord8 -> False + LitNumWord16 -> False + LitNumWord32 -> False LitNumWord64 -> False litIsLifted _ = False @@ -623,8 +798,14 @@ literalType (LitNumber lt _) = case lt of LitNumInteger -> integerTy LitNumNatural -> naturalTy LitNumInt -> intPrimTy + LitNumInt8 -> int8PrimTy + LitNumInt16 -> int16PrimTy + LitNumInt32 -> int32PrimTy LitNumInt64 -> int64PrimTy LitNumWord -> wordPrimTy + LitNumWord8 -> word8PrimTy + LitNumWord16 -> word16PrimTy + LitNumWord32 -> word32PrimTy LitNumWord64 -> word64PrimTy literalType (LitRubbish) = mkForAllTy a Inferred (mkTyVarTy a) where @@ -700,8 +881,14 @@ pprLiteral add_par (LitNumber nt i) LitNumInteger -> pprIntegerVal add_par i LitNumNatural -> pprIntegerVal add_par i LitNumInt -> pprPrimInt i + LitNumInt8 -> pprPrimInt8 i + LitNumInt16 -> pprPrimInt16 i + LitNumInt32 -> pprPrimInt32 i LitNumInt64 -> pprPrimInt64 i LitNumWord -> pprPrimWord i + LitNumWord8 -> pprPrimWord8 i + LitNumWord16 -> pprPrimWord16 i + LitNumWord32 -> pprPrimWord32 i LitNumWord64 -> pprPrimWord64 i pprLiteral add_par (LitLabel l mb fod) = add_par (text "__label" <+> b <+> ppr fod) |