{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}

-- |
-- Module      : Data.Text.Internal.Unsafe.Shift
-- Copyright   : (c) Bryan O'Sullivan 2009
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- /Warning/: this is an internal module, and does not have a stable
-- API or name. Functions in this module may not check or enforce
-- preconditions expected by public modules. Use at your own risk!
--
-- Fast, unchecked bit shifting functions.

module Data.Text.Internal.Unsafe.Shift
    (
      UnsafeShift(..)
    ) where

-- import qualified Data.Bits as Bits
import GHC.Base
#if __GLASGOW_HASKELL__ >= 903
  hiding (uncheckedShiftL64#, uncheckedShiftRL64#)
#endif
import GHC.Word

-- | This is a workaround for poor optimisation in GHC 6.8.2.  It
-- fails to notice constant-width shifts, and adds a test and branch
-- to every shift.  This imposes about a 10% performance hit.
--
-- These functions are undefined when the amount being shifted by is
-- greater than the size in bits of a machine Int#.
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#
narrow16WordCompat# (Word# -> Word#
word16ToWordCompat# 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# -> Word#
wordToWord16Compat# (Word# -> Word#
word16ToWordCompat# 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#
narrow32WordCompat# (Word# -> Word#
word32ToWordCompat# 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# -> Word#
wordToWord32Compat# (Word# -> Word#
word32ToWordCompat# 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#)

{-
instance UnsafeShift Integer where
    {-# INLINE shiftL #-}
    shiftL = Bits.shiftL

    {-# INLINE shiftR #-}
    shiftR = Bits.shiftR
-}

#if MIN_VERSION_base(4,16,0)
word16ToWordCompat# :: Word16# -> Word#
word16ToWordCompat# = word16ToWord#

word32ToWordCompat# :: Word32# -> Word#
word32ToWordCompat# = word32ToWord#

wordToWord16Compat# :: Word# -> Word16#
wordToWord16Compat# = wordToWord16#

wordToWord32Compat# :: Word# -> Word32#
wordToWord32Compat# = wordToWord32#

narrow16WordCompat# :: Word# -> Word16#
narrow16WordCompat# = wordToWord16#

narrow32WordCompat# :: Word# -> Word32#
narrow32WordCompat# = wordToWord32#
#else
-- No-ops
word16ToWordCompat# :: Word# -> Word#
word16ToWordCompat# :: Word# -> Word#
word16ToWordCompat# Word#
x = Word#
x

word32ToWordCompat# :: Word# -> Word#
word32ToWordCompat# :: Word# -> Word#
word32ToWordCompat# Word#
x = Word#
x

wordToWord16Compat# :: Word# -> Word#
wordToWord16Compat# :: Word# -> Word#
wordToWord16Compat# Word#
x = Word#
x

wordToWord32Compat# :: Word# -> Word#
wordToWord32Compat# :: Word# -> Word#
wordToWord32Compat# Word#
x = Word#
x

-- Actual narrowing
narrow16WordCompat# :: Word# -> Word#
narrow16WordCompat# :: Word# -> Word#
narrow16WordCompat# = Word# -> Word#
narrow16Word#

narrow32WordCompat# :: Word# -> Word#
narrow32WordCompat# :: Word# -> Word#
narrow32WordCompat# = Word# -> Word#
narrow32Word#
#endif