[Git][ghc/ghc][wip/primop-naming-consistency] Cleanup some primop-related identifers
John Ericson
gitlab at gitlab.haskell.org
Mon Nov 23 04:58:01 UTC 2020
John Ericson pushed to branch wip/primop-naming-consistency 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.)
- - - - -
20 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- 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/Core/Opt/ConstantFold.hs
=====================================
@@ -135,24 +135,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,19 +183,19 @@ 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
@@ -206,34 +206,34 @@ primOpRules nm = \case
, subsumedByPrimOp Narrow8IntOp
, Narrow8IntOp `subsumesPrimOp` Narrow16IntOp
, Narrow8IntOp `subsumesPrimOp` Narrow32IntOp
- , narrowSubsumesAnd AndIOp Narrow8IntOp 8 ]
+ , narrowSubsumesAnd IntAndOp Narrow8IntOp 8 ]
Narrow16IntOp -> mkPrimOpRule nm 1 [ liftLit narrow16IntLit
, subsumedByPrimOp Narrow8IntOp
, subsumedByPrimOp Narrow16IntOp
, Narrow16IntOp `subsumesPrimOp` Narrow32IntOp
- , narrowSubsumesAnd AndIOp Narrow16IntOp 16 ]
+ , narrowSubsumesAnd IntAndOp Narrow16IntOp 16 ]
Narrow32IntOp -> mkPrimOpRule nm 1 [ liftLit narrow32IntLit
, subsumedByPrimOp Narrow8IntOp
, subsumedByPrimOp Narrow16IntOp
, subsumedByPrimOp Narrow32IntOp
, removeOp32
- , narrowSubsumesAnd AndIOp Narrow32IntOp 32 ]
+ , narrowSubsumesAnd IntAndOp Narrow32IntOp 32 ]
Narrow8WordOp -> mkPrimOpRule nm 1 [ liftLit narrow8WordLit
, subsumedByPrimOp Narrow8WordOp
, Narrow8WordOp `subsumesPrimOp` Narrow16WordOp
, Narrow8WordOp `subsumesPrimOp` Narrow32WordOp
- , narrowSubsumesAnd AndOp Narrow8WordOp 8 ]
+ , narrowSubsumesAnd WordAndOp Narrow8WordOp 8 ]
Narrow16WordOp -> mkPrimOpRule nm 1 [ liftLit narrow16WordLit
, subsumedByPrimOp Narrow8WordOp
, subsumedByPrimOp Narrow16WordOp
, Narrow16WordOp `subsumesPrimOp` Narrow32WordOp
- , narrowSubsumesAnd AndOp Narrow16WordOp 16 ]
+ , narrowSubsumesAnd WordAndOp Narrow16WordOp 16 ]
Narrow32WordOp -> mkPrimOpRule nm 1 [ liftLit narrow32WordLit
, 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
@@ -792,7 +792,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 +1322,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 +1332,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 +2306,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 +2318,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 +2327,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/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)]
=====================================
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/-/commit/58a37f8bf3afaee2407ef772af711e27f6da54b0
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/58a37f8bf3afaee2407ef772af711e27f6da54b0
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/20201122/0d8dec1e/attachment-0001.html>
More information about the ghc-commits
mailing list