{-# LANGUAGE CPP #-}

-- |
-- Copyright   : (c) 2010 Simon Meier
--
--               Original serialization code from 'Data.Binary.Builder':
--               (c) Lennart Kolmodin, Ross Patterson
--
-- License     : BSD3-style
--
-- Utilty module defining unchecked shifts.
--
-- These functions are undefined when the amount being shifted by is
-- greater than the size in bits of a machine Int#.-
module PtrPoker.UncheckedShifting
  ( shiftr_w16,
    shiftr_w32,
    shiftr_w64,
    shiftr_w,
    caseWordSize_32_64,
  )
where

#if !defined(__HADDOCK__)
import GHC.Base
import GHC.Word (Word32(..),Word16(..),Word64(..))

#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608
import GHC.Word (uncheckedShiftRL64#)
#endif
#else
import Data.Word
#endif

import Foreign
import Prelude

------------------------------------------------------------------------
-- Unchecked shifts

-- | Right-shift of a 'Word16'.
{-# INLINE shiftr_w16 #-}
shiftr_w16 :: Word16 -> Int -> Word16

-- | Right-shift of a 'Word32'.
{-# INLINE shiftr_w32 #-}
shiftr_w32 :: Word32 -> Int -> Word32

-- | Right-shift of a 'Word64'.
{-# INLINE shiftr_w64 #-}
shiftr_w64 :: Word64 -> Int -> Word64

-- | Right-shift of a 'Word'.
{-# INLINE shiftr_w #-}
shiftr_w :: Word -> Int -> Word
#if WORD_SIZE_IN_BITS < 64
shiftr_w :: Word -> Int -> Word
shiftr_w Word
w Int
s = Word32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word) -> Word32 -> Word
forall a b. (a -> b) -> a -> b
$ (Word32 -> Int -> Word32
`shiftr_w32` Int
s) (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w
#else
shiftr_w w s = fromIntegral $ (`shiftr_w64` s) $ fromIntegral w
#endif

#if !defined(__HADDOCK__)
#if __GLASGOW_HASKELL__ >= 902
shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRLWord16#` i)
shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRLWord32#` i)
#else
shiftr_w16 :: Word16 -> Int -> Word16
shiftr_w16 (W16# Word#
w) (I# Int#
i) = Word# -> Word16
W16# (Word#
w Word# -> Int# -> Word#
`uncheckedShiftRL#`       Int#
i)
shiftr_w32 :: Word32 -> Int -> Word32
shiftr_w32 (W32# Word#
w) (I# Int#
i) = Word# -> Word32
W32# (Word#
w Word# -> Int# -> Word#
`uncheckedShiftRL#`       Int#
i)
#endif

#if WORD_SIZE_IN_BITS < 64
shiftr_w64 :: Word64 -> Int -> Word64
shiftr_w64 (W64# Word#
w) (I# Int#
i) = Word# -> Word64
W64# (Word#
w Word# -> Int# -> Word#
`uncheckedShiftRL64#`     Int#
i)
#else
shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#`       i)
#endif

#else
shiftr_w16 = shiftR
shiftr_w32 = shiftR
shiftr_w64 = shiftR
#endif

-- | Select an implementation depending on the bit-size of 'Word's.
-- Currently, it produces a runtime failure if the bitsize is different.
-- This is detected by the testsuite.
{-# INLINE caseWordSize_32_64 #-}
caseWordSize_32_64 :: a -> a -> a
caseWordSize_32_64 :: a -> a -> a
caseWordSize_32_64 a
f32 a
f64 =
  case Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
forall a. HasCallStack => a
undefined :: Word) of
    Int
32 -> a
f32
    Int
64 -> a
f64
    Int
s -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"caseWordSize_32_64: unsupported Word bit-size " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
s