{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash, UnboxedTuples,
             StandaloneDeriving, NegativeLiterals #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Int
-- Copyright   :  (c) The University of Glasgow 1997-2002
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  cvs-ghc@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- The sized integral datatypes, 'Int8', 'Int16', 'Int32', and 'Int64'.
--
-----------------------------------------------------------------------------

#include "MachDeps.h"

module GHC.Int (
        Int(..), Int8(..), Int16(..), Int32(..), Int64(..),
        uncheckedIShiftL64#, uncheckedIShiftRA64#,
        -- * Equality operators
        -- | See GHC.Classes#matching_overloaded_methods_in_rules
        eqInt, neInt, gtInt, geInt, ltInt, leInt,
        eqInt8, neInt8, gtInt8, geInt8, ltInt8, leInt8,
        eqInt16, neInt16, gtInt16, geInt16, ltInt16, leInt16,
        eqInt32, neInt32, gtInt32, geInt32, ltInt32, leInt32,
        eqInt64, neInt64, gtInt64, geInt64, ltInt64, leInt64
    ) where

import Data.Bits
import Data.Maybe

#if WORD_SIZE_IN_BITS < 64
import GHC.IntWord64
#endif

import GHC.Base
import GHC.Enum
import GHC.Num
import GHC.Real
import GHC.Read
import GHC.Arr
import GHC.Word hiding (uncheckedShiftL64#, uncheckedShiftRL64#)
import GHC.Show

------------------------------------------------------------------------
-- type Int8
------------------------------------------------------------------------

-- Int8 is represented in the same way as Int. Operations may assume
-- and must ensure that it holds only values from its logical range.

data {-# CTYPE "HsInt8" #-} Int8 = I8# Int#
-- ^ 8-bit signed integer type

-- See GHC.Classes#matching_overloaded_methods_in_rules
-- | @since 2.01
instance Eq Int8 where
    (==) = eqInt8
    (/=) = neInt8

eqInt8, neInt8 :: Int8 -> Int8 -> Bool
eqInt8 (I8# x) (I8# y) = isTrue# (x ==# y)
neInt8 (I8# x) (I8# y) = isTrue# (x /=# y)
{-# INLINE [1] eqInt8 #-}
{-# INLINE [1] neInt8 #-}

-- | @since 2.01
instance Ord Int8 where
    (<)  = ltInt8
    (<=) = leInt8
    (>=) = geInt8
    (>)  = gtInt8

{-# INLINE [1] gtInt8 #-}
{-# INLINE [1] geInt8 #-}
{-# INLINE [1] ltInt8 #-}
{-# INLINE [1] leInt8 #-}
gtInt8, geInt8, ltInt8, leInt8 :: Int8 -> Int8 -> Bool
(I8# x) `gtInt8` (I8# y) = isTrue# (x >#  y)
(I8# x) `geInt8` (I8# y) = isTrue# (x >=# y)
(I8# x) `ltInt8` (I8# y) = isTrue# (x <#  y)
(I8# x) `leInt8` (I8# y) = isTrue# (x <=# y)

-- | @since 2.01
instance Show Int8 where
    showsPrec p x = showsPrec p (fromIntegral x :: Int)

-- | @since 2.01
instance Num Int8 where
    (I8# x#) + (I8# y#)    = I8# (narrow8Int# (x# +# y#))
    (I8# x#) - (I8# y#)    = I8# (narrow8Int# (x# -# y#))
    (I8# x#) * (I8# y#)    = I8# (narrow8Int# (x# *# y#))
    negate (I8# x#)        = I8# (narrow8Int# (negateInt# x#))
    abs x | x >= 0         = x
          | otherwise      = negate x
    signum x | x > 0       = 1
    signum 0               = 0
    signum _               = -1
    fromInteger i          = I8# (narrow8Int# (integerToInt i))

-- | @since 2.01
instance Real Int8 where
    toRational x = toInteger x % 1

-- | @since 2.01
instance Enum Int8 where
    succ x
        | x /= maxBound = x + 1
        | otherwise     = succError "Int8"
    pred x
        | x /= minBound = x - 1
        | otherwise     = predError "Int8"
    toEnum i@(I# i#)
        | i >= fromIntegral (minBound::Int8) && i <= fromIntegral (maxBound::Int8)
                        = I8# i#
        | otherwise     = toEnumError "Int8" i (minBound::Int8, maxBound::Int8)
    fromEnum (I8# x#)   = I# x#
    enumFrom            = boundedEnumFrom
    enumFromThen        = boundedEnumFromThen

-- | @since 2.01
instance Integral Int8 where
    quot    x@(I8# x#) y@(I8# y#)
        | y == 0                     = divZeroError
        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
        | otherwise                  = I8# (narrow8Int# (x# `quotInt#` y#))
    rem     (I8# x#) y@(I8# y#)
        | y == 0                     = divZeroError
        | otherwise                  = I8# (narrow8Int# (x# `remInt#` y#))
    div     x@(I8# x#) y@(I8# y#)
        | y == 0                     = divZeroError
        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
        | otherwise                  = I8# (narrow8Int# (x# `divInt#` y#))
    mod       (I8# x#) y@(I8# y#)
        | y == 0                     = divZeroError
        | otherwise                  = I8# (narrow8Int# (x# `modInt#` y#))
    quotRem x@(I8# x#) y@(I8# y#)
        | y == 0                     = divZeroError
          -- Note [Order of tests]
        | y == (-1) && x == minBound = (overflowError, 0)
        | otherwise                  = case x# `quotRemInt#` y# of
                                       (# q, r #) ->
                                           (I8# (narrow8Int# q),
                                            I8# (narrow8Int# r))
    divMod  x@(I8# x#) y@(I8# y#)
        | y == 0                     = divZeroError
          -- Note [Order of tests]
        | y == (-1) && x == minBound = (overflowError, 0)
        | otherwise                  = case x# `divModInt#` y# of
                                       (# d, m #) ->
                                           (I8# (narrow8Int# d),
                                            I8# (narrow8Int# m))
    toInteger (I8# x#)               = smallInteger x#

-- | @since 2.01
instance Bounded Int8 where
    minBound = -0x80
    maxBound =  0x7F

-- | @since 2.01
instance Ix Int8 where
    range (m,n)         = [m..n]
    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
    inRange (m,n) i     = m <= i && i <= n

-- | @since 2.01
instance Read Int8 where
    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]

-- | @since 2.01
instance Bits Int8 where
    {-# INLINE shift #-}
    {-# INLINE bit #-}
    {-# INLINE testBit #-}
    {-# INLINE popCount #-}

    (I8# x#) .&.   (I8# y#)   = I8# (word2Int# (int2Word# x# `and#` int2Word# y#))
    (I8# x#) .|.   (I8# y#)   = I8# (word2Int# (int2Word# x# `or#`  int2Word# y#))
    (I8# x#) `xor` (I8# y#)   = I8# (word2Int# (int2Word# x# `xor#` int2Word# y#))
    complement (I8# x#)       = I8# (word2Int# (not# (int2Word# x#)))
    (I8# x#) `shift` (I# i#)
        | isTrue# (i# >=# 0#) = I8# (narrow8Int# (x# `iShiftL#` i#))
        | otherwise           = I8# (x# `iShiftRA#` negateInt# i#)
    (I8# x#) `shiftL`       (I# i#)
        | isTrue# (i# >=# 0#) = I8# (narrow8Int# (x# `iShiftL#` i#))
        | otherwise           = overflowError
    (I8# x#) `unsafeShiftL` (I# i#) = I8# (narrow8Int# (x# `uncheckedIShiftL#` i#))
    (I8# x#) `shiftR`       (I# i#)
        | isTrue# (i# >=# 0#) = I8# (x# `iShiftRA#` i#)
        | otherwise           = overflowError
    (I8# x#) `unsafeShiftR` (I# i#) = I8# (x# `uncheckedIShiftRA#` i#)
    (I8# x#) `rotate` (I# i#)
        | isTrue# (i'# ==# 0#)
        = I8# x#
        | otherwise
        = I8# (narrow8Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                                       (x'# `uncheckedShiftRL#` (8# -# i'#)))))
        where
        !x'# = narrow8Word# (int2Word# x#)
        !i'# = word2Int# (int2Word# i# `and#` 7##)
    bitSizeMaybe i            = Just (finiteBitSize i)
    bitSize i                 = finiteBitSize i
    isSigned _                = True
    popCount (I8# x#)         = I# (word2Int# (popCnt8# (int2Word# x#)))
    bit                       = bitDefault
    testBit                   = testBitDefault

-- | @since 4.6.0.0
instance FiniteBits Int8 where
    {-# INLINE countLeadingZeros #-}
    {-# INLINE countTrailingZeros #-}
    finiteBitSize _ = 8
    countLeadingZeros  (I8# x#) = I# (word2Int# (clz8# (int2Word# x#)))
    countTrailingZeros (I8# x#) = I# (word2Int# (ctz8# (int2Word# x#)))

{-# RULES
"fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8
"fromIntegral/a->Int8"    fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (narrow8Int# x#)
"fromIntegral/Int8->a"    fromIntegral = \(I8# x#) -> fromIntegral (I# x#)
  #-}

{-# RULES
"properFraction/Float->(Int8,Float)"
    properFraction = \x ->
                      case properFraction x of {
                        (n, y) -> ((fromIntegral :: Int -> Int8) n, y :: Float) }
"truncate/Float->Int8"
    truncate = (fromIntegral :: Int -> Int8) . (truncate :: Float -> Int)
"floor/Float->Int8"
    floor    = (fromIntegral :: Int -> Int8) . (floor :: Float -> Int)
"ceiling/Float->Int8"
    ceiling  = (fromIntegral :: Int -> Int8) . (ceiling :: Float -> Int)
"round/Float->Int8"
    round    = (fromIntegral :: Int -> Int8) . (round  :: Float -> Int)
  #-}

{-# RULES
"properFraction/Double->(Int8,Double)"
    properFraction = \x ->
                      case properFraction x of {
                        (n, y) -> ((fromIntegral :: Int -> Int8) n, y :: Double) }
"truncate/Double->Int8"
    truncate = (fromIntegral :: Int -> Int8) . (truncate :: Double -> Int)
"floor/Double->Int8"
    floor    = (fromIntegral :: Int -> Int8) . (floor :: Double -> Int)
"ceiling/Double->Int8"
    ceiling  = (fromIntegral :: Int -> Int8) . (ceiling :: Double -> Int)
"round/Double->Int8"
    round    = (fromIntegral :: Int -> Int8) . (round  :: Double -> Int)
  #-}

------------------------------------------------------------------------
-- type Int16
------------------------------------------------------------------------

-- Int16 is represented in the same way as Int. Operations may assume
-- and must ensure that it holds only values from its logical range.

data {-# CTYPE "HsInt16" #-} Int16 = I16# Int#
-- ^ 16-bit signed integer type

-- See GHC.Classes#matching_overloaded_methods_in_rules
-- | @since 2.01
instance Eq Int16 where
    (==) = eqInt16
    (/=) = neInt16

eqInt16, neInt16 :: Int16 -> Int16 -> Bool
eqInt16 (I16# x) (I16# y) = isTrue# (x ==# y)
neInt16 (I16# x) (I16# y) = isTrue# (x /=# y)
{-# INLINE [1] eqInt16 #-}
{-# INLINE [1] neInt16 #-}

-- | @since 2.01
instance Ord Int16 where
    (<)  = ltInt16
    (<=) = leInt16
    (>=) = geInt16
    (>)  = gtInt16

{-# INLINE [1] gtInt16 #-}
{-# INLINE [1] geInt16 #-}
{-# INLINE [1] ltInt16 #-}
{-# INLINE [1] leInt16 #-}
gtInt16, geInt16, ltInt16, leInt16 :: Int16 -> Int16 -> Bool
(I16# x) `gtInt16` (I16# y) = isTrue# (x >#  y)
(I16# x) `geInt16` (I16# y) = isTrue# (x >=# y)
(I16# x) `ltInt16` (I16# y) = isTrue# (x <#  y)
(I16# x) `leInt16` (I16# y) = isTrue# (x <=# y)

-- | @since 2.01
instance Show Int16 where
    showsPrec p x = showsPrec p (fromIntegral x :: Int)

-- | @since 2.01
instance Num Int16 where
    (I16# x#) + (I16# y#)  = I16# (narrow16Int# (x# +# y#))
    (I16# x#) - (I16# y#)  = I16# (narrow16Int# (x# -# y#))
    (I16# x#) * (I16# y#)  = I16# (narrow16Int# (x# *# y#))
    negate (I16# x#)       = I16# (narrow16Int# (negateInt# x#))
    abs x | x >= 0         = x
          | otherwise      = negate x
    signum x | x > 0       = 1
    signum 0               = 0
    signum _               = -1
    fromInteger i          = I16# (narrow16Int# (integerToInt i))

-- | @since 2.01
instance Real Int16 where
    toRational x = toInteger x % 1

-- | @since 2.01
instance Enum Int16 where
    succ x
        | x /= maxBound = x + 1
        | otherwise     = succError "Int16"
    pred x
        | x /= minBound = x - 1
        | otherwise     = predError "Int16"
    toEnum i@(I# i#)
        | i >= fromIntegral (minBound::Int16) && i <= fromIntegral (maxBound::Int16)
                        = I16# i#
        | otherwise     = toEnumError "Int16" i (minBound::Int16, maxBound::Int16)
    fromEnum (I16# x#)  = I# x#
    enumFrom            = boundedEnumFrom
    enumFromThen        = boundedEnumFromThen

-- | @since 2.01
instance Integral Int16 where
    quot    x@(I16# x#) y@(I16# y#)
        | y == 0                     = divZeroError
        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
        | otherwise                  = I16# (narrow16Int# (x# `quotInt#` y#))
    rem       (I16# x#) y@(I16# y#)
        | y == 0                     = divZeroError
        | otherwise                  = I16# (narrow16Int# (x# `remInt#` y#))
    div     x@(I16# x#) y@(I16# y#)
        | y == 0                     = divZeroError
        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
        | otherwise                  = I16# (narrow16Int# (x# `divInt#` y#))
    mod       (I16# x#) y@(I16# y#)
        | y == 0                     = divZeroError
        | otherwise                  = I16# (narrow16Int# (x# `modInt#` y#))
    quotRem x@(I16# x#) y@(I16# y#)
        | y == 0                     = divZeroError
          -- Note [Order of tests]
        | y == (-1) && x == minBound = (overflowError, 0)
        | otherwise                  = case x# `quotRemInt#` y# of
                                       (# q, r #) ->
                                           (I16# (narrow16Int# q),
                                            I16# (narrow16Int# r))
    divMod  x@(I16# x#) y@(I16# y#)
        | y == 0                     = divZeroError
          -- Note [Order of tests]
        | y == (-1) && x == minBound = (overflowError, 0)
        | otherwise                  = case x# `divModInt#` y# of
                                       (# d, m #) ->
                                           (I16# (narrow16Int# d),
                                            I16# (narrow16Int# m))
    toInteger (I16# x#)              = smallInteger x#

-- | @since 2.01
instance Bounded Int16 where
    minBound = -0x8000
    maxBound =  0x7FFF

-- | @since 2.01
instance Ix Int16 where
    range (m,n)         = [m..n]
    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
    inRange (m,n) i     = m <= i && i <= n

-- | @since 2.01
instance Read Int16 where
    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]

-- | @since 2.01
instance Bits Int16 where
    {-# INLINE shift #-}
    {-# INLINE bit #-}
    {-# INLINE testBit #-}
    {-# INLINE popCount #-}

    (I16# x#) .&.   (I16# y#)  = I16# (word2Int# (int2Word# x# `and#` int2Word# y#))
    (I16# x#) .|.   (I16# y#)  = I16# (word2Int# (int2Word# x# `or#`  int2Word# y#))
    (I16# x#) `xor` (I16# y#)  = I16# (word2Int# (int2Word# x# `xor#` int2Word# y#))
    complement (I16# x#)       = I16# (word2Int# (not# (int2Word# x#)))
    (I16# x#) `shift` (I# i#)
        | isTrue# (i# >=# 0#)  = I16# (narrow16Int# (x# `iShiftL#` i#))
        | otherwise            = I16# (x# `iShiftRA#` negateInt# i#)
    (I16# x#) `shiftL`       (I# i#)
        | isTrue# (i# >=# 0#)  = I16# (narrow16Int# (x# `iShiftL#` i#))
        | otherwise            = overflowError
    (I16# x#) `unsafeShiftL` (I# i#) = I16# (narrow16Int# (x# `uncheckedIShiftL#` i#))
    (I16# x#) `shiftR`       (I# i#)
        | isTrue# (i# >=# 0#)  = I16# (x# `iShiftRA#` i#)
        | otherwise            = overflowError
    (I16# x#) `unsafeShiftR` (I# i#) = I16# (x# `uncheckedIShiftRA#` i#)
    (I16# x#) `rotate` (I# i#)
        | isTrue# (i'# ==# 0#)
        = I16# x#
        | otherwise
        = I16# (narrow16Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                                         (x'# `uncheckedShiftRL#` (16# -# i'#)))))
        where
        !x'# = narrow16Word# (int2Word# x#)
        !i'# = word2Int# (int2Word# i# `and#` 15##)
    bitSizeMaybe i             = Just (finiteBitSize i)
    bitSize i                  = finiteBitSize i
    isSigned _                 = True
    popCount (I16# x#)         = I# (word2Int# (popCnt16# (int2Word# x#)))
    bit                        = bitDefault
    testBit                    = testBitDefault

-- | @since 4.6.0.0
instance FiniteBits Int16 where
    {-# INLINE countLeadingZeros #-}
    {-# INLINE countTrailingZeros #-}
    finiteBitSize _ = 16
    countLeadingZeros  (I16# x#) = I# (word2Int# (clz16# (int2Word# x#)))
    countTrailingZeros (I16# x#) = I# (word2Int# (ctz16# (int2Word# x#)))

{-# RULES
"fromIntegral/Word8->Int16"  fromIntegral = \(W8# x#) -> I16# (word2Int# x#)
"fromIntegral/Int8->Int16"   fromIntegral = \(I8# x#) -> I16# x#
"fromIntegral/Int16->Int16"  fromIntegral = id :: Int16 -> Int16
"fromIntegral/a->Int16"      fromIntegral = \x -> case fromIntegral x of I# x# -> I16# (narrow16Int# x#)
"fromIntegral/Int16->a"      fromIntegral = \(I16# x#) -> fromIntegral (I# x#)
  #-}

{-# RULES
"properFraction/Float->(Int16,Float)"
    properFraction = \x ->
                      case properFraction x of {
                        (n, y) -> ((fromIntegral :: Int -> Int16) n, y :: Float) }
"truncate/Float->Int16"
    truncate = (fromIntegral :: Int -> Int16) . (truncate :: Float -> Int)
"floor/Float->Int16"
    floor    = (fromIntegral :: Int -> Int16) . (floor :: Float -> Int)
"ceiling/Float->Int16"
    ceiling  = (fromIntegral :: Int -> Int16) . (ceiling :: Float -> Int)
"round/Float->Int16"
    round    = (fromIntegral :: Int -> Int16) . (round  :: Float -> Int)
  #-}

{-# RULES
"properFraction/Double->(Int16,Double)"
    properFraction = \x ->
                      case properFraction x of {
                        (n, y) -> ((fromIntegral :: Int -> Int16) n, y :: Double) }
"truncate/Double->Int16"
    truncate = (fromIntegral :: Int -> Int16) . (truncate :: Double -> Int)
"floor/Double->Int16"
    floor    = (fromIntegral :: Int -> Int16) . (floor :: Double -> Int)
"ceiling/Double->Int16"
    ceiling  = (fromIntegral :: Int -> Int16) . (ceiling :: Double -> Int)
"round/Double->Int16"
    round    = (fromIntegral :: Int -> Int16) . (round  :: Double -> Int)
  #-}

------------------------------------------------------------------------
-- type Int32
------------------------------------------------------------------------

-- Int32 is represented in the same way as Int.
#if WORD_SIZE_IN_BITS > 32
-- Operations may assume and must ensure that it holds only values
-- from its logical range.
#endif

data {-# CTYPE "HsInt32" #-} Int32 = I32# Int#
-- ^ 32-bit signed integer type

-- See GHC.Classes#matching_overloaded_methods_in_rules
-- | @since 2.01
instance Eq Int32 where
    (==) = eqInt32
    (/=) = neInt32

eqInt32, neInt32 :: Int32 -> Int32 -> Bool
eqInt32 (I32# x) (I32# y) = isTrue# (x ==# y)
neInt32 (I32# x) (I32# y) = isTrue# (x /=# y)
{-# INLINE [1] eqInt32 #-}
{-# INLINE [1] neInt32 #-}

-- | @since 2.01
instance Ord Int32 where
    (<)  = ltInt32
    (<=) = leInt32
    (>=) = geInt32
    (>)  = gtInt32

{-# INLINE [1] gtInt32 #-}
{-# INLINE [1] geInt32 #-}
{-# INLINE [1] ltInt32 #-}
{-# INLINE [1] leInt32 #-}
gtInt32, geInt32, ltInt32, leInt32 :: Int32 -> Int32 -> Bool
(I32# x) `gtInt32` (I32# y) = isTrue# (x >#  y)
(I32# x) `geInt32` (I32# y) = isTrue# (x >=# y)
(I32# x) `ltInt32` (I32# y) = isTrue# (x <#  y)
(I32# x) `leInt32` (I32# y) = isTrue# (x <=# y)

-- | @since 2.01
instance Show Int32 where
    showsPrec p x = showsPrec p (fromIntegral x :: Int)

-- | @since 2.01
instance Num Int32 where
    (I32# x#) + (I32# y#)  = I32# (narrow32Int# (x# +# y#))
    (I32# x#) - (I32# y#)  = I32# (narrow32Int# (x# -# y#))
    (I32# x#) * (I32# y#)  = I32# (narrow32Int# (x# *# y#))
    negate (I32# x#)       = I32# (narrow32Int# (negateInt# x#))
    abs x | x >= 0         = x
          | otherwise      = negate x
    signum x | x > 0       = 1
    signum 0               = 0
    signum _               = -1
    fromInteger i          = I32# (narrow32Int# (integerToInt i))

-- | @since 2.01
instance Enum Int32 where
    succ x
        | x /= maxBound = x + 1
        | otherwise     = succError "Int32"
    pred x
        | x /= minBound = x - 1
        | otherwise     = predError "Int32"
#if WORD_SIZE_IN_BITS == 32
    toEnum (I# i#)      = I32# i#
#else
    toEnum i@(I# i#)
        | i >= fromIntegral (minBound::Int32) && i <= fromIntegral (maxBound::Int32)
                        = I32# i#
        | otherwise     = toEnumError "Int32" i (minBound::Int32, maxBound::Int32)
#endif
    fromEnum (I32# x#)  = I# x#
    enumFrom            = boundedEnumFrom
    enumFromThen        = boundedEnumFromThen

-- | @since 2.01
instance Integral Int32 where
    quot    x@(I32# x#) y@(I32# y#)
        | y == 0                     = divZeroError
        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
        | otherwise                  = I32# (narrow32Int# (x# `quotInt#` y#))
    rem       (I32# x#) y@(I32# y#)
        | y == 0                     = divZeroError
          -- The quotRem CPU instruction fails for minBound `quotRem` -1,
          -- but minBound `rem` -1 is well-defined (0). We therefore
          -- special-case it.
        | y == (-1)                  = 0
        | otherwise                  = I32# (narrow32Int# (x# `remInt#` y#))
    div     x@(I32# x#) y@(I32# y#)
        | y == 0                     = divZeroError
        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
        | otherwise                  = I32# (narrow32Int# (x# `divInt#` y#))
    mod       (I32# x#) y@(I32# y#)
        | y == 0                     = divZeroError
          -- The divMod CPU instruction fails for minBound `divMod` -1,
          -- but minBound `mod` -1 is well-defined (0). We therefore
          -- special-case it.
        | y == (-1)                  = 0
        | otherwise                  = I32# (narrow32Int# (x# `modInt#` y#))
    quotRem x@(I32# x#) y@(I32# y#)
        | y == 0                     = divZeroError
          -- Note [Order of tests]
        | y == (-1) && x == minBound = (overflowError, 0)
        | otherwise                  = case x# `quotRemInt#` y# of
                                       (# q, r #) ->
                                           (I32# (narrow32Int# q),
                                            I32# (narrow32Int# r))
    divMod  x@(I32# x#) y@(I32# y#)
        | y == 0                     = divZeroError
          -- Note [Order of tests]
        | y == (-1) && x == minBound = (overflowError, 0)
        | otherwise                  = case x# `divModInt#` y# of
                                       (# d, m #) ->
                                           (I32# (narrow32Int# d),
                                            I32# (narrow32Int# m))
    toInteger (I32# x#)              = smallInteger x#

-- | @since 2.01
instance Read Int32 where
    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]

-- | @since 2.01
instance Bits Int32 where
    {-# INLINE shift #-}
    {-# INLINE bit #-}
    {-# INLINE testBit #-}
    {-# INLINE popCount #-}

    (I32# x#) .&.   (I32# y#)  = I32# (word2Int# (int2Word# x# `and#` int2Word# y#))
    (I32# x#) .|.   (I32# y#)  = I32# (word2Int# (int2Word# x# `or#`  int2Word# y#))
    (I32# x#) `xor` (I32# y#)  = I32# (word2Int# (int2Word# x# `xor#` int2Word# y#))
    complement (I32# x#)       = I32# (word2Int# (not# (int2Word# x#)))
    (I32# x#) `shift` (I# i#)
        | isTrue# (i# >=# 0#)  = I32# (narrow32Int# (x# `iShiftL#` i#))
        | otherwise            = I32# (x# `iShiftRA#` negateInt# i#)
    (I32# x#) `shiftL`       (I# i#)
        | isTrue# (i# >=# 0#)  = I32# (narrow32Int# (x# `iShiftL#` i#))
        | otherwise            = overflowError
    (I32# x#) `unsafeShiftL` (I# i#) =
        I32# (narrow32Int# (x# `uncheckedIShiftL#` i#))
    (I32# x#) `shiftR`       (I# i#)
        | isTrue# (i# >=# 0#)  = I32# (x# `iShiftRA#` i#)
        | otherwise            = overflowError
    (I32# x#) `unsafeShiftR` (I# i#) = I32# (x# `uncheckedIShiftRA#` i#)
    (I32# x#) `rotate` (I# i#)
        | isTrue# (i'# ==# 0#)
        = I32# x#
        | otherwise
        = I32# (narrow32Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                                         (x'# `uncheckedShiftRL#` (32# -# i'#)))))
        where
        !x'# = narrow32Word# (int2Word# x#)
        !i'# = word2Int# (int2Word# i# `and#` 31##)
    bitSizeMaybe i             = Just (finiteBitSize i)
    bitSize i                  = finiteBitSize i
    isSigned _                 = True
    popCount (I32# x#)         = I# (word2Int# (popCnt32# (int2Word# x#)))
    bit                        = bitDefault
    testBit                    = testBitDefault

-- | @since 4.6.0.0
instance FiniteBits Int32 where
    {-# INLINE countLeadingZeros #-}
    {-# INLINE countTrailingZeros #-}
    finiteBitSize _ = 32
    countLeadingZeros  (I32# x#) = I# (word2Int# (clz32# (int2Word# x#)))
    countTrailingZeros (I32# x#) = I# (word2Int# (ctz32# (int2Word# x#)))

{-# RULES
"fromIntegral/Word8->Int32"  fromIntegral = \(W8# x#) -> I32# (word2Int# x#)
"fromIntegral/Word16->Int32" fromIntegral = \(W16# x#) -> I32# (word2Int# x#)
"fromIntegral/Int8->Int32"   fromIntegral = \(I8# x#) -> I32# x#
"fromIntegral/Int16->Int32"  fromIntegral = \(I16# x#) -> I32# x#
"fromIntegral/Int32->Int32"  fromIntegral = id :: Int32 -> Int32
"fromIntegral/a->Int32"      fromIntegral = \x -> case fromIntegral x of I# x# -> I32# (narrow32Int# x#)
"fromIntegral/Int32->a"      fromIntegral = \(I32# x#) -> fromIntegral (I# x#)
  #-}

{-# RULES
"properFraction/Float->(Int32,Float)"
    properFraction = \x ->
                      case properFraction x of {
                        (n, y) -> ((fromIntegral :: Int -> Int32) n, y :: Float) }
"truncate/Float->Int32"
    truncate = (fromIntegral :: Int -> Int32) . (truncate :: Float -> Int)
"floor/Float->Int32"
    floor    = (fromIntegral :: Int -> Int32) . (floor :: Float -> Int)
"ceiling/Float->Int32"
    ceiling  = (fromIntegral :: Int -> Int32) . (ceiling :: Float -> Int)
"round/Float->Int32"
    round    = (fromIntegral :: Int -> Int32) . (round  :: Float -> Int)
  #-}

{-# RULES
"properFraction/Double->(Int32,Double)"
    properFraction = \x ->
                      case properFraction x of {
                        (n, y) -> ((fromIntegral :: Int -> Int32) n, y :: Double) }
"truncate/Double->Int32"
    truncate = (fromIntegral :: Int -> Int32) . (truncate :: Double -> Int)
"floor/Double->Int32"
    floor    = (fromIntegral :: Int -> Int32) . (floor :: Double -> Int)
"ceiling/Double->Int32"
    ceiling  = (fromIntegral :: Int -> Int32) . (ceiling :: Double -> Int)
"round/Double->Int32"
    round    = (fromIntegral :: Int -> Int32) . (round  :: Double -> Int)
  #-}

-- | @since 2.01
instance Real Int32 where
    toRational x = toInteger x % 1

-- | @since 2.01
instance Bounded Int32 where
    minBound = -0x80000000
    maxBound =  0x7FFFFFFF

-- | @since 2.01
instance Ix Int32 where
    range (m,n)         = [m..n]
    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
    inRange (m,n) i     = m <= i && i <= n

------------------------------------------------------------------------
-- type Int64
------------------------------------------------------------------------

#if WORD_SIZE_IN_BITS < 64

data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64#
-- ^ 64-bit signed integer type

-- See GHC.Classes#matching_overloaded_methods_in_rules
-- | @since 2.01
instance Eq Int64 where
    (==) = eqInt64
    (/=) = neInt64

eqInt64, neInt64 :: Int64 -> Int64 -> Bool
eqInt64 (I64# x) (I64# y) = isTrue# (x `eqInt64#` y)
neInt64 (I64# x) (I64# y) = isTrue# (x `neInt64#` y)
{-# INLINE [1] eqInt64 #-}
{-# INLINE [1] neInt64 #-}

-- | @since 2.01
instance Ord Int64 where
    (<)  = ltInt64
    (<=) = leInt64
    (>=) = geInt64
    (>)  = gtInt64

{-# INLINE [1] gtInt64 #-}
{-# INLINE [1] geInt64 #-}
{-# INLINE [1] ltInt64 #-}
{-# INLINE [1] leInt64 #-}
gtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool
(I64# x) `gtInt64` (I64# y) = isTrue# (x `gtInt64#` y)
(I64# x) `geInt64` (I64# y) = isTrue# (x `geInt64#` y)
(I64# x) `ltInt64` (I64# y) = isTrue# (x `ltInt64#` y)
(I64# x) `leInt64` (I64# y) = isTrue# (x `leInt64#` y)

-- | @since 2.01
instance Show Int64 where
    showsPrec p x = showsPrec p (toInteger x)

-- | @since 2.01
instance Num Int64 where
    (I64# x#) + (I64# y#)  = I64# (x# `plusInt64#`  y#)
    (I64# x#) - (I64# y#)  = I64# (x# `minusInt64#` y#)
    (I64# x#) * (I64# y#)  = I64# (x# `timesInt64#` y#)
    negate (I64# x#)       = I64# (negateInt64# x#)
    abs x | x >= 0         = x
          | otherwise      = negate x
    signum x | x > 0       = 1
    signum 0               = 0
    signum _               = -1
    fromInteger i          = I64# (integerToInt64 i)

-- | @since 2.01
instance Enum Int64 where
    succ x
        | x /= maxBound = x + 1
        | otherwise     = succError "Int64"
    pred x
        | x /= minBound = x - 1
        | otherwise     = predError "Int64"
    toEnum (I# i#)      = I64# (intToInt64# i#)
    fromEnum x@(I64# x#)
        | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)
                        = I# (int64ToInt# x#)
        | otherwise     = fromEnumError "Int64" x
    enumFrom            = integralEnumFrom
    enumFromThen        = integralEnumFromThen
    enumFromTo          = integralEnumFromTo
    enumFromThenTo      = integralEnumFromThenTo

-- | @since 2.01
instance Integral Int64 where
    quot    x@(I64# x#) y@(I64# y#)
        | y == 0                     = divZeroError
        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
        | otherwise                  = I64# (x# `quotInt64#` y#)
    rem       (I64# x#) y@(I64# y#)
        | y == 0                     = divZeroError
          -- The quotRem CPU instruction fails for minBound `quotRem` -1,
          -- but minBound `rem` -1 is well-defined (0). We therefore
          -- special-case it.
        | y == (-1)                  = 0
        | otherwise                  = I64# (x# `remInt64#` y#)
    div     x@(I64# x#) y@(I64# y#)
        | y == 0                     = divZeroError
        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
        | otherwise                  = I64# (x# `divInt64#` y#)
    mod       (I64# x#) y@(I64# y#)
        | y == 0                     = divZeroError
          -- The divMod CPU instruction fails for minBound `divMod` -1,
          -- but minBound `mod` -1 is well-defined (0). We therefore
          -- special-case it.
        | y == (-1)                  = 0
        | otherwise                  = I64# (x# `modInt64#` y#)
    quotRem x@(I64# x#) y@(I64# y#)
        | y == 0                     = divZeroError
          -- Note [Order of tests]
        | y == (-1) && x == minBound = (overflowError, 0)
        | otherwise                  = (I64# (x# `quotInt64#` y#),
                                        I64# (x# `remInt64#` y#))
    divMod  x@(I64# x#) y@(I64# y#)
        | y == 0                     = divZeroError
          -- Note [Order of tests]
        | y == (-1) && x == minBound = (overflowError, 0)
        | otherwise                  = (I64# (x# `divInt64#` y#),
                                        I64# (x# `modInt64#` y#))
    toInteger (I64# x)               = int64ToInteger x

divInt64#, modInt64# :: Int64# -> Int64# -> Int64#

-- Define div in terms of quot, being careful to avoid overflow (#7233)
x# `divInt64#` y#
    | isTrue# (x# `gtInt64#` zero) && isTrue# (y# `ltInt64#` zero)
        = ((x# `minusInt64#` one) `quotInt64#` y#) `minusInt64#` one
    | isTrue# (x# `ltInt64#` zero) && isTrue# (y# `gtInt64#` zero)
        = ((x# `plusInt64#` one)  `quotInt64#` y#) `minusInt64#` one
    | otherwise
        = x# `quotInt64#` y#
    where
    !zero = intToInt64# 0#
    !one  = intToInt64# 1#

x# `modInt64#` y#
    | isTrue# (x# `gtInt64#` zero) && isTrue# (y# `ltInt64#` zero) ||
      isTrue# (x# `ltInt64#` zero) && isTrue# (y# `gtInt64#` zero)
        = if isTrue# (r# `neInt64#` zero) then r# `plusInt64#` y# else zero
    | otherwise = r#
    where
    !zero = intToInt64# 0#
    !r# = x# `remInt64#` y#

-- | @since 2.01
instance Read Int64 where
    readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]

-- | @since 2.01
instance Bits Int64 where
    {-# INLINE shift #-}
    {-# INLINE bit #-}
    {-# INLINE testBit #-}
    {-# INLINE popCount #-}

    (I64# x#) .&.   (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `and64#` int64ToWord64# y#))
    (I64# x#) .|.   (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `or64#`  int64ToWord64# y#))
    (I64# x#) `xor` (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `xor64#` int64ToWord64# y#))
    complement (I64# x#)       = I64# (word64ToInt64# (not64# (int64ToWord64# x#)))
    (I64# x#) `shift` (I# i#)
        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL64#` i#)
        | otherwise            = I64# (x# `iShiftRA64#` negateInt# i#)
    (I64# x#) `shiftL` (I# i#)
        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL64#` i#)
        | otherwise            = overflowError
    (I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL64#` i#)
    (I64# x#) `shiftR` (I# i#)
        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftRA64#` i#)
        | otherwise            = overflowError
    (I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA64#` i#)
    (I64# x#) `rotate` (I# i#)
        | isTrue# (i'# ==# 0#)
        = I64# x#
        | otherwise
        = I64# (word64ToInt64# ((x'# `uncheckedShiftL64#` i'#) `or64#`
                                (x'# `uncheckedShiftRL64#` (64# -# i'#))))
        where
        !x'# = int64ToWord64# x#
        !i'# = word2Int# (int2Word# i# `and#` 63##)
    bitSizeMaybe i             = Just (finiteBitSize i)
    bitSize i                  = finiteBitSize i
    isSigned _                 = True
    popCount (I64# x#)         =
        I# (word2Int# (popCnt64# (int64ToWord64# x#)))
    bit                        = bitDefault
    testBit                    = testBitDefault

-- give the 64-bit shift operations the same treatment as the 32-bit
-- ones (see GHC.Base), namely we wrap them in tests to catch the
-- cases when we're shifting more than 64 bits to avoid unspecified
-- behaviour in the C shift operations.

iShiftL64#, iShiftRA64# :: Int64# -> Int# -> Int64#

a `iShiftL64#` b  | isTrue# (b >=# 64#) = intToInt64# 0#
                  | otherwise           = a `uncheckedIShiftL64#` b

a `iShiftRA64#` b | isTrue# (b >=# 64#) = if isTrue# (a `ltInt64#` (intToInt64# 0#))
                                          then intToInt64# (-1#)
                                          else intToInt64# 0#
                  | otherwise = a `uncheckedIShiftRA64#` b

{-# RULES
"fromIntegral/Int->Int64"    fromIntegral = \(I#   x#) -> I64# (intToInt64# x#)
"fromIntegral/Word->Int64"   fromIntegral = \(W#   x#) -> I64# (word64ToInt64# (wordToWord64# x#))
"fromIntegral/Word64->Int64" fromIntegral = \(W64# x#) -> I64# (word64ToInt64# x#)
"fromIntegral/Int64->Int"    fromIntegral = \(I64# x#) -> I#   (int64ToInt# x#)
"fromIntegral/Int64->Word"   fromIntegral = \(I64# x#) -> W#   (int2Word# (int64ToInt# x#))
"fromIntegral/Int64->Word64" fromIntegral = \(I64# x#) -> W64# (int64ToWord64# x#)
"fromIntegral/Int64->Int64"  fromIntegral = id :: Int64 -> Int64
  #-}

-- No RULES for RealFrac methods if Int is smaller than Int64, we can't
-- go through Int and whether going through Integer is faster is uncertain.
#else

-- Int64 is represented in the same way as Int.
-- Operations may assume and must ensure that it holds only values
-- from its logical range.

data {-# CTYPE "HsInt64" #-} Int64 = I64# Int#
-- ^ 64-bit signed integer type

-- See GHC.Classes#matching_overloaded_methods_in_rules
-- | @since 2.01
instance Eq Int64 where
    (==) = eqInt64
    (/=) = neInt64

eqInt64, neInt64 :: Int64 -> Int64 -> Bool
eqInt64 (I64# x) (I64# y) = isTrue# (x ==# y)
neInt64 (I64# x) (I64# y) = isTrue# (x /=# y)
{-# INLINE [1] eqInt64 #-}
{-# INLINE [1] neInt64 #-}

-- | @since 2.01
instance Ord Int64 where
    (<)  = ltInt64
    (<=) = leInt64
    (>=) = geInt64
    (>)  = gtInt64

{-# INLINE [1] gtInt64 #-}
{-# INLINE [1] geInt64 #-}
{-# INLINE [1] ltInt64 #-}
{-# INLINE [1] leInt64 #-}
gtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool
(I64# x) `gtInt64` (I64# y) = isTrue# (x >#  y)
(I64# x) `geInt64` (I64# y) = isTrue# (x >=# y)
(I64# x) `ltInt64` (I64# y) = isTrue# (x <#  y)
(I64# x) `leInt64` (I64# y) = isTrue# (x <=# y)

-- | @since 2.01
instance Show Int64 where
    showsPrec p x = showsPrec p (fromIntegral x :: Int)

-- | @since 2.01
instance Num Int64 where
    (I64# x#) + (I64# y#)  = I64# (x# +# y#)
    (I64# x#) - (I64# y#)  = I64# (x# -# y#)
    (I64# x#) * (I64# y#)  = I64# (x# *# y#)
    negate (I64# x#)       = I64# (negateInt# x#)
    abs x | x >= 0         = x
          | otherwise      = negate x
    signum x | x > 0       = 1
    signum 0               = 0
    signum _               = -1
    fromInteger i          = I64# (integerToInt i)

-- | @since 2.01
instance Enum Int64 where
    succ x
        | x /= maxBound = x + 1
        | otherwise     = succError "Int64"
    pred x
        | x /= minBound = x - 1
        | otherwise     = predError "Int64"
    toEnum (I# i#)      = I64# i#
    fromEnum (I64# x#)  = I# x#
    enumFrom            = boundedEnumFrom
    enumFromThen        = boundedEnumFromThen

-- | @since 2.01
instance Integral Int64 where
    quot    x@(I64# x#) y@(I64# y#)
        | y == 0                     = divZeroError
        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
        | otherwise                  = I64# (x# `quotInt#` y#)
    rem       (I64# x#) y@(I64# y#)
        | y == 0                     = divZeroError
          -- The quotRem CPU instruction fails for minBound `quotRem` -1,
          -- but minBound `rem` -1 is well-defined (0). We therefore
          -- special-case it.
        | y == (-1)                  = 0
        | otherwise                  = I64# (x# `remInt#` y#)
    div     x@(I64# x#) y@(I64# y#)
        | y == 0                     = divZeroError
        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
        | otherwise                  = I64# (x# `divInt#` y#)
    mod       (I64# x#) y@(I64# y#)
        | y == 0                     = divZeroError
          -- The divMod CPU instruction fails for minBound `divMod` -1,
          -- but minBound `mod` -1 is well-defined (0). We therefore
          -- special-case it.
        | y == (-1)                  = 0
        | otherwise                  = I64# (x# `modInt#` y#)
    quotRem x@(I64# x#) y@(I64# y#)
        | y == 0                     = divZeroError
          -- Note [Order of tests]
        | y == (-1) && x == minBound = (overflowError, 0)
        | otherwise                  = case x# `quotRemInt#` y# of
                                       (# q, r #) ->
                                           (I64# q, I64# r)
    divMod  x@(I64# x#) y@(I64# y#)
        | y == 0                     = divZeroError
          -- Note [Order of tests]
        | y == (-1) && x == minBound = (overflowError, 0)
        | otherwise                  = case x# `divModInt#` y# of
                                       (# d, m #) ->
                                           (I64# d, I64# m)
    toInteger (I64# x#)              = smallInteger x#

-- | @since 2.01
instance Read Int64 where
    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]

-- | @since 2.01
instance Bits Int64 where
    {-# INLINE shift #-}
    {-# INLINE bit #-}
    {-# INLINE testBit #-}
    {-# INLINE popCount #-}

    (I64# x#) .&.   (I64# y#)  = I64# (word2Int# (int2Word# x# `and#` int2Word# y#))
    (I64# x#) .|.   (I64# y#)  = I64# (word2Int# (int2Word# x# `or#`  int2Word# y#))
    (I64# x#) `xor` (I64# y#)  = I64# (word2Int# (int2Word# x# `xor#` int2Word# y#))
    complement (I64# x#)       = I64# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
    (I64# x#) `shift` (I# i#)
        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL#` i#)
        | otherwise            = I64# (x# `iShiftRA#` negateInt# i#)
    (I64# x#) `shiftL`       (I# i#)
        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL#` i#)
        | otherwise            = overflowError
    (I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL#` i#)
    (I64# x#) `shiftR`       (I# i#)
        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftRA#` i#)
        | otherwise            = overflowError
    (I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA#` i#)
    (I64# x#) `rotate` (I# i#)
        | isTrue# (i'# ==# 0#)
        = I64# x#
        | otherwise
        = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                           (x'# `uncheckedShiftRL#` (64# -# i'#))))
        where
        !x'# = int2Word# x#
        !i'# = word2Int# (int2Word# i# `and#` 63##)
    bitSizeMaybe i             = Just (finiteBitSize i)
    bitSize i                  = finiteBitSize i
    isSigned _                 = True
    popCount (I64# x#)         = I# (word2Int# (popCnt64# (int2Word# x#)))
    bit                        = bitDefault
    testBit                    = testBitDefault

{-# RULES
"fromIntegral/a->Int64" fromIntegral = \x -> case fromIntegral x of I# x# -> I64# x#
"fromIntegral/Int64->a" fromIntegral = \(I64# x#) -> fromIntegral (I# x#)
  #-}

{-# RULES
"properFraction/Float->(Int64,Float)"
    properFraction = \x ->
                      case properFraction x of {
                        (n, y) -> ((fromIntegral :: Int -> Int64) n, y :: Float) }
"truncate/Float->Int64"
    truncate = (fromIntegral :: Int -> Int64) . (truncate :: Float -> Int)
"floor/Float->Int64"
    floor    = (fromIntegral :: Int -> Int64) . (floor :: Float -> Int)
"ceiling/Float->Int64"
    ceiling  = (fromIntegral :: Int -> Int64) . (ceiling :: Float -> Int)
"round/Float->Int64"
    round    = (fromIntegral :: Int -> Int64) . (round  :: Float -> Int)
  #-}

{-# RULES
"properFraction/Double->(Int64,Double)"
    properFraction = \x ->
                      case properFraction x of {
                        (n, y) -> ((fromIntegral :: Int -> Int64) n, y :: Double) }
"truncate/Double->Int64"
    truncate = (fromIntegral :: Int -> Int64) . (truncate :: Double -> Int)
"floor/Double->Int64"
    floor    = (fromIntegral :: Int -> Int64) . (floor :: Double -> Int)
"ceiling/Double->Int64"
    ceiling  = (fromIntegral :: Int -> Int64) . (ceiling :: Double -> Int)
"round/Double->Int64"
    round    = (fromIntegral :: Int -> Int64) . (round  :: Double -> Int)
  #-}

uncheckedIShiftL64# :: Int# -> Int# -> Int#
uncheckedIShiftL64#  = uncheckedIShiftL#

uncheckedIShiftRA64# :: Int# -> Int# -> Int#
uncheckedIShiftRA64# = uncheckedIShiftRA#
#endif

-- | @since 4.6.0.0
instance FiniteBits Int64 where
    {-# INLINE countLeadingZeros #-}
    {-# INLINE countTrailingZeros #-}
    finiteBitSize _ = 64
#if WORD_SIZE_IN_BITS < 64
    countLeadingZeros  (I64# x#) = I# (word2Int# (clz64# (int64ToWord64# x#)))
    countTrailingZeros (I64# x#) = I# (word2Int# (ctz64# (int64ToWord64# x#)))
#else
    countLeadingZeros  (I64# x#) = I# (word2Int# (clz64# (int2Word# x#)))
    countTrailingZeros (I64# x#) = I# (word2Int# (ctz64# (int2Word# x#)))
#endif

-- | @since 2.01
instance Real Int64 where
    toRational x = toInteger x % 1

-- | @since 2.01
instance Bounded Int64 where
    minBound = -0x8000000000000000
    maxBound =  0x7FFFFFFFFFFFFFFF

-- | @since 2.01
instance Ix Int64 where
    range (m,n)         = [m..n]
    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
    inRange (m,n) i     = m <= i && i <= n

-------------------------------------------------------------------------------

{-# RULES
"fromIntegral/Natural->Int8"
    fromIntegral = (fromIntegral :: Int -> Int8)    . naturalToInt
"fromIntegral/Natural->Int16"
    fromIntegral = (fromIntegral :: Int -> Int16)   . naturalToInt
"fromIntegral/Natural->Int32"
    fromIntegral = (fromIntegral :: Int -> Int32)   . naturalToInt
  #-}

{-# RULES
"fromIntegral/Int8->Natural"
    fromIntegral = intToNatural  . (fromIntegral :: Int8  -> Int)
"fromIntegral/Int16->Natural"
    fromIntegral = intToNatural  . (fromIntegral :: Int16 -> Int)
"fromIntegral/Int32->Natural"
    fromIntegral = intToNatural  . (fromIntegral :: Int32 -> Int)
  #-}

#if WORD_SIZE_IN_BITS == 64
-- these RULES are valid for Word==Word64 & Int==Int64
{-# RULES
"fromIntegral/Natural->Int64"
    fromIntegral = (fromIntegral :: Int -> Int64) . naturalToInt
"fromIntegral/Int64->Natural"
    fromIntegral = intToNatural . (fromIntegral :: Int64 -> Int)
  #-}
#endif

{- Note [Order of tests]
~~~~~~~~~~~~~~~~~~~~~~~~~
(See Trac #3065, #5161.) Suppose we had a definition like:

    quot x y
     | y == 0                     = divZeroError
     | x == minBound && y == (-1) = overflowError
     | otherwise                  = x `primQuot` y

Note in particular that the
    x == minBound
test comes before the
    y == (-1)
test.

this expands to something like:

    case y of
    0 -> divZeroError
    _ -> case x of
         -9223372036854775808 ->
             case y of
             -1 -> overflowError
             _ -> x `primQuot` y
         _ -> x `primQuot` y

Now if we have the call (x `quot` 2), and quot gets inlined, then we get:

    case 2 of
    0 -> divZeroError
    _ -> case x of
         -9223372036854775808 ->
             case 2 of
             -1 -> overflowError
             _ -> x `primQuot` 2
         _ -> x `primQuot` 2

which simplifies to:

    case x of
    -9223372036854775808 -> x `primQuot` 2
    _                    -> x `primQuot` 2

Now we have a case with two identical branches, which would be
eliminated (assuming it doesn't affect strictness, which it doesn't in
this case), leaving the desired:

    x `primQuot` 2

except in the minBound branch we know what x is, and GHC cleverly does
the division at compile time, giving:

    case x of
    -9223372036854775808 -> -4611686018427387904
    _                    -> x `primQuot` 2

So instead we use a definition like:

    quot x y
     | y == 0                     = divZeroError
     | y == (-1) && x == minBound = overflowError
     | otherwise                  = x `primQuot` y

which gives us:

    case y of
    0 -> divZeroError
    -1 ->
        case x of
        -9223372036854775808 -> overflowError
        _ -> x `primQuot` y
    _ -> x `primQuot` y

for which our call (x `quot` 2) expands to:

    case 2 of
    0 -> divZeroError
    -1 ->
        case x of
        -9223372036854775808 -> overflowError
        _ -> x `primQuot` 2
    _ -> x `primQuot` 2

which simplifies to:

    x `primQuot` 2

as required.

But we now have the same problem with a constant numerator: the call
(2 `quot` y) expands to

    case y of
    0 -> divZeroError
    -1 ->
        case 2 of
        -9223372036854775808 -> overflowError
        _ -> 2 `primQuot` y
    _ -> 2 `primQuot` y

which simplifies to:

    case y of
    0 -> divZeroError
    -1 -> 2 `primQuot` y
    _ -> 2 `primQuot` y

which simplifies to:

    case y of
    0 -> divZeroError
    -1 -> -2
    _ -> 2 `primQuot` y

However, constant denominators are more common than constant numerators,
so the
    y == (-1) && x == minBound
order gives us better code in the common case.
-}


{-# LANGUAGE Unsafe #-}
{-# LANGUAGE NoImplicitPrelude
           , BangPatterns
           , RankNTypes
           , MagicHash
           , ScopedTypeVariables
           , UnboxedTuples
  #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.IO
-- Copyright   :  (c) The University of Glasgow 1994-2002
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  cvs-ghc@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- Definitions for the 'IO' monad and its friends.
--
-----------------------------------------------------------------------------

module GHC.IO (
        IO(..), unIO, failIO, liftIO, mplusIO,
        unsafePerformIO, unsafeInterleaveIO,
        unsafeDupablePerformIO, unsafeDupableInterleaveIO,
        noDuplicate,

        -- To and from from ST
        stToIO, ioToST, unsafeIOToST, unsafeSTToIO,

        FilePath,

        catch, catchException, catchAny, throwIO,
        mask, mask_, uninterruptibleMask, uninterruptibleMask_,
        MaskingState(..), getMaskingState,
        unsafeUnmask, interruptible,
        onException, bracket, finally, evaluate
    ) where

import GHC.Base
import GHC.ST
import GHC.Exception
import GHC.Show
import GHC.IO.Unsafe

import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError )

-- ---------------------------------------------------------------------------
-- The IO Monad

{-
The IO Monad is just an instance of the ST monad, where the state thread
is the real world.  We use the exception mechanism (in GHC.Exception) to
implement IO exceptions.

NOTE: The IO representation is deeply wired in to various parts of the
system.  The following list may or may not be exhaustive:

Compiler  - types of various primitives in PrimOp.hs

RTS       - forceIO (StgStartup.cmm)
          - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
            (Exception.cmm)
          - raiseAsync (RaiseAsync.c)

Prelude   - GHC.IO.hs, and several other places including
            GHC.Exception.hs.

Libraries - parts of hslibs/lang.

--SDM
-}

liftIO :: IO a -> State# RealWorld -> STret RealWorld a
liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r

failIO :: String -> IO a
failIO s = IO (raiseIO# (toException (userError s)))

-- ---------------------------------------------------------------------------
-- Coercions between IO and ST

-- | Embed a strict state thread in an 'IO'
-- action.  The 'RealWorld' parameter indicates that the internal state
-- used by the 'ST' computation is a special one supplied by the 'IO'
-- monad, and thus distinct from those used by invocations of 'runST'.
stToIO        :: ST RealWorld a -> IO a
stToIO (ST m) = IO m

-- | Convert an 'IO' action into an 'ST' action. The type of the result
-- is constrained to use a 'RealWorld' state thread, and therefore the
-- result cannot be passed to 'runST'.
ioToST        :: IO a -> ST RealWorld a
ioToST (IO m) = (ST m)

-- | Convert an 'IO' action to an 'ST' action.
-- This relies on 'IO' and 'ST' having the same representation modulo the
-- constraint on the state thread type parameter.
unsafeIOToST        :: IO a -> ST s a
unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s

-- | Convert an 'ST' action to an 'IO' action.
-- This relies on 'IO' and 'ST' having the same representation modulo the
-- constraint on the state thread type parameter.
--
-- For an example demonstrating why this is unsafe, see
-- https://mail.haskell.org/pipermail/haskell-cafe/2009-April/060719.html
unsafeSTToIO :: ST s a -> IO a
unsafeSTToIO (ST m) = IO (unsafeCoerce# m)

-- -----------------------------------------------------------------------------
-- | File and directory names are values of type 'String', whose precise
-- meaning is operating system dependent. Files can be opened, yielding a
-- handle which can then be used to operate on the contents of that file.

type FilePath = String

-- -----------------------------------------------------------------------------
-- Primitive catch and throwIO

{-
catchException/catch used to handle the passing around of the state to the
action and the handler.  This turned out to be a bad idea - it meant
that we had to wrap both arguments in thunks so they could be entered
as normal (remember IO returns an unboxed pair...).

Now catch# has type

    catch# :: IO a -> (b -> IO a) -> IO a

(well almost; the compiler doesn't know about the IO newtype so we
have to work around that in the definition of catch below).
-}

-- | Catch an exception in the 'IO' monad.
--
-- Note that this function is /strict/ in the action. That is,
-- @catchException undefined b == _|_@. See #exceptions_and_strictness#
-- for details.
catchException :: Exception e => IO a -> (e -> IO a) -> IO a
catchException !io handler = catch io handler

-- | This is the simplest of the exception-catching functions.  It
-- takes a single argument, runs it, and if an exception is raised
-- the \"handler\" is executed, with the value of the exception passed as an
-- argument.  Otherwise, the result is returned as normal.  For example:
--
-- >   catch (readFile f)
-- >         (\e -> do let err = show (e :: IOException)
-- >                   hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err)
-- >                   return "")
--
-- Note that we have to give a type signature to @e@, or the program
-- will not typecheck as the type is ambiguous. While it is possible
-- to catch exceptions of any type, see the section \"Catching all
-- exceptions\" (in "Control.Exception") for an explanation of the problems with doing so.
--
-- For catching exceptions in pure (non-'IO') expressions, see the
-- function 'evaluate'.
--
-- Note that due to Haskell\'s unspecified evaluation order, an
-- expression may throw one of several possible exceptions: consider
-- the expression @(error \"urk\") + (1 \`div\` 0)@.  Does
-- the expression throw
-- @ErrorCall \"urk\"@, or @DivideByZero@?
--
-- The answer is \"it might throw either\"; the choice is
-- non-deterministic. If you are catching any type of exception then you
-- might catch either. If you are calling @catch@ with type
-- @IO Int -> (ArithException -> IO Int) -> IO Int@ then the handler may
-- get run with @DivideByZero@ as an argument, or an @ErrorCall \"urk\"@
-- exception may be propogated further up. If you call it again, you
-- might get a the opposite behaviour. This is ok, because 'catch' is an
-- 'IO' computation.
--
catch   :: Exception e
        => IO a         -- ^ The computation to run
        -> (e -> IO a)  -- ^ Handler to invoke if an exception is raised
        -> IO a
-- See #exceptions_and_strictness#.
catch (IO io) handler = IO $ catch# io handler'
    where handler' e = case fromException e of
                       Just e' -> unIO (handler e')
                       Nothing -> raiseIO# e

-- | Catch any 'Exception' type in the 'IO' monad.
--
-- Note that this function is /strict/ in the action. That is,
-- @catchAny undefined b == _|_@. See #exceptions_and_strictness# for
-- details.
catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a
catchAny !(IO io) handler = IO $ catch# io handler'
    where handler' (SomeException e) = unIO (handler e)

-- Using catchException here means that if `m` throws an
-- 'IOError' /as an imprecise exception/, we will not catch
-- it. No one should really be doing that anyway.
mplusIO :: IO a -> IO a -> IO a
mplusIO m n = m `catchException` \ (_ :: IOError) -> n

-- | A variant of 'throw' that can only be used within the 'IO' monad.
--
-- Although 'throwIO' has a type that is an instance of the type of 'throw', the
-- two functions are subtly different:
--
-- > throw e   `seq` x  ===> throw e
-- > throwIO e `seq` x  ===> x
--
-- The first example will cause the exception @e@ to be raised,
-- whereas the second one won\'t.  In fact, 'throwIO' will only cause
-- an exception to be raised when it is used within the 'IO' monad.
-- The 'throwIO' variant should be used in preference to 'throw' to
-- raise an exception within the 'IO' monad because it guarantees
-- ordering with respect to other 'IO' operations, whereas 'throw'
-- does not.
throwIO :: Exception e => e -> IO a
throwIO e = IO (raiseIO# (toException e))

-- -----------------------------------------------------------------------------
-- Controlling asynchronous exception delivery

-- Applying 'block' to a computation will
-- execute that computation with asynchronous exceptions
-- /blocked/.  That is, any thread which
-- attempts to raise an exception in the current thread with 'Control.Exception.throwTo' will be
-- blocked until asynchronous exceptions are unblocked again.  There\'s
-- no need to worry about re-enabling asynchronous exceptions; that is
-- done automatically on exiting the scope of
-- 'block'.
--
-- Threads created by 'Control.Concurrent.forkIO' inherit the blocked
-- state from the parent; that is, to start a thread in blocked mode,
-- use @block $ forkIO ...@.  This is particularly useful if you need to
-- establish an exception handler in the forked thread before any
-- asynchronous exceptions are received.
block :: IO a -> IO a
block (IO io) = IO $ maskAsyncExceptions# io

-- To re-enable asynchronous exceptions inside the scope of
-- 'block', 'unblock' can be
-- used.  It scopes in exactly the same way, so on exit from
-- 'unblock' asynchronous exception delivery will
-- be disabled again.
unblock :: IO a -> IO a
unblock = unsafeUnmask

unsafeUnmask :: IO a -> IO a
unsafeUnmask (IO io) = IO $ unmaskAsyncExceptions# io

-- | Allow asynchronous exceptions to be raised even inside 'mask', making
-- the operation interruptible (see the discussion of "Interruptible operations"
-- in 'Control.Exception').
--
-- When called outside 'mask', or inside 'uninterruptibleMask', this
-- function has no effect.
--
-- @since 4.9.0.0
interruptible :: IO a -> IO a
interruptible act = do
  st <- getMaskingState
  case st of
    Unmasked              -> act
    MaskedInterruptible   -> unsafeUnmask act
    MaskedUninterruptible -> act

blockUninterruptible :: IO a -> IO a
blockUninterruptible (IO io) = IO $ maskUninterruptible# io

-- | Describes the behaviour of a thread when an asynchronous
-- exception is received.
data MaskingState
  = Unmasked -- ^ asynchronous exceptions are unmasked (the normal state)
  | MaskedInterruptible
      -- ^ the state during 'mask': asynchronous exceptions are masked, but blocking operations may still be interrupted
  | MaskedUninterruptible
      -- ^ the state during 'uninterruptibleMask': asynchronous exceptions are masked, and blocking operations may not be interrupted
 deriving ( Eq   -- ^ @since 4.3.0.0
          , Show -- ^ @since 4.3.0.0
          )

-- | Returns the 'MaskingState' for the current thread.
getMaskingState :: IO MaskingState
getMaskingState  = IO $ \s ->
  case getMaskingState# s of
     (# s', i #) -> (# s', case i of
                             0# -> Unmasked
                             1# -> MaskedUninterruptible
                             _  -> MaskedInterruptible #)

onException :: IO a -> IO b -> IO a
onException io what = io `catchException` \e -> do _ <- what
                                                   throwIO (e :: SomeException)

-- | Executes an IO computation with asynchronous
-- exceptions /masked/.  That is, any thread which attempts to raise
-- an exception in the current thread with 'Control.Exception.throwTo'
-- will be blocked until asynchronous exceptions are unmasked again.
--
-- The argument passed to 'mask' is a function that takes as its
-- argument another function, which can be used to restore the
-- prevailing masking state within the context of the masked
-- computation.  For example, a common way to use 'mask' is to protect
-- the acquisition of a resource:
--
-- > mask $ \restore -> do
-- >     x <- acquire
-- >     restore (do_something_with x) `onException` release
-- >     release
--
-- This code guarantees that @acquire@ is paired with @release@, by masking
-- asynchronous exceptions for the critical parts. (Rather than write
-- this code yourself, it would be better to use
-- 'Control.Exception.bracket' which abstracts the general pattern).
--
-- Note that the @restore@ action passed to the argument to 'mask'
-- does not necessarily unmask asynchronous exceptions, it just
-- restores the masking state to that of the enclosing context.  Thus
-- if asynchronous exceptions are already masked, 'mask' cannot be used
-- to unmask exceptions again.  This is so that if you call a library function
-- with exceptions masked, you can be sure that the library call will not be
-- able to unmask exceptions again.  If you are writing library code and need
-- to use asynchronous exceptions, the only way is to create a new thread;
-- see 'Control.Concurrent.forkIOWithUnmask'.
--
-- Asynchronous exceptions may still be received while in the masked
-- state if the masked thread /blocks/ in certain ways; see
-- "Control.Exception#interruptible".
--
-- Threads created by 'Control.Concurrent.forkIO' inherit the
-- 'MaskingState' from the parent; that is, to start a thread in the
-- 'MaskedInterruptible' state,
-- use @mask_ $ forkIO ...@.  This is particularly useful if you need
-- to establish an exception handler in the forked thread before any
-- asynchronous exceptions are received.  To create a new thread in
-- an unmasked state use 'Control.Concurrent.forkIOWithUnmask'.
--
mask  :: ((forall a. IO a -> IO a) -> IO b) -> IO b

-- | Like 'mask', but does not pass a @restore@ action to the argument.
mask_ :: IO a -> IO a

-- | Like 'mask', but the masked computation is not interruptible (see
-- "Control.Exception#interruptible").  THIS SHOULD BE USED WITH
-- GREAT CARE, because if a thread executing in 'uninterruptibleMask'
-- blocks for any reason, then the thread (and possibly the program,
-- if this is the main thread) will be unresponsive and unkillable.
-- This function should only be necessary if you need to mask
-- exceptions around an interruptible operation, and you can guarantee
-- that the interruptible operation will only block for a short period
-- of time.
--
uninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b

-- | Like 'uninterruptibleMask', but does not pass a @restore@ action
-- to the argument.
uninterruptibleMask_ :: IO a -> IO a

mask_ io = mask $ \_ -> io

mask io = do
  b <- getMaskingState
  case b of
    Unmasked              -> block $ io unblock
    MaskedInterruptible   -> io block
    MaskedUninterruptible -> io blockUninterruptible

uninterruptibleMask_ io = uninterruptibleMask $ \_ -> io

uninterruptibleMask io = do
  b <- getMaskingState
  case b of
    Unmasked              -> blockUninterruptible $ io unblock
    MaskedInterruptible   -> blockUninterruptible $ io block
    MaskedUninterruptible -> io blockUninterruptible

bracket
        :: IO a         -- ^ computation to run first (\"acquire resource\")
        -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
        -> (a -> IO c)  -- ^ computation to run in-between
        -> IO c         -- returns the value from the in-between computation
bracket before after thing =
  mask $ \restore -> do
    a <- before
    r <- restore (thing a) `onException` after a
    _ <- after a
    return r

finally :: IO a         -- ^ computation to run first
        -> IO b         -- ^ computation to run afterward (even if an exception
                        -- was raised)
        -> IO a         -- returns the value from the first computation
a `finally` sequel =
  mask $ \restore -> do
    r <- restore a `onException` sequel
    _ <- sequel
    return r

-- | Evaluate the argument to weak head normal form.
--
-- 'evaluate' is typically used to uncover any exceptions that a lazy value
-- may contain, and possibly handle them.
--
-- 'evaluate' only evaluates to /weak head normal form/. If deeper
-- evaluation is needed, the @force@ function from @Control.DeepSeq@
-- may be handy:
--
-- > evaluate $ force x
--
-- There is a subtle difference between @'evaluate' x@ and @'return' '$!' x@,
-- analogous to the difference between 'throwIO' and 'throw'. If the lazy
-- value @x@ throws an exception, @'return' '$!' x@ will fail to return an
-- 'IO' action and will throw an exception instead. @'evaluate' x@, on the
-- other hand, always produces an 'IO' action; that action will throw an
-- exception upon /execution/ iff @x@ throws an exception upon /evaluation/.
--
-- The practical implication of this difference is that due to the
-- /imprecise exceptions/ semantics,
--
-- > (return $! error "foo") >> error "bar"
--
-- may throw either @"foo"@ or @"bar"@, depending on the optimizations
-- performed by the compiler. On the other hand,
--
-- > evaluate (error "foo") >> error "bar"
--
-- is guaranteed to throw @"foo"@.
--
-- The rule of thumb is to use 'evaluate' to force or handle exceptions in
-- lazy values. If, on the other hand, you are forcing a lazy value for
-- efficiency reasons only and do not care about exceptions, you may
-- use @'return' '$!' x@.
evaluate :: a -> IO a
evaluate a = IO $ \s -> seq# a s -- NB. see #2273, #5129

{- $exceptions_and_strictness

Laziness can interact with @catch@-like operations in non-obvious ways (see,
e.g. GHC Trac #11555 and #13330). For instance, consider these subtly-different
examples:

> test1 = Control.Exception.catch (error "uh oh") (\(_ :: SomeException) -> putStrLn "it failed")
>
> test2 = GHC.IO.catchException (error "uh oh") (\(_ :: SomeException) -> putStrLn "it failed")

While @test1@ will print "it failed", @test2@ will print "uh oh".

When using 'catchException', exceptions thrown while evaluating the
action-to-be-executed will not be caught; only exceptions thrown during
execution of the action will be handled by the exception handler.

Since this strictness is a small optimization and may lead to surprising
results, all of the @catch@ and @handle@ variants offered by "Control.Exception"
use 'catch' rather than 'catchException'.
-}


{-# LANGUAGE Unsafe #-}
{-# LANGUAGE NoImplicitPrelude, RoleAnnotations #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.IOArray
-- Copyright   :  (c) The University of Glasgow 2008
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  cvs-ghc@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- The IOArray type
--
-----------------------------------------------------------------------------

module GHC.IOArray (
        IOArray(..),
        newIOArray, unsafeReadIOArray, unsafeWriteIOArray,
        readIOArray, writeIOArray,
        boundsIOArray
    ) where

import GHC.Base
import GHC.IO
import GHC.Arr

-- ---------------------------------------------------------------------------
-- | An 'IOArray' is a mutable, boxed, non-strict array in the 'IO' monad.
-- The type arguments are as follows:
--
--  * @i@: the index type of the array (should be an instance of 'Ix')
--
--  * @e@: the element type of the array.
--
--

newtype IOArray i e = IOArray (STArray RealWorld i e)

-- index type should have a nominal role due to Ix class. See also #9220.
type role IOArray nominal representational

-- explicit instance because Haddock can't figure out a derived one
-- | @since 4.1.0.0
instance Eq (IOArray i e) where
  IOArray x == IOArray y = x == y

-- |Build a new 'IOArray'
newIOArray :: Ix i => (i,i) -> e -> IO (IOArray i e)
{-# INLINE newIOArray #-}
newIOArray lu initial  = stToIO $ do {marr <- newSTArray lu initial; return (IOArray marr)}

-- | Read a value from an 'IOArray'
unsafeReadIOArray  :: IOArray i e -> Int -> IO e
{-# INLINE unsafeReadIOArray #-}
unsafeReadIOArray (IOArray marr) i = stToIO (unsafeReadSTArray marr i)

-- | Write a new value into an 'IOArray'
unsafeWriteIOArray :: IOArray i e -> Int -> e -> IO ()
{-# INLINE unsafeWriteIOArray #-}
unsafeWriteIOArray (IOArray marr) i e = stToIO (unsafeWriteSTArray marr i e)

-- | Read a value from an 'IOArray'
readIOArray  :: Ix i => IOArray i e -> i -> IO e
readIOArray (IOArray marr) i = stToIO (readSTArray marr i)

-- | Write a new value into an 'IOArray'
writeIOArray :: Ix i => IOArray i e -> i -> e -> IO ()
writeIOArray (IOArray marr) i e = stToIO (writeSTArray marr i e)

{-# INLINE boundsIOArray #-}
boundsIOArray :: IOArray i e -> (i,i)
boundsIOArray (IOArray marr) = boundsSTArray marr


{-# LANGUAGE Unsafe #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.IORef
-- Copyright   :  (c) The University of Glasgow 2008
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  cvs-ghc@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- The IORef type
--
-----------------------------------------------------------------------------

module GHC.IORef (
        IORef(..),
        newIORef, readIORef, writeIORef, atomicModifyIORef2Lazy,
        atomicModifyIORef2, atomicModifyIORefLazy_, atomicModifyIORef'_,
        atomicModifyIORefP, atomicSwapIORef, atomicModifyIORef'
    ) where

import GHC.Base
import GHC.STRef
import GHC.IO

-- ---------------------------------------------------------------------------
-- IORefs

-- |A mutable variable in the 'IO' monad
newtype IORef a = IORef (STRef RealWorld a)
  deriving Eq
  -- ^ Pointer equality.
  --
  -- @since 4.0.0.0

-- |Build a new 'IORef'
newIORef    :: a -> IO (IORef a)
newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)

-- |Read the value of an 'IORef'
readIORef   :: IORef a -> IO a
readIORef  (IORef var) = stToIO (readSTRef var)

-- |Write a new value into an 'IORef'
writeIORef  :: IORef a -> a -> IO ()
writeIORef (IORef var) v = stToIO (writeSTRef var v)

-- Atomically apply a function to the contents of an 'IORef',
-- installing its first component in the 'IORef' and returning
-- the old contents and the result of applying the function.
-- The result of the function application (the pair) is not forced.
-- As a result, this can lead to memory leaks. It is generally better
-- to use 'atomicModifyIORef2'.
atomicModifyIORef2Lazy :: IORef a -> (a -> (a,b)) -> IO (a, (a, b))
atomicModifyIORef2Lazy (IORef (STRef r#)) f =
  IO (\s -> case atomicModifyMutVar2# r# f s of
              (# s', old, res #) -> (# s', (old, res) #))

-- Atomically apply a function to the contents of an 'IORef',
-- installing its first component in the 'IORef' and returning
-- the old contents and the result of applying the function.
-- The result of the function application (the pair) is forced,
-- but neither of its components is.
atomicModifyIORef2 :: IORef a -> (a -> (a,b)) -> IO (a, (a, b))
atomicModifyIORef2 ref f = do
  r@(_old, (_new, _res)) <- atomicModifyIORef2Lazy ref f
  return r

-- | A version of 'Data.IORef.atomicModifyIORef' that forces
-- the (pair) result of the function.
atomicModifyIORefP :: IORef a -> (a -> (a,b)) -> IO b
atomicModifyIORefP ref f = do
  (_old, (_,r)) <- atomicModifyIORef2 ref f
  pure r

-- | Atomically apply a function to the contents of an
-- 'IORef' and return the old and new values. The result
-- of the function is not forced. As this can lead to a
-- memory leak, it is usually better to use `atomicModifyIORef'_`.
atomicModifyIORefLazy_ :: IORef a -> (a -> a) -> IO (a, a)
atomicModifyIORefLazy_ (IORef (STRef ref)) f = IO $ \s ->
  case atomicModifyMutVar_# ref f s of
    (# s', old, new #) -> (# s', (old, new) #)

-- | Atomically apply a function to the contents of an
-- 'IORef' and return the old and new values. The result
-- of the function is forced.
atomicModifyIORef'_ :: IORef a -> (a -> a) -> IO (a, a)
atomicModifyIORef'_ ref f = do
  (old, !new) <- atomicModifyIORefLazy_ ref f
  return (old, new)

-- | Atomically replace the contents of an 'IORef', returning
-- the old contents.
atomicSwapIORef :: IORef a -> a -> IO a
-- Bad implementation! This will be a primop shortly.
atomicSwapIORef (IORef (STRef ref)) new = IO $ \s ->
  case atomicModifyMutVar2# ref (\_old -> Box new) s of
    (# s', old, Box _new #) -> (# s', old #)

data Box a = Box a

-- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both
-- the value stored in the 'IORef' and the value returned. The new value
-- is installed in the 'IORef' before the returned value is forced.
-- So
--
-- @atomicModifyIORef' ref (\x -> (x+1, undefined))@
--
-- will increment the 'IORef' and then throw an exception in the calling
-- thread.
--
-- @since 4.6.0.0
atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
-- See Note [atomicModifyIORef' definition]
atomicModifyIORef' ref f = do
  (_old, (_new, !res)) <- atomicModifyIORef2 ref $
    \old -> case f old of
       r@(!_new, _res) -> r
  pure res

-- Note [atomicModifyIORef' definition]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- atomicModifyIORef' was historically defined
--
--    atomicModifyIORef' ref f = do
--        b <- atomicModifyIORef ref $ \a ->
--                case f a of
--                    v@(a',_) -> a' `seq` v
--        b `seq` return b
--
-- The most obvious definition, now that we have atomicModifyMutVar2#,
-- would be
--
--    atomicModifyIORef' ref f = do
--      (_old, (!_new, !res)) <- atomicModifyIORef2 ref f
--      pure res
--
-- Why do we force the new value on the "inside" instead of afterwards?
-- I initially thought the latter would be okay, but then I realized
-- that if we write
--
--   atomicModifyIORef' ref $ \x -> (x + 5, x - 5)
--
-- then we'll end up building a pair of thunks to calculate x + 5
-- and x - 5. That's no good! With the more complicated definition,
-- we avoid this problem; the result pair is strict in the new IORef
-- contents. Of course, if the function passed to atomicModifyIORef'
-- doesn't inline, we'll build a closure for it. But that was already
-- true for the historical definition of atomicModifyIORef' (in terms
-- of atomicModifyIORef), so we shouldn't lose anything. Note that
-- in keeping with the historical behavior, we *don't* propagate the
-- strict demand on the result inwards. In particular,
--
--   atomicModifyIORef' ref (\x -> (x + 1, undefined))
--
-- will increment the IORef and throw an exception; it will not
-- install an undefined value in the IORef.
--
-- A clearer version, in my opinion (but one quite incompatible with
-- the traditional one) would only force the new IORef value and not
-- the result. This version would have been relatively inefficient
-- to implement using atomicModifyMutVar#, but is just fine now.