diff --git a/changelog/2023-01-04T14_23_01+01_00_fix_2386 b/changelog/2023-01-04T14_23_01+01_00_fix_2386 new file mode 100644 index 0000000000..573f07119a --- /dev/null +++ b/changelog/2023-01-04T14_23_01+01_00_fix_2386 @@ -0,0 +1,2 @@ +FIXED: Clash no longer gives `Dubious primitive instantiation warning` +when using `unpack` [#2386](https://github.com/clash-lang/clash-compiler/issues/2386). diff --git a/clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs b/clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs index 5bbfb0fb33..f1506f276d 100644 --- a/clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs +++ b/clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs @@ -2,7 +2,8 @@ Copyright : (C) 2013-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2017-2022, Google Inc., - 2017-2022, QBayLogic B.V. + 2017-2023, QBayLogic B.V. + 2023, LumiGuide Fietsdetectie B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -2202,6 +2203,136 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of -> reduce (boolToBoolLiteral tcm ty (s1 == s2)) | otherwise -> error (show args) + "Clash.Class.BitPack.Internal.packInt8#" -- :: Int8 -> BitVector 8 + | [DC _ [Left arg]] <- args + , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind +#if MIN_VERSION_ghc(8,8,0) + , mach2@Machine{mStack=[],mTerm=Literal (Int8Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#else + , mach2@Machine{mStack=[],mTerm=Literal (IntLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#endif + -> let resTyInfo = extractTySizeInfo tcm ty tys + in Just $ mach2 + { mStack = mStack mach + , mTerm = mkBitVectorLit' resTyInfo 0 i + } + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.packInt16#" -- :: Int16 -> BitVector 16 + | [DC _ [Left arg]] <- args + , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind +#if MIN_VERSION_ghc(8,8,0) + , mach2@Machine{mStack=[],mTerm=Literal (Int16Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#else + , mach2@Machine{mStack=[],mTerm=Literal (IntLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#endif + -> let resTyInfo = extractTySizeInfo tcm ty tys + in Just $ mach2 + { mStack = mStack mach + , mTerm = mkBitVectorLit' resTyInfo 0 i + } + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.packInt32#" -- :: Int32 -> BitVector 32 + | [DC _ [Left arg]] <- args + , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind +#if MIN_VERSION_ghc(8,8,0) + , mach2@Machine{mStack=[],mTerm=Literal (Int32Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#else + , mach2@Machine{mStack=[],mTerm=Literal (IntLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#endif + -> let resTyInfo = extractTySizeInfo tcm ty tys + in Just $ mach2 + { mStack = mStack mach + , mTerm = mkBitVectorLit' resTyInfo 0 i + } + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.packInt64#" -- :: Int64 -> BitVector 64 + | [DC _ [Left arg]] <- args + , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind +#if MIN_VERSION_ghc(8,8,0) + , mach2@Machine{mStack=[],mTerm=Literal (Int64Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#else + , mach2@Machine{mStack=[],mTerm=Literal (IntLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#endif + -> let resTyInfo = extractTySizeInfo tcm ty tys + in Just $ mach2 + { mStack = mStack mach + , mTerm = mkBitVectorLit' resTyInfo 0 i + } + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.packWord#" -- :: Word -> BitVector WORD_SIZE_IN_BITS + | [DC _ [Left arg]] <- args + , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind + , mach2@Machine{mStack=[],mTerm=Literal (WordLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) + -> let resTyInfo = extractTySizeInfo tcm ty tys + in Just $ mach2 + { mStack = mStack mach + , mTerm = mkBitVectorLit' resTyInfo 0 i + } + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.packWord8#" -- :: Word8 -> BitVector 8 + | [DC _ [Left arg]] <- args + , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind +#if MIN_VERSION_ghc(8,8,0) + , mach2@Machine{mStack=[],mTerm=Literal (Word8Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#else + , mach2@Machine{mStack=[],mTerm=Literal (WordLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#endif + -> let resTyInfo = extractTySizeInfo tcm ty tys + in Just $ mach2 + { mStack = mStack mach + , mTerm = mkBitVectorLit' resTyInfo 0 i + } + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.packWord16#" -- :: Word16 -> BitVector 16 + | [DC _ [Left arg]] <- args + , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind +#if MIN_VERSION_ghc(8,8,0) + , mach2@Machine{mStack=[],mTerm=Literal (Word16Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#else + , mach2@Machine{mStack=[],mTerm=Literal (WordLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#endif + -> let resTyInfo = extractTySizeInfo tcm ty tys + in Just $ mach2 + { mStack = mStack mach + , mTerm = mkBitVectorLit' resTyInfo 0 i + } + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.packWord32#" -- :: Word32 -> BitVector 32 + | [DC _ [Left arg]] <- args + , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind +#if MIN_VERSION_ghc(8,8,0) + , mach2@Machine{mStack=[],mTerm=Literal (Word32Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#else + , mach2@Machine{mStack=[],mTerm=Literal (WordLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#endif + -> let resTyInfo = extractTySizeInfo tcm ty tys + in Just $ mach2 + { mStack = mStack mach + , mTerm = mkBitVectorLit' resTyInfo 0 i + } + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.packWord64#" -- :: Word64 -> BitVector 64 + | [DC _ [Left arg]] <- args + , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind +#if MIN_VERSION_ghc(8,8,0) + , mach2@Machine{mStack=[],mTerm=Literal (Word64Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#else + , mach2@Machine{mStack=[],mTerm=Literal (WordLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#endif + -> let resTyInfo = extractTySizeInfo tcm ty tys + in Just $ mach2 + { mStack = mStack mach + , mTerm = mkBitVectorLit' resTyInfo 0 i + } + | otherwise -> error (show args) "Clash.Class.BitPack.Internal.packDouble#" -- :: Double -> BitVector 64 | [DC _ [Left arg]] <- args @@ -2223,6 +2354,84 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of , mTerm = mkBitVectorLit' resTyInfo 0 (toInteger $ (pack :: Word32 -> BitVector 32) i) } + "Clash.Class.BitPack.Internal.packCUShort#" -- :: CUShort -> BitVector 16 + | [DC _ [Left arg]] <- args + , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind +#if MIN_VERSION_ghc(8,8,0) + , mach2@Machine{mStack=[],mTerm=Literal (Word16Literal i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#else + , mach2@Machine{mStack=[],mTerm=Literal (WordLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach) +#endif + -> let resTyInfo = extractTySizeInfo tcm ty tys + in Just $ mach2 + { mStack = mStack mach + , mTerm = mkBitVectorLit' resTyInfo 0 i + } + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.unpackInt8#" -- BitVector 8 -> Int8 + | [i] <- bitVectorLiterals' args + -> let resTy = getResultTy tcm ty tys + val = toInteger (unpack (toBV i) :: Signed 8) + in reduce (mkIntCLit tcm Int8Literal val resTy) + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.unpackInt16#" -- BitVector 16 -> Int16 + | [i] <- bitVectorLiterals' args + -> let resTy = getResultTy tcm ty tys + val = toInteger (unpack (toBV i) :: Signed 16) + in reduce (mkIntCLit tcm Int16Literal val resTy) + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.unpackInt32#" -- BitVector 32 -> Int32 + | [i] <- bitVectorLiterals' args + -> let resTy = getResultTy tcm ty tys + val = toInteger (unpack (toBV i) :: Signed 32) + in reduce (mkIntCLit tcm Int32Literal val resTy) + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.unpackInt64#" -- BitVector 64 -> Int64 + | [i] <- bitVectorLiterals' args + -> let resTy = getResultTy tcm ty tys + val = toInteger (unpack (toBV i) :: Signed 64) + in reduce (mkIntCLit tcm Int64Literal val resTy) + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.unpackWord#" -- BitVector WORD_SIZE_IN_BITS -> Word + | [i] <- bitVectorLiterals' args + -> let resTy = getResultTy tcm ty tys + val = toInteger (unpack (toBV i) :: Unsigned 64) + in reduce (mkIntCLit tcm WordLiteral val resTy) + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.unpackWord8#" -- BitVector 8 -> Word8 + | [i] <- bitVectorLiterals' args + -> let resTy = getResultTy tcm ty tys + val = toInteger (unpack (toBV i) :: Unsigned 8) + in reduce (mkIntCLit tcm Word8Literal val resTy) + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.unpackWord16#" -- BitVector 16 -> Word16 + | [i] <- bitVectorLiterals' args + -> let resTy = getResultTy tcm ty tys + val = toInteger (unpack (toBV i) :: Unsigned 16) + in reduce (mkIntCLit tcm Word16Literal val resTy) + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.unpackWord32#" -- BitVector 32 -> Word32 + | [i] <- bitVectorLiterals' args + -> let resTy = getResultTy tcm ty tys + val = toInteger (unpack (toBV i) :: Unsigned 32) + in reduce (mkIntCLit tcm Word32Literal val resTy) + | otherwise -> error (show args) + + "Clash.Class.BitPack.Internal.unpackWord64#" -- BitVector 64 -> Word64 + | [i] <- bitVectorLiterals' args + -> let resTy = getResultTy tcm ty tys + val = toInteger (unpack (toBV i) :: Unsigned 64) + in reduce (mkIntCLit tcm Word64Literal val resTy) + | otherwise -> error (show args) + "Clash.Class.BitPack.Internal.unpackFloat#" | [i] <- bitVectorLiterals' args -> let resTy = getResultTy tcm ty tys @@ -2235,6 +2444,13 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of val = unpack (toBV i :: BitVector 64) in reduce (mkDoubleCLit tcm val resTy) + "Clash.Class.BitPack.Internal.unpackCUShort#" + | [i] <- bitVectorLiterals' args + -> let resTy = getResultTy tcm ty tys + val = toInteger (unpack (toBV i) :: Unsigned 16) + in reduce (mkIntCLit tcm Word16Literal val resTy) + | otherwise -> error (show args) + "Clash.Class.BitPack.Internal.xToBV" | isSubj , Just (nTy, kn) <- extractKnownNat tcm tys @@ -2793,7 +3009,7 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of "Clash.Sized.Internal.Index.fromEnum#" | [i] <- indexLiterals' args -> let resTy = getResultTy tcm ty tys - in reduce (mkIntCLit tcm i resTy) + in reduce (mkIntCLit tcm IntLiteral i resTy) -- Bounded "Clash.Sized.Internal.Index.maxBound#" @@ -2910,7 +3126,7 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of "Clash.Sized.Internal.Signed.fromEnum#" | [i] <- signedLiterals' args -> let resTy = getResultTy tcm ty tys - in reduce (mkIntCLit tcm i resTy) + in reduce (mkIntCLit tcm IntLiteral i resTy) -- Bounded "Clash.Sized.Internal.Signed.minBound#" @@ -3128,7 +3344,7 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of "Clash.Sized.Internal.Unsigned.fromEnum#" | [i] <- unsignedLiterals' args -> let resTy = getResultTy tcm ty tys - in reduce (mkIntCLit tcm i resTy) + in reduce (mkIntCLit tcm IntLiteral i resTy) -- Bounded "Clash.Sized.Internal.Unsigned.minBound#" @@ -4709,9 +4925,9 @@ bitVectorLitIntLit tcm tys args | otherwise = Nothing -mkIntCLit :: TyConMap -> Integer -> Type -> Term -mkIntCLit tcm lit resTy = - App (Data intDc) (Literal (IntLiteral lit)) +mkIntCLit :: TyConMap -> (Integer -> Literal) -> Integer -> Type -> Term +mkIntCLit tcm proj lit resTy = + App (Data intDc) (Literal (proj lit)) where (_, tyView -> TyConApp intTcNm []) = splitFunForallTy resTy Just intTc = UniqMap.lookup intTcNm tcm @@ -5045,7 +5261,7 @@ liftBitVector2CInt liftBitVector2CInt tcm resTy f args _p | [i] <- bitVectorLiterals' args = let val = f (toBV i) - in Just $ mkIntCLit tcm val resTy + in Just $ mkIntCLit tcm IntLiteral val resTy | otherwise = Nothing diff --git a/clash-lib/prims/common/Clash_Class_BitPack.primitives.yaml b/clash-lib/prims/common/Clash_Class_BitPack.primitives.yaml index 354221505c..8257616dd5 100644 --- a/clash-lib/prims/common/Clash_Class_BitPack.primitives.yaml +++ b/clash-lib/prims/common/Clash_Class_BitPack.primitives.yaml @@ -1,15 +1,71 @@ - BlackBox: - name: Clash.Class.BitPack.Internal.packFloat# + name: Clash.Class.BitPack.Internal.packInt8# kind: Expression - type: 'packFloat# :: Float - -> BitVector 32' + type: 'packInt8# :: Int8 + -> Bitvector 8' template: ~ARG[0] workInfo: Never - BlackBox: - name: Clash.Class.BitPack.Internal.unpackFloat# + name: Clash.Class.BitPack.Internal.packInt16# kind: Expression - type: 'packFloat# :: BitVector - 32 -> Float' + type: 'packInt16# :: Int16 + -> Bitvector 16' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packInt32# + kind: Expression + type: 'packInt32# :: Int32 + -> Bitvector 32' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packInt64# + kind: Expression + type: 'packInt64# :: Int64 + -> Bitvector 64' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord# + kind: Expression + type: 'packWord# :: Word + -> Bitvector WORD_SIZE_IN_BITS' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord8# + kind: Expression + type: 'packWord8# :: Word8 + -> Bitvector 8' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord16# + kind: Expression + type: 'packWord16# :: Word16 + -> Bitvector 16' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord32# + kind: Expression + type: 'packWord32# :: Word32 + -> Bitvector 32' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packWord64# + kind: Expression + type: 'packWord64# :: Word64 + -> Bitvector 64' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packFloat# + kind: Expression + type: 'packFloat# :: Float + -> BitVector 32' template: ~ARG[0] workInfo: Never - BlackBox: @@ -19,13 +75,97 @@ -> BitVector 64' template: ~ARG[0] workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.packCUShort# + kind: Expression + type: 'packCUShort# :: CUShort + -> Bitvector 16' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackInt8# + kind: Expression + type: 'unpackInt8# :: Bitvector + 8 -> Int8' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackInt16# + kind: Expression + type: 'unpackInt16# :: Bitvector + 16 -> Int16' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackInt32# + kind: Expression + type: 'unpackInt32# :: Bitvector + 32 -> Int32' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackInt64# + kind: Expression + type: 'unpackInt64# :: Bitvector + 64 -> Int64' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord# + kind: Expression + type: 'unpackWord# :: Bitvector + WORD_SIZE_IN_BITS -> Word' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord8# + kind: Expression + type: 'unpackWord8# :: Bitvector + 8 -> Word8' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord16# + kind: Expression + type: 'unpackWord16# :: Bitvector + 16 -> Word16' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord32# + kind: Expression + type: 'unpackWord32# :: Bitvector + 32 -> Word32' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackWord64# + kind: Expression + type: 'unpackWord64# :: Bitvector + 64 -> Word64' + template: ~ARG[0] + workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackFloat# + kind: Expression + type: 'unpackFloat# :: BitVector + 32 -> Float' + template: ~ARG[0] + workInfo: Never - BlackBox: name: Clash.Class.BitPack.Internal.unpackDouble# kind: Expression - type: 'packFloat# :: BitVector + type: 'unpackDouble# :: BitVector 64 -> Double' template: ~ARG[0] workInfo: Never +- BlackBox: + name: Clash.Class.BitPack.Internal.unpackCUShort# + kind: Expression + type: 'unpackCUShort# :: Bitvector 16 + -> CUShort' + template: ~ARG[0] + workInfo: Never - BlackBox: name: Clash.Class.BitPack.Internal.xToBV kind: Expression diff --git a/clash-lib/src/Clash/Netlist/BlackBox.hs b/clash-lib/src/Clash/Netlist/BlackBox.hs index 9e4bfa3057..1965109c2b 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox.hs @@ -3,8 +3,9 @@ Copyright : (C) 2012-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2017 , Google Inc., - 2021-2022, QBayLogic B.V. + 2021-2023, QBayLogic B.V. 2022 , Google Inc. + 2023, LumiGuide Fietsdetectie B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. @@ -302,7 +303,7 @@ mkArgument bbName bndr nArg e = do return ((N.Literal (Just (Signed 64,64)) (N.NumLit i),hwTy,True),[]) (C.Literal (Word64Literal i), [],_) -> return ((N.Literal (Just (Unsigned 64,64)) (N.NumLit i),hwTy,True),[]) -#if MIN_VERSION_base(4,16,0) +#if MIN_VERSION_base(4,13,0) (C.Literal (Int8Literal i), [],_) -> return ((N.Literal (Just (Signed 8,8)) (N.NumLit i),hwTy,True),[]) (C.Literal (Int16Literal i), [],_) -> diff --git a/clash-prelude/src/Clash/Class/BitPack/Internal.hs b/clash-prelude/src/Clash/Class/BitPack/Internal.hs index 60309ef6ee..36785e3535 100644 --- a/clash-prelude/src/Clash/Class/BitPack/Internal.hs +++ b/clash-prelude/src/Clash/Class/BitPack/Internal.hs @@ -1,8 +1,9 @@ {-| Copyright : (C) 2013-2016, University of Twente, 2016-2017, Myrtle Software Ltd, - 2021-2022 QBayLogic B.V., + 2021-2023 QBayLogic B.V., 2022, Google Inc. + 2023, LumiGuide Fietsdetectie B.V. License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -243,53 +244,143 @@ instance BitPack Bit where instance BitPack Int where type BitSize Int = WORD_SIZE_IN_BITS - pack = packXWith fromIntegral - unpack = checkUnpackUndef fromIntegral + pack = packXWith toEnum + unpack = checkUnpackUndef fromEnum instance BitPack Int8 where type BitSize Int8 = 8 - pack = packXWith fromIntegral - unpack = checkUnpackUndef fromIntegral + pack = packXWith packInt8# + unpack = checkUnpackUndef unpackInt8# + +packInt8# :: Int8 -> BitVector 8 +packInt8# = fromIntegral +{-# NOINLINE packInt8# #-} +{-# ANN packInt8# hasBlackBox #-} + +unpackInt8# :: BitVector 8 -> Int8 +unpackInt8# = fromIntegral +{-# NOINLINE unpackInt8# #-} +{-# ANN unpackInt8# hasBlackBox #-} instance BitPack Int16 where type BitSize Int16 = 16 - pack = packXWith fromIntegral - unpack = checkUnpackUndef fromIntegral + pack = packXWith packInt16# + unpack = checkUnpackUndef unpackInt16# + +packInt16# :: Int16 -> BitVector 16 +packInt16# = fromIntegral +{-# NOINLINE packInt16# #-} +{-# ANN packInt16# hasBlackBox #-} + +unpackInt16# :: BitVector 16 -> Int16 +unpackInt16# = fromIntegral +{-# NOINLINE unpackInt16# #-} +{-# ANN unpackInt16# hasBlackBox #-} instance BitPack Int32 where type BitSize Int32 = 32 - pack = packXWith fromIntegral - unpack = checkUnpackUndef fromIntegral + pack = packXWith packInt32# + unpack = checkUnpackUndef unpackInt32# + +packInt32# :: Int32 -> BitVector 32 +packInt32# = fromIntegral +{-# NOINLINE packInt32# #-} +{-# ANN packInt32# hasBlackBox #-} + +unpackInt32# :: BitVector 32 -> Int32 +unpackInt32# = fromIntegral +{-# NOINLINE unpackInt32# #-} +{-# ANN unpackInt32# hasBlackBox #-} instance BitPack Int64 where type BitSize Int64 = 64 - pack = packXWith fromIntegral - unpack = checkUnpackUndef fromIntegral + pack = packXWith packInt64# + unpack = checkUnpackUndef unpackInt64# + +packInt64# :: Int64 -> BitVector 64 +packInt64# = fromIntegral +{-# NOINLINE packInt64# #-} +{-# ANN packInt64# hasBlackBox #-} + +unpackInt64# :: BitVector 64 -> Int64 +unpackInt64# = fromIntegral +{-# NOINLINE unpackInt64# #-} +{-# ANN unpackInt64# hasBlackBox #-} instance BitPack Word where type BitSize Word = WORD_SIZE_IN_BITS - pack = packXWith fromIntegral - unpack = checkUnpackUndef fromIntegral + pack = packXWith packWord# + unpack = checkUnpackUndef unpackWord# + +packWord# :: Word -> BitVector WORD_SIZE_IN_BITS +packWord# = fromIntegral +{-# NOINLINE packWord# #-} +{-# ANN packWord# hasBlackBox #-} + +unpackWord# :: BitVector WORD_SIZE_IN_BITS -> Word +unpackWord# = fromIntegral +{-# NOINLINE unpackWord# #-} +{-# ANN unpackWord# hasBlackBox #-} instance BitPack Word8 where type BitSize Word8 = 8 - pack = packXWith fromIntegral - unpack = checkUnpackUndef fromIntegral + pack = packXWith packWord8# + unpack = checkUnpackUndef unpackWord8# + +packWord8# :: Word8 -> BitVector 8 +packWord8# = fromIntegral +{-# NOINLINE packWord8# #-} +{-# ANN packWord8# hasBlackBox #-} + +unpackWord8# :: BitVector 8 -> Word8 +unpackWord8# = fromIntegral +{-# NOINLINE unpackWord8# #-} +{-# ANN unpackWord8# hasBlackBox #-} instance BitPack Word16 where type BitSize Word16 = 16 - pack = packXWith fromIntegral - unpack = checkUnpackUndef fromIntegral + pack = packXWith packWord16# + unpack = checkUnpackUndef unpackWord16# + +packWord16# :: Word16 -> BitVector 16 +packWord16# = fromIntegral +{-# NOINLINE packWord16# #-} +{-# ANN packWord16# hasBlackBox #-} + +unpackWord16# :: BitVector 16 -> Word16 +unpackWord16# = fromIntegral +{-# NOINLINE unpackWord16# #-} +{-# ANN unpackWord16# hasBlackBox #-} instance BitPack Word32 where type BitSize Word32 = 32 - pack = packXWith fromIntegral - unpack = checkUnpackUndef fromIntegral + pack = packXWith packWord32# + unpack = checkUnpackUndef unpackWord32# + +packWord32# :: Word32 -> BitVector 32 +packWord32# = fromIntegral +{-# NOINLINE packWord32# #-} +{-# ANN packWord32# hasBlackBox #-} + +unpackWord32# :: BitVector 32 -> Word32 +unpackWord32# = fromIntegral +{-# NOINLINE unpackWord32# #-} +{-# ANN unpackWord32# hasBlackBox #-} instance BitPack Word64 where type BitSize Word64 = 64 - pack = packXWith fromIntegral - unpack = checkUnpackUndef fromIntegral + pack = packXWith packWord64# + unpack = checkUnpackUndef unpackWord64# + +packWord64# :: Word64 -> BitVector 64 +packWord64# = fromIntegral +{-# NOINLINE packWord64# #-} +{-# ANN packWord64# hasBlackBox #-} + +unpackWord64# :: BitVector 64 -> Word64 +unpackWord64# = fromIntegral +{-# NOINLINE unpackWord64# #-} +{-# ANN unpackWord64# hasBlackBox #-} instance BitPack Float where type BitSize Float = 32 @@ -323,8 +414,18 @@ unpackDouble# (unsafeToNatural -> w) = wordToDouble (fromIntegral w) instance BitPack CUShort where type BitSize CUShort = 16 - pack = packXWith fromIntegral - unpack = checkUnpackUndef fromIntegral + pack = packXWith packCUShort# + unpack = checkUnpackUndef unpackCUShort# + +packCUShort# :: CUShort -> BitVector 16 +packCUShort# = fromIntegral +{-# NOINLINE packCUShort# #-} +{-# ANN packCUShort# hasBlackBox #-} + +unpackCUShort# :: BitVector 16 -> CUShort +unpackCUShort# = fromIntegral +{-# NOINLINE unpackCUShort# #-} +{-# ANN unpackCUShort# hasBlackBox #-} instance BitPack Half where type BitSize Half = 16