{-# LANGUAGE MagicHash #-}
module Data.Text.Internal.Unsafe.Shift
(
UnsafeShift(..)
) where
import GHC.Base
import GHC.Word
class UnsafeShift a where
shiftL :: a -> Int -> a
shiftR :: a -> Int -> a
instance UnsafeShift Word16 where
{-# INLINE shiftL #-}
shiftL :: Word16 -> Int -> Word16
shiftL (W16# Word#
x#) (I# Int#
i#) = Word# -> Word16
W16# (Word# -> Word#
narrow16Word# (Word#
x# Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
i#))
{-# INLINE shiftR #-}
shiftR :: Word16 -> Int -> Word16
shiftR (W16# Word#
x#) (I# Int#
i#) = Word# -> Word16
W16# (Word#
x# Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
i#)
instance UnsafeShift Word32 where
{-# INLINE shiftL #-}
shiftL :: Word32 -> Int -> Word32
shiftL (W32# Word#
x#) (I# Int#
i#) = Word# -> Word32
W32# (Word# -> Word#
narrow32Word# (Word#
x# Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
i#))
{-# INLINE shiftR #-}
shiftR :: Word32 -> Int -> Word32
shiftR (W32# Word#
x#) (I# Int#
i#) = Word# -> Word32
W32# (Word#
x# Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
i#)
instance UnsafeShift Word64 where
{-# INLINE shiftL #-}
shiftL :: Word64 -> Int -> Word64
shiftL (W64# Word#
x#) (I# Int#
i#) = Word# -> Word64
W64# (Word#
x# Word# -> Int# -> Word#
`uncheckedShiftL64#` Int#
i#)
{-# INLINE shiftR #-}
shiftR :: Word64 -> Int -> Word64
shiftR (W64# Word#
x#) (I# Int#
i#) = Word# -> Word64
W64# (Word#
x# Word# -> Int# -> Word#
`uncheckedShiftRL64#` Int#
i#)
instance UnsafeShift Int where
{-# INLINE shiftL #-}
shiftL :: Int -> Int -> Int
shiftL (I# Int#
x#) (I# Int#
i#) = Int# -> Int
I# (Int#
x# Int# -> Int# -> Int#
`iShiftL#` Int#
i#)
{-# INLINE shiftR #-}
shiftR :: Int -> Int -> Int
shiftR (I# Int#
x#) (I# Int#
i#) = Int# -> Int
I# (Int#
x# Int# -> Int# -> Int#
`iShiftRA#` Int#
i#)