[Git][ghc/ghc][wip/int64-everywhere] Fix Word64/Int64 constant-folding
Sylvain Henry
gitlab at gitlab.haskell.org
Mon Oct 12 17:36:45 UTC 2020
Sylvain Henry pushed to branch wip/int64-everywhere at Glasgow Haskell Compiler / GHC
Commits:
c6b4bbc2 by Sylvain Henry at 2020-10-12T19:36:30+02:00
Fix Word64/Int64 constant-folding
I've refactored literal narrow/coerce functions to make them more
generic. Hence this patch incidentally implements basic support for
Int8/16/32 and Word8/16/32 in Core.
- - - - -
7 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/CoreToByteCode.hs
- compiler/GHC/Types/Literal.hs
- compiler/GHC/Utils/Outputable.hs
- testsuite/driver/testlib.py
- testsuite/tests/simplCore/should_compile/T8832.stdout
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -458,8 +458,14 @@ assembleI platform i = case i of
-- LitString requires a zero-terminator when emitted
literal (LitNumber nt i) = case nt of
LitNumInt -> int (fromIntegral i)
- LitNumWord -> int (fromIntegral i)
+ LitNumInt8 -> int (fromIntegral i)
+ LitNumInt16 -> int (fromIntegral i)
+ LitNumInt32 -> int (fromIntegral i)
LitNumInt64 -> int64 (fromIntegral i)
+ LitNumWord -> int (fromIntegral i)
+ LitNumWord8 -> int (fromIntegral i)
+ LitNumWord16 -> int (fromIntegral i)
+ LitNumWord32 -> int (fromIntegral i)
LitNumWord64 -> int64 (fromIntegral i)
LitNumInteger -> panic "GHC.ByteCode.Asm.literal: LitNumInteger"
LitNumNatural -> panic "GHC.ByteCode.Asm.literal: LitNumNatural"
=====================================
compiler/GHC/Core/Opt/ConstantFold.hs
=====================================
@@ -71,7 +71,6 @@ import Control.Monad
import Data.Functor (($>))
import Data.Bits as Bits
import qualified Data.ByteString as BS
-import Data.Int
import Data.Ratio
import Data.Word
import Data.Maybe (fromMaybe)
@@ -264,41 +263,50 @@ primOpRules nm = \case
WordSrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord shiftRightLogical ]
-- coercions
- Word64ToInt64Op-> mkPrimOpRule nm 1 [ liftLitPlatform $ const word64ToInt64Lit
+ Word64ToInt64Op-> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumInt64)
, inversePrimOp Int64ToWord64Op ]
- Int64ToWord64Op-> mkPrimOpRule nm 1 [ liftLitPlatform $ const int64ToWord64Lit
+ Int64ToWord64Op-> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumWord64)
, inversePrimOp Word64ToInt64Op ]
- WordToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform wordToIntLit
- , inversePrimOp IntToWordOp ]
- IntToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform intToWordLit
- , inversePrimOp WordToIntOp ]
- Narrow8IntOp -> mkPrimOpRule nm 1 [ liftLit narrow8IntLit
+ Int64ToInt -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumInt)
+ , inversePrimOp IntToInt64 ]
+ Word64ToWord -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumWord)
+ , inversePrimOp WordToWord64 ]
+ IntToInt64 -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumInt64)
+ , inversePrimOp Int64ToInt ]
+ WordToWord64 -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumWord64)
+ , inversePrimOp Word64ToWord ]
+ WordToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumInt)
+ , inversePrimOp IntToWordOp ]
+ IntToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumWord)
+ , inversePrimOp WordToIntOp ]
+
+ Narrow8IntOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumInt8)
, subsumedByPrimOp Narrow8IntOp
, Narrow8IntOp `subsumesPrimOp` Narrow16IntOp
, Narrow8IntOp `subsumesPrimOp` Narrow32IntOp
, narrowSubsumesAnd IntAndOp Narrow8IntOp 8 ]
- Narrow16IntOp -> mkPrimOpRule nm 1 [ liftLit narrow16IntLit
+ Narrow16IntOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumInt16)
, subsumedByPrimOp Narrow8IntOp
, subsumedByPrimOp Narrow16IntOp
, Narrow16IntOp `subsumesPrimOp` Narrow32IntOp
, narrowSubsumesAnd IntAndOp Narrow16IntOp 16 ]
- Narrow32IntOp -> mkPrimOpRule nm 1 [ liftLit narrow32IntLit
+ Narrow32IntOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumInt32)
, subsumedByPrimOp Narrow8IntOp
, subsumedByPrimOp Narrow16IntOp
, subsumedByPrimOp Narrow32IntOp
, removeOp32
, narrowSubsumesAnd IntAndOp Narrow32IntOp 32 ]
- Narrow8WordOp -> mkPrimOpRule nm 1 [ liftLit narrow8WordLit
+ Narrow8WordOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumWord8)
, subsumedByPrimOp Narrow8WordOp
, Narrow8WordOp `subsumesPrimOp` Narrow16WordOp
, Narrow8WordOp `subsumesPrimOp` Narrow32WordOp
, narrowSubsumesAnd WordAndOp Narrow8WordOp 8 ]
- Narrow16WordOp -> mkPrimOpRule nm 1 [ liftLit narrow16WordLit
+ Narrow16WordOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumWord16)
, subsumedByPrimOp Narrow8WordOp
, subsumedByPrimOp Narrow16WordOp
, Narrow16WordOp `subsumesPrimOp` Narrow32WordOp
, narrowSubsumesAnd WordAndOp Narrow16WordOp 16 ]
- Narrow32WordOp -> mkPrimOpRule nm 1 [ liftLit narrow32WordLit
+ Narrow32WordOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumWord32)
, subsumedByPrimOp Narrow8WordOp
, subsumedByPrimOp Narrow16WordOp
, subsumedByPrimOp Narrow32WordOp
@@ -710,28 +718,6 @@ mkRuleFn platform Gt _ (Lit lit) | isMaxBound platform lit = Just $ falseValInt
mkRuleFn platform Le _ (Lit lit) | isMaxBound platform lit = Just $ trueValInt platform
mkRuleFn _ _ _ _ = Nothing
-isMinBound :: Platform -> Literal -> Bool
-isMinBound _ (LitChar c) = c == minBound
-isMinBound platform (LitNumber nt i) = case nt of
- LitNumInt -> i == platformMinInt platform
- LitNumInt64 -> i == toInteger (minBound :: Int64)
- LitNumWord -> i == 0
- LitNumWord64 -> i == 0
- LitNumNatural -> i == 0
- LitNumInteger -> False
-isMinBound _ _ = False
-
-isMaxBound :: Platform -> Literal -> Bool
-isMaxBound _ (LitChar c) = c == maxBound
-isMaxBound platform (LitNumber nt i) = case nt of
- LitNumInt -> i == platformMaxInt platform
- LitNumInt64 -> i == toInteger (maxBound :: Int64)
- LitNumWord -> i == platformMaxWord platform
- LitNumWord64 -> i == toInteger (maxBound :: Word64)
- LitNumNatural -> False
- LitNumInteger -> False
-isMaxBound _ _ = False
-
-- | Create an Int literal expression while ensuring the given Integer is in the
-- target Int range
int64Result :: Integer -> Maybe CoreExpr
=====================================
compiler/GHC/CoreToByteCode.hs
=====================================
@@ -1641,8 +1641,14 @@ pushAtom _ _ (AnnLit lit) = do
LitRubbish -> code N
LitNumber nt _ -> case nt of
LitNumInt -> code N
- LitNumWord -> code N
+ LitNumInt8 -> code N
+ LitNumInt16 -> code N
+ LitNumInt32 -> code N
LitNumInt64 -> code L
+ LitNumWord -> code N
+ LitNumWord8 -> code N
+ LitNumWord16 -> code N
+ LitNumWord32 -> code N
LitNumWord64 -> code L
-- No LitInteger's or LitNatural's should be left by the time this is
-- called. CorePrep should have converted them all to a real core
=====================================
compiler/GHC/Types/Literal.hs
=====================================
@@ -2,12 +2,15 @@
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1998
-\section[Literal]{@Literal@: literals}
-}
{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+-- | Core literals
module GHC.Types.Literal
(
-- * Main data type
@@ -30,6 +33,11 @@ module GHC.Types.Literal
, pprLiteral
, litNumIsSigned
, litNumCheckRange
+ , litNumWrap
+ , litNumCoerce
+ , litNumNarrow
+ , isMinBound
+ , isMaxBound
-- ** Predicates on Literals and their contents
, litIsDupable, litIsTrivial, litIsLifted
@@ -39,11 +47,6 @@ module GHC.Types.Literal
, litValue, isLitValue, isLitValue_maybe, mapLitValue
-- ** Coercions
- , word64ToInt64Lit, int64ToWord64Lit
- , wordToIntLit, intToWordLit
- , narrowLit
- , narrow8IntLit, narrow16IntLit, narrow32IntLit
- , narrow8WordLit, narrow16WordLit, narrow32WordLit
, charToIntLit, intToCharLit
, floatToIntLit, intToFloatLit
, floatToInt64Lit, int64ToFloatLit
@@ -78,7 +81,6 @@ import Data.Word
import Data.Char
import Data.Maybe ( isJust )
import Data.Data ( Data )
-import Data.Proxy
import Numeric ( fromRat )
{-
@@ -158,8 +160,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)
@@ -169,8 +177,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
{-
@@ -289,43 +303,65 @@ doesn't yield a warning. Instead we simply squash the value into the *target*
Int/Word range.
-}
--- | Wrap a literal number according to its type
-wrapLitNumber :: Platform -> Literal -> Literal
-wrapLitNumber platform v@(LitNumber nt i) = case nt of
+-- | Make a literal number using wrapping semantics if the value is out of
+-- bound.
+mkLitNumberWrap :: Platform -> LitNumType -> Integer -> Literal
+mkLitNumberWrap platform nt i = case nt of
LitNumInt -> case platformWordSize platform of
- PW4 -> int32
- PW8 -> int64
+ PW4 -> wrap @Int32
+ PW8 -> wrap @Int64
LitNumWord -> case platformWordSize platform of
- PW4 -> word32
- PW8 -> word64
- LitNumInt64 -> int64
- LitNumWord64 -> word64
- LitNumInteger -> v
- LitNumNatural -> v
+ PW4 -> wrap @Word32
+ PW8 -> wrap @Word64
+ LitNumInt8 -> wrap @Int8
+ LitNumInt16 -> wrap @Int16
+ LitNumInt32 -> wrap @Int32
+ LitNumInt64 -> wrap @Int64
+ LitNumWord8 -> wrap @Word8
+ LitNumWord16 -> wrap @Word16
+ LitNumWord32 -> wrap @Word32
+ LitNumWord64 -> wrap @Word64
+ LitNumInteger -> LitNumber nt i
+ LitNumNatural
+ | i < 0 -> panic "mkLitNumberWrap: trying to create a negative Natural"
+ | otherwise -> LitNumber nt i
where
- int32 = LitNumber nt $ wrapInt32 i
- word32 = LitNumber nt $ wrapWord32 i
- int64 = LitNumber nt $ wrapInt64 i
- word64 = LitNumber nt $ wrapWord64 i
-wrapLitNumber _ x = x
-
-wrapInt32, wrapWord32, wrapInt64, wrapWord64 :: Integer -> Integer
-wrapInt32 i = toInteger (fromIntegral i :: Int32)
-wrapWord32 i = toInteger (fromIntegral i :: Word32)
-wrapInt64 i = toInteger (fromIntegral i :: Int64)
-wrapWord64 i = toInteger (fromIntegral i :: Word64)
+ wrap :: forall a. (Integral a, Num a) => Literal
+ wrap = LitNumber nt (toInteger (fromIntegral i :: a))
+
+-- | Wrap a literal number according to its type using wrapping semantics.
+litNumWrap :: Platform -> Literal -> Literal
+litNumWrap platform (LitNumber nt i) = mkLitNumberWrap platform nt i
+litNumWrap _ l = pprPanic "litNumWrap" (ppr l)
+
+-- | Coerce a literal number into another using wrapping semantics.
+litNumCoerce :: LitNumType -> Platform -> Literal -> Literal
+litNumCoerce pt platform (LitNumber _nt i) = mkLitNumberWrap platform pt i
+litNumCoerce _ _ l = pprPanic "litNumWrapCoerce: not a number" (ppr l)
+
+-- | Narrow a literal number by converting it into another number type and then
+-- converting it back to its original type.
+litNumNarrow :: LitNumType -> Platform -> Literal -> Literal
+litNumNarrow pt platform (LitNumber nt i)
+ = case mkLitNumberWrap platform pt i of
+ LitNumber _ j -> mkLitNumberWrap platform nt j
+ l -> pprPanic "litNumNarrow: got invalid literal" (ppr l)
+litNumNarrow _ _ l = pprPanic "litNumNarrow: invalid literal" (ppr l)
--- | Create a numeric 'Literal' of the given type
-mkLitNumberWrap :: Platform -> LitNumType -> Integer -> Literal
-mkLitNumberWrap platform nt i = wrapLitNumber platform (LitNumber nt i)
-- | Check that a given number is in the range of a numeric literal
litNumCheckRange :: Platform -> LitNumType -> Integer -> Bool
litNumCheckRange platform nt i = case nt of
LitNumInt -> platformInIntRange platform i
LitNumWord -> platformInWordRange platform i
- LitNumInt64 -> inInt64Range i
- LitNumWord64 -> inWord64Range i
+ LitNumInt8 -> inBoundedRange @Int8 i
+ LitNumInt16 -> inBoundedRange @Int16 i
+ LitNumInt32 -> inBoundedRange @Int32 i
+ LitNumInt64 -> inBoundedRange @Int64 i
+ LitNumWord8 -> inBoundedRange @Word8 i
+ LitNumWord16 -> inBoundedRange @Word16 i
+ LitNumWord32 -> inBoundedRange @Word32 i
+ LitNumWord64 -> inBoundedRange @Word64 i
LitNumNatural -> i >= 0
LitNumInteger -> True
@@ -344,7 +380,7 @@ mkLitInt platform x = ASSERT2( platformInIntRange platform x, integer x )
-- If the argument is out of the (target-dependent) range, it is wrapped.
-- See Note [Word/Int underflow/overflow]
mkLitIntWrap :: Platform -> Integer -> Literal
-mkLitIntWrap platform i = wrapLitNumber platform $ mkLitIntUnchecked i
+mkLitIntWrap platform i = mkLitNumberWrap platform LitNumInt i
-- | Creates a 'Literal' of type @Int#@ without checking its range.
mkLitIntUnchecked :: Integer -> Literal
@@ -368,7 +404,7 @@ mkLitWord platform x = ASSERT2( platformInWordRange platform x, integer x )
-- If the argument is out of the (target-dependent) range, it is wrapped.
-- See Note [Word/Int underflow/overflow]
mkLitWordWrap :: Platform -> Integer -> Literal
-mkLitWordWrap platform i = wrapLitNumber platform $ mkLitWordUnchecked i
+mkLitWordWrap platform i = mkLitNumberWrap platform LitNumWord i
-- | Creates a 'Literal' of type @Word#@ without checking its range.
mkLitWordUnchecked :: Integer -> Literal
@@ -385,12 +421,12 @@ mkLitWordWrapC platform i = (n, i /= i')
-- | Creates a 'Literal' of type @Int64#@
mkLitInt64 :: Integer -> Literal
-mkLitInt64 x = ASSERT2( inInt64Range x, integer x ) (mkLitInt64Unchecked x)
+mkLitInt64 x = ASSERT2( inBoundedRange @Int64 x, integer x ) (mkLitInt64Unchecked x)
-- | Creates a 'Literal' of type @Int64#@.
-- If the argument is out of the range, it is wrapped.
mkLitInt64Wrap :: Integer -> Literal
-mkLitInt64Wrap = mkLitInt64Unchecked . wrapInt64
+mkLitInt64Wrap i = LitNumber LitNumInt64 (toInteger (fromIntegral i :: Int64))
-- | Creates a 'Literal' of type @Int64#@ without checking its range.
mkLitInt64Unchecked :: Integer -> Literal
@@ -398,12 +434,12 @@ mkLitInt64Unchecked i = LitNumber LitNumInt64 i
-- | Creates a 'Literal' of type @Word64#@
mkLitWord64 :: Integer -> Literal
-mkLitWord64 x = ASSERT2( inWord64Range x, integer x ) (mkLitWord64Unchecked x)
+mkLitWord64 x = ASSERT2( inBoundedRange @Word64 x, integer x ) (mkLitWord64Unchecked x)
-- | Creates a 'Literal' of type @Word64#@.
-- If the argument is out of the range, it is wrapped.
mkLitWord64Wrap :: Integer -> Literal
-mkLitWord64Wrap = mkLitWord64Unchecked . wrapWord64
+mkLitWord64Wrap i = LitNumber LitNumWord64 (toInteger (fromIntegral i :: Word64))
-- | Creates a 'Literal' of type @Word64#@ without checking its range.
mkLitWord64Unchecked :: Integer -> Literal
@@ -437,11 +473,43 @@ mkLitNatural x = ASSERT2( inNaturalRange x, integer x )
inNaturalRange :: Integer -> Bool
inNaturalRange x = x >= 0
-inInt64Range, inWord64Range :: Integer -> Bool
-inInt64Range x = x >= toInteger (minBound :: Int64) &&
- x <= toInteger (maxBound :: Int64)
-inWord64Range x = x >= toInteger (minBound :: Word64) &&
- x <= toInteger (maxBound :: Word64)
+inBoundedRange :: forall a. (Bounded a, Integral a) => Integer -> Bool
+inBoundedRange x = x >= toInteger (minBound :: a) &&
+ x <= toInteger (maxBound :: a)
+
+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
+isMinBound _ _ = False
+
+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
+isMaxBound _ _ = False
inCharRange :: Char -> Bool
inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR
@@ -475,7 +543,7 @@ isLitValue_maybe _ = Nothing
mapLitValue :: Platform -> (Integer -> Integer) -> Literal -> Literal
mapLitValue _ f (LitChar c) = mkLitChar (fchar c)
where fchar = chr . fromInteger . f . toInteger . ord
-mapLitValue platform f (LitNumber nt i) = wrapLitNumber platform (LitNumber nt (f i))
+mapLitValue platform f (LitNumber nt i) = mkLitNumberWrap platform nt (f i)
mapLitValue _ _ l = pprPanic "mapLitValue" (ppr l)
-- | Indicate if the `Literal` contains an 'Integer' value, e.g. 'Char',
@@ -488,9 +556,7 @@ isLitValue = isJust . isLitValue_maybe
~~~~~~~~~
-}
-narrow8IntLit, narrow16IntLit, narrow32IntLit,
- narrow8WordLit, narrow16WordLit, narrow32WordLit,
- charToIntLit, intToCharLit,
+charToIntLit, intToCharLit,
floatToIntLit, intToFloatLit,
floatToInt64Lit, int64ToFloatLit,
doubleToIntLit, intToDoubleLit,
@@ -498,58 +564,6 @@ narrow8IntLit, narrow16IntLit, narrow32IntLit,
floatToDoubleLit, doubleToFloatLit
:: Literal -> Literal
-maxBoundInt64, maxBoundWord64 :: Integer
-maxBoundInt64 = toInteger (maxBound :: Int64)
-maxBoundWord64 = toInteger (maxBound :: Word64)
-
-word64ToInt64Lit, int64ToWord64Lit :: Literal -> Literal
-
-word64ToInt64Lit (LitNumber LitNumWord64 w)
- -- Map Word64 range [max_int64+1, max_word64]
- -- to Int64 range [min_int64 , -1]
- -- Range [0,max_int64] has the same representation with both Int64 and Word64
- | w > maxBoundInt64 = mkLitInt64 $ w - maxBoundWord64 - 1
- | otherwise = mkLitInt64 w
-word64ToInt64Lit l = pprPanic "word64ToInt64Lit" (ppr l)
-
-int64ToWord64Lit (LitNumber LitNumInt64 i)
- -- Map Int64 range [min_int64 , -1]
- -- to Word64 range [max_int64+1, max_word64]
- -- Range [0,max_int64] has the same representation with both Int64 and Word64
- | i < 0 = mkLitWord64 $ 1 + maxBoundWord64 + i
- | otherwise = mkLitWord64 i
-int64ToWord64Lit l = pprPanic "int64ToWord64Lit" (ppr l)
-
-wordToIntLit, intToWordLit :: Platform -> Literal -> Literal
-
-wordToIntLit platform (LitNumber LitNumWord w)
- -- Map Word range [max_int+1, max_word]
- -- to Int range [min_int , -1]
- -- Range [0,max_int] has the same representation with both Int and Word
- | w > platformMaxInt platform = mkLitInt platform (w - platformMaxWord platform - 1)
- | otherwise = mkLitInt platform w
-wordToIntLit _ l = pprPanic "wordToIntLit" (ppr l)
-
-intToWordLit platform (LitNumber LitNumInt i)
- -- Map Int range [min_int , -1]
- -- to Word range [max_int+1, max_word]
- -- Range [0,max_int] has the same representation with both Int and Word
- | i < 0 = mkLitWord platform (1 + platformMaxWord platform + i)
- | otherwise = mkLitWord platform 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)
-
charToIntLit (LitChar c) = mkLitIntUnchecked (toInteger (ord c))
charToIntLit l = pprPanic "charToIntLit" (ppr l)
intToCharLit (LitNumber _ i) = LitChar (chr (fromInteger i))
@@ -632,8 +646,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
@@ -645,8 +665,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
@@ -661,8 +687,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
@@ -683,8 +715,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
@@ -760,8 +798,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)
@@ -803,9 +847,9 @@ LitChar 'a'#
LitString "aaa"#
LitNullAddr "__NULL"
LitInt -1#
-LitInt64 -1L#
+LitIntN -1#N
LitWord 1##
-LitWord64 1L##
+LitWordN 1##N
LitFloat -1.0#
LitDouble -1.0##
LitInteger -1 (-1)
=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -59,10 +59,16 @@ module GHC.Utils.Outputable (
pprHsChar, pprHsString, pprHsBytes,
primFloatSuffix, primCharSuffix, primDoubleSuffix,
+ primInt8Suffix, primWord8Suffix,
+ primInt16Suffix, primWord16Suffix,
+ primInt32Suffix, primWord32Suffix,
primInt64Suffix, primWord64Suffix,
primIntSuffix, primWordSuffix,
pprPrimChar, pprPrimInt, pprPrimWord,
+ pprPrimInt8, pprPrimWord8,
+ pprPrimInt16, pprPrimWord16,
+ pprPrimInt32, pprPrimWord32,
pprPrimInt64, pprPrimWord64,
pprFastFilePath, pprFilePathString,
@@ -1156,22 +1162,42 @@ pprHsBytes bs = let escaped = concatMap escape $ BS.unpack bs
-- See Note [Printing of literals in Core] in "GHC.Types.Literal".
primCharSuffix, primFloatSuffix, primDoubleSuffix,
primIntSuffix, primWordSuffix,
- primInt64Suffix, primWord64Suffix :: SDoc
+ primInt8Suffix, primWord8Suffix,
+ primInt16Suffix, primWord16Suffix,
+ primInt32Suffix, primWord32Suffix,
+ primInt64Suffix, primWord64Suffix
+ :: SDoc
primCharSuffix = char '#'
primFloatSuffix = char '#'
primIntSuffix = char '#'
primDoubleSuffix = text "##"
primWordSuffix = text "##"
-primInt64Suffix = text "L#"
-primWord64Suffix = text "L##"
+primInt8Suffix = text "#8"
+primWord8Suffix = text "##8"
+primInt16Suffix = text "#16"
+primWord16Suffix = text "##16"
+primInt32Suffix = text "#32"
+primWord32Suffix = text "##32"
+primInt64Suffix = text "#64"
+primWord64Suffix = text "##64"
-- | Special combinator for showing unboxed literals.
pprPrimChar :: Char -> SDoc
pprPrimInt, pprPrimWord,
- pprPrimInt64, pprPrimWord64 :: Integer -> SDoc
+ pprPrimInt8, pprPrimWord8,
+ pprPrimInt16, pprPrimWord16,
+ pprPrimInt32, pprPrimWord32,
+ pprPrimInt64, pprPrimWord64
+ :: Integer -> SDoc
pprPrimChar c = pprHsChar c <> primCharSuffix
pprPrimInt i = integer i <> primIntSuffix
pprPrimWord w = word w <> primWordSuffix
+pprPrimInt8 i = integer i <> primInt8Suffix
+pprPrimWord8 w = word w <> primWord8Suffix
+pprPrimInt16 i = integer i <> primInt16Suffix
+pprPrimWord16 w = word w <> primWord16Suffix
+pprPrimInt32 i = integer i <> primInt32Suffix
+pprPrimWord32 w = word w <> primWord32Suffix
pprPrimInt64 i = integer i <> primInt64Suffix
pprPrimWord64 w = word w <> primWord64Suffix
=====================================
testsuite/driver/testlib.py
=====================================
@@ -2143,7 +2143,7 @@ def normalise_callstacks(s: str) -> str:
s = re.sub(r'CallStack \(from -prof\):(\n .*)*\n?', '', s)
return s
-tyCon_re = re.compile(r'TyCon\s*\d+L?\#\#\s*\d+L?\#\#\s*', flags=re.MULTILINE)
+tyCon_re = re.compile(r'TyCon\s*\d+\#\#\d?\d?\s*\d+\#\#\d?\d?\s*', flags=re.MULTILINE)
def normalise_type_reps(s: str) -> str:
""" Normalise out fingerprints from Typeable TyCon representations """
=====================================
testsuite/tests/simplCore/should_compile/T8832.stdout
=====================================
@@ -2,10 +2,10 @@ i = GHC.Types.I# 0#
i8 = GHC.Int.I8# 0#
i16 = GHC.Int.I16# 0#
i32 = GHC.Int.I32# 0#
-i64 = GHC.Int.I64# 0L#
+i64 = GHC.Int.I64# 0#64
w = GHC.Types.W# 0##
w8 = GHC.Word.W8# 0##
w16 = GHC.Word.W16# 0##
w32 = GHC.Word.W32# 0##
-w64 = GHC.Word.W64# 0L##
+w64 = GHC.Word.W64# 0##64
z = 0
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6b4bbc2867076310bdaabea03905901697d32c7
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6b4bbc2867076310bdaabea03905901697d32c7
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201012/c0a9ef5d/attachment-0001.html>
More information about the ghc-commits
mailing list