content: {-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
  
  {-# LANGUAGE BangPatterns      #-}
  {-# LANGUAGE CPP               #-}
  {-# LANGUAGE MagicHash         #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  
  #if !MIN_VERSION_base(4,8,0)
  {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE StandaloneDeriving #-}
  #endif
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Data.Int.Int24
  -- Copyright   :  (c) The University of Glasgow 1997-2002
  -- License     :  see src/Data/LICENSE
  --
  -- Stability   :  experimental
  -- Portability :  non-portable (GHC Extensions)
  --
  -- The 24 bit integral datatype, 'Int24'.
  --
  -----------------------------------------------------------------------------
  
  module Data.Int.Int24 (
    -- * Int24 type
    Int24(..)
    -- * Internal helper
    , narrow24Int#
    ) where
  
  import           Data.Bits
  import           Data.Data
  import           Data.Maybe
  import           Data.Word.Word24
  import           Foreign.Storable
  
  import           GHC.Arr
  import           GHC.Base
  import           GHC.Enum
  import           GHC.Int.Compat
  import           GHC.Integer (smallInteger, integerToInt)
  import           GHC.Num hiding (integerToInt)
  import           GHC.Ptr
  import           GHC.Read
  import           GHC.Real
  import           GHC.Show
  import           GHC.Word.Compat
  
  import           Control.DeepSeq
  
  #if !MIN_VERSION_base(4,8,0)
  import           Data.Typeable
  #endif
  
  ------------------------------------------------------------------------
  
  -- Int24 is represented in the same way as Int. Operations may assume
  -- and must ensure that it holds only values from its logical range.
  
  -- | 24-bit signed integer type
  data Int24 = I24# Int# deriving (Eq, Ord)
  
  #if !MIN_VERSION_base(4,8,0)
  deriving instance Typeable Int24
  #endif
  
  instance NFData Int24  where rnf !_ = ()
  
  int24Type :: DataType
  int24Type = mkIntType "Data.Word.Int24.Int24"
  
  instance Data Int24 where
    toConstr x = mkIntegralConstr int24Type x
    gunfold _ z c = case constrRep c of
                      (IntConstr x) -> z (fromIntegral x)
                      _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
                                   ++ " is not of type Int24."
    dataTypeOf _ = int24Type
  
  -- the narrowings are primops in GHC; I don't have that luxury.
  -- if the 24th bit (from right) is on, the value is negative, so
  -- fill the uppermost bits with 1s.  Otherwise clear them to 0s.
  narrow24Int# :: Int# -> Int#
  narrow24Int# x# = if isTrue# ((x'# `and#` mask#) `eqWord#` mask#)
      then word2Int# (x'# `or#`  int2Word# m1#)
      else word2Int# (x'# `and#` int2Word# m2#)
    where
      !x'#   = int2Word# x#
      !mask# = int2Word# 0x00800000#
      !(I# m1#) = -8388608
      !(I# m2#) = 16777215
  
  instance Show Int24 where
      showsPrec p x = showsPrec p (fromIntegral x :: Int)
  
  instance Num Int24 where
      (I24# x#) + (I24# y#)  = I24# (narrow24Int# (x# +# y#))
      (I24# x#) - (I24# y#)  = I24# (narrow24Int# (x# -# y#))
      (I24# x#) * (I24# y#)  = I24# (narrow24Int# (x# *# y#))
      negate (I24# x#)       = I24# (narrow24Int# (negateInt# x#))
      abs x | x >= 0         = x
            | otherwise      = negate x
      signum x | x > 0       = 1
      signum 0               = 0
      signum _               = -1
      fromInteger i          = I24# (narrow24Int# (integerToInt i))
  
  instance Real Int24 where
      toRational x = toInteger x % 1
  
  instance Enum Int24 where
      succ x
          | x /= maxBound = x + 1
          | otherwise     = succError "Int24"
      pred x
          | x /= minBound = x - 1
          | otherwise     = predError "Int24"
      toEnum i@(I# i#)
          | i >= fromIntegral (minBound::Int24) && i <= fromIntegral (maxBound::Int24)
                          = I24# i#
          | otherwise     = toEnumError "Int24" i (minBound::Int24, maxBound::Int24)
      fromEnum (I24# x#)  = I# x#
      enumFrom            = boundedEnumFrom
      enumFromThen        = boundedEnumFromThen
  
  instance Integral Int24 where
      quot    x@(I24# x#) y@(I24# y#)
          | y == 0                     = divZeroError
          | x == minBound && y == (-1) = overflowError
          | otherwise                  = I24# (narrow24Int# (x# `quotInt#` y#))
      rem     x@(I24# x#) y@(I24# y#)
          | y == 0                     = divZeroError
          | x == minBound && y == (-1) = overflowError
          | otherwise                  = I24# (narrow24Int# (x# `remInt#` y#))
      div     x@(I24# x#) y@(I24# y#)
          | y == 0                     = divZeroError
          | x == minBound && y == (-1) = overflowError
          | otherwise                  = I24# (narrow24Int# (x# `divInt#` y#))
      mod     x@(I24# x#) y@(I24# y#)
          | y == 0                     = divZeroError
          | x == minBound && y == (-1) = overflowError
          | otherwise                  = I24# (narrow24Int# (x# `modInt#` y#))
      quotRem x@(I24# x#) y@(I24# y#)
          | y == 0                     = divZeroError
          | x == minBound && y == (-1) = overflowError
          | otherwise                  = (I24# (narrow24Int# (x# `quotInt#` y#)),
                                          I24# (narrow24Int# (x# `remInt#` y#)))
      divMod  x@(I24# x#) y@(I24# y#)
          | y == 0                     = divZeroError
          | x == minBound && y == (-1) = overflowError
          | otherwise                  = (I24# (narrow24Int# (x# `divInt#` y#)),
                                          I24# (narrow24Int# (x# `modInt#` y#)))
      toInteger (I24# x#)              = smallInteger x#
  
  instance Bounded Int24 where
      minBound = -0x800000
      maxBound =  0x7FFFFF
  
  instance Ix Int24 where
      range (m,n)         = [m..n]
      unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
      inRange (m,n) i     = m <= i && i <= n
  
  instance Read Int24 where
      readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
  
  instance Bits Int24 where
      {-# INLINE shift #-}
      {-# INLINE bit #-}
      {-# INLINE testBit #-}
  
      (I24# x#) .&.   (I24# y#)  = I24# (word2Int# (int2Word# x# `and#` int2Word# y#))
      (I24# x#) .|.   (I24# y#)  = I24# (word2Int# (int2Word# x# `or#`  int2Word# y#))
      (I24# x#) `xor` (I24# y#)  = I24# (word2Int# (int2Word# x# `xor#` int2Word# y#))
      complement (I24# x#)       = I24# (word2Int# (not# (int2Word# x#)))
      (I24# x#) `shift` (I# i#)
          | isTrue# (i# >=# 0#)  = I24# (narrow24Int# (x# `iShiftL#` i#))
          | otherwise            = I24# (x# `iShiftRA#` negateInt# i#)
      (I24# x#) `shiftL`       (I# i#) = I24# (narrow24Int# (x# `iShiftL#` i#))
      (I24# x#) `unsafeShiftL` (I# i#) = I24# (narrow24Int# (x# `uncheckedIShiftL#` i#))
      (I24# x#) `shiftR`       (I# i#) = I24# (x# `iShiftRA#` i#)
      (I24# x#) `unsafeShiftR` (I# i#) = I24# (x# `uncheckedIShiftRA#` i#)
      (I24# x#) `rotate` i
          | isTrue# (i'# ==# 0#) = I24# x#
          | otherwise = I24# (narrow24Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                                           (x'# `uncheckedShiftRL#` (24# -# i'#)))))
        where
          !x'# = narrow24Word# (int2Word# x#)
          !(I# i'#) = i `mod` 24
      bitSizeMaybe i             = Just (finiteBitSize i)
      bitSize                    = finiteBitSize
      isSigned _                 = True
      popCount (I24# x#)         = I# (word2Int# (popCnt24# (int2Word# x#)))
      bit                        = bitDefault
      testBit                    = testBitDefault
  
  instance FiniteBits Int24 where
      finiteBitSize _ = 24
  #if MIN_VERSION_base(4,8,0)
      countLeadingZeros  (I24# x#) = I# (word2Int# (clz24# (int2Word# x#)))
      countTrailingZeros (I24# x#) = I# (word2Int# (ctz24# (int2Word# x#)))
  #endif
  
  {-# RULES
  "fromIntegral/Word8->Int24"   fromIntegral = \(W8# x#) -> I24# (word2Int# x#)
  "fromIntegral/Word16->Int24"  fromIntegral = \(W16# x#) -> I24# (word2Int# x#)
  "fromIntegral/Int8->Int24"    fromIntegral = \(I8# x#) -> I24# x#
  "fromIntegral/Int16->Int24"   fromIntegral = \(I16# x#) -> I24# x#
  "fromIntegral/Int24->Int24"   fromIntegral = id :: Int24 -> Int24
  "fromIntegral/a->Int24"       fromIntegral = \x -> case fromIntegral x of I# x# -> I24# (narrow24Int# x#)
  "fromIntegral/Int24->a"       fromIntegral = \(I24# x#) -> fromIntegral (I# x#)
    #-}
  
  {-# RULES
  "properFraction/Float->(Int24,Float)"
      properFraction = \x ->
                        case properFraction x of {
                          (n, y) -> ((fromIntegral :: Int -> Int24) n, y :: Float) }
  "truncate/Float->Int24"
      truncate = (fromIntegral :: Int -> Int24) . (truncate :: Float -> Int)
  "floor/Float->Int24"
      floor    = (fromIntegral :: Int -> Int24) . (floor :: Float -> Int)
  "ceiling/Float->Int24"
      ceiling  = (fromIntegral :: Int -> Int24) . (ceiling :: Float -> Int)
  "round/Float->Int24"
      round    = (fromIntegral :: Int -> Int24) . (round  :: Float -> Int)
    #-}
  
  {-# RULES
  "properFraction/Double->(Int24,Double)"
      properFraction = \x ->
                        case properFraction x of {
                          (n, y) -> ((fromIntegral :: Int -> Int24) n, y :: Double) }
  "truncate/Double->Int24"
      truncate = (fromIntegral :: Int -> Int24) . (truncate :: Double -> Int)
  "floor/Double->Int24"
      floor    = (fromIntegral :: Int -> Int24) . (floor :: Double -> Int)
  "ceiling/Double->Int24"
      ceiling  = (fromIntegral :: Int -> Int24) . (ceiling :: Double -> Int)
  "round/Double->Int24"
      round    = (fromIntegral :: Int -> Int24) . (round  :: Double -> Int)
    #-}
  
  instance Storable Int24 where
    sizeOf _ = 3
    alignment _ = 3
    peek p = fmap fromIntegral $ peek ((castPtr p) :: Ptr Word24)
    poke p v = poke (castPtr p :: Ptr Word24) (fromIntegral v)
  