{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_HADDOCK not-home #-}
#include "MachDeps.h"
module GHC.Int (
Int(..), Int8(..), Int16(..), Int32(..), Int64(..),
uncheckedIShiftL64#, uncheckedIShiftRA64#,
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.Prim
#endif
import GHC.Base
import GHC.Enum
import GHC.Num
import GHC.Real
import GHC.Read
import GHC.Arr
import GHC.Show
data {-# CTYPE "HsInt8" #-} Int8 = I8# Int8#
instance Eq Int8 where
== :: Int8 -> Int8 -> Bool
(==) = Int8 -> Int8 -> Bool
eqInt8
/= :: Int8 -> Int8 -> Bool
(/=) = Int8 -> Int8 -> Bool
neInt8
eqInt8, neInt8 :: Int8 -> Int8 -> Bool
eqInt8 :: Int8 -> Int8 -> Bool
eqInt8 (I8# Int8#
x) (I8# Int8#
y) = Int# -> Bool
isTrue# ((Int8# -> Int#
int8ToInt# Int8#
x) Int# -> Int# -> Int#
==# (Int8# -> Int#
int8ToInt# Int8#
y))
neInt8 :: Int8 -> Int8 -> Bool
neInt8 (I8# Int8#
x) (I8# Int8#
y) = Int# -> Bool
isTrue# ((Int8# -> Int#
int8ToInt# Int8#
x) Int# -> Int# -> Int#
/=# (Int8# -> Int#
int8ToInt# Int8#
y))
{-# INLINE [1] eqInt8 #-}
{-# INLINE [1] neInt8 #-}
instance Ord Int8 where
< :: Int8 -> Int8 -> Bool
(<) = Int8 -> Int8 -> Bool
ltInt8
<= :: Int8 -> Int8 -> Bool
(<=) = Int8 -> Int8 -> Bool
leInt8
>= :: Int8 -> Int8 -> Bool
(>=) = Int8 -> Int8 -> Bool
geInt8
> :: Int8 -> Int8 -> Bool
(>) = Int8 -> Int8 -> Bool
gtInt8
{-# INLINE [1] gtInt8 #-}
{-# INLINE [1] geInt8 #-}
{-# INLINE [1] ltInt8 #-}
{-# INLINE [1] leInt8 #-}
gtInt8, geInt8, ltInt8, leInt8 :: Int8 -> Int8 -> Bool
(I8# Int8#
x) gtInt8 :: Int8 -> Int8 -> Bool
`gtInt8` (I8# Int8#
y) = Int# -> Bool
isTrue# (Int8#
x Int8# -> Int8# -> Int#
`gtInt8#` Int8#
y)
(I8# Int8#
x) geInt8 :: Int8 -> Int8 -> Bool
`geInt8` (I8# Int8#
y) = Int# -> Bool
isTrue# (Int8#
x Int8# -> Int8# -> Int#
`geInt8#` Int8#
y)
(I8# Int8#
x) ltInt8 :: Int8 -> Int8 -> Bool
`ltInt8` (I8# Int8#
y) = Int# -> Bool
isTrue# (Int8#
x Int8# -> Int8# -> Int#
`ltInt8#` Int8#
y)
(I8# Int8#
x) leInt8 :: Int8 -> Int8 -> Bool
`leInt8` (I8# Int8#
y) = Int# -> Bool
isTrue# (Int8#
x Int8# -> Int8# -> Int#
`leInt8#` Int8#
y)
instance Show Int8 where
showsPrec :: Int -> Int8 -> ShowS
showsPrec Int
p Int8
x = Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
x :: Int)
instance Num Int8 where
(I8# Int8#
x#) + :: Int8 -> Int8 -> Int8
+ (I8# Int8#
y#) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
+# (Int8# -> Int#
int8ToInt# Int8#
y#)))
(I8# Int8#
x#) - :: Int8 -> Int8 -> Int8
- (I8# Int8#
y#) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
-# (Int8# -> Int#
int8ToInt# Int8#
y#)))
(I8# Int8#
x#) * :: Int8 -> Int8 -> Int8
* (I8# Int8#
y#) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
*# (Int8# -> Int#
int8ToInt# Int8#
y#)))
negate :: Int8 -> Int8
negate (I8# Int8#
x#) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# (Int# -> Int#
negateInt# (Int8# -> Int#
int8ToInt# Int8#
x#)))
abs :: Int8 -> Int8
abs Int8
x | Int8
x Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int8
0 = Int8
x
| Bool
otherwise = Int8 -> Int8
forall a. Num a => a -> a
negate Int8
x
signum :: Int8 -> Int8
signum Int8
x | Int8
x Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
> Int8
0 = Int8
1
signum Int8
0 = Int8
0
signum Int8
_ = Int8
-1
fromInteger :: Integer -> Int8
fromInteger Integer
i = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# (Integer -> Int#
integerToInt# Integer
i))
instance Real Int8 where
toRational :: Int8 -> Rational
toRational Int8
x = Int8 -> Integer
forall a. Integral a => a -> Integer
toInteger Int8
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1
instance Enum Int8 where
succ :: Int8 -> Int8
succ Int8
x
| Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int8
forall a. Bounded a => a
maxBound = Int8
x Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+ Int8
1
| Bool
otherwise = String -> Int8
forall a. String -> a
succError String
"Int8"
pred :: Int8 -> Int8
pred Int8
x
| Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int8
forall a. Bounded a => a
minBound = Int8
x Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
- Int8
1
| Bool
otherwise = String -> Int8
forall a. String -> a
predError String
"Int8"
toEnum :: Int -> Int8
toEnum i :: Int
i@(I# Int#
i#)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8
forall a. Bounded a => a
minBound::Int8) Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8
forall a. Bounded a => a
maxBound::Int8)
= Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# Int#
i#)
| Bool
otherwise = String -> Int -> (Int8, Int8) -> Int8
forall a b. Show a => String -> Int -> (a, a) -> b
toEnumError String
"Int8" Int
i (Int8
forall a. Bounded a => a
minBound::Int8, Int8
forall a. Bounded a => a
maxBound::Int8)
fromEnum :: Int8 -> Int
fromEnum (I8# Int8#
x#) = Int# -> Int
I# (Int8# -> Int#
int8ToInt# Int8#
x#)
enumFrom :: Int8 -> [Int8]
enumFrom = Int8 -> [Int8]
forall a. (Enum a, Bounded a) => a -> [a]
boundedEnumFrom
enumFromThen :: Int8 -> Int8 -> [Int8]
enumFromThen = Int8 -> Int8 -> [Int8]
forall a. (Enum a, Bounded a) => a -> a -> [a]
boundedEnumFromThen
instance Integral Int8 where
quot :: Int8 -> Int8 -> Int8
quot x :: Int8
x@(I8# Int8#
x#) y :: Int8
y@(I8# Int8#
y#)
| Int8
y Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
0 = Int8
forall a. a
divZeroError
| Int8
y Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int8
-1) Bool -> Bool -> Bool
&& Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
forall a. Bounded a => a
minBound = Int8
forall a. a
overflowError
| Bool
otherwise = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
`quotInt#` (Int8# -> Int#
int8ToInt# Int8#
y#)))
rem :: Int8 -> Int8 -> Int8
rem (I8# Int8#
x#) y :: Int8
y@(I8# Int8#
y#)
| Int8
y Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
0 = Int8
forall a. a
divZeroError
| Int8
y Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int8
-1) = Int8
0
| Bool
otherwise = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
`remInt#` (Int8# -> Int#
int8ToInt# Int8#
y#)))
div :: Int8 -> Int8 -> Int8
div x :: Int8
x@(I8# Int8#
x#) y :: Int8
y@(I8# Int8#
y#)
| Int8
y Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
0 = Int8
forall a. a
divZeroError
| Int8
y Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int8
-1) Bool -> Bool -> Bool
&& Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
forall a. Bounded a => a
minBound = Int8
forall a. a
overflowError
| Bool
otherwise = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
`divInt#` (Int8# -> Int#
int8ToInt# Int8#
y#)))
mod :: Int8 -> Int8 -> Int8
mod (I8# Int8#
x#) y :: Int8
y@(I8# Int8#
y#)
| Int8
y Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
0 = Int8
forall a. a
divZeroError
| Int8
y Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int8
-1) = Int8
0
| Bool
otherwise = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
`modInt#` (Int8# -> Int#
int8ToInt# Int8#
y#)))
quotRem :: Int8 -> Int8 -> (Int8, Int8)
quotRem x :: Int8
x@(I8# Int8#
x#) y :: Int8
y@(I8# Int8#
y#)
| Int8
y Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
0 = (Int8, Int8)
forall a. a
divZeroError
| Int8
y Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int8
-1) Bool -> Bool -> Bool
&& Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
forall a. Bounded a => a
minBound = (Int8
forall a. a
overflowError, Int8
0)
| Bool
otherwise = case (Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> (# Int#, Int# #)
`quotRemInt#` (Int8# -> Int#
int8ToInt# Int8#
y#) of
(# Int#
q, Int#
r #) ->
(Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# Int#
q),
Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# Int#
r))
divMod :: Int8 -> Int8 -> (Int8, Int8)
divMod x :: Int8
x@(I8# Int8#
x#) y :: Int8
y@(I8# Int8#
y#)
| Int8
y Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
0 = (Int8, Int8)
forall a. a
divZeroError
| Int8
y Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int8
-1) Bool -> Bool -> Bool
&& Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
forall a. Bounded a => a
minBound = (Int8
forall a. a
overflowError, Int8
0)
| Bool
otherwise = case (Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> (# Int#, Int# #)
`divModInt#` (Int8# -> Int#
int8ToInt# Int8#
y#) of
(# Int#
d, Int#
m #) ->
(Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# Int#
d),
Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# Int#
m))
toInteger :: Int8 -> Integer
toInteger (I8# Int8#
x#) = Int# -> Integer
IS (Int8# -> Int#
int8ToInt# Int8#
x#)
instance Bounded Int8 where
minBound :: Int8
minBound = Int8
-0x80
maxBound :: Int8
maxBound = Int8
0x7F
instance Ix Int8 where
range :: (Int8, Int8) -> [Int8]
range (Int8
m,Int8
n) = [Int8
m..Int8
n]
unsafeIndex :: (Int8, Int8) -> Int8 -> Int
unsafeIndex (Int8
m,Int8
_) Int8
i = Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
m
inRange :: (Int8, Int8) -> Int8 -> Bool
inRange (Int8
m,Int8
n) Int8
i = Int8
m Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int8
i Bool -> Bool -> Bool
&& Int8
i Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int8
n
instance Read Int8 where
readsPrec :: Int -> ReadS Int8
readsPrec Int
p String
s = [(Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x::Int), String
r) | (Int
x, String
r) <- Int -> ReadS Int
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
s]
instance Bits Int8 where
{-# INLINE shift #-}
{-# INLINE bit #-}
{-# INLINE testBit #-}
{-# INLINE popCount #-}
(I8# Int8#
x#) .&. :: Int8 -> Int8 -> Int8
.&. (I8# Int8#
y#) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
`andI#` (Int8# -> Int#
int8ToInt# Int8#
y#)))
(I8# Int8#
x#) .|. :: Int8 -> Int8 -> Int8
.|. (I8# Int8#
y#) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
`orI#` (Int8# -> Int#
int8ToInt# Int8#
y#)))
(I8# Int8#
x#) xor :: Int8 -> Int8 -> Int8
`xor` (I8# Int8#
y#) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
`xorI#` (Int8# -> Int#
int8ToInt# Int8#
y#)))
complement :: Int8 -> Int8
complement (I8# Int8#
x#) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# (Int# -> Int#
notI# (Int8# -> Int#
int8ToInt# Int8#
x#)))
(I8# Int8#
x#) shift :: Int8 -> Int -> Int8
`shift` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
`iShiftL#` Int#
i#))
| Bool
otherwise = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
`iShiftRA#` Int# -> Int#
negateInt# Int#
i#))
(I8# Int8#
x#) shiftL :: Int8 -> Int -> Int8
`shiftL` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
`iShiftL#` Int#
i#))
| Bool
otherwise = Int8
forall a. a
overflowError
(I8# Int8#
x#) unsafeShiftL :: Int8 -> Int -> Int8
`unsafeShiftL` (I# Int#
i#) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
i#))
(I8# Int8#
x#) shiftR :: Int8 -> Int -> Int8
`shiftR` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
`iShiftRA#` Int#
i#))
| Bool
otherwise = Int8
forall a. a
overflowError
(I8# Int8#
x#) unsafeShiftR :: Int8 -> Int -> Int8
`unsafeShiftR` (I# Int#
i#) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# ((Int8# -> Int#
int8ToInt# Int8#
x#) Int# -> Int# -> Int#
`uncheckedIShiftRA#` Int#
i#))
(I8# Int8#
x#) rotate :: Int8 -> Int -> Int8
`rotate` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i'# Int# -> Int# -> Int#
==# Int#
0#)
= Int8# -> Int8
I8# Int8#
x#
| Bool
otherwise
= Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# (Word# -> Int#
word2Int# ((Word#
x'# Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
i'#) Word# -> Word# -> Word#
`or#`
(Word#
x'# Word# -> Int# -> Word#
`uncheckedShiftRL#` (Int#
8# Int# -> Int# -> Int#
-# Int#
i'#)))))
where
!x'# :: Word#
x'# = Word# -> Word#
narrow8Word# (Int# -> Word#
int2Word# (Int8# -> Int#
int8ToInt# Int8#
x#))
!i'# :: Int#
i'# = Word# -> Int#
word2Int# (Int# -> Word#
int2Word# Int#
i# Word# -> Word# -> Word#
`and#` Word#
7##)
bitSizeMaybe :: Int8 -> Maybe Int
bitSizeMaybe Int8
i = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int8 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Int8
i)
bitSize :: Int8 -> Int
bitSize Int8
i = Int8 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Int8
i
isSigned :: Int8 -> Bool
isSigned Int8
_ = Bool
True
popCount :: Int8 -> Int
popCount (I8# Int8#
x#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
popCnt8# (Int# -> Word#
int2Word# (Int8# -> Int#
int8ToInt# Int8#
x#))))
bit :: Int -> Int8
bit = Int -> Int8
forall a. (Bits a, Num a) => Int -> a
bitDefault
testBit :: Int8 -> Int -> Bool
testBit = Int8 -> Int -> Bool
forall a. (Bits a, Num a) => a -> Int -> Bool
testBitDefault
instance FiniteBits Int8 where
{-# INLINE countLeadingZeros #-}
{-# INLINE countTrailingZeros #-}
finiteBitSize :: Int8 -> Int
finiteBitSize Int8
_ = Int
8
countLeadingZeros :: Int8 -> Int
countLeadingZeros (I8# Int8#
x#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
clz8# (Int# -> Word#
int2Word# (Int8# -> Int#
int8ToInt# Int8#
x#))))
countTrailingZeros :: Int8 -> Int
countTrailingZeros (I8# Int8#
x#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
ctz8# (Int# -> Word#
int2Word# (Int8# -> Int#
int8ToInt# Int8#
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)
#-}
data {-# CTYPE "HsInt16" #-} Int16 = I16# Int16#
instance Eq Int16 where
== :: Int16 -> Int16 -> Bool
(==) = Int16 -> Int16 -> Bool
eqInt16
/= :: Int16 -> Int16 -> Bool
(/=) = Int16 -> Int16 -> Bool
neInt16
eqInt16, neInt16 :: Int16 -> Int16 -> Bool
eqInt16 :: Int16 -> Int16 -> Bool
eqInt16 (I16# Int16#
x) (I16# Int16#
y) = Int# -> Bool
isTrue# ((Int16# -> Int#
int16ToInt# Int16#
x) Int# -> Int# -> Int#
==# (Int16# -> Int#
int16ToInt# Int16#
y))
neInt16 :: Int16 -> Int16 -> Bool
neInt16 (I16# Int16#
x) (I16# Int16#
y) = Int# -> Bool
isTrue# ((Int16# -> Int#
int16ToInt# Int16#
x) Int# -> Int# -> Int#
/=# (Int16# -> Int#
int16ToInt# Int16#
y))
{-# INLINE [1] eqInt16 #-}
{-# INLINE [1] neInt16 #-}
instance Ord Int16 where
< :: Int16 -> Int16 -> Bool
(<) = Int16 -> Int16 -> Bool
ltInt16
<= :: Int16 -> Int16 -> Bool
(<=) = Int16 -> Int16 -> Bool
leInt16
>= :: Int16 -> Int16 -> Bool
(>=) = Int16 -> Int16 -> Bool
geInt16
> :: Int16 -> Int16 -> Bool
(>) = Int16 -> Int16 -> Bool
gtInt16
{-# INLINE [1] gtInt16 #-}
{-# INLINE [1] geInt16 #-}
{-# INLINE [1] ltInt16 #-}
{-# INLINE [1] leInt16 #-}
gtInt16, geInt16, ltInt16, leInt16 :: Int16 -> Int16 -> Bool
(I16# Int16#
x) gtInt16 :: Int16 -> Int16 -> Bool
`gtInt16` (I16# Int16#
y) = Int# -> Bool
isTrue# (Int16#
x Int16# -> Int16# -> Int#
`gtInt16#` Int16#
y)
(I16# Int16#
x) geInt16 :: Int16 -> Int16 -> Bool
`geInt16` (I16# Int16#
y) = Int# -> Bool
isTrue# (Int16#
x Int16# -> Int16# -> Int#
`geInt16#` Int16#
y)
(I16# Int16#
x) ltInt16 :: Int16 -> Int16 -> Bool
`ltInt16` (I16# Int16#
y) = Int# -> Bool
isTrue# (Int16#
x Int16# -> Int16# -> Int#
`ltInt16#` Int16#
y)
(I16# Int16#
x) leInt16 :: Int16 -> Int16 -> Bool
`leInt16` (I16# Int16#
y) = Int# -> Bool
isTrue# (Int16#
x Int16# -> Int16# -> Int#
`leInt16#` Int16#
y)
instance Show Int16 where
showsPrec :: Int -> Int16 -> ShowS
showsPrec Int
p Int16
x = Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
x :: Int)
instance Num Int16 where
(I16# Int16#
x#) + :: Int16 -> Int16 -> Int16
+ (I16# Int16#
y#) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
+# (Int16# -> Int#
int16ToInt# Int16#
y#)))
(I16# Int16#
x#) - :: Int16 -> Int16 -> Int16
- (I16# Int16#
y#) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
-# (Int16# -> Int#
int16ToInt# Int16#
y#)))
(I16# Int16#
x#) * :: Int16 -> Int16 -> Int16
* (I16# Int16#
y#) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
*# (Int16# -> Int#
int16ToInt# Int16#
y#)))
negate :: Int16 -> Int16
negate (I16# Int16#
x#) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# (Int# -> Int#
negateInt# (Int16# -> Int#
int16ToInt# Int16#
x#)))
abs :: Int16 -> Int16
abs Int16
x | Int16
x Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int16
0 = Int16
x
| Bool
otherwise = Int16 -> Int16
forall a. Num a => a -> a
negate Int16
x
signum :: Int16 -> Int16
signum Int16
x | Int16
x Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
> Int16
0 = Int16
1
signum Int16
0 = Int16
0
signum Int16
_ = Int16
-1
fromInteger :: Integer -> Int16
fromInteger Integer
i = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# (Integer -> Int#
integerToInt# Integer
i))
instance Real Int16 where
toRational :: Int16 -> Rational
toRational Int16
x = Int16 -> Integer
forall a. Integral a => a -> Integer
toInteger Int16
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1
instance Enum Int16 where
succ :: Int16 -> Int16
succ Int16
x
| Int16
x Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int16
forall a. Bounded a => a
maxBound = Int16
x Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
1
| Bool
otherwise = String -> Int16
forall a. String -> a
succError String
"Int16"
pred :: Int16 -> Int16
pred Int16
x
| Int16
x Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int16
forall a. Bounded a => a
minBound = Int16
x Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
- Int16
1
| Bool
otherwise = String -> Int16
forall a. String -> a
predError String
"Int16"
toEnum :: Int -> Int16
toEnum i :: Int
i@(I# Int#
i#)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16
forall a. Bounded a => a
minBound::Int16) Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16
forall a. Bounded a => a
maxBound::Int16)
= Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# Int#
i#)
| Bool
otherwise = String -> Int -> (Int16, Int16) -> Int16
forall a b. Show a => String -> Int -> (a, a) -> b
toEnumError String
"Int16" Int
i (Int16
forall a. Bounded a => a
minBound::Int16, Int16
forall a. Bounded a => a
maxBound::Int16)
fromEnum :: Int16 -> Int
fromEnum (I16# Int16#
x#) = Int# -> Int
I# (Int16# -> Int#
int16ToInt# Int16#
x#)
enumFrom :: Int16 -> [Int16]
enumFrom = Int16 -> [Int16]
forall a. (Enum a, Bounded a) => a -> [a]
boundedEnumFrom
enumFromThen :: Int16 -> Int16 -> [Int16]
enumFromThen = Int16 -> Int16 -> [Int16]
forall a. (Enum a, Bounded a) => a -> a -> [a]
boundedEnumFromThen
instance Integral Int16 where
quot :: Int16 -> Int16 -> Int16
quot x :: Int16
x@(I16# Int16#
x#) y :: Int16
y@(I16# Int16#
y#)
| Int16
y Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
0 = Int16
forall a. a
divZeroError
| Int16
y Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int16
-1) Bool -> Bool -> Bool
&& Int16
x Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
forall a. Bounded a => a
minBound = Int16
forall a. a
overflowError
| Bool
otherwise = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
`quotInt#` (Int16# -> Int#
int16ToInt# Int16#
y#)))
rem :: Int16 -> Int16 -> Int16
rem (I16# Int16#
x#) y :: Int16
y@(I16# Int16#
y#)
| Int16
y Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
0 = Int16
forall a. a
divZeroError
| Int16
y Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int16
-1) = Int16
0
| Bool
otherwise = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
`remInt#` (Int16# -> Int#
int16ToInt# Int16#
y#)))
div :: Int16 -> Int16 -> Int16
div x :: Int16
x@(I16# Int16#
x#) y :: Int16
y@(I16# Int16#
y#)
| Int16
y Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
0 = Int16
forall a. a
divZeroError
| Int16
y Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int16
-1) Bool -> Bool -> Bool
&& Int16
x Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
forall a. Bounded a => a
minBound = Int16
forall a. a
overflowError
| Bool
otherwise = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
`divInt#` (Int16# -> Int#
int16ToInt# Int16#
y#)))
mod :: Int16 -> Int16 -> Int16
mod (I16# Int16#
x#) y :: Int16
y@(I16# Int16#
y#)
| Int16
y Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
0 = Int16
forall a. a
divZeroError
| Int16
y Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int16
-1) = Int16
0
| Bool
otherwise = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
`modInt#` (Int16# -> Int#
int16ToInt# Int16#
y#)))
quotRem :: Int16 -> Int16 -> (Int16, Int16)
quotRem x :: Int16
x@(I16# Int16#
x#) y :: Int16
y@(I16# Int16#
y#)
| Int16
y Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
0 = (Int16, Int16)
forall a. a
divZeroError
| Int16
y Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int16
-1) Bool -> Bool -> Bool
&& Int16
x Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
forall a. Bounded a => a
minBound = (Int16
forall a. a
overflowError, Int16
0)
| Bool
otherwise = case (Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> (# Int#, Int# #)
`quotRemInt#` (Int16# -> Int#
int16ToInt# Int16#
y#) of
(# Int#
q, Int#
r #) ->
(Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# Int#
q),
Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# Int#
r))
divMod :: Int16 -> Int16 -> (Int16, Int16)
divMod x :: Int16
x@(I16# Int16#
x#) y :: Int16
y@(I16# Int16#
y#)
| Int16
y Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
0 = (Int16, Int16)
forall a. a
divZeroError
| Int16
y Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int16
-1) Bool -> Bool -> Bool
&& Int16
x Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
forall a. Bounded a => a
minBound = (Int16
forall a. a
overflowError, Int16
0)
| Bool
otherwise = case (Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> (# Int#, Int# #)
`divModInt#` (Int16# -> Int#
int16ToInt# Int16#
y#) of
(# Int#
d, Int#
m #) ->
(Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# Int#
d),
Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# Int#
m))
toInteger :: Int16 -> Integer
toInteger (I16# Int16#
x#) = Int# -> Integer
IS (Int16# -> Int#
int16ToInt# Int16#
x#)
instance Bounded Int16 where
minBound :: Int16
minBound = Int16
-0x8000
maxBound :: Int16
maxBound = Int16
0x7FFF
instance Ix Int16 where
range :: (Int16, Int16) -> [Int16]
range (Int16
m,Int16
n) = [Int16
m..Int16
n]
unsafeIndex :: (Int16, Int16) -> Int16 -> Int
unsafeIndex (Int16
m,Int16
_) Int16
i = Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
m
inRange :: (Int16, Int16) -> Int16 -> Bool
inRange (Int16
m,Int16
n) Int16
i = Int16
m Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int16
i Bool -> Bool -> Bool
&& Int16
i Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int16
n
instance Read Int16 where
readsPrec :: Int -> ReadS Int16
readsPrec Int
p String
s = [(Int -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x::Int), String
r) | (Int
x, String
r) <- Int -> ReadS Int
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
s]
instance Bits Int16 where
{-# INLINE shift #-}
{-# INLINE bit #-}
{-# INLINE testBit #-}
{-# INLINE popCount #-}
(I16# Int16#
x#) .&. :: Int16 -> Int16 -> Int16
.&. (I16# Int16#
y#) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
`andI#` (Int16# -> Int#
int16ToInt# Int16#
y#)))
(I16# Int16#
x#) .|. :: Int16 -> Int16 -> Int16
.|. (I16# Int16#
y#) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
`orI#` (Int16# -> Int#
int16ToInt# Int16#
y#)))
(I16# Int16#
x#) xor :: Int16 -> Int16 -> Int16
`xor` (I16# Int16#
y#) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
`xorI#` (Int16# -> Int#
int16ToInt# Int16#
y#)))
complement :: Int16 -> Int16
complement (I16# Int16#
x#) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# (Int# -> Int#
notI# (Int16# -> Int#
int16ToInt# Int16#
x#)))
(I16# Int16#
x#) shift :: Int16 -> Int -> Int16
`shift` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
`iShiftL#` Int#
i#))
| Bool
otherwise = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
`iShiftRA#` Int# -> Int#
negateInt# Int#
i#))
(I16# Int16#
x#) shiftL :: Int16 -> Int -> Int16
`shiftL` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
`iShiftL#` Int#
i#))
| Bool
otherwise = Int16
forall a. a
overflowError
(I16# Int16#
x#) unsafeShiftL :: Int16 -> Int -> Int16
`unsafeShiftL` (I# Int#
i#) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
i#))
(I16# Int16#
x#) shiftR :: Int16 -> Int -> Int16
`shiftR` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
`iShiftRA#` Int#
i#))
| Bool
otherwise = Int16
forall a. a
overflowError
(I16# Int16#
x#) unsafeShiftR :: Int16 -> Int -> Int16
`unsafeShiftR` (I# Int#
i#) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# ((Int16# -> Int#
int16ToInt# Int16#
x#) Int# -> Int# -> Int#
`uncheckedIShiftRA#` Int#
i#))
(I16# Int16#
x#) rotate :: Int16 -> Int -> Int16
`rotate` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i'# Int# -> Int# -> Int#
==# Int#
0#)
= Int16# -> Int16
I16# Int16#
x#
| Bool
otherwise
= Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# (Word# -> Int#
word2Int# ((Word#
x'# Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
i'#) Word# -> Word# -> Word#
`or#`
(Word#
x'# Word# -> Int# -> Word#
`uncheckedShiftRL#` (Int#
16# Int# -> Int# -> Int#
-# Int#
i'#)))))
where
!x'# :: Word#
x'# = Word# -> Word#
narrow16Word# (Int# -> Word#
int2Word# (Int16# -> Int#
int16ToInt# Int16#
x#))
!i'# :: Int#
i'# = Word# -> Int#
word2Int# (Int# -> Word#
int2Word# Int#
i# Word# -> Word# -> Word#
`and#` Word#
15##)
bitSizeMaybe :: Int16 -> Maybe Int
bitSizeMaybe Int16
i = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int16 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Int16
i)
bitSize :: Int16 -> Int
bitSize Int16
i = Int16 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Int16
i
isSigned :: Int16 -> Bool
isSigned Int16
_ = Bool
True
popCount :: Int16 -> Int
popCount (I16# Int16#
x#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
popCnt16# (Int# -> Word#
int2Word# (Int16# -> Int#
int16ToInt# Int16#
x#))))
bit :: Int -> Int16
bit = Int -> Int16
forall a. (Bits a, Num a) => Int -> a
bitDefault
testBit :: Int16 -> Int -> Bool
testBit = Int16 -> Int -> Bool
forall a. (Bits a, Num a) => a -> Int -> Bool
testBitDefault
instance FiniteBits Int16 where
{-# INLINE countLeadingZeros #-}
{-# INLINE countTrailingZeros #-}
finiteBitSize :: Int16 -> Int
finiteBitSize Int16
_ = Int
16
countLeadingZeros :: Int16 -> Int
countLeadingZeros (I16# Int16#
x#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
clz16# (Int# -> Word#
int2Word# (Int16# -> Int#
int16ToInt# Int16#
x#))))
countTrailingZeros :: Int16 -> Int
countTrailingZeros (I16# Int16#
x#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
ctz16# (Int# -> Word#
int2Word# (Int16# -> Int#
int16ToInt# Int16#
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)
#-}
data {-# CTYPE "HsInt32" #-} Int32 = I32# Int32#
instance Eq Int32 where
== :: Int32 -> Int32 -> Bool
(==) = Int32 -> Int32 -> Bool
eqInt32
/= :: Int32 -> Int32 -> Bool
(/=) = Int32 -> Int32 -> Bool
neInt32
eqInt32, neInt32 :: Int32 -> Int32 -> Bool
eqInt32 :: Int32 -> Int32 -> Bool
eqInt32 (I32# Int32#
x) (I32# Int32#
y) = Int# -> Bool
isTrue# ((Int32# -> Int#
int32ToInt# Int32#
x) Int# -> Int# -> Int#
==# (Int32# -> Int#
int32ToInt# Int32#
y))
neInt32 :: Int32 -> Int32 -> Bool
neInt32 (I32# Int32#
x) (I32# Int32#
y) = Int# -> Bool
isTrue# ((Int32# -> Int#
int32ToInt# Int32#
x) Int# -> Int# -> Int#
/=# (Int32# -> Int#
int32ToInt# Int32#
y))
{-# INLINE [1] eqInt32 #-}
{-# INLINE [1] neInt32 #-}
instance Ord Int32 where
< :: Int32 -> Int32 -> Bool
(<) = Int32 -> Int32 -> Bool
ltInt32
<= :: Int32 -> Int32 -> Bool
(<=) = Int32 -> Int32 -> Bool
leInt32
>= :: Int32 -> Int32 -> Bool
(>=) = Int32 -> Int32 -> Bool
geInt32
> :: Int32 -> Int32 -> Bool
(>) = Int32 -> Int32 -> Bool
gtInt32
{-# INLINE [1] gtInt32 #-}
{-# INLINE [1] geInt32 #-}
{-# INLINE [1] ltInt32 #-}
{-# INLINE [1] leInt32 #-}
gtInt32, geInt32, ltInt32, leInt32 :: Int32 -> Int32 -> Bool
(I32# Int32#
x) gtInt32 :: Int32 -> Int32 -> Bool
`gtInt32` (I32# Int32#
y) = Int# -> Bool
isTrue# (Int32#
x Int32# -> Int32# -> Int#
`gtInt32#` Int32#
y)
(I32# Int32#
x) geInt32 :: Int32 -> Int32 -> Bool
`geInt32` (I32# Int32#
y) = Int# -> Bool
isTrue# (Int32#
x Int32# -> Int32# -> Int#
`geInt32#` Int32#
y)
(I32# Int32#
x) ltInt32 :: Int32 -> Int32 -> Bool
`ltInt32` (I32# Int32#
y) = Int# -> Bool
isTrue# (Int32#
x Int32# -> Int32# -> Int#
`ltInt32#` Int32#
y)
(I32# Int32#
x) leInt32 :: Int32 -> Int32 -> Bool
`leInt32` (I32# Int32#
y) = Int# -> Bool
isTrue# (Int32#
x Int32# -> Int32# -> Int#
`leInt32#` Int32#
y)
instance Show Int32 where
showsPrec :: Int -> Int32 -> ShowS
showsPrec Int
p Int32
x = Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x :: Int)
instance Num Int32 where
(I32# Int32#
x#) + :: Int32 -> Int32 -> Int32
+ (I32# Int32#
y#) = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
+# (Int32# -> Int#
int32ToInt# Int32#
y#)))
(I32# Int32#
x#) - :: Int32 -> Int32 -> Int32
- (I32# Int32#
y#) = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
-# (Int32# -> Int#
int32ToInt# Int32#
y#)))
(I32# Int32#
x#) * :: Int32 -> Int32 -> Int32
* (I32# Int32#
y#) = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
*# (Int32# -> Int#
int32ToInt# Int32#
y#)))
negate :: Int32 -> Int32
negate (I32# Int32#
x#) = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# (Int# -> Int#
negateInt# (Int32# -> Int#
int32ToInt# Int32#
x#)))
abs :: Int32 -> Int32
abs Int32
x | Int32
x Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
0 = Int32
x
| Bool
otherwise = Int32 -> Int32
forall a. Num a => a -> a
negate Int32
x
signum :: Int32 -> Int32
signum Int32
x | Int32
x Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
0 = Int32
1
signum Int32
0 = Int32
0
signum Int32
_ = Int32
-1
fromInteger :: Integer -> Int32
fromInteger Integer
i = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# (Integer -> Int#
integerToInt# Integer
i))
instance Enum Int32 where
succ :: Int32 -> Int32
succ Int32
x
| Int32
x Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
forall a. Bounded a => a
maxBound = Int32
x Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1
| Bool
otherwise = String -> Int32
forall a. String -> a
succError String
"Int32"
pred :: Int32 -> Int32
pred Int32
x
| Int32
x Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
forall a. Bounded a => a
minBound = Int32
x Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1
| Bool
otherwise = String -> Int32
forall a. String -> a
predError String
"Int32"
#if WORD_SIZE_IN_BITS == 32
toEnum (I# i#) = I32# (intToInt32# i#)
#else
toEnum :: Int -> Int32
toEnum i :: Int
i@(I# Int#
i#)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
forall a. Bounded a => a
minBound::Int32) Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
forall a. Bounded a => a
maxBound::Int32)
= Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# Int#
i#)
| Bool
otherwise = String -> Int -> (Int32, Int32) -> Int32
forall a b. Show a => String -> Int -> (a, a) -> b
toEnumError String
"Int32" Int
i (Int32
forall a. Bounded a => a
minBound::Int32, Int32
forall a. Bounded a => a
maxBound::Int32)
#endif
fromEnum :: Int32 -> Int
fromEnum (I32# Int32#
x#) = Int# -> Int
I# (Int32# -> Int#
int32ToInt# Int32#
x#)
enumFrom :: Int32 -> [Int32]
enumFrom = Int32 -> [Int32]
forall a. (Enum a, Bounded a) => a -> [a]
boundedEnumFrom
enumFromThen :: Int32 -> Int32 -> [Int32]
enumFromThen = Int32 -> Int32 -> [Int32]
forall a. (Enum a, Bounded a) => a -> a -> [a]
boundedEnumFromThen
instance Integral Int32 where
quot :: Int32 -> Int32 -> Int32
quot x :: Int32
x@(I32# Int32#
x#) y :: Int32
y@(I32# Int32#
y#)
| Int32
y Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0 = Int32
forall a. a
divZeroError
| Int32
y Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int32
-1) Bool -> Bool -> Bool
&& Int32
x Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
forall a. Bounded a => a
minBound = Int32
forall a. a
overflowError
| Bool
otherwise = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
`quotInt#` (Int32# -> Int#
int32ToInt# Int32#
y#)))
rem :: Int32 -> Int32 -> Int32
rem (I32# Int32#
x#) y :: Int32
y@(I32# Int32#
y#)
| Int32
y Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0 = Int32
forall a. a
divZeroError
| Int32
y Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int32
-1) = Int32
0
| Bool
otherwise = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
`remInt#` (Int32# -> Int#
int32ToInt# Int32#
y#)))
div :: Int32 -> Int32 -> Int32
div x :: Int32
x@(I32# Int32#
x#) y :: Int32
y@(I32# Int32#
y#)
| Int32
y Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0 = Int32
forall a. a
divZeroError
| Int32
y Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int32
-1) Bool -> Bool -> Bool
&& Int32
x Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
forall a. Bounded a => a
minBound = Int32
forall a. a
overflowError
| Bool
otherwise = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
`divInt#` (Int32# -> Int#
int32ToInt# Int32#
y#)))
mod :: Int32 -> Int32 -> Int32
mod (I32# Int32#
x#) y :: Int32
y@(I32# Int32#
y#)
| Int32
y Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0 = Int32
forall a. a
divZeroError
| Int32
y Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int32
-1) = Int32
0
| Bool
otherwise = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
`modInt#` (Int32# -> Int#
int32ToInt# Int32#
y#)))
quotRem :: Int32 -> Int32 -> (Int32, Int32)
quotRem x :: Int32
x@(I32# Int32#
x#) y :: Int32
y@(I32# Int32#
y#)
| Int32
y Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0 = (Int32, Int32)
forall a. a
divZeroError
| Int32
y Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int32
-1) Bool -> Bool -> Bool
&& Int32
x Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
forall a. Bounded a => a
minBound = (Int32
forall a. a
overflowError, Int32
0)
| Bool
otherwise = case (Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> (# Int#, Int# #)
`quotRemInt#` (Int32# -> Int#
int32ToInt# Int32#
y#) of
(# Int#
q, Int#
r #) ->
(Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# Int#
q),
Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# Int#
r))
divMod :: Int32 -> Int32 -> (Int32, Int32)
divMod x :: Int32
x@(I32# Int32#
x#) y :: Int32
y@(I32# Int32#
y#)
| Int32
y Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0 = (Int32, Int32)
forall a. a
divZeroError
| Int32
y Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int32
-1) Bool -> Bool -> Bool
&& Int32
x Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
forall a. Bounded a => a
minBound = (Int32
forall a. a
overflowError, Int32
0)
| Bool
otherwise = case (Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> (# Int#, Int# #)
`divModInt#` (Int32# -> Int#
int32ToInt# Int32#
y#) of
(# Int#
d, Int#
m #) ->
(Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# Int#
d),
Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# Int#
m))
toInteger :: Int32 -> Integer
toInteger (I32# Int32#
x#) = Int# -> Integer
IS (Int32# -> Int#
int32ToInt# Int32#
x#)
instance Read Int32 where
readsPrec :: Int -> ReadS Int32
readsPrec Int
p String
s = [(Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x::Int), String
r) | (Int
x, String
r) <- Int -> ReadS Int
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
s]
instance Bits Int32 where
{-# INLINE shift #-}
{-# INLINE bit #-}
{-# INLINE testBit #-}
{-# INLINE popCount #-}
(I32# Int32#
x#) .&. :: Int32 -> Int32 -> Int32
.&. (I32# Int32#
y#) = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
`andI#` (Int32# -> Int#
int32ToInt# Int32#
y#)))
(I32# Int32#
x#) .|. :: Int32 -> Int32 -> Int32
.|. (I32# Int32#
y#) = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
`orI#` (Int32# -> Int#
int32ToInt# Int32#
y#)))
(I32# Int32#
x#) xor :: Int32 -> Int32 -> Int32
`xor` (I32# Int32#
y#) = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
`xorI#` (Int32# -> Int#
int32ToInt# Int32#
y#)))
complement :: Int32 -> Int32
complement (I32# Int32#
x#) = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# (Int# -> Int#
notI# (Int32# -> Int#
int32ToInt# Int32#
x#)))
(I32# Int32#
x#) shift :: Int32 -> Int -> Int32
`shift` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
`iShiftL#` Int#
i#))
| Bool
otherwise = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
`iShiftRA#` Int# -> Int#
negateInt# Int#
i#))
(I32# Int32#
x#) shiftL :: Int32 -> Int -> Int32
`shiftL` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
`iShiftL#` Int#
i#))
| Bool
otherwise = Int32
forall a. a
overflowError
(I32# Int32#
x#) unsafeShiftL :: Int32 -> Int -> Int32
`unsafeShiftL` (I# Int#
i#) =
Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
i#))
(I32# Int32#
x#) shiftR :: Int32 -> Int -> Int32
`shiftR` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
`iShiftRA#` Int#
i#))
| Bool
otherwise = Int32
forall a. a
overflowError
(I32# Int32#
x#) unsafeShiftR :: Int32 -> Int -> Int32
`unsafeShiftR` (I# Int#
i#) = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# ((Int32# -> Int#
int32ToInt# Int32#
x#) Int# -> Int# -> Int#
`uncheckedIShiftRA#` Int#
i#))
(I32# Int32#
x#) rotate :: Int32 -> Int -> Int32
`rotate` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i'# Int# -> Int# -> Int#
==# Int#
0#)
= Int32# -> Int32
I32# Int32#
x#
| Bool
otherwise
= Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# (Word# -> Int#
word2Int# ((Word#
x'# Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
i'#) Word# -> Word# -> Word#
`or#`
(Word#
x'# Word# -> Int# -> Word#
`uncheckedShiftRL#` (Int#
32# Int# -> Int# -> Int#
-# Int#
i'#)))))
where
!x'# :: Word#
x'# = Word# -> Word#
narrow32Word# (Int# -> Word#
int2Word# (Int32# -> Int#
int32ToInt# Int32#
x#))
!i'# :: Int#
i'# = Word# -> Int#
word2Int# (Int# -> Word#
int2Word# Int#
i# Word# -> Word# -> Word#
`and#` Word#
31##)
bitSizeMaybe :: Int32 -> Maybe Int
bitSizeMaybe Int32
i = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int32 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Int32
i)
bitSize :: Int32 -> Int
bitSize Int32
i = Int32 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Int32
i
isSigned :: Int32 -> Bool
isSigned Int32
_ = Bool
True
popCount :: Int32 -> Int
popCount (I32# Int32#
x#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
popCnt32# (Int# -> Word#
int2Word# (Int32# -> Int#
int32ToInt# Int32#
x#))))
bit :: Int -> Int32
bit = Int -> Int32
forall a. (Bits a, Num a) => Int -> a
bitDefault
testBit :: Int32 -> Int -> Bool
testBit = Int32 -> Int -> Bool
forall a. (Bits a, Num a) => a -> Int -> Bool
testBitDefault
instance FiniteBits Int32 where
{-# INLINE countLeadingZeros #-}
{-# INLINE countTrailingZeros #-}
finiteBitSize :: Int32 -> Int
finiteBitSize Int32
_ = Int
32
countLeadingZeros :: Int32 -> Int
countLeadingZeros (I32# Int32#
x#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
clz32# (Int# -> Word#
int2Word# (Int32# -> Int#
int32ToInt# Int32#
x#))))
countTrailingZeros :: Int32 -> Int
countTrailingZeros (I32# Int32#
x#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
ctz32# (Int# -> Word#
int2Word# (Int32# -> Int#
int32ToInt# Int32#
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)
#-}
instance Real Int32 where
toRational :: Int32 -> Rational
toRational Int32
x = Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger Int32
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1
instance Bounded Int32 where
minBound :: Int32
minBound = Int32
-0x80000000
maxBound :: Int32
maxBound = Int32
0x7FFFFFFF
instance Ix Int32 where
range :: (Int32, Int32) -> [Int32]
range (Int32
m,Int32
n) = [Int32
m..Int32
n]
unsafeIndex :: (Int32, Int32) -> Int32 -> Int
unsafeIndex (Int32
m,Int32
_) Int32
i = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
m
inRange :: (Int32, Int32) -> Int32 -> Bool
inRange (Int32
m,Int32
n) Int32
i = Int32
m Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
i Bool -> Bool -> Bool
&& Int32
i Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
n
#if WORD_SIZE_IN_BITS < 64
data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64#
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 #-}
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)
instance Show Int64 where
showsPrec p x = showsPrec p (toInteger x)
instance Num Int64 where
(I64# x#) + (I64# y#) = I64# (x# `plusInt64#` y#)
(I64# x#) - (I64# y#) = I64# (x# `subInt64#` 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)
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
instance Integral Int64 where
quot x@(I64# x#) y@(I64# y#)
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError
| otherwise = I64# (x# `quotInt64#` y#)
rem (I64# x#) y@(I64# y#)
| y == 0 = divZeroError
| y == (-1) = 0
| otherwise = I64# (x# `remInt64#` y#)
div x@(I64# x#) y@(I64# y#)
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError
| otherwise = I64# (x# `divInt64#` y#)
mod (I64# x#) y@(I64# y#)
| y == 0 = divZeroError
| y == (-1) = 0
| otherwise = I64# (x# `modInt64#` y#)
quotRem x@(I64# x#) y@(I64# y#)
| y == 0 = divZeroError
| 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
| y == (-1) && x == minBound = (overflowError, 0)
| otherwise = (I64# (x# `divInt64#` y#),
I64# (x# `modInt64#` y#))
toInteger (I64# x) = integerFromInt64# x
divInt64#, modInt64# :: Int64# -> Int64# -> Int64#
x# `divInt64#` y#
| isTrue# (x# `gtInt64#` zero) && isTrue# (y# `ltInt64#` zero)
= ((x# `subInt64#` one) `quotInt64#` y#) `subInt64#` one
| isTrue# (x# `ltInt64#` zero) && isTrue# (y# `gtInt64#` zero)
= ((x# `plusInt64#` one) `quotInt64#` y#) `subInt64#` 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#
instance Read Int64 where
readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
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
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
#else
data {-# CTYPE "HsInt64" #-} Int64 = I64# Int#
instance Eq Int64 where
== :: Int64 -> Int64 -> Bool
(==) = Int64 -> Int64 -> Bool
eqInt64
/= :: Int64 -> Int64 -> Bool
(/=) = Int64 -> Int64 -> Bool
neInt64
eqInt64, neInt64 :: Int64 -> Int64 -> Bool
eqInt64 :: Int64 -> Int64 -> Bool
eqInt64 (I64# Int#
x) (I64# Int#
y) = Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
==# Int#
y)
neInt64 :: Int64 -> Int64 -> Bool
neInt64 (I64# Int#
x) (I64# Int#
y) = Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
/=# Int#
y)
{-# INLINE [1] eqInt64 #-}
{-# INLINE [1] neInt64 #-}
instance Ord Int64 where
< :: Int64 -> Int64 -> Bool
(<) = Int64 -> Int64 -> Bool
ltInt64
<= :: Int64 -> Int64 -> Bool
(<=) = Int64 -> Int64 -> Bool
leInt64
>= :: Int64 -> Int64 -> Bool
(>=) = Int64 -> Int64 -> Bool
geInt64
> :: Int64 -> Int64 -> Bool
(>) = Int64 -> Int64 -> Bool
gtInt64
{-# INLINE [1] gtInt64 #-}
{-# INLINE [1] geInt64 #-}
{-# INLINE [1] ltInt64 #-}
{-# INLINE [1] leInt64 #-}
gtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool
(I64# Int#
x) gtInt64 :: Int64 -> Int64 -> Bool
`gtInt64` (I64# Int#
y) = Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
># Int#
y)
(I64# Int#
x) geInt64 :: Int64 -> Int64 -> Bool
`geInt64` (I64# Int#
y) = Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
>=# Int#
y)
(I64# Int#
x) ltInt64 :: Int64 -> Int64 -> Bool
`ltInt64` (I64# Int#
y) = Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
<# Int#
y)
(I64# Int#
x) leInt64 :: Int64 -> Int64 -> Bool
`leInt64` (I64# Int#
y) = Int# -> Bool
isTrue# (Int#
x Int# -> Int# -> Int#
<=# Int#
y)
instance Show Int64 where
showsPrec :: Int -> Int64 -> ShowS
showsPrec Int
p Int64
x = Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x :: Int)
instance Num Int64 where
(I64# Int#
x#) + :: Int64 -> Int64 -> Int64
+ (I64# Int#
y#) = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
+# Int#
y#)
(I64# Int#
x#) - :: Int64 -> Int64 -> Int64
- (I64# Int#
y#) = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
-# Int#
y#)
(I64# Int#
x#) * :: Int64 -> Int64 -> Int64
* (I64# Int#
y#) = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
*# Int#
y#)
negate :: Int64 -> Int64
negate (I64# Int#
x#) = Int# -> Int64
I64# (Int# -> Int#
negateInt# Int#
x#)
abs :: Int64 -> Int64
abs Int64
x | Int64
x Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0 = Int64
x
| Bool
otherwise = Int64 -> Int64
forall a. Num a => a -> a
negate Int64
x
signum :: Int64 -> Int64
signum Int64
x | Int64
x Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 = Int64
1
signum Int64
0 = Int64
0
signum Int64
_ = Int64
-1
fromInteger :: Integer -> Int64
fromInteger Integer
i = Int# -> Int64
I64# (Integer -> Int#
integerToInt# Integer
i)
instance Enum Int64 where
succ :: Int64 -> Int64
succ Int64
x
| Int64
x Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
forall a. Bounded a => a
maxBound = Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1
| Bool
otherwise = String -> Int64
forall a. String -> a
succError String
"Int64"
pred :: Int64 -> Int64
pred Int64
x
| Int64
x Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
forall a. Bounded a => a
minBound = Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1
| Bool
otherwise = String -> Int64
forall a. String -> a
predError String
"Int64"
toEnum :: Int -> Int64
toEnum (I# Int#
i#) = Int# -> Int64
I64# Int#
i#
fromEnum :: Int64 -> Int
fromEnum (I64# Int#
x#) = Int# -> Int
I# Int#
x#
enumFrom :: Int64 -> [Int64]
enumFrom = Int64 -> [Int64]
forall a. (Enum a, Bounded a) => a -> [a]
boundedEnumFrom
enumFromThen :: Int64 -> Int64 -> [Int64]
enumFromThen = Int64 -> Int64 -> [Int64]
forall a. (Enum a, Bounded a) => a -> a -> [a]
boundedEnumFromThen
instance Integral Int64 where
quot :: Int64 -> Int64 -> Int64
quot x :: Int64
x@(I64# Int#
x#) y :: Int64
y@(I64# Int#
y#)
| Int64
y Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 = Int64
forall a. a
divZeroError
| Int64
y Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int64
-1) Bool -> Bool -> Bool
&& Int64
x Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
forall a. Bounded a => a
minBound = Int64
forall a. a
overflowError
| Bool
otherwise = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
`quotInt#` Int#
y#)
rem :: Int64 -> Int64 -> Int64
rem (I64# Int#
x#) y :: Int64
y@(I64# Int#
y#)
| Int64
y Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 = Int64
forall a. a
divZeroError
| Int64
y Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int64
-1) = Int64
0
| Bool
otherwise = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
`remInt#` Int#
y#)
div :: Int64 -> Int64 -> Int64
div x :: Int64
x@(I64# Int#
x#) y :: Int64
y@(I64# Int#
y#)
| Int64
y Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 = Int64
forall a. a
divZeroError
| Int64
y Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int64
-1) Bool -> Bool -> Bool
&& Int64
x Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
forall a. Bounded a => a
minBound = Int64
forall a. a
overflowError
| Bool
otherwise = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
`divInt#` Int#
y#)
mod :: Int64 -> Int64 -> Int64
mod (I64# Int#
x#) y :: Int64
y@(I64# Int#
y#)
| Int64
y Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 = Int64
forall a. a
divZeroError
| Int64
y Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int64
-1) = Int64
0
| Bool
otherwise = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
`modInt#` Int#
y#)
quotRem :: Int64 -> Int64 -> (Int64, Int64)
quotRem x :: Int64
x@(I64# Int#
x#) y :: Int64
y@(I64# Int#
y#)
| Int64
y Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 = (Int64, Int64)
forall a. a
divZeroError
| Int64
y Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int64
-1) Bool -> Bool -> Bool
&& Int64
x Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
forall a. Bounded a => a
minBound = (Int64
forall a. a
overflowError, Int64
0)
| Bool
otherwise = case Int#
x# Int# -> Int# -> (# Int#, Int# #)
`quotRemInt#` Int#
y# of
(# Int#
q, Int#
r #) ->
(Int# -> Int64
I64# Int#
q, Int# -> Int64
I64# Int#
r)
divMod :: Int64 -> Int64 -> (Int64, Int64)
divMod x :: Int64
x@(I64# Int#
x#) y :: Int64
y@(I64# Int#
y#)
| Int64
y Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 = (Int64, Int64)
forall a. a
divZeroError
| Int64
y Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int64
-1) Bool -> Bool -> Bool
&& Int64
x Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
forall a. Bounded a => a
minBound = (Int64
forall a. a
overflowError, Int64
0)
| Bool
otherwise = case Int#
x# Int# -> Int# -> (# Int#, Int# #)
`divModInt#` Int#
y# of
(# Int#
d, Int#
m #) ->
(Int# -> Int64
I64# Int#
d, Int# -> Int64
I64# Int#
m)
toInteger :: Int64 -> Integer
toInteger (I64# Int#
x#) = Int# -> Integer
IS Int#
x#
instance Read Int64 where
readsPrec :: Int -> ReadS Int64
readsPrec Int
p String
s = [(Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x::Int), String
r) | (Int
x, String
r) <- Int -> ReadS Int
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
s]
instance Bits Int64 where
{-# INLINE shift #-}
{-# INLINE bit #-}
{-# INLINE testBit #-}
{-# INLINE popCount #-}
(I64# Int#
x#) .&. :: Int64 -> Int64 -> Int64
.&. (I64# Int#
y#) = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
`andI#` Int#
y#)
(I64# Int#
x#) .|. :: Int64 -> Int64 -> Int64
.|. (I64# Int#
y#) = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
`orI#` Int#
y#)
(I64# Int#
x#) xor :: Int64 -> Int64 -> Int64
`xor` (I64# Int#
y#) = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
`xorI#` Int#
y#)
complement :: Int64 -> Int64
complement (I64# Int#
x#) = Int# -> Int64
I64# (Int# -> Int#
notI# Int#
x#)
(I64# Int#
x#) shift :: Int64 -> Int -> Int64
`shift` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
`iShiftL#` Int#
i#)
| Bool
otherwise = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
`iShiftRA#` Int# -> Int#
negateInt# Int#
i#)
(I64# Int#
x#) shiftL :: Int64 -> Int -> Int64
`shiftL` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
`iShiftL#` Int#
i#)
| Bool
otherwise = Int64
forall a. a
overflowError
(I64# Int#
x#) unsafeShiftL :: Int64 -> Int -> Int64
`unsafeShiftL` (I# Int#
i#) = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
i#)
(I64# Int#
x#) shiftR :: Int64 -> Int -> Int64
`shiftR` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
`iShiftRA#` Int#
i#)
| Bool
otherwise = Int64
forall a. a
overflowError
(I64# Int#
x#) unsafeShiftR :: Int64 -> Int -> Int64
`unsafeShiftR` (I# Int#
i#) = Int# -> Int64
I64# (Int#
x# Int# -> Int# -> Int#
`uncheckedIShiftRA#` Int#
i#)
(I64# Int#
x#) rotate :: Int64 -> Int -> Int64
`rotate` (I# Int#
i#)
| Int# -> Bool
isTrue# (Int#
i'# Int# -> Int# -> Int#
==# Int#
0#)
= Int# -> Int64
I64# Int#
x#
| Bool
otherwise
= Int# -> Int64
I64# (Word# -> Int#
word2Int# ((Word#
x'# Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
i'#) Word# -> Word# -> Word#
`or#`
(Word#
x'# Word# -> Int# -> Word#
`uncheckedShiftRL#` (Int#
64# Int# -> Int# -> Int#
-# Int#
i'#))))
where
!x'# :: Word#
x'# = Int# -> Word#
int2Word# Int#
x#
!i'# :: Int#
i'# = Word# -> Int#
word2Int# (Int# -> Word#
int2Word# Int#
i# Word# -> Word# -> Word#
`and#` Word#
63##)
bitSizeMaybe :: Int64 -> Maybe Int
bitSizeMaybe Int64
i = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int64 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Int64
i)
bitSize :: Int64 -> Int
bitSize Int64
i = Int64 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Int64
i
isSigned :: Int64 -> Bool
isSigned Int64
_ = Bool
True
popCount :: Int64 -> Int
popCount (I64# Int#
x#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
popCnt64# (Int# -> Word#
int2Word# Int#
x#)))
bit :: Int -> Int64
bit = Int -> Int64
forall a. (Bits a, Num a) => Int -> a
bitDefault
testBit :: Int64 -> Int -> Bool
testBit = Int64 -> Int -> Bool
forall a. (Bits a, Num a) => a -> Int -> Bool
testBitDefault
{-# 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# :: Int# -> Int# -> Int#
uncheckedIShiftL64# = Int# -> Int# -> Int#
uncheckedIShiftL#
uncheckedIShiftRA64# :: Int# -> Int# -> Int#
uncheckedIShiftRA64# :: Int# -> Int# -> Int#
uncheckedIShiftRA64# = Int# -> Int# -> Int#
uncheckedIShiftRA#
#endif
instance FiniteBits Int64 where
{-# INLINE countLeadingZeros #-}
{-# INLINE countTrailingZeros #-}
finiteBitSize :: Int64 -> Int
finiteBitSize Int64
_ = Int
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 :: Int64 -> Int
countLeadingZeros (I64# Int#
x#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
clz64# (Int# -> Word#
int2Word# Int#
x#)))
countTrailingZeros :: Int64 -> Int
countTrailingZeros (I64# Int#
x#) = Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
ctz64# (Int# -> Word#
int2Word# Int#
x#)))
#endif
instance Real Int64 where
toRational :: Int64 -> Rational
toRational Int64
x = Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1
instance Bounded Int64 where
minBound :: Int64
minBound = Int64
-0x8000000000000000
maxBound :: Int64
maxBound = Int64
0x7FFFFFFFFFFFFFFF
instance Ix Int64 where
range :: (Int64, Int64) -> [Int64]
range (Int64
m,Int64
n) = [Int64
m..Int64
n]
unsafeIndex :: (Int64, Int64) -> Int64 -> Int
unsafeIndex (Int64
m,Int64
_) Int64
i = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
m
inRange :: (Int64, Int64) -> Int64 -> Bool
inRange (Int64
m,Int64
n) Int64
i = Int64
m Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
i Bool -> Bool -> Bool
&& Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
n