{-# language DataKinds #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}

module Basics.Int
  ( -- Types
    T
  , T#
  , R
    -- Lifting
  , lift
  , unlift
    -- Arithmetic
  , plus
  , minus
  , plus#
  , minus#
  , times#
  , quot#
  , rem#
    -- Compare
  , gt#
  , lt#
  , gte#
  , lte#
  , eq#
  , neq#
  , gt
  , lt
  , gte
  , lte
  , eq
  , neq
    -- Array
  , read#
  , write#
  , index#
  , set#
  , uninitialized#
  , initialized#
  , uninitialized
  , initialized
  , copy#
  , copyMutable#
  , shrink#
    -- Constants
  , zero
  , def
    -- Metadata
  , signed
  , size
    -- Encoding
  , shows
  ) where

import Prelude hiding (shows)

import Data.Primitive (MutableByteArray(..))
import GHC.Exts ((+#),(*#),(-#))
import GHC.Exts (Int(I#),RuntimeRep(IntRep))
import GHC.Exts (State#,MutableByteArray#,Int#,ByteArray#)
import GHC.ST (ST(ST))

import qualified Prelude
import qualified GHC.Exts as Exts
import qualified Foreign.Storable as FS

type T = Int
type T# = Int#
type R = 'IntRep

def :: T
{-# inline def #-}
def :: T
def = T
0

zero :: T
{-# inline zero #-}
zero :: T
zero = T
0

size :: Int
{-# inline size #-}
size :: T
size = forall a. Storable a => a -> T
FS.sizeOf (forall a. HasCallStack => a
undefined :: Int)

signed :: Bool
{-# inline signed #-}
signed :: Bool
signed = Bool
True

lift :: T# -> T
{-# inline lift #-}
lift :: T# -> T
lift = T# -> T
I#

unlift :: T -> T#
{-# inline unlift #-}
unlift :: T -> T#
unlift (I# T#
i) = T#
i

plus :: T -> T -> T
{-# inline plus #-}
plus :: T -> T -> T
plus (I# T#
x) (I# T#
y) = T# -> T
I# (T#
x T# -> T# -> T#
+# T#
y)

minus :: T -> T -> T
{-# inline minus #-}
minus :: T -> T -> T
minus (I# T#
x) (I# T#
y) = T# -> T
I# (T#
x T# -> T# -> T#
-# T#
y)

times# :: T# -> T# -> T#
{-# inline times# #-}
times# :: T# -> T# -> T#
times# = T# -> T# -> T#
(*#)

quot# :: T# -> T# -> T#
{-# inline quot# #-}
quot# :: T# -> T# -> T#
quot# = T# -> T# -> T#
Exts.quotInt#

rem# :: T# -> T# -> T#
{-# inline rem# #-}
rem# :: T# -> T# -> T#
rem# = T# -> T# -> T#
Exts.remInt#

plus# :: T# -> T# -> T#
{-# inline plus# #-}
plus# :: T# -> T# -> T#
plus# = T# -> T# -> T#
(+#)

minus# :: T# -> T# -> T#
{-# inline minus# #-}
minus# :: T# -> T# -> T#
minus# = T# -> T# -> T#
(-#)

gt# :: T# -> T# -> Int#
{-# inline gt# #-}
gt# :: T# -> T# -> T#
gt# = T# -> T# -> T#
(Exts.>#)

lt# :: T# -> T# -> Int#
{-# inline lt# #-}
lt# :: T# -> T# -> T#
lt# = T# -> T# -> T#
(Exts.<#)

gte# :: T# -> T# -> Int#
{-# inline gte# #-}
gte# :: T# -> T# -> T#
gte# = T# -> T# -> T#
(Exts.>=#)

lte# :: T# -> T# -> Int#
{-# inline lte# #-}
lte# :: T# -> T# -> T#
lte# = T# -> T# -> T#
(Exts.<=#)

eq# :: T# -> T# -> Int#
{-# inline eq# #-}
eq# :: T# -> T# -> T#
eq# = T# -> T# -> T#
(Exts.==#)

neq# :: T# -> T# -> Int#
{-# inline neq# #-}
neq# :: T# -> T# -> T#
neq# = T# -> T# -> T#
(Exts./=#)

gt :: T -> T -> Bool
{-# inline gt #-}
gt :: T -> T -> Bool
gt = forall a. Ord a => a -> a -> Bool
(>)

lt :: T -> T -> Bool
{-# inline lt #-}
lt :: T -> T -> Bool
lt = forall a. Ord a => a -> a -> Bool
(<)

gte :: T -> T -> Bool
{-# inline gte #-}
gte :: T -> T -> Bool
gte = forall a. Ord a => a -> a -> Bool
(>=)

lte :: T -> T -> Bool
{-# inline lte #-}
lte :: T -> T -> Bool
lte = forall a. Ord a => a -> a -> Bool
(<=)

eq :: T -> T -> Bool
{-# inline eq #-}
eq :: T -> T -> Bool
eq = forall a. Eq a => a -> a -> Bool
(==)

neq :: T -> T -> Bool
{-# inline neq #-}
neq :: T -> T -> Bool
neq = forall a. Eq a => a -> a -> Bool
(/=)

index# :: ByteArray# -> Int# -> T#
{-# inline index# #-}
index# :: ByteArray# -> T# -> T#
index# = ByteArray# -> T# -> T#
Exts.indexIntArray#

read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)
{-# inline read# #-}
read# :: forall s.
MutableByteArray# s -> T# -> State# s -> (# State# s, T# #)
read# = forall s.
MutableByteArray# s -> T# -> State# s -> (# State# s, T# #)
Exts.readIntArray#

write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s
{-# inline write# #-}
write# :: forall s. MutableByteArray# s -> T# -> T# -> State# s -> State# s
write# = forall s. MutableByteArray# s -> T# -> T# -> State# s -> State# s
Exts.writeIntArray#

set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s
{-# inline set# #-}
set# :: forall s.
MutableByteArray# s -> T# -> T# -> T# -> State# s -> State# s
set# MutableByteArray# s
marr T#
off T#
len T#
x State# s
s = case T#
len of
  T#
0# -> State# s
s
  T#
_ -> forall s.
MutableByteArray# s -> T# -> T# -> T# -> State# s -> State# s
set# MutableByteArray# s
marr (T#
off T# -> T# -> T#
+# T#
1# ) (T#
len T# -> T# -> T#
-# T#
1# ) T#
x (forall s. MutableByteArray# s -> T# -> T# -> State# s -> State# s
write# MutableByteArray# s
marr T#
off T#
x State# s
s)

uninitialized# :: Int# -> State# s -> (# State# s, MutableByteArray# s #)
{-# inline uninitialized# #-}
uninitialized# :: forall s. T# -> State# s -> (# State# s, MutableByteArray# s #)
uninitialized# T#
sz = forall s. T# -> State# s -> (# State# s, MutableByteArray# s #)
Exts.newByteArray# (T#
sz T# -> T# -> T#
*# (case T
size of I# T#
i -> T#
i))

initialized# ::
     Int# -> T# -> State# s
  -> (# State# s, MutableByteArray# s #)
{-# inline initialized# #-}
initialized# :: forall s.
T# -> T# -> State# s -> (# State# s, MutableByteArray# s #)
initialized# T#
n T#
e State# s
s0 = case forall s. T# -> State# s -> (# State# s, MutableByteArray# s #)
uninitialized# T#
n State# s
s0 of
  (# State# s
s1, MutableByteArray# s
a #) -> case forall s.
MutableByteArray# s -> T# -> T# -> T# -> State# s -> State# s
set# MutableByteArray# s
a T#
0# T#
n T#
e State# s
s1 of
    State# s
s2 -> (# State# s
s2, MutableByteArray# s
a #)

uninitialized :: Int -> ST s (MutableByteArray s)
{-# inline uninitialized #-}
uninitialized :: forall s. T -> ST s (MutableByteArray s)
uninitialized (I# T#
sz) = forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \State# s
s0 -> case forall s. T# -> State# s -> (# State# s, MutableByteArray# s #)
uninitialized# T#
sz State# s
s0 of
  (# State# s
s1, MutableByteArray# s
a #) -> (# State# s
s1, forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
a #)

initialized :: Int -> T -> ST s (MutableByteArray s)
{-# inline initialized #-}
initialized :: forall s. T -> T -> ST s (MutableByteArray s)
initialized (I# T#
sz) T
e = forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \State# s
s0 -> case forall s.
T# -> T# -> State# s -> (# State# s, MutableByteArray# s #)
initialized# T#
sz (T -> T#
unlift T
e) State# s
s0 of
  (# State# s
s1, MutableByteArray# s
a #) -> (# State# s
s1, forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
a #)

copy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s
{-# inline copy# #-}
copy# :: forall s.
MutableByteArray# s
-> T# -> ByteArray# -> T# -> T# -> State# s -> State# s
copy# MutableByteArray# s
dst T#
doff ByteArray#
src T#
soff T#
len = forall d.
ByteArray#
-> T# -> MutableByteArray# d -> T# -> T# -> State# d -> State# d
Exts.copyByteArray#
  ByteArray#
src
  (T#
soff T# -> T# -> T#
*# (case T
size of I# T#
i -> T#
i))
  MutableByteArray# s
dst
  (T#
doff T# -> T# -> T#
*# (case T
size of I# T#
i -> T#
i))
  (T#
len T# -> T# -> T#
*# (case T
size of I# T#
i -> T#
i))

copyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
{-# inline copyMutable# #-}
copyMutable# :: forall s.
MutableByteArray# s
-> T# -> MutableByteArray# s -> T# -> T# -> State# s -> State# s
copyMutable# MutableByteArray# s
dst T#
doff MutableByteArray# s
src T#
soff T#
len = forall s.
MutableByteArray# s
-> T# -> MutableByteArray# s -> T# -> T# -> State# s -> State# s
Exts.copyMutableByteArray#
  MutableByteArray# s
src
  (T#
soff T# -> T# -> T#
*# (case T
size of I# T#
i -> T#
i))
  MutableByteArray# s
dst
  (T#
doff T# -> T# -> T#
*# (case T
size of I# T#
i -> T#
i))
  (T#
len T# -> T# -> T#
*# (case T
size of I# T#
i -> T#
i))

shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
{-# inline shrink# #-}
shrink# :: forall s.
MutableByteArray# s
-> T# -> State# s -> (# State# s, MutableByteArray# s #)
shrink# MutableByteArray# s
m T#
i State# s
s0 = (# forall d. MutableByteArray# d -> T# -> State# d -> State# d
Exts.shrinkMutableByteArray# MutableByteArray# s
m (T#
i T# -> T# -> T#
*# (case T
size of I# T#
sz -> T#
sz)) State# s
s0, MutableByteArray# s
m #)

shows :: T -> String -> String
{-# inline shows #-}
shows :: T -> String -> String
shows = forall a. Show a => a -> String -> String
Prelude.shows