diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/cmm/CmmUtils.hs | 4 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmArgRep.hs | 2 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 45 | ||||
| -rw-r--r-- | compiler/prelude/PrelNames.hs | 115 | ||||
| -rw-r--r-- | compiler/prelude/TysPrim.hs | 22 | ||||
| -rw-r--r-- | compiler/prelude/TysWiredIn.hs | 15 | ||||
| -rw-r--r-- | compiler/prelude/TysWiredIn.hs-boot | 1 | ||||
| -rw-r--r-- | compiler/prelude/primops.txt.pp | 82 | ||||
| -rw-r--r-- | compiler/simplStg/RepType.hs | 2 | ||||
| -rw-r--r-- | compiler/typecheck/TcGenDeriv.hs | 42 | ||||
| -rw-r--r-- | compiler/types/TyCon.hs | 4 | ||||
| -rw-r--r-- | compiler/utils/Binary.hs | 4 |
12 files changed, 269 insertions, 69 deletions
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs index 11e4df5bf4..a5d1a8e375 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -99,6 +99,8 @@ primRepCmmType dflags IntRep = bWord dflags primRepCmmType dflags WordRep = bWord dflags primRepCmmType _ Int8Rep = b8 primRepCmmType _ Word8Rep = b8 +primRepCmmType _ Int16Rep = b16 +primRepCmmType _ Word16Rep = b16 primRepCmmType _ Int64Rep = b64 primRepCmmType _ Word64Rep = b64 primRepCmmType dflags AddrRep = bWord dflags @@ -134,9 +136,11 @@ primRepForeignHint LiftedRep = AddrHint primRepForeignHint UnliftedRep = AddrHint primRepForeignHint IntRep = SignedHint primRepForeignHint Int8Rep = SignedHint +primRepForeignHint Int16Rep = SignedHint primRepForeignHint Int64Rep = SignedHint primRepForeignHint WordRep = NoHint primRepForeignHint Word8Rep = NoHint +primRepForeignHint Word16Rep = NoHint primRepForeignHint Word64Rep = NoHint primRepForeignHint AddrRep = AddrHint -- NB! AddrHint, but NonPtrArg primRepForeignHint FloatRep = NoHint diff --git a/compiler/codeGen/StgCmmArgRep.hs b/compiler/codeGen/StgCmmArgRep.hs index 95f96dc16f..7d1962fd09 100644 --- a/compiler/codeGen/StgCmmArgRep.hs +++ b/compiler/codeGen/StgCmmArgRep.hs @@ -72,6 +72,8 @@ toArgRep IntRep = N toArgRep WordRep = N toArgRep Int8Rep = N -- Gets widened to native word width for calls toArgRep Word8Rep = N -- Gets widened to native word width for calls +toArgRep Int16Rep = N -- Gets widened to native word width for calls +toArgRep Word16Rep = N -- Gets widened to native word width for calls toArgRep AddrRep = N toArgRep Int64Rep = L toArgRep Word64Rep = L diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 75d46b5b3a..eb4d681923 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -884,6 +884,11 @@ callishPrimOpSupported dflags op -> Left (MO_S_QuotRem W8) | otherwise -> Right (genericIntQuotRemOp W8) + Int16QuotRemOp | (ncg && x86ish) + || llvm -> Left (MO_S_QuotRem W16) + | otherwise -> Right (genericIntQuotRemOp W16) + + WordQuotRemOp | ncg && (x86ish || ppc) -> Left (MO_U_QuotRem (wordWidth dflags)) | otherwise -> @@ -898,6 +903,10 @@ callishPrimOpSupported dflags op -> Left (MO_U_QuotRem W8) | otherwise -> Right (genericWordQuotRemOp W8) + Word16QuotRemOp| (ncg && x86ish) + || llvm -> Left (MO_U_QuotRem W16) + | otherwise -> Right (genericWordQuotRemOp W16) + WordAdd2Op | (ncg && (x86ish || ppc)) || llvm -> Left (MO_Add2 (wordWidth dflags)) @@ -1356,6 +1365,42 @@ translateOp _ Word8LeOp = Just (MO_U_Le W8) translateOp _ Word8LtOp = Just (MO_U_Lt W8) translateOp _ Word8NeOp = Just (MO_Ne W8) +-- Int16# signed ops + +translateOp dflags Int16Extend = Just (MO_SS_Conv W16 (wordWidth dflags)) +translateOp dflags Int16Narrow = Just (MO_SS_Conv (wordWidth dflags) W16) +translateOp _ Int16NegOp = Just (MO_S_Neg W16) +translateOp _ Int16AddOp = Just (MO_Add W16) +translateOp _ Int16SubOp = Just (MO_Sub W16) +translateOp _ Int16MulOp = Just (MO_Mul W16) +translateOp _ Int16QuotOp = Just (MO_S_Quot W16) +translateOp _ Int16RemOp = Just (MO_S_Rem W16) + +translateOp _ Int16EqOp = Just (MO_Eq W16) +translateOp _ Int16GeOp = Just (MO_S_Ge W16) +translateOp _ Int16GtOp = Just (MO_S_Gt W16) +translateOp _ Int16LeOp = Just (MO_S_Le W16) +translateOp _ Int16LtOp = Just (MO_S_Lt W16) +translateOp _ Int16NeOp = Just (MO_Ne W16) + +-- Word16# unsigned ops + +translateOp dflags Word16Extend = Just (MO_UU_Conv W16 (wordWidth dflags)) +translateOp dflags Word16Narrow = Just (MO_UU_Conv (wordWidth dflags) W16) +translateOp _ Word16NotOp = Just (MO_Not W16) +translateOp _ Word16AddOp = Just (MO_Add W16) +translateOp _ Word16SubOp = Just (MO_Sub W16) +translateOp _ Word16MulOp = Just (MO_Mul W16) +translateOp _ Word16QuotOp = Just (MO_U_Quot W16) +translateOp _ Word16RemOp = Just (MO_U_Rem W16) + +translateOp _ Word16EqOp = Just (MO_Eq W16) +translateOp _ Word16GeOp = Just (MO_U_Ge W16) +translateOp _ Word16GtOp = Just (MO_U_Gt W16) +translateOp _ Word16LeOp = Just (MO_U_Le W16) +translateOp _ Word16LtOp = Just (MO_U_Lt W16) +translateOp _ Word16NeOp = Just (MO_Ne W16) + -- Char# ops translateOp dflags CharEqOp = Just (MO_Eq (wordWidth dflags)) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 46d4484e47..5c86f65bb8 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -1682,7 +1682,8 @@ addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, byteArrayPrimTyConKey, charPrimTyConKey, charTyConKey, doublePrimTyConKey, doubleTyConKey, floatPrimTyConKey, floatTyConKey, funTyConKey, intPrimTyConKey, intTyConKey, int8TyConKey, int16TyConKey, - int8PrimTyConKey, int32PrimTyConKey, int32TyConKey, int64PrimTyConKey, int64TyConKey, + int8PrimTyConKey, int16PrimTyConKey, int32PrimTyConKey, int32TyConKey, + int64PrimTyConKey, int64TyConKey, integerTyConKey, naturalTyConKey, listTyConKey, foreignObjPrimTyConKey, maybeTyConKey, weakPrimTyConKey, mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey, @@ -1705,36 +1706,37 @@ intPrimTyConKey = mkPreludeTyConUnique 14 intTyConKey = mkPreludeTyConUnique 15 int8PrimTyConKey = mkPreludeTyConUnique 16 int8TyConKey = mkPreludeTyConUnique 17 -int16TyConKey = mkPreludeTyConUnique 18 -int32PrimTyConKey = mkPreludeTyConUnique 19 -int32TyConKey = mkPreludeTyConUnique 20 -int64PrimTyConKey = mkPreludeTyConUnique 21 -int64TyConKey = mkPreludeTyConUnique 22 -integerTyConKey = mkPreludeTyConUnique 23 -naturalTyConKey = mkPreludeTyConUnique 24 - -listTyConKey = mkPreludeTyConUnique 25 -foreignObjPrimTyConKey = mkPreludeTyConUnique 26 -maybeTyConKey = mkPreludeTyConUnique 27 -weakPrimTyConKey = mkPreludeTyConUnique 28 -mutableArrayPrimTyConKey = mkPreludeTyConUnique 29 -mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 30 -orderingTyConKey = mkPreludeTyConUnique 31 -mVarPrimTyConKey = mkPreludeTyConUnique 32 -ratioTyConKey = mkPreludeTyConUnique 33 -rationalTyConKey = mkPreludeTyConUnique 34 -realWorldTyConKey = mkPreludeTyConUnique 35 -stablePtrPrimTyConKey = mkPreludeTyConUnique 36 -stablePtrTyConKey = mkPreludeTyConUnique 37 -eqTyConKey = mkPreludeTyConUnique 39 -heqTyConKey = mkPreludeTyConUnique 40 -arrayArrayPrimTyConKey = mkPreludeTyConUnique 41 -mutableArrayArrayPrimTyConKey = mkPreludeTyConUnique 42 +int16PrimTyConKey = mkPreludeTyConUnique 18 +int16TyConKey = mkPreludeTyConUnique 19 +int32PrimTyConKey = mkPreludeTyConUnique 20 +int32TyConKey = mkPreludeTyConUnique 21 +int64PrimTyConKey = mkPreludeTyConUnique 22 +int64TyConKey = mkPreludeTyConUnique 23 +integerTyConKey = mkPreludeTyConUnique 24 +naturalTyConKey = mkPreludeTyConUnique 25 + +listTyConKey = mkPreludeTyConUnique 26 +foreignObjPrimTyConKey = mkPreludeTyConUnique 27 +maybeTyConKey = mkPreludeTyConUnique 28 +weakPrimTyConKey = mkPreludeTyConUnique 29 +mutableArrayPrimTyConKey = mkPreludeTyConUnique 30 +mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 31 +orderingTyConKey = mkPreludeTyConUnique 32 +mVarPrimTyConKey = mkPreludeTyConUnique 33 +ratioTyConKey = mkPreludeTyConUnique 34 +rationalTyConKey = mkPreludeTyConUnique 35 +realWorldTyConKey = mkPreludeTyConUnique 36 +stablePtrPrimTyConKey = mkPreludeTyConUnique 37 +stablePtrTyConKey = mkPreludeTyConUnique 38 +eqTyConKey = mkPreludeTyConUnique 40 +heqTyConKey = mkPreludeTyConUnique 41 +arrayArrayPrimTyConKey = mkPreludeTyConUnique 42 +mutableArrayArrayPrimTyConKey = mkPreludeTyConUnique 43 statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey, mutVarPrimTyConKey, ioTyConKey, wordPrimTyConKey, wordTyConKey, word8PrimTyConKey, word8TyConKey, - word16TyConKey, word32PrimTyConKey, word32TyConKey, + word16PrimTyConKey, word16TyConKey, word32PrimTyConKey, word32TyConKey, word64PrimTyConKey, word64TyConKey, liftedConKey, unliftedConKey, anyBoxConKey, kindConKey, boxityConKey, typeConKey, threadIdPrimTyConKey, bcoPrimTyConKey, ptrTyConKey, @@ -1754,23 +1756,24 @@ wordPrimTyConKey = mkPreludeTyConUnique 59 wordTyConKey = mkPreludeTyConUnique 60 word8PrimTyConKey = mkPreludeTyConUnique 61 word8TyConKey = mkPreludeTyConUnique 62 -word16TyConKey = mkPreludeTyConUnique 63 -word32PrimTyConKey = mkPreludeTyConUnique 64 -word32TyConKey = mkPreludeTyConUnique 65 -word64PrimTyConKey = mkPreludeTyConUnique 66 -word64TyConKey = mkPreludeTyConUnique 67 -liftedConKey = mkPreludeTyConUnique 68 -unliftedConKey = mkPreludeTyConUnique 69 -anyBoxConKey = mkPreludeTyConUnique 70 -kindConKey = mkPreludeTyConUnique 71 -boxityConKey = mkPreludeTyConUnique 72 -typeConKey = mkPreludeTyConUnique 73 -threadIdPrimTyConKey = mkPreludeTyConUnique 74 -bcoPrimTyConKey = mkPreludeTyConUnique 75 -ptrTyConKey = mkPreludeTyConUnique 76 -funPtrTyConKey = mkPreludeTyConUnique 77 -tVarPrimTyConKey = mkPreludeTyConUnique 78 -compactPrimTyConKey = mkPreludeTyConUnique 79 +word16PrimTyConKey = mkPreludeTyConUnique 63 +word16TyConKey = mkPreludeTyConUnique 64 +word32PrimTyConKey = mkPreludeTyConUnique 65 +word32TyConKey = mkPreludeTyConUnique 66 +word64PrimTyConKey = mkPreludeTyConUnique 67 +word64TyConKey = mkPreludeTyConUnique 68 +liftedConKey = mkPreludeTyConUnique 69 +unliftedConKey = mkPreludeTyConUnique 70 +anyBoxConKey = mkPreludeTyConUnique 71 +kindConKey = mkPreludeTyConUnique 72 +boxityConKey = mkPreludeTyConUnique 73 +typeConKey = mkPreludeTyConUnique 74 +threadIdPrimTyConKey = mkPreludeTyConUnique 75 +bcoPrimTyConKey = mkPreludeTyConUnique 76 +ptrTyConKey = mkPreludeTyConUnique 77 +funPtrTyConKey = mkPreludeTyConUnique 78 +tVarPrimTyConKey = mkPreludeTyConUnique 79 +compactPrimTyConKey = mkPreludeTyConUnique 80 -- dotnet interop objectTyConKey :: Unique @@ -2044,7 +2047,7 @@ sumRepDataConKey = mkPreludeDataConUnique 73 runtimeRepSimpleDataConKeys, unliftedSimpleRepDataConKeys, unliftedRepDataConKeys :: [Unique] liftedRepDataConKey :: Unique runtimeRepSimpleDataConKeys@(liftedRepDataConKey : unliftedSimpleRepDataConKeys) - = map mkPreludeDataConUnique [74..84] + = map mkPreludeDataConUnique [74..86] unliftedRepDataConKeys = vecRepDataConKey : tupleRepDataConKey : @@ -2054,29 +2057,29 @@ unliftedRepDataConKeys = vecRepDataConKey : -- See Note [Wiring in RuntimeRep] in TysWiredIn -- VecCount vecCountDataConKeys :: [Unique] -vecCountDataConKeys = map mkPreludeDataConUnique [85..90] +vecCountDataConKeys = map mkPreludeDataConUnique [87..92] -- See Note [Wiring in RuntimeRep] in TysWiredIn -- VecElem vecElemDataConKeys :: [Unique] -vecElemDataConKeys = map mkPreludeDataConUnique [91..100] +vecElemDataConKeys = map mkPreludeDataConUnique [93..102] -- Typeable things kindRepTyConAppDataConKey, kindRepVarDataConKey, kindRepAppDataConKey, kindRepFunDataConKey, kindRepTYPEDataConKey, kindRepTypeLitSDataConKey, kindRepTypeLitDDataConKey :: Unique -kindRepTyConAppDataConKey = mkPreludeDataConUnique 101 -kindRepVarDataConKey = mkPreludeDataConUnique 102 -kindRepAppDataConKey = mkPreludeDataConUnique 103 -kindRepFunDataConKey = mkPreludeDataConUnique 104 -kindRepTYPEDataConKey = mkPreludeDataConUnique 105 -kindRepTypeLitSDataConKey = mkPreludeDataConUnique 106 -kindRepTypeLitDDataConKey = mkPreludeDataConUnique 107 +kindRepTyConAppDataConKey = mkPreludeDataConUnique 103 +kindRepVarDataConKey = mkPreludeDataConUnique 104 +kindRepAppDataConKey = mkPreludeDataConUnique 105 +kindRepFunDataConKey = mkPreludeDataConUnique 106 +kindRepTYPEDataConKey = mkPreludeDataConUnique 107 +kindRepTypeLitSDataConKey = mkPreludeDataConUnique 108 +kindRepTypeLitDDataConKey = mkPreludeDataConUnique 109 typeLitSymbolDataConKey, typeLitNatDataConKey :: Unique -typeLitSymbolDataConKey = mkPreludeDataConUnique 108 -typeLitNatDataConKey = mkPreludeDataConUnique 109 +typeLitSymbolDataConKey = mkPreludeDataConUnique 110 +typeLitNatDataConKey = mkPreludeDataConUnique 111 ---------------- Template Haskell ------------------- diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index 7d04788d51..4147cff53b 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -69,6 +69,9 @@ module TysPrim( int8PrimTyCon, int8PrimTy, word8PrimTyCon, word8PrimTy, + int16PrimTyCon, int16PrimTy, + word16PrimTyCon, word16PrimTy, + int32PrimTyCon, int32PrimTy, word32PrimTyCon, word32PrimTy, @@ -91,6 +94,7 @@ import {-# SOURCE #-} TysWiredIn ( runtimeRepTy, unboxedTupleKind, liftedTypeKind , vecRepDataConTyCon, tupleRepDataConTyCon , liftedRepDataConTy, unliftedRepDataConTy, intRepDataConTy, int8RepDataConTy + , int16RepDataConTy, word16RepDataConTy , wordRepDataConTy, int64RepDataConTy, word8RepDataConTy, word64RepDataConTy , addrRepDataConTy , floatRepDataConTy, doubleRepDataConTy @@ -150,6 +154,7 @@ exposedPrimTyCons , floatPrimTyCon , intPrimTyCon , int8PrimTyCon + , int16PrimTyCon , int32PrimTyCon , int64PrimTyCon , bcoPrimTyCon @@ -171,6 +176,7 @@ exposedPrimTyCons , threadIdPrimTyCon , wordPrimTyCon , word8PrimTyCon + , word16PrimTyCon , word32PrimTyCon , word64PrimTyCon @@ -194,14 +200,16 @@ mkBuiltInPrimTc fs unique tycon BuiltInSyntax -charPrimTyConName, intPrimTyConName, int8PrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word8PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName, voidPrimTyConName :: Name +charPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word8PrimTyConName, word16PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName, voidPrimTyConName :: Name charPrimTyConName = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon intPrimTyConName = mkPrimTc (fsLit "Int#") intPrimTyConKey intPrimTyCon int8PrimTyConName = mkPrimTc (fsLit "Int8#") int8PrimTyConKey int8PrimTyCon +int16PrimTyConName = mkPrimTc (fsLit "Int16#") int16PrimTyConKey int16PrimTyCon int32PrimTyConName = mkPrimTc (fsLit "Int32#") int32PrimTyConKey int32PrimTyCon int64PrimTyConName = mkPrimTc (fsLit "Int64#") int64PrimTyConKey int64PrimTyCon wordPrimTyConName = mkPrimTc (fsLit "Word#") wordPrimTyConKey wordPrimTyCon word8PrimTyConName = mkPrimTc (fsLit "Word8#") word8PrimTyConKey word8PrimTyCon +word16PrimTyConName = mkPrimTc (fsLit "Word16#") word16PrimTyConKey word16PrimTyCon word32PrimTyConName = mkPrimTc (fsLit "Word32#") word32PrimTyConKey word32PrimTyCon word64PrimTyConName = mkPrimTc (fsLit "Word64#") word64PrimTyConKey word64PrimTyCon addrPrimTyConName = mkPrimTc (fsLit "Addr#") addrPrimTyConKey addrPrimTyCon @@ -522,9 +530,11 @@ primRepToRuntimeRep rep = case rep of UnliftedRep -> unliftedRepDataConTy IntRep -> intRepDataConTy Int8Rep -> int8RepDataConTy + Int16Rep -> int16RepDataConTy WordRep -> wordRepDataConTy Int64Rep -> int64RepDataConTy Word8Rep -> word8RepDataConTy + Word16Rep -> word16RepDataConTy Word64Rep -> word64RepDataConTy AddrRep -> addrRepDataConTy FloatRep -> floatRepDataConTy @@ -571,6 +581,11 @@ int8PrimTy = mkTyConTy int8PrimTyCon int8PrimTyCon :: TyCon int8PrimTyCon = pcPrimTyCon0 int8PrimTyConName Int8Rep +int16PrimTy :: Type +int16PrimTy = mkTyConTy int16PrimTyCon +int16PrimTyCon :: TyCon +int16PrimTyCon = pcPrimTyCon0 int16PrimTyConName Int16Rep + int32PrimTy :: Type int32PrimTy = mkTyConTy int32PrimTyCon int32PrimTyCon :: TyCon @@ -591,6 +606,11 @@ word8PrimTy = mkTyConTy word8PrimTyCon word8PrimTyCon :: TyCon word8PrimTyCon = pcPrimTyCon0 word8PrimTyConName Word8Rep +word16PrimTy :: Type +word16PrimTy = mkTyConTy word16PrimTyCon +word16PrimTyCon :: TyCon +word16PrimTyCon = pcPrimTyCon0 word16PrimTyConName Word16Rep + word32PrimTy :: Type word32PrimTy = mkTyConTy word32PrimTyCon word32PrimTyCon :: TyCon diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 7ceeeffd46..a0a043dfa9 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -108,6 +108,7 @@ module TysWiredIn ( vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon, liftedRepDataConTy, unliftedRepDataConTy, intRepDataConTy, int8RepDataConTy, + int16RepDataConTy, word16RepDataConTy, wordRepDataConTy, int64RepDataConTy, word8RepDataConTy, word64RepDataConTy, addrRepDataConTy, floatRepDataConTy, doubleRepDataConTy, @@ -420,8 +421,10 @@ runtimeRepSimpleDataConNames , fsLit "IntRep" , fsLit "WordRep" , fsLit "Int8Rep" + , fsLit "Int16Rep" , fsLit "Int64Rep" , fsLit "Word8Rep" + , fsLit "Word16Rep" , fsLit "Word64Rep" , fsLit "AddrRep" , fsLit "FloatRep" @@ -1179,8 +1182,8 @@ runtimeRepSimpleDataCons :: [DataCon] liftedRepDataCon :: DataCon runtimeRepSimpleDataCons@(liftedRepDataCon : _) = zipWithLazy mk_runtime_rep_dc - [ LiftedRep, UnliftedRep, IntRep, WordRep, Int8Rep, Int64Rep - , Word8Rep, Word64Rep, AddrRep, FloatRep, DoubleRep ] + [ LiftedRep, UnliftedRep, IntRep, WordRep, Int8Rep, Int16Rep, Int64Rep + , Word8Rep, Word16Rep, Word64Rep, AddrRep, FloatRep, DoubleRep ] runtimeRepSimpleDataConNames where mk_runtime_rep_dc primrep name @@ -1188,12 +1191,12 @@ runtimeRepSimpleDataCons@(liftedRepDataCon : _) -- See Note [Wiring in RuntimeRep] liftedRepDataConTy, unliftedRepDataConTy, - intRepDataConTy, int8RepDataConTy, wordRepDataConTy, int64RepDataConTy, - word8RepDataConTy, word64RepDataConTy, addrRepDataConTy, + intRepDataConTy, int8RepDataConTy, int16RepDataConTy, wordRepDataConTy, int64RepDataConTy, + word8RepDataConTy, word16RepDataConTy, word64RepDataConTy, addrRepDataConTy, floatRepDataConTy, doubleRepDataConTy :: Type [liftedRepDataConTy, unliftedRepDataConTy, - intRepDataConTy, wordRepDataConTy, int8RepDataConTy, int64RepDataConTy, - word8RepDataConTy, word64RepDataConTy, + intRepDataConTy, wordRepDataConTy, int8RepDataConTy, int16RepDataConTy, int64RepDataConTy, + word8RepDataConTy, word16RepDataConTy, word64RepDataConTy, addrRepDataConTy, floatRepDataConTy, doubleRepDataConTy] = map (mkTyConTy . promoteDataCon) runtimeRepSimpleDataCons diff --git a/compiler/prelude/TysWiredIn.hs-boot b/compiler/prelude/TysWiredIn.hs-boot index b853290da3..1481a758b1 100644 --- a/compiler/prelude/TysWiredIn.hs-boot +++ b/compiler/prelude/TysWiredIn.hs-boot @@ -25,6 +25,7 @@ runtimeRepTy :: Type liftedRepDataConTyCon, vecRepDataConTyCon, tupleRepDataConTyCon :: TyCon liftedRepDataConTy, unliftedRepDataConTy, intRepDataConTy, int8RepDataConTy, + int16RepDataConTy, word16RepDataConTy, wordRepDataConTy, int64RepDataConTy, word8RepDataConTy, word64RepDataConTy, addrRepDataConTy, floatRepDataConTy, doubleRepDataConTy :: Type diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 8fceec0107..bf69776166 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -426,6 +426,88 @@ primop Word8LtOp "ltWord8#" Compare Word8# -> Word8# -> Int# primop Word8NeOp "neWord8#" Compare Word8# -> Word8# -> Int# ------------------------------------------------------------------------ +section "Int16#" + {Operations on 16-bit integers.} +------------------------------------------------------------------------ + +primtype Int16# + +primop Int16Extend "extendInt16#" GenPrimOp Int16# -> Int# +primop Int16Narrow "narrowInt16#" GenPrimOp Int# -> Int16# + +primop Int16NegOp "negateInt16#" Monadic Int16# -> Int16# + +primop Int16AddOp "plusInt16#" Dyadic Int16# -> Int16# -> Int16# + with + commutable = True + +primop Int16SubOp "subInt16#" Dyadic Int16# -> Int16# -> Int16# + +primop Int16MulOp "timesInt16#" Dyadic Int16# -> Int16# -> Int16# + with + commutable = True + +primop Int16QuotOp "quotInt16#" Dyadic Int16# -> Int16# -> Int16# + with + can_fail = True + +primop Int16RemOp "remInt16#" Dyadic Int16# -> Int16# -> Int16# + with + can_fail = True + +primop Int16QuotRemOp "quotRemInt16#" GenPrimOp Int16# -> Int16# -> (# Int16#, Int16# #) + with + can_fail = True + +primop Int16EqOp "eqInt16#" Compare Int16# -> Int16# -> Int# +primop Int16GeOp "geInt16#" Compare Int16# -> Int16# -> Int# +primop Int16GtOp "gtInt16#" Compare Int16# -> Int16# -> Int# +primop Int16LeOp "leInt16#" Compare Int16# -> Int16# -> Int# +primop Int16LtOp "ltInt16#" Compare Int16# -> Int16# -> Int# +primop Int16NeOp "neInt16#" Compare Int16# -> Int16# -> Int# + +------------------------------------------------------------------------ +section "Word16#" + {Operations on 16-bit unsigned integers.} +------------------------------------------------------------------------ + +primtype Word16# + +primop Word16Extend "extendWord16#" GenPrimOp Word16# -> Word# +primop Word16Narrow "narrowWord16#" GenPrimOp Word# -> Word16# + +primop Word16NotOp "notWord16#" Monadic Word16# -> Word16# + +primop Word16AddOp "plusWord16#" Dyadic Word16# -> Word16# -> Word16# + with + commutable = True + +primop Word16SubOp "subWord16#" Dyadic Word16# -> Word16# -> Word16# + +primop Word16MulOp "timesWord16#" Dyadic Word16# -> Word16# -> Word16# + with + commutable = True + +primop Word16QuotOp "quotWord16#" Dyadic Word16# -> Word16# -> Word16# + with + can_fail = True + +primop Word16RemOp "remWord16#" Dyadic Word16# -> Word16# -> Word16# + with + can_fail = True + +primop Word16QuotRemOp "quotRemWord16#" GenPrimOp Word16# -> Word16# -> (# Word16#, Word16# #) + with + can_fail = True + +primop Word16EqOp "eqWord16#" Compare Word16# -> Word16# -> Int# +primop Word16GeOp "geWord16#" Compare Word16# -> Word16# -> Int# +primop Word16GtOp "gtWord16#" Compare Word16# -> Word16# -> Int# +primop Word16LeOp "leWord16#" Compare Word16# -> Word16# -> Int# +primop Word16LtOp "ltWord16#" Compare Word16# -> Word16# -> Int# +primop Word16NeOp "neWord16#" Compare Word16# -> Word16# -> Int# + +------------------------------------------------------------------------ section "Word#" {Operations on native-sized unsigned words (32+ bits).} ------------------------------------------------------------------------ diff --git a/compiler/simplStg/RepType.hs b/compiler/simplStg/RepType.hs index a5b8ea67db..eb148b15b4 100644 --- a/compiler/simplStg/RepType.hs +++ b/compiler/simplStg/RepType.hs @@ -259,9 +259,11 @@ primRepSlot LiftedRep = PtrSlot primRepSlot UnliftedRep = PtrSlot primRepSlot IntRep = WordSlot primRepSlot Int8Rep = WordSlot +primRepSlot Int16Rep = WordSlot primRepSlot Int64Rep = Word64Slot primRepSlot WordRep = WordSlot primRepSlot Word8Rep = WordSlot +primRepSlot Word16Rep = WordSlot primRepSlot Word64Rep = Word64Slot primRepSlot AddrRep = WordSlot primRepSlot FloatRep = FloatSlot diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index f4a23851dc..c3e7372278 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -1452,12 +1452,15 @@ gfoldl_RDR, gunfold_RDR, toConstr_RDR, dataTypeOf_RDR, mkConstr_RDR, eqChar_RDR , ltChar_RDR , geChar_RDR , gtChar_RDR , leChar_RDR , eqInt_RDR , ltInt_RDR , geInt_RDR , gtInt_RDR , leInt_RDR , eqInt8_RDR , ltInt8_RDR , geInt8_RDR , gtInt8_RDR , leInt8_RDR , + eqInt16_RDR , ltInt16_RDR , geInt16_RDR , gtInt16_RDR , leInt16_RDR , eqWord_RDR , ltWord_RDR , geWord_RDR , gtWord_RDR , leWord_RDR , eqWord8_RDR , ltWord8_RDR , geWord8_RDR , gtWord8_RDR , leWord8_RDR , + eqWord16_RDR, ltWord16_RDR, geWord16_RDR, gtWord16_RDR, leWord16_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 :: RdrName + extendWord8_RDR, extendInt8_RDR, + extendWord16_RDR, extendInt16_RDR :: RdrName gfoldl_RDR = varQual_RDR gENERICS (fsLit "gfoldl") gunfold_RDR = varQual_RDR gENERICS (fsLit "gunfold") toConstr_RDR = varQual_RDR gENERICS (fsLit "toConstr") @@ -1492,17 +1495,29 @@ leInt8_RDR = varQual_RDR gHC_PRIM (fsLit "leInt8#") gtInt8_RDR = varQual_RDR gHC_PRIM (fsLit "gtInt8#" ) geInt8_RDR = varQual_RDR gHC_PRIM (fsLit "geInt8#") +eqInt16_RDR = varQual_RDR gHC_PRIM (fsLit "eqInt16#") +ltInt16_RDR = varQual_RDR gHC_PRIM (fsLit "ltInt16#" ) +leInt16_RDR = varQual_RDR gHC_PRIM (fsLit "leInt16#") +gtInt16_RDR = varQual_RDR gHC_PRIM (fsLit "gtInt16#" ) +geInt16_RDR = varQual_RDR gHC_PRIM (fsLit "geInt16#") + eqWord_RDR = varQual_RDR gHC_PRIM (fsLit "eqWord#") ltWord_RDR = varQual_RDR gHC_PRIM (fsLit "ltWord#") leWord_RDR = varQual_RDR gHC_PRIM (fsLit "leWord#") gtWord_RDR = varQual_RDR gHC_PRIM (fsLit "gtWord#") geWord_RDR = varQual_RDR gHC_PRIM (fsLit "geWord#") -eqWord8_RDR = varQual_RDR gHC_PRIM (fsLit "eqWord8#") -ltWord8_RDR = varQual_RDR gHC_PRIM (fsLit "ltWord8#" ) -leWord8_RDR = varQual_RDR gHC_PRIM (fsLit "leWord8#") -gtWord8_RDR = varQual_RDR gHC_PRIM (fsLit "gtWord8#" ) -geWord8_RDR = varQual_RDR gHC_PRIM (fsLit "geWord8#") +eqWord8_RDR = varQual_RDR gHC_PRIM (fsLit "eqWord8#") +ltWord8_RDR = varQual_RDR gHC_PRIM (fsLit "ltWord8#" ) +leWord8_RDR = varQual_RDR gHC_PRIM (fsLit "leWord8#") +gtWord8_RDR = varQual_RDR gHC_PRIM (fsLit "gtWord8#" ) +geWord8_RDR = varQual_RDR gHC_PRIM (fsLit "geWord8#") + +eqWord16_RDR = varQual_RDR gHC_PRIM (fsLit "eqWord16#") +ltWord16_RDR = varQual_RDR gHC_PRIM (fsLit "ltWord16#" ) +leWord16_RDR = varQual_RDR gHC_PRIM (fsLit "leWord16#") +gtWord16_RDR = varQual_RDR gHC_PRIM (fsLit "gtWord16#" ) +geWord16_RDR = varQual_RDR gHC_PRIM (fsLit "geWord16#") eqAddr_RDR = varQual_RDR gHC_PRIM (fsLit "eqAddr#") ltAddr_RDR = varQual_RDR gHC_PRIM (fsLit "ltAddr#") @@ -1525,6 +1540,9 @@ geDouble_RDR = varQual_RDR gHC_PRIM (fsLit ">=##") extendWord8_RDR = varQual_RDR gHC_PRIM (fsLit "extendWord8#") extendInt8_RDR = varQual_RDR gHC_PRIM (fsLit "extendInt8#") +extendWord16_RDR = varQual_RDR gHC_PRIM (fsLit "extendWord16#") +extendInt16_RDR = varQual_RDR gHC_PRIM (fsLit "extendInt16#") + {- ************************************************************************ @@ -2133,8 +2151,10 @@ ordOpTbl = [(charPrimTy , (ltChar_RDR , leChar_RDR , eqChar_RDR , geChar_RDR , gtChar_RDR )) ,(intPrimTy , (ltInt_RDR , leInt_RDR , eqInt_RDR , geInt_RDR , gtInt_RDR )) ,(int8PrimTy , (ltInt8_RDR , leInt8_RDR , eqInt8_RDR , geInt8_RDR , gtInt8_RDR )) + ,(int16PrimTy , (ltInt16_RDR , leInt16_RDR , eqInt16_RDR , geInt16_RDR , gtInt16_RDR )) ,(wordPrimTy , (ltWord_RDR , leWord_RDR , eqWord_RDR , geWord_RDR , gtWord_RDR )) ,(word8PrimTy , (ltWord8_RDR , leWord8_RDR , eqWord8_RDR , geWord8_RDR , gtWord8_RDR )) + ,(word16PrimTy, (ltWord16_RDR, leWord16_RDR, eqWord16_RDR, geWord16_RDR, gtWord16_RDR )) ,(addrPrimTy , (ltAddr_RDR , leAddr_RDR , eqAddr_RDR , geAddr_RDR , gtAddr_RDR )) ,(floatPrimTy , (ltFloat_RDR , leFloat_RDR , eqFloat_RDR , geFloat_RDR , gtFloat_RDR )) ,(doublePrimTy, (ltDouble_RDR, leDouble_RDR, eqDouble_RDR, geDouble_RDR, gtDouble_RDR)) ] @@ -2155,6 +2175,12 @@ boxConTbl = , (word8PrimTy, nlHsApp (nlHsVar $ getRdrName wordDataCon) . nlHsApp (nlHsVar extendWord8_RDR)) + , (int16PrimTy, + nlHsApp (nlHsVar $ getRdrName intDataCon) + . nlHsApp (nlHsVar extendInt16_RDR)) + , (word16PrimTy, + nlHsApp (nlHsVar $ getRdrName wordDataCon) + . nlHsApp (nlHsVar extendWord16_RDR)) ] @@ -2168,12 +2194,16 @@ postfixModTbl ,(doublePrimTy, "##") ,(int8PrimTy, "#") ,(word8PrimTy, "##") + ,(int16PrimTy, "#") + ,(word16PrimTy, "##") ] primConvTbl :: [(Type, String)] primConvTbl = [ (int8PrimTy, "narrowInt8#") , (word8PrimTy, "narrowWord8#") + , (int16PrimTy, "narrowInt16#") + , (word16PrimTy, "narrowWord16#") ] litConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)] diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 29f4b9a2d7..98dbf4b944 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -1326,10 +1326,12 @@ data PrimRep | LiftedRep | UnliftedRep -- ^ Unlifted pointer | Int8Rep -- ^ Signed, 8-bit value + | Int16Rep -- ^ Signed, 16-bit value | IntRep -- ^ Signed, word-sized value | WordRep -- ^ Unsigned, word-sized value | Int64Rep -- ^ Signed, 64 bit value (with 32-bit words only) | Word8Rep -- ^ Unsigned, 8 bit value + | Word16Rep -- ^ Unsigned, 16 bit value | Word64Rep -- ^ Unsigned, 64 bit value (with 32-bit words only) | AddrRep -- ^ A pointer, but /not/ to a Haskell value (use '(Un)liftedRep') | FloatRep @@ -1376,8 +1378,10 @@ primRepSizeB :: DynFlags -> PrimRep -> Int primRepSizeB dflags IntRep = wORD_SIZE dflags primRepSizeB dflags WordRep = wORD_SIZE dflags primRepSizeB _ Int8Rep = 1 +primRepSizeB _ Int16Rep = 2 primRepSizeB _ Int64Rep = wORD64_SIZE primRepSizeB _ Word8Rep = 1 +primRepSizeB _ Word16Rep = 2 primRepSizeB _ Word64Rep = wORD64_SIZE primRepSizeB _ FloatRep = fLOAT_SIZE primRepSizeB dflags DoubleRep = dOUBLE_SIZE dflags diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 63efd14a5b..9e8133e5e8 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -640,6 +640,8 @@ instance Binary RuntimeRep where #if __GLASGOW_HASKELL__ >= 807 put_ bh Int8Rep = putByte bh 12 put_ bh Word8Rep = putByte bh 13 + put_ bh Int16Rep = putByte bh 14 + put_ bh Word16Rep = putByte bh 15 #endif get bh = do @@ -660,6 +662,8 @@ instance Binary RuntimeRep where #if __GLASGOW_HASKELL__ >= 807 12 -> pure Int8Rep 13 -> pure Word8Rep + 14 -> pure Int16Rep + 15 -> pure Word16Rep #endif _ -> fail "Binary.putRuntimeRep: invalid tag" |