[Git][ghc/ghc][wip/fixed-width-lits] 2 commits: Cleanup some primop-related identifers
John Ericson
gitlab at gitlab.haskell.org
Mon Nov 23 15:37:22 UTC 2020
John Ericson pushed to branch wip/fixed-width-lits at Glasgow Haskell Compiler / GHC
Commits:
58a37f8b by John Ericson at 2020-11-23T04:50:12+00:00
Cleanup some primop-related identifers
- Don't use "extend" or "narrow" in some of the user-facing primops
names for conversions.
- Names like `narrowInt32#` are misleading when `Int` is 32-bits.
- Names like `extendInt64#` are flat-out wrong when `Int is
32-bits.
- `narrow{Int,Word}<N>#` however map a type to itself, and so don't
suffer from this problem. They are left as-is.
- Harmonize the internal (big sum type) names of the native vs
fixed-sized number primops a bit. (Mainly by renaming the former.)
- - - - -
cfb672c4 by Sylvain Henry at 2020-11-23T15:37:10+00:00
Make proper fixed-with number literals
(Progress towards #11953, #17377, #17375)
Besides being nicer to use, this also will allow for better constant
folding for the fixed-width types, on par with what `Int#` and `Word#`
have today.
- - - - -
26 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/CoreToByteCode.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Types/Literal.hs
- compiler/GHC/Utils/Outputable.hs
- testsuite/driver/testlib.py
- testsuite/tests/cmm/opt/T18141.hs
- testsuite/tests/codeGen/should_compile/T18614.hs
- testsuite/tests/ffi/should_run/PrimFFIInt16.hs
- testsuite/tests/ffi/should_run/PrimFFIInt8.hs
- testsuite/tests/ffi/should_run/PrimFFIWord16.hs
- testsuite/tests/ffi/should_run/PrimFFIWord8.hs
- testsuite/tests/primops/should_run/ArithInt16.hs
- testsuite/tests/primops/should_run/ArithInt8.hs
- testsuite/tests/primops/should_run/ArithWord16.hs
- testsuite/tests/primops/should_run/ArithWord8.hs
- testsuite/tests/primops/should_run/CmpInt16.hs
- testsuite/tests/primops/should_run/CmpInt8.hs
- testsuite/tests/primops/should_run/CmpWord16.hs
- testsuite/tests/primops/should_run/CmpWord8.hs
- testsuite/tests/primops/should_run/ShowPrim.hs
- testsuite/tests/primops/should_run/ShowPrim.stdout
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -291,8 +291,8 @@ section "Int8#"
primtype Int8#
-primop Int8Extend "extendInt8#" GenPrimOp Int8# -> Int#
-primop Int8Narrow "narrowInt8#" GenPrimOp Int# -> Int8#
+primop Int8ToInt "int8ToInt#" GenPrimOp Int8# -> Int#
+primop IntToInt8 "intToInt8#" GenPrimOp Int# -> Int8#
primop Int8NegOp "negateInt8#" GenPrimOp Int8# -> Int8#
@@ -327,13 +327,13 @@ primop Int8NeOp "neInt8#" Compare Int8# -> Int8# -> Int#
------------------------------------------------------------------------
section "Word8#"
- {Operations on 8-bit unsigned integers.}
+ {Operations on 8-bit unsigned words.}
------------------------------------------------------------------------
primtype Word8#
-primop Word8Extend "extendWord8#" GenPrimOp Word8# -> Word#
-primop Word8Narrow "narrowWord8#" GenPrimOp Word# -> Word8#
+primop Word8ToWord "word8ToWord#" GenPrimOp Word8# -> Word#
+primop WordToWord8 "wordToWord8#" 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 Int16ToInt "int16ToInt#" GenPrimOp Int16# -> Int#
+primop IntToInt16 "intToInt16#" GenPrimOp Int# -> Int16#
primop Int16NegOp "negateInt16#" GenPrimOp Int16# -> Int16#
@@ -409,13 +409,13 @@ primop Int16NeOp "neInt16#" Compare Int16# -> Int16# -> Int#
------------------------------------------------------------------------
section "Word16#"
- {Operations on 16-bit unsigned integers.}
+ {Operations on 16-bit unsigned words.}
------------------------------------------------------------------------
primtype Word16#
-primop Word16Extend "extendWord16#" GenPrimOp Word16# -> Word#
-primop Word16Narrow "narrowWord16#" GenPrimOp Word# -> Word16#
+primop Word16ToWord "word16ToWord#" GenPrimOp Word16# -> Word#
+primop WordToWord16 "wordToWord16#" GenPrimOp Word# -> Word16#
primop Word16NotOp "notWord16#" GenPrimOp Word16# -> Word16#
@@ -540,19 +540,19 @@ primop IntQuotRemOp "quotRemInt#" GenPrimOp
{Rounds towards zero.}
with can_fail = True
-primop AndIOp "andI#" GenPrimOp Int# -> Int# -> Int#
+primop IntAndOp "andI#" GenPrimOp Int# -> Int# -> Int#
{Bitwise "and".}
with commutable = True
-primop OrIOp "orI#" GenPrimOp Int# -> Int# -> Int#
+primop IntOrOp "orI#" GenPrimOp Int# -> Int# -> Int#
{Bitwise "or".}
with commutable = True
-primop XorIOp "xorI#" GenPrimOp Int# -> Int# -> Int#
+primop IntXorOp "xorI#" GenPrimOp Int# -> Int# -> Int#
{Bitwise "xor".}
with commutable = True
-primop NotIOp "notI#" GenPrimOp Int# -> Int#
+primop IntNotOp "notI#" GenPrimOp Int# -> Int#
{Bitwise "not", also known as the binary complement.}
primop IntNegOp "negateInt#" GenPrimOp Int# -> Int#
@@ -612,13 +612,13 @@ primop IntToDoubleOp "int2Double#" GenPrimOp Int# -> Double#
primop WordToFloatOp "word2Float#" GenPrimOp Word# -> Float#
primop WordToDoubleOp "word2Double#" GenPrimOp Word# -> Double#
-primop ISllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int#
+primop IntSllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int#
{Shift left. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
-primop ISraOp "uncheckedIShiftRA#" GenPrimOp Int# -> Int# -> Int#
+primop IntSraOp "uncheckedIShiftRA#" GenPrimOp Int# -> Int# -> Int#
{Shift right arithmetic. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
-primop ISrlOp "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int#
+primop IntSrlOp "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int#
{Shift right logical. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
@@ -678,21 +678,21 @@ primop WordQuotRem2Op "quotRemWord2#" GenPrimOp
Requires that high word < divisor.}
with can_fail = True
-primop AndOp "and#" GenPrimOp Word# -> Word# -> Word#
+primop WordAndOp "and#" GenPrimOp Word# -> Word# -> Word#
with commutable = True
-primop OrOp "or#" GenPrimOp Word# -> Word# -> Word#
+primop WordOrOp "or#" GenPrimOp Word# -> Word# -> Word#
with commutable = True
-primop XorOp "xor#" GenPrimOp Word# -> Word# -> Word#
+primop WordXorOp "xor#" GenPrimOp Word# -> Word# -> Word#
with commutable = True
-primop NotOp "not#" GenPrimOp Word# -> Word#
+primop WordNotOp "not#" GenPrimOp Word# -> Word#
-primop SllOp "uncheckedShiftL#" GenPrimOp Word# -> Int# -> Word#
+primop WordSllOp "uncheckedShiftL#" GenPrimOp Word# -> Int# -> Word#
{Shift left logical. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
-primop SrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word#
+primop WordSrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word#
{Shift right logical. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -463,8 +463,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
=====================================
@@ -76,7 +76,6 @@ import Control.Applicative ( Alternative(..) )
import Control.Monad
import Data.Bits as Bits
import qualified Data.ByteString as BS
-import Data.Int
import Data.Ratio
import Data.Word
import Data.Maybe (fromMaybe)
@@ -135,24 +134,24 @@ primOpRules nm = \case
retLit zeroi
, equalArgs >> retLit zeroi
, equalArgs >> retLit zeroi ]
- AndIOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.&.))
+ IntAndOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.&.))
, idempotent
, zeroElem zeroi ]
- OrIOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.|.))
+ IntOrOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.|.))
, idempotent
, identityPlatform zeroi ]
- XorIOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 xor)
+ IntXorOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 xor)
, identityPlatform zeroi
, equalArgs >> retLit zeroi ]
- NotIOp -> mkPrimOpRule nm 1 [ unaryLit complementOp
- , inversePrimOp NotIOp ]
+ IntNotOp -> mkPrimOpRule nm 1 [ unaryLit complementOp
+ , inversePrimOp IntNotOp ]
IntNegOp -> mkPrimOpRule nm 1 [ unaryLit negOp
, inversePrimOp IntNegOp ]
- ISllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumInt (const Bits.shiftL)
+ IntSllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumInt (const Bits.shiftL)
, rightIdentityPlatform zeroi ]
- ISraOp -> mkPrimOpRule nm 2 [ shiftRule LitNumInt (const Bits.shiftR)
+ IntSraOp -> mkPrimOpRule nm 2 [ shiftRule LitNumInt (const Bits.shiftR)
, rightIdentityPlatform zeroi ]
- ISrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumInt shiftRightLogical
+ IntSrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumInt shiftRightLogical
, rightIdentityPlatform zeroi ]
-- Word operations
@@ -183,57 +182,58 @@ primOpRules nm = \case
guard (l == onew platform)
retLit zerow
, equalArgs >> retLit zerow ]
- AndOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.&.))
+ WordAndOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.&.))
, idempotent
, zeroElem zerow ]
- OrOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.|.))
+ WordOrOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.|.))
, idempotent
, identityPlatform zerow ]
- XorOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor)
+ WordXorOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor)
, identityPlatform zerow
, equalArgs >> retLit zerow ]
- NotOp -> mkPrimOpRule nm 1 [ unaryLit complementOp
- , inversePrimOp NotOp ]
- SllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord (const Bits.shiftL) ]
- SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord shiftRightLogical ]
+ WordNotOp -> mkPrimOpRule nm 1 [ unaryLit complementOp
+ , inversePrimOp WordNotOp ]
+ WordSllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord (const Bits.shiftL) ]
+ WordSrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord shiftRightLogical ]
-- coercions
- WordToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform wordToIntLit
+ WordToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumInt)
, inversePrimOp IntToWordOp ]
- IntToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform intToWordLit
+ IntToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumWord)
, inversePrimOp WordToIntOp ]
- Narrow8IntOp -> mkPrimOpRule nm 1 [ liftLit narrow8IntLit
+
+ Narrow8IntOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumInt8)
, subsumedByPrimOp Narrow8IntOp
, Narrow8IntOp `subsumesPrimOp` Narrow16IntOp
, Narrow8IntOp `subsumesPrimOp` Narrow32IntOp
- , narrowSubsumesAnd AndIOp Narrow8IntOp 8 ]
- Narrow16IntOp -> mkPrimOpRule nm 1 [ liftLit narrow16IntLit
+ , narrowSubsumesAnd IntAndOp Narrow8IntOp 8 ]
+ Narrow16IntOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumInt16)
, subsumedByPrimOp Narrow8IntOp
, subsumedByPrimOp Narrow16IntOp
, Narrow16IntOp `subsumesPrimOp` Narrow32IntOp
- , narrowSubsumesAnd AndIOp Narrow16IntOp 16 ]
- Narrow32IntOp -> mkPrimOpRule nm 1 [ liftLit narrow32IntLit
+ , narrowSubsumesAnd IntAndOp Narrow16IntOp 16 ]
+ Narrow32IntOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumInt32)
, subsumedByPrimOp Narrow8IntOp
, subsumedByPrimOp Narrow16IntOp
, subsumedByPrimOp Narrow32IntOp
, removeOp32
- , narrowSubsumesAnd AndIOp Narrow32IntOp 32 ]
- Narrow8WordOp -> mkPrimOpRule nm 1 [ liftLit narrow8WordLit
+ , narrowSubsumesAnd IntAndOp Narrow32IntOp 32 ]
+ Narrow8WordOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumWord8)
, subsumedByPrimOp Narrow8WordOp
, Narrow8WordOp `subsumesPrimOp` Narrow16WordOp
, Narrow8WordOp `subsumesPrimOp` Narrow32WordOp
- , narrowSubsumesAnd AndOp Narrow8WordOp 8 ]
- Narrow16WordOp -> mkPrimOpRule nm 1 [ liftLit narrow16WordLit
+ , narrowSubsumesAnd WordAndOp Narrow8WordOp 8 ]
+ Narrow16WordOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumWord16)
, subsumedByPrimOp Narrow8WordOp
, subsumedByPrimOp Narrow16WordOp
, Narrow16WordOp `subsumesPrimOp` Narrow32WordOp
- , narrowSubsumesAnd AndOp Narrow16WordOp 16 ]
- Narrow32WordOp -> mkPrimOpRule nm 1 [ liftLit narrow32WordLit
+ , narrowSubsumesAnd WordAndOp Narrow16WordOp 16 ]
+ Narrow32WordOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumWord32)
, subsumedByPrimOp Narrow8WordOp
, subsumedByPrimOp Narrow16WordOp
, subsumedByPrimOp Narrow32WordOp
, removeOp32
- , narrowSubsumesAnd AndOp Narrow32WordOp 32 ]
+ , narrowSubsumesAnd WordAndOp Narrow32WordOp 32 ]
OrdOp -> mkPrimOpRule nm 1 [ liftLit charToIntLit
, inversePrimOp ChrOp ]
ChrOp -> mkPrimOpRule nm 1 [ do [Lit lit] <- getArgs
@@ -489,8 +489,8 @@ shiftRule :: LitNumType -- Type of the result, either LitNumInt or LitNumWord
-> RuleM CoreExpr
-- Shifts take an Int; hence third arg of op is Int
-- Used for shift primops
--- ISllOp, ISraOp, ISrlOp :: Int# -> Int# -> Int#
--- SllOp, SrlOp :: Word# -> Int# -> Word#
+-- IntSllOp, IntSraOp, IntSrlOp :: Int# -> Int# -> Int#
+-- SllOp, SrlOp :: Word# -> Int# -> Word#
shiftRule lit_num_ty shift_op
= do { platform <- getPlatform
; [e1, Lit (LitNumber LitNumInt shift_len)] <- getArgs
@@ -542,7 +542,7 @@ doubleOp2 _ _ _ _ = Nothing
doubleDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr
doubleDecodeOp env (LitDouble ((decodeFloat . fromRational @Double) -> (m, e)))
= Just $ mkCoreUbxTup [iNT64Ty, intPrimTy]
- [ Lit (mkLitINT64 (roPlatform env) (toInteger m))
+ [ Lit (mkLitINT64 (toInteger m))
, mkIntVal platform (toInteger e) ]
where
platform = roPlatform env
@@ -550,7 +550,7 @@ doubleDecodeOp env (LitDouble ((decodeFloat . fromRational @Double) -> (m, e)))
| platformWordSizeInBits platform < 64
= (int64PrimTy, mkLitInt64Wrap)
| otherwise
- = (intPrimTy , mkLitIntWrap)
+ = (intPrimTy , mkLitIntWrap platform)
doubleDecodeOp _ _
= Nothing
@@ -621,28 +621,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
intResult :: Platform -> Integer -> Maybe CoreExpr
@@ -792,7 +770,7 @@ transform the invalid shift into an "obviously incorrect" value.
There are two cases:
-- Shifting fixed-width things: the primops ISll, Sll, etc
+- Shifting fixed-width things: the primops IntSll, Sll, etc
These are handled by shiftRule.
We are happy to shift by any amount up to wordSize but no more.
@@ -1322,7 +1300,7 @@ builtinRules enableBignumRules
[arg, Lit (LitNumber LitNumInt d)] <- getArgs
Just n <- return $ exactLog2 d
platform <- getPlatform
- return $ Var (mkPrimOpId ISraOp) `App` arg `App` mkIntVal platform n
+ return $ Var (mkPrimOpId IntSraOp) `App` arg `App` mkIntVal platform n
],
mkBasicRule modIntName 2 $ msum
@@ -1332,7 +1310,7 @@ builtinRules enableBignumRules
[arg, Lit (LitNumber LitNumInt d)] <- getArgs
Just _ <- return $ exactLog2 d
platform <- getPlatform
- return $ Var (mkPrimOpId AndIOp)
+ return $ Var (mkPrimOpId IntAndOp)
`App` arg `App` mkIntVal platform (d - 1)
]
]
@@ -2306,8 +2284,8 @@ adjustDyadicRight op lit
IntAddOp -> Just (\y -> y-lit )
WordSubOp -> Just (\y -> y+lit )
IntSubOp -> Just (\y -> y+lit )
- XorOp -> Just (\y -> y `xor` lit)
- XorIOp -> Just (\y -> y `xor` lit)
+ WordXorOp -> Just (\y -> y `xor` lit)
+ IntXorOp -> Just (\y -> y `xor` lit)
_ -> Nothing
adjustDyadicLeft :: Integer -> PrimOp -> Maybe (Integer -> Integer)
@@ -2318,8 +2296,8 @@ adjustDyadicLeft lit op
IntAddOp -> Just (\y -> y-lit )
WordSubOp -> Just (\y -> lit-y )
IntSubOp -> Just (\y -> lit-y )
- XorOp -> Just (\y -> y `xor` lit)
- XorIOp -> Just (\y -> y `xor` lit)
+ WordXorOp -> Just (\y -> y `xor` lit)
+ IntXorOp -> Just (\y -> y `xor` lit)
_ -> Nothing
@@ -2327,8 +2305,8 @@ adjustUnary :: PrimOp -> Maybe (Integer -> Integer)
-- Given (op x) return a function 'f' s.t. f (op x) = x
adjustUnary op
= case op of
- NotOp -> Just (\y -> complement y)
- NotIOp -> Just (\y -> complement y)
+ WordNotOp -> Just (\y -> complement y)
+ IntNotOp -> Just (\y -> complement y)
IntNegOp -> Just (\y -> negate y )
_ -> Nothing
=====================================
compiler/GHC/CoreToByteCode.hs
=====================================
@@ -1636,8 +1636,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/HsToCore/Match/Literal.hs
=====================================
@@ -97,8 +97,8 @@ dsLit l = do
HsCharPrim _ c -> return (Lit (LitChar c))
HsIntPrim _ i -> return (Lit (mkLitIntWrap platform i))
HsWordPrim _ w -> return (Lit (mkLitWordWrap platform w))
- HsInt64Prim _ i -> return (Lit (mkLitInt64Wrap platform i))
- HsWord64Prim _ w -> return (Lit (mkLitWord64Wrap platform w))
+ HsInt64Prim _ i -> return (Lit (mkLitInt64Wrap i))
+ HsWord64Prim _ w -> return (Lit (mkLitWord64Wrap w))
HsFloatPrim _ f -> return (Lit (LitFloat (fl_value f)))
HsDoublePrim _ d -> return (Lit (LitDouble (fl_value d)))
HsChar _ c -> return (mkCharExpr c)
@@ -514,8 +514,8 @@ hsLitKey :: Platform -> HsLit GhcTc -> Literal
-- HsLit does not.
hsLitKey platform (HsIntPrim _ i) = mkLitIntWrap platform i
hsLitKey platform (HsWordPrim _ w) = mkLitWordWrap platform w
-hsLitKey platform (HsInt64Prim _ i) = mkLitInt64Wrap platform i
-hsLitKey platform (HsWord64Prim _ w) = mkLitWord64Wrap platform w
+hsLitKey _ (HsInt64Prim _ i) = mkLitInt64Wrap i
+hsLitKey _ (HsWord64Prim _ w) = mkLitWord64Wrap w
hsLitKey _ (HsCharPrim _ c) = mkLitChar c
hsLitKey _ (HsFloatPrim _ f) = mkLitFloat (fl_value f)
hsLitKey _ (HsDoublePrim _ d) = mkLitDouble (fl_value d)
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -1147,12 +1147,12 @@ emitPrimOp dflags primop = case primop of
AddrEqOp -> \args -> opTranslate args (mo_wordEq platform)
AddrNeOp -> \args -> opTranslate args (mo_wordNe platform)
- AndOp -> \args -> opTranslate args (mo_wordAnd platform)
- OrOp -> \args -> opTranslate args (mo_wordOr platform)
- XorOp -> \args -> opTranslate args (mo_wordXor platform)
- NotOp -> \args -> opTranslate args (mo_wordNot platform)
- SllOp -> \args -> opTranslate args (mo_wordShl platform)
- SrlOp -> \args -> opTranslate args (mo_wordUShr platform)
+ WordAndOp -> \args -> opTranslate args (mo_wordAnd platform)
+ WordOrOp -> \args -> opTranslate args (mo_wordOr platform)
+ WordXorOp -> \args -> opTranslate args (mo_wordXor platform)
+ WordNotOp -> \args -> opTranslate args (mo_wordNot platform)
+ WordSllOp -> \args -> opTranslate args (mo_wordShl platform)
+ WordSrlOp -> \args -> opTranslate args (mo_wordUShr platform)
AddrRemOp -> \args -> opTranslate args (mo_wordURem platform)
@@ -1169,13 +1169,13 @@ emitPrimOp dflags primop = case primop of
IntGtOp -> \args -> opTranslate args (mo_wordSGt platform)
IntLtOp -> \args -> opTranslate args (mo_wordSLt platform)
- AndIOp -> \args -> opTranslate args (mo_wordAnd platform)
- OrIOp -> \args -> opTranslate args (mo_wordOr platform)
- XorIOp -> \args -> opTranslate args (mo_wordXor platform)
- NotIOp -> \args -> opTranslate args (mo_wordNot platform)
- ISllOp -> \args -> opTranslate args (mo_wordShl platform)
- ISraOp -> \args -> opTranslate args (mo_wordSShr platform)
- ISrlOp -> \args -> opTranslate args (mo_wordUShr platform)
+ IntAndOp -> \args -> opTranslate args (mo_wordAnd platform)
+ IntOrOp -> \args -> opTranslate args (mo_wordOr platform)
+ IntXorOp -> \args -> opTranslate args (mo_wordXor platform)
+ IntNotOp -> \args -> opTranslate args (mo_wordNot platform)
+ IntSllOp -> \args -> opTranslate args (mo_wordShl platform)
+ IntSraOp -> \args -> opTranslate args (mo_wordSShr platform)
+ IntSrlOp -> \args -> opTranslate args (mo_wordUShr platform)
-- Native word unsigned ops
@@ -1195,8 +1195,8 @@ emitPrimOp dflags primop = case primop of
-- Int8# signed ops
- Int8Extend -> \args -> opTranslate args (MO_SS_Conv W8 (wordWidth platform))
- Int8Narrow -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W8)
+ Int8ToInt -> \args -> opTranslate args (MO_SS_Conv W8 (wordWidth platform))
+ IntToInt8 -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W8)
Int8NegOp -> \args -> opTranslate args (MO_S_Neg W8)
Int8AddOp -> \args -> opTranslate args (MO_Add W8)
Int8SubOp -> \args -> opTranslate args (MO_Sub W8)
@@ -1213,8 +1213,8 @@ emitPrimOp dflags primop = case primop of
-- Word8# unsigned ops
- Word8Extend -> \args -> opTranslate args (MO_UU_Conv W8 (wordWidth platform))
- Word8Narrow -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W8)
+ Word8ToWord -> \args -> opTranslate args (MO_UU_Conv W8 (wordWidth platform))
+ WordToWord8 -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W8)
Word8NotOp -> \args -> opTranslate args (MO_Not W8)
Word8AddOp -> \args -> opTranslate args (MO_Add W8)
Word8SubOp -> \args -> opTranslate args (MO_Sub W8)
@@ -1231,8 +1231,8 @@ emitPrimOp dflags primop = case primop of
-- Int16# signed ops
- Int16Extend -> \args -> opTranslate args (MO_SS_Conv W16 (wordWidth platform))
- Int16Narrow -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W16)
+ Int16ToInt -> \args -> opTranslate args (MO_SS_Conv W16 (wordWidth platform))
+ IntToInt16 -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W16)
Int16NegOp -> \args -> opTranslate args (MO_S_Neg W16)
Int16AddOp -> \args -> opTranslate args (MO_Add W16)
Int16SubOp -> \args -> opTranslate args (MO_Sub W16)
@@ -1249,8 +1249,8 @@ emitPrimOp dflags primop = case primop of
-- Word16# unsigned ops
- Word16Extend -> \args -> opTranslate args (MO_UU_Conv W16 (wordWidth platform))
- Word16Narrow -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W16)
+ Word16ToWord -> \args -> opTranslate args (MO_UU_Conv W16 (wordWidth platform))
+ WordToWord16 -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W16)
Word16NotOp -> \args -> opTranslate args (MO_Not W16)
Word16AddOp -> \args -> opTranslate args (MO_Add W16)
Word16SubOp -> \args -> opTranslate args (MO_Sub W16)
=====================================
compiler/GHC/Tc/Deriv/Generate.hs
=====================================
@@ -1517,8 +1517,9 @@ gfoldl_RDR, gunfold_RDR, toConstr_RDR, dataTypeOf_RDR, mkConstr_RDR,
eqAddr_RDR , ltAddr_RDR , geAddr_RDR , gtAddr_RDR , leAddr_RDR ,
eqFloat_RDR , ltFloat_RDR , geFloat_RDR , gtFloat_RDR , leFloat_RDR ,
eqDouble_RDR, ltDouble_RDR, geDouble_RDR, gtDouble_RDR, leDouble_RDR,
- extendWord8_RDR, extendInt8_RDR,
- extendWord16_RDR, extendInt16_RDR :: RdrName
+ word8ToWord_RDR , int8ToInt_RDR ,
+ word16ToWord_RDR, int16ToInt_RDR
+ :: RdrName
gfoldl_RDR = varQual_RDR gENERICS (fsLit "gfoldl")
gunfold_RDR = varQual_RDR gENERICS (fsLit "gunfold")
toConstr_RDR = varQual_RDR gENERICS (fsLit "toConstr")
@@ -1595,11 +1596,11 @@ leDouble_RDR = varQual_RDR gHC_PRIM (fsLit "<=##")
gtDouble_RDR = varQual_RDR gHC_PRIM (fsLit ">##" )
geDouble_RDR = varQual_RDR gHC_PRIM (fsLit ">=##")
-extendWord8_RDR = varQual_RDR gHC_PRIM (fsLit "extendWord8#")
-extendInt8_RDR = varQual_RDR gHC_PRIM (fsLit "extendInt8#")
+word8ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word8ToWord#")
+int8ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int8ToInt#")
-extendWord16_RDR = varQual_RDR gHC_PRIM (fsLit "extendWord16#")
-extendInt16_RDR = varQual_RDR gHC_PRIM (fsLit "extendInt16#")
+word16ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word16ToWord#")
+int16ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int16ToInt#")
{-
@@ -2282,16 +2283,16 @@ boxConTbl =
, (doublePrimTy, nlHsApp (nlHsVar $ getRdrName doubleDataCon))
, (int8PrimTy,
nlHsApp (nlHsVar $ getRdrName intDataCon)
- . nlHsApp (nlHsVar extendInt8_RDR))
+ . nlHsApp (nlHsVar int8ToInt_RDR))
, (word8PrimTy,
nlHsApp (nlHsVar $ getRdrName wordDataCon)
- . nlHsApp (nlHsVar extendWord8_RDR))
+ . nlHsApp (nlHsVar word8ToWord_RDR))
, (int16PrimTy,
nlHsApp (nlHsVar $ getRdrName intDataCon)
- . nlHsApp (nlHsVar extendInt16_RDR))
+ . nlHsApp (nlHsVar int16ToInt_RDR))
, (word16PrimTy,
nlHsApp (nlHsVar $ getRdrName wordDataCon)
- . nlHsApp (nlHsVar extendWord16_RDR))
+ . nlHsApp (nlHsVar word16ToWord_RDR))
]
@@ -2311,10 +2312,10 @@ postfixModTbl
primConvTbl :: [(Type, String)]
primConvTbl =
- [ (int8PrimTy, "narrowInt8#")
- , (word8PrimTy, "narrowWord8#")
- , (int16PrimTy, "narrowInt16#")
- , (word16PrimTy, "narrowWord16#")
+ [ (int8PrimTy, "intToInt8#")
+ , (word8PrimTy, "wordToWord8#")
+ , (int16PrimTy, "intToInt16#")
+ , (word16PrimTy, "wordToWord16#")
]
litConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)]
=====================================
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,10 +47,6 @@ module GHC.Types.Literal
, litValue, mapLitValue
-- ** Coercions
- , wordToIntLit, intToWordLit
- , narrowLit
- , narrow8IntLit, narrow16IntLit, narrow32IntLit
- , narrow8WordLit, narrow16WordLit, narrow32WordLit
, charToIntLit, intToCharLit
, floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit
, nullAddrLit, rubbishLit, floatToDoubleLit, doubleToFloatLit
@@ -72,7 +76,6 @@ import Data.Int
import Data.Word
import Data.Char
import Data.Data ( Data )
-import Data.Proxy
import Numeric ( fromRat )
{-
@@ -152,8 +155,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 +172,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
{-
@@ -281,32 +296,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 -> LitNumber nt (toInteger (fromIntegral i :: Int32))
- PW8 -> LitNumber nt (toInteger (fromIntegral i :: Int64))
+ PW4 -> wrap @Int32
+ PW8 -> wrap @Int64
LitNumWord -> case platformWordSize platform of
- PW4 -> LitNumber nt (toInteger (fromIntegral i :: Word32))
- PW8 -> LitNumber nt (toInteger (fromIntegral i :: Word64))
- LitNumInt64 -> LitNumber nt (toInteger (fromIntegral i :: Int64))
- LitNumWord64 -> LitNumber nt (toInteger (fromIntegral i :: Word64))
- LitNumInteger -> v
- LitNumNatural -> v
-wrapLitNumber _ x = x
+ 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
+ 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
@@ -325,7 +373,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
@@ -349,7 +397,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
@@ -366,12 +414,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 :: Platform -> Integer -> Literal
-mkLitInt64Wrap platform i = wrapLitNumber platform $ mkLitInt64Unchecked i
+mkLitInt64Wrap :: Integer -> Literal
+mkLitInt64Wrap i = LitNumber LitNumInt64 (toInteger (fromIntegral i :: Int64))
-- | Creates a 'Literal' of type @Int64#@ without checking its range.
mkLitInt64Unchecked :: Integer -> Literal
@@ -379,12 +427,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 :: Platform -> Integer -> Literal
-mkLitWord64Wrap platform i = wrapLitNumber platform $ mkLitWord64Unchecked i
+mkLitWord64Wrap :: Integer -> Literal
+mkLitWord64Wrap i = LitNumber LitNumWord64 (toInteger (fromIntegral i :: Word64))
-- | Creates a 'Literal' of type @Word64#@ without checking its range.
mkLitWord64Unchecked :: Integer -> Literal
@@ -418,11 +466,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
@@ -456,7 +536,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)
{-
@@ -464,42 +544,12 @@ mapLitValue _ _ l = pprPanic "mapLitValue" (ppr l)
~~~~~~~~~
-}
-narrow8IntLit, narrow16IntLit, narrow32IntLit,
- narrow8WordLit, narrow16WordLit, narrow32WordLit,
- charToIntLit, intToCharLit,
- floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit,
+charToIntLit, intToCharLit,
+ floatToIntLit, intToFloatLit,
+ doubleToIntLit, intToDoubleLit,
floatToDoubleLit, doubleToFloatLit
:: Literal -> Literal
-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))
@@ -572,8 +622,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 +641,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 +663,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 +691,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 +774,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)
@@ -743,9 +823,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,18 @@ module GHC.Utils.Outputable (
pprInfixVar, pprPrefixVar,
pprHsChar, pprHsString, pprHsBytes,
- primFloatSuffix, primCharSuffix, primWordSuffix, primDoubleSuffix,
- primInt64Suffix, primWord64Suffix, primIntSuffix,
-
- pprPrimChar, pprPrimInt, pprPrimWord, pprPrimInt64, pprPrimWord64,
+ 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,
@@ -1148,22 +1156,44 @@ pprHsBytes bs = let escaped = concatMap escape $ BS.unpack bs
-- Postfix modifiers for unboxed literals.
-- See Note [Printing of literals in Core] in "GHC.Types.Literal".
-primCharSuffix, primFloatSuffix, primIntSuffix :: SDoc
-primDoubleSuffix, primWordSuffix, primInt64Suffix, primWord64Suffix :: SDoc
+primCharSuffix, primFloatSuffix, primDoubleSuffix,
+ primIntSuffix, primWordSuffix,
+ 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
+pprPrimInt, pprPrimWord,
+ 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
=====================================
@@ -2163,7 +2163,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/cmm/opt/T18141.hs
=====================================
@@ -12,6 +12,6 @@ x# `divInt8#` y#
((x# `plusInt8#` one#) `quotInt8#` y#) `subInt8#` one#
| otherwise = x# `quotInt8#` y#
where
- zero# = narrowInt8# 0#
- one# = narrowInt8# 1#
+ zero# = intToInt8# 0#
+ one# = intToInt8# 1#
=====================================
testsuite/tests/codeGen/should_compile/T18614.hs
=====================================
@@ -8,4 +8,4 @@ import GHC.Exts
main = pure ()
test :: Word8# -> Word8#
-test x = x `plusWord8#` narrowWord8# 1##
+test x = x `plusWord8#` wordToWord8# 1##
=====================================
testsuite/tests/ffi/should_run/PrimFFIInt16.hs
=====================================
@@ -14,15 +14,15 @@ foreign import ccall "add_all_int16"
main :: IO ()
main = do
- let a = narrowInt16# 0#
- b = narrowInt16# 1#
- c = narrowInt16# 2#
- d = narrowInt16# 3#
- e = narrowInt16# 4#
- f = narrowInt16# 5#
- g = narrowInt16# 6#
- h = narrowInt16# 7#
- i = narrowInt16# 8#
- j = narrowInt16# 9#
- x = I# (extendInt16# (add_all_int16 a b c d e f g h i j))
+ let a = intToInt16# 0#
+ b = intToInt16# 1#
+ c = intToInt16# 2#
+ d = intToInt16# 3#
+ e = intToInt16# 4#
+ f = intToInt16# 5#
+ g = intToInt16# 6#
+ h = intToInt16# 7#
+ i = intToInt16# 8#
+ j = intToInt16# 9#
+ x = I# (int16ToInt# (add_all_int16 a b c d e f g h i j))
print x
=====================================
testsuite/tests/ffi/should_run/PrimFFIInt8.hs
=====================================
@@ -14,15 +14,15 @@ foreign import ccall "add_all_int8"
main :: IO ()
main = do
- let a = narrowInt8# 0#
- b = narrowInt8# 1#
- c = narrowInt8# 2#
- d = narrowInt8# 3#
- e = narrowInt8# 4#
- f = narrowInt8# 5#
- g = narrowInt8# 6#
- h = narrowInt8# 7#
- i = narrowInt8# 8#
- j = narrowInt8# 9#
- x = I# (extendInt8# (add_all_int8 a b c d e f g h i j))
+ let a = intToInt8# 0#
+ b = intToInt8# 1#
+ c = intToInt8# 2#
+ d = intToInt8# 3#
+ e = intToInt8# 4#
+ f = intToInt8# 5#
+ g = intToInt8# 6#
+ h = intToInt8# 7#
+ i = intToInt8# 8#
+ j = intToInt8# 9#
+ x = I# (int8ToInt# (add_all_int8 a b c d e f g h i j))
print x
=====================================
testsuite/tests/ffi/should_run/PrimFFIWord16.hs
=====================================
@@ -14,15 +14,15 @@ foreign import ccall "add_all_word16"
main :: IO ()
main = do
- let a = narrowWord16# 0##
- b = narrowWord16# 1##
- c = narrowWord16# 2##
- d = narrowWord16# 3##
- e = narrowWord16# 4##
- f = narrowWord16# 5##
- g = narrowWord16# 6##
- h = narrowWord16# 7##
- i = narrowWord16# 8##
- j = narrowWord16# 9##
- x = W# (extendWord16# (add_all_word16 a b c d e f g h i j))
+ let a = wordToWord16# 0##
+ b = wordToWord16# 1##
+ c = wordToWord16# 2##
+ d = wordToWord16# 3##
+ e = wordToWord16# 4##
+ f = wordToWord16# 5##
+ g = wordToWord16# 6##
+ h = wordToWord16# 7##
+ i = wordToWord16# 8##
+ j = wordToWord16# 9##
+ x = W# (word16ToWord# (add_all_word16 a b c d e f g h i j))
print x
=====================================
testsuite/tests/ffi/should_run/PrimFFIWord8.hs
=====================================
@@ -14,15 +14,15 @@ foreign import ccall "add_all_word8"
main :: IO ()
main = do
- let a = narrowWord8# 0##
- b = narrowWord8# 1##
- c = narrowWord8# 2##
- d = narrowWord8# 3##
- e = narrowWord8# 4##
- f = narrowWord8# 5##
- g = narrowWord8# 6##
- h = narrowWord8# 7##
- i = narrowWord8# 8##
- j = narrowWord8# 9##
- x = W# (extendWord8# (add_all_word8 a b c d e f g h i j))
+ let a = wordToWord8# 0##
+ b = wordToWord8# 1##
+ c = wordToWord8# 2##
+ d = wordToWord8# 3##
+ e = wordToWord8# 4##
+ f = wordToWord8# 5##
+ g = wordToWord8# 6##
+ h = wordToWord8# 7##
+ i = wordToWord8# 8##
+ j = wordToWord8# 9##
+ x = W# (word8ToWord# (add_all_word8 a b c d e f g h i j))
print x
=====================================
testsuite/tests/primops/should_run/ArithInt16.hs
=====================================
@@ -146,32 +146,32 @@ addMany (I# a) (I# b) (I# c) (I# d)
(I# e) (I# f) (I# g) (I# h)
(I# i) (I# j) (I# k) (I# l)
(I# m) (I# n) (I# o) (I# p)
- = I# (extendInt16# int16)
+ = I# (int16ToInt# int16)
where
!int16 = addMany#
- (narrowInt16# a) (narrowInt16# b) (narrowInt16# c) (narrowInt16# d)
- (narrowInt16# e) (narrowInt16# f) (narrowInt16# g) (narrowInt16# h)
- (narrowInt16# i) (narrowInt16# j) (narrowInt16# k) (narrowInt16# l)
- (narrowInt16# m) (narrowInt16# n) (narrowInt16# o) (narrowInt16# p)
+ (intToInt16# a) (intToInt16# b) (intToInt16# c) (intToInt16# d)
+ (intToInt16# e) (intToInt16# f) (intToInt16# g) (intToInt16# h)
+ (intToInt16# i) (intToInt16# j) (intToInt16# k) (intToInt16# l)
+ (intToInt16# m) (intToInt16# n) (intToInt16# o) (intToInt16# p)
{-# NOINLINE addMany #-}
-- Convenient and also tests higher order functions on Int16#
apply1 :: (Int16# -> Int16#) -> Int -> Int
-apply1 opToTest (I# a) = I# (extendInt16# (opToTest (narrowInt16# a)))
+apply1 opToTest (I# a) = I# (int16ToInt# (opToTest (intToInt16# a)))
{-# NOINLINE apply1 #-}
apply2 :: (Int16# -> Int16# -> Int16#) -> Int -> Int -> Int
apply2 opToTest (I# a) (I# b) =
- let (# sa, sb #) = (# narrowInt16# a, narrowInt16# b #)
+ let (# sa, sb #) = (# intToInt16# a, intToInt16# b #)
r = opToTest sa sb
- in I# (extendInt16# r)
+ in I# (int16ToInt# r)
{-# NOINLINE apply2 #-}
apply3 :: (Int16# -> Int16# -> (# Int16#, Int16# #)) -> Int -> Int -> (Int, Int)
apply3 opToTest (I# a) (I# b) =
- let (# sa, sb #) = (# narrowInt16# a, narrowInt16# b #)
+ let (# sa, sb #) = (# intToInt16# a, intToInt16# b #)
(# ra, rb #) = opToTest sa sb
- in (I# (extendInt16# ra), I# (extendInt16# rb))
+ in (I# (int16ToInt# ra), I# (int16ToInt# rb))
{-# NOINLINE apply3 #-}
instance
=====================================
testsuite/tests/primops/should_run/ArithInt8.hs
=====================================
@@ -150,32 +150,32 @@ addMany (I# a) (I# b) (I# c) (I# d)
(I# e) (I# f) (I# g) (I# h)
(I# i) (I# j) (I# k) (I# l)
(I# m) (I# n) (I# o) (I# p)
- = I# (extendInt8# int8)
+ = I# (int8ToInt# int8)
where
!int8 = addMany#
- (narrowInt8# a) (narrowInt8# b) (narrowInt8# c) (narrowInt8# d)
- (narrowInt8# e) (narrowInt8# f) (narrowInt8# g) (narrowInt8# h)
- (narrowInt8# i) (narrowInt8# j) (narrowInt8# k) (narrowInt8# l)
- (narrowInt8# m) (narrowInt8# n) (narrowInt8# o) (narrowInt8# p)
+ (intToInt8# a) (intToInt8# b) (intToInt8# c) (intToInt8# d)
+ (intToInt8# e) (intToInt8# f) (intToInt8# g) (intToInt8# h)
+ (intToInt8# i) (intToInt8# j) (intToInt8# k) (intToInt8# l)
+ (intToInt8# m) (intToInt8# n) (intToInt8# o) (intToInt8# p)
{-# NOINLINE addMany #-}
-- Convenient and also tests higher order functions on Int8#
apply1 :: (Int8# -> Int8#) -> Int -> Int
-apply1 opToTest (I# a) = I# (extendInt8# (opToTest (narrowInt8# a)))
+apply1 opToTest (I# a) = I# (int8ToInt# (opToTest (intToInt8# a)))
{-# NOINLINE apply1 #-}
apply2 :: (Int8# -> Int8# -> Int8#) -> Int -> Int -> Int
apply2 opToTest (I# a) (I# b) =
- let (# sa, sb #) = (# narrowInt8# a, narrowInt8# b #)
+ let (# sa, sb #) = (# intToInt8# a, intToInt8# b #)
r = opToTest sa sb
- in I# (extendInt8# r)
+ in I# (int8ToInt# r)
{-# NOINLINE apply2 #-}
apply3 :: (Int8# -> Int8# -> (# Int8#, Int8# #)) -> Int -> Int -> (Int, Int)
apply3 opToTest (I# a) (I# b) =
- let (# sa, sb #) = (# narrowInt8# a, narrowInt8# b #)
+ let (# sa, sb #) = (# intToInt8# a, intToInt8# b #)
(# ra, rb #) = opToTest sa sb
- in (I# (extendInt8# ra), I# (extendInt8# rb))
+ in (I# (int8ToInt# ra), I# (int8ToInt# rb))
{-# NOINLINE apply3 #-}
instance
=====================================
testsuite/tests/primops/should_run/ArithWord16.hs
=====================================
@@ -141,34 +141,34 @@ addMany (W# a) (W# b) (W# c) (W# d)
(W# e) (W# f) (W# g) (W# h)
(W# i) (W# j) (W# k) (W# l)
(W# m) (W# n) (W# o) (W# p)
- = W# (extendWord16# word16)
+ = W# (word16ToWord# word16)
where
!word16 =
addMany#
- (narrowWord16# a) (narrowWord16# b) (narrowWord16# c) (narrowWord16# d)
- (narrowWord16# e) (narrowWord16# f) (narrowWord16# g) (narrowWord16# h)
- (narrowWord16# i) (narrowWord16# j) (narrowWord16# k) (narrowWord16# l)
- (narrowWord16# m) (narrowWord16# n) (narrowWord16# o) (narrowWord16# p)
+ (wordToWord16# a) (wordToWord16# b) (wordToWord16# c) (wordToWord16# d)
+ (wordToWord16# e) (wordToWord16# f) (wordToWord16# g) (wordToWord16# h)
+ (wordToWord16# i) (wordToWord16# j) (wordToWord16# k) (wordToWord16# l)
+ (wordToWord16# m) (wordToWord16# n) (wordToWord16# o) (wordToWord16# p)
{-# NOINLINE addMany #-}
-- Convenient and also tests higher order functions on Word16#
apply1 :: (Word16# -> Word16#) -> Word -> Word
-apply1 opToTest (W# a) = W# (extendWord16# (opToTest (narrowWord16# a)))
+apply1 opToTest (W# a) = W# (word16ToWord# (opToTest (wordToWord16# a)))
{-# NOINLINE apply1 #-}
apply2 :: (Word16# -> Word16# -> Word16#) -> Word -> Word -> Word
apply2 opToTest (W# a) (W# b) =
- let (# sa, sb #) = (# narrowWord16# a, narrowWord16# b #)
+ let (# sa, sb #) = (# wordToWord16# a, wordToWord16# b #)
r = opToTest sa sb
- in W# (extendWord16# r)
+ in W# (word16ToWord# r)
{-# NOINLINE apply2 #-}
apply3
:: (Word16# -> Word16# -> (# Word16#, Word16# #)) -> Word -> Word -> (Word, Word)
apply3 opToTest (W# a) (W# b) =
- let (# sa, sb #) = (# narrowWord16# a, narrowWord16# b #)
+ let (# sa, sb #) = (# wordToWord16# a, wordToWord16# b #)
(# ra, rb #) = opToTest sa sb
- in (W# (extendWord16# ra), W# (extendWord16# rb))
+ in (W# (word16ToWord# ra), W# (word16ToWord# rb))
{-# NOINLINE apply3 #-}
instance
=====================================
testsuite/tests/primops/should_run/ArithWord8.hs
=====================================
@@ -145,34 +145,34 @@ addMany (W# a) (W# b) (W# c) (W# d)
(W# e) (W# f) (W# g) (W# h)
(W# i) (W# j) (W# k) (W# l)
(W# m) (W# n) (W# o) (W# p)
- = W# (extendWord8# word8)
+ = W# (word8ToWord# word8)
where
!word8 =
addMany#
- (narrowWord8# a) (narrowWord8# b) (narrowWord8# c) (narrowWord8# d)
- (narrowWord8# e) (narrowWord8# f) (narrowWord8# g) (narrowWord8# h)
- (narrowWord8# i) (narrowWord8# j) (narrowWord8# k) (narrowWord8# l)
- (narrowWord8# m) (narrowWord8# n) (narrowWord8# o) (narrowWord8# p)
+ (wordToWord8# a) (wordToWord8# b) (wordToWord8# c) (wordToWord8# d)
+ (wordToWord8# e) (wordToWord8# f) (wordToWord8# g) (wordToWord8# h)
+ (wordToWord8# i) (wordToWord8# j) (wordToWord8# k) (wordToWord8# l)
+ (wordToWord8# m) (wordToWord8# n) (wordToWord8# o) (wordToWord8# p)
{-# NOINLINE addMany #-}
-- Convenient and also tests higher order functions on Word8#
apply1 :: (Word8# -> Word8#) -> Word -> Word
-apply1 opToTest (W# a) = W# (extendWord8# (opToTest (narrowWord8# a)))
+apply1 opToTest (W# a) = W# (word8ToWord# (opToTest (wordToWord8# a)))
{-# NOINLINE apply1 #-}
apply2 :: (Word8# -> Word8# -> Word8#) -> Word -> Word -> Word
apply2 opToTest (W# a) (W# b) =
- let (# sa, sb #) = (# narrowWord8# a, narrowWord8# b #)
+ let (# sa, sb #) = (# wordToWord8# a, wordToWord8# b #)
r = opToTest sa sb
- in W# (extendWord8# r)
+ in W# (word8ToWord# r)
{-# NOINLINE apply2 #-}
apply3
:: (Word8# -> Word8# -> (# Word8#, Word8# #)) -> Word -> Word -> (Word, Word)
apply3 opToTest (W# a) (W# b) =
- let (# sa, sb #) = (# narrowWord8# a, narrowWord8# b #)
+ let (# sa, sb #) = (# wordToWord8# a, wordToWord8# b #)
(# ra, rb #) = opToTest sa sb
- in (W# (extendWord8# ra), W# (extendWord8# rb))
+ in (W# (word8ToWord# ra), W# (word8ToWord# rb))
{-# NOINLINE apply3 #-}
instance
=====================================
testsuite/tests/primops/should_run/CmpInt16.hs
=====================================
@@ -16,7 +16,7 @@ data TestInt16 = T16 Int16#
deriving (Eq, Ord)
mkT16 :: Int -> TestInt16
-mkT16 (I# a) = T16 (narrowInt16# a)
+mkT16 (I# a) = T16 (intToInt16# a)
main :: IO ()
main = do
=====================================
testsuite/tests/primops/should_run/CmpInt8.hs
=====================================
@@ -16,7 +16,7 @@ data TestInt8 = T8 Int8#
deriving (Eq, Ord)
mkT8 :: Int -> TestInt8
-mkT8 (I# a) = T8 (narrowInt8# a)
+mkT8 (I# a) = T8 (intToInt8# a)
main :: IO ()
main = do
=====================================
testsuite/tests/primops/should_run/CmpWord16.hs
=====================================
@@ -16,7 +16,7 @@ data TestWord16 = T16 Word16#
deriving (Eq, Ord)
mkT16 :: Word -> TestWord16
-mkT16 (W# a) = T16 (narrowWord16# a)
+mkT16 (W# a) = T16 (wordToWord16# a)
main :: IO ()
main = do
=====================================
testsuite/tests/primops/should_run/CmpWord8.hs
=====================================
@@ -16,7 +16,7 @@ data TestWord8 = T8 Word8#
deriving (Eq, Ord)
mkT8 :: Word -> TestWord8
-mkT8 (W# a) = T8 (narrowWord8# a)
+mkT8 (W# a) = T8 (wordToWord8# a)
main :: IO ()
main = do
=====================================
testsuite/tests/primops/should_run/ShowPrim.hs
=====================================
@@ -11,10 +11,10 @@ data Test2 = Test2 Int16# Word16#
deriving (Show)
test1 :: Test1
-test1 = Test1 (narrowInt8# 1#) (narrowWord8# 2##)
+test1 = Test1 (intToInt8# 1#) (wordToWord8# 2##)
test2 :: Test2
-test2 = Test2 (narrowInt16# 1#) (narrowWord16# 2##)
+test2 = Test2 (intToInt16# 1#) (wordToWord16# 2##)
main :: IO ()
main = do
=====================================
testsuite/tests/primops/should_run/ShowPrim.stdout
=====================================
@@ -1,2 +1,2 @@
-Test1 (narrowInt8# 1#) (narrowWord8# 2##)
-Test2 (narrowInt16# 1#) (narrowWord16# 2##)
+Test1 (intToInt8# 1#) (wordToWord8# 2##)
+Test2 (intToInt16# 1#) (wordToWord16# 2##)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f004001ecd2b87d63a15ace3dd7035cc05ef6787...cfb672c49dc9081982f9284abf6302fd202f4eea
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f004001ecd2b87d63a15ace3dd7035cc05ef6787...cfb672c49dc9081982f9284abf6302fd202f4eea
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/20201123/8fc18c0d/attachment-0001.html>
More information about the ghc-commits
mailing list