{-# LANGUAGE Trustworthy, CPP, MagicHash, UnboxedTuples, BangPatterns #-}

{- |
    Module      :  SDP.Unboxed
    Copyright   :  (c) Andrey Mulik 2019
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  portable
    
    "SDP.Unboxed" provide service class 'Unboxed', that needed for
    "SDP.Prim.SBytes"-based structures.
-}
module SDP.Unboxed
(
  -- * Unboxed
  Unboxed (..), cloneUnboxed#, cloneUnboxed1#,
  
  -- ** Proxy
  psizeof, pnewUnboxed, pcopyUnboxed, pcopyUnboxedM, fromProxy,
  pnewUnboxed1, pcopyUnboxed1, pcopyUnboxedM1, fromProxy1
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.Ratio

import GHC.Stable
import GHC.Base
import GHC.Word
import GHC.Int
import GHC.Ptr
import GHC.ST

import Data.Complex

import Foreign.C.Types

#include "MachDeps.h"

default ()

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

{- |
  'Unboxed' is a layer between untyped raw data and parameterized unboxed data
  structures. Also it prevents direct interaction with primitives.
-}
class (Eq e) => Unboxed e
  where
    {-# MINIMAL (sizeof#|sizeof), (!#), (!>#), writeByteArray#, newUnboxed #-}
    
    {- |
      @sizeof e n@ returns the length (in bytes) of primitive, where @n@ - count
      of elements, @e@ - type parameter.
    -}
    {-# INLINE sizeof #-}
    sizeof :: e -> Int -> Int
    sizeof e
e (I# Int#
c#) = Int# -> Int
I# (e -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# e
e Int#
c#)
    
    -- | 'sizeof#' is unboxed 'sizeof'.
    {-# INLINE sizeof# #-}
    sizeof# :: e -> Int# -> Int#
    sizeof# e
e Int#
c# = case e -> Int -> Int
forall e. Unboxed e => e -> Int -> Int
sizeof e
e (Int# -> Int
I# Int#
c#) of I# Int#
n# -> Int#
n#
    
    -- | Unsafe 'ByteArray#' reader with overloaded result type.
    (!#) :: ByteArray# -> Int# -> e
    
    -- | Unsafe 'MutableByteArray#' reader with overloaded result type.
    (!>#) :: MutableByteArray# s -> Int# -> State# s -> (# State# s, e #)
    
    -- | Unsafe 'MutableByteArray#' writer.
    writeByteArray# :: MutableByteArray# s -> Int# -> e -> State# s -> State# s
    
    {-# INLINE fillByteArray# #-}
    -- | Procedure for filling the array with the default value (like calloc).
    fillByteArray# :: MutableByteArray# s -> Int# -> e -> State# s -> State# s
    fillByteArray# MutableByteArray# s
mbytes# Int#
n# e
e = Int# -> Int
I# Int#
n# Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool
-> (State# s -> State# s)
-> (State# s -> State# s)
-> State# s
-> State# s
forall a. Bool -> a -> a -> a
? Int# -> State# s -> State# s
go (Int#
n# Int# -> Int# -> Int#
-# Int#
1#) ((State# s -> State# s) -> State# s -> State# s)
-> (State# s -> State# s) -> State# s -> State# s
forall a b. (a -> b) -> a -> b
$ \ State# s
s1# -> State# s
s1#
      where
        go :: Int# -> State# s -> State# s
go Int#
0# State# s
s2# = MutableByteArray# s -> Int# -> e -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
0# e
e State# s
s2#
        go Int#
c# State# s
s2# = Int# -> State# s -> State# s
go (Int#
c# Int# -> Int# -> Int#
-# Int#
1#) (MutableByteArray# s -> Int# -> e -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
c# e
e State# s
s2#)
    
    {- |
      'newUnboxed' creates new 'MutableByteArray#' of given count of elements.
      First argument used as type variable.
    -}
    newUnboxed :: e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
    
    {-# INLINE newUnboxed' #-}
    {- |
      'newUnboxed'' is version of 'newUnboxed', that use first argument as
      initial value. May fail when trying to write 'error' or 'undefined'.
    -}
    newUnboxed' :: e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
    newUnboxed' e
e Int#
n# = \ State# s
s1# -> case e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall e s.
Unboxed e =>
e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed e
e Int#
n# State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> e -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# e
e State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)
    
    {- |
      @'copyUnboxed#' e bytes\# o1\# mbytes\# o2\# n\#@ unsafely writes elements
      from @bytes\#@ to @mbytes\#@, where o1\# and o2\# - offsets (element
      count), @n\#@ - count of elements to copy.
    -}
    copyUnboxed# :: e -> ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
    copyUnboxed# e
e ByteArray#
bytes# Int#
o1# MutableByteArray# s
mbytes# Int#
o2# Int#
n# = ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
bytes# (e -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# e
e Int#
o1#) MutableByteArray# s
mbytes# (e -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# e
e Int#
o2#) (e -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# e
e Int#
n#)
    
    {- |
      @'copyUnboxedM#' e msrc\# o1\# mbytes\# o2\# n\#@ unsafely writes elements
      from @msrc\#@ to @mbytes\#@, where o1\# and o2\# - offsets (element
      count), @n\#@ - count of elements to copy.
    -}
    copyUnboxedM# :: e -> MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
    copyUnboxedM# e
e MutableByteArray# s
msrc# Int#
o1# MutableByteArray# s
mbytes# Int#
o2# Int#
n# = MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
MutableByteArray# d
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableByteArray# MutableByteArray# s
msrc# (e -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# e
e Int#
o1#) MutableByteArray# s
mbytes# (e -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# e
e Int#
o2#) (e -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# e
e Int#
n#)
    
    {- |
      @'hashUnboxedWith' e len# off# bytes# salt@ returns @bytes#@ @FNV-1@ hash,
      where @off#@ and @len#@ is offset and length (in elements).
      
      Note: the standard definition of this function is written in Haskell using
      low-level functions, but this implementation mayn't be as efficient as the
      foreign procedure in the @hashable@ package.
    -}
    hashUnboxedWith :: e -> Int# -> Int# -> ByteArray# -> Int# -> Int#
    hashUnboxedWith e
e Int#
len# Int#
off# ByteArray#
bytes# = Int# -> Int# -> Int# -> Int#
go (e -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# e
e Int#
off#) (e -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# e
e Int#
len#)
      where
        go :: Int# -> Int# -> Int# -> Int#
go Int#
_  Int#
0# Int#
salt# = Int#
salt#
        go Int#
o# Int#
n# Int#
salt# = Int# -> Int# -> Int# -> Int#
go (Int#
o# Int# -> Int# -> Int#
+# Int#
1#) (Int#
n# Int# -> Int# -> Int#
-# Int#
1#) (Word# -> Int#
word2Int# Word#
hash#)
          where
            prod# :: Word#
prod# = Int# -> Word#
int2Word# (Int#
salt# Int# -> Int# -> Int#
*# Int#
16777619#)
            elem# :: Word#
elem# = ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
bytes# Int#
o#
            hash# :: Word#
hash# = Word#
prod# Word# -> Word# -> Word#
`xor#` Word#
elem#

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

-- | 'psizeof' is @Proxy 'sizeof'@.
psizeof :: (Unboxed e) => proxy e -> Int -> Int
psizeof :: proxy e -> Int -> Int
psizeof =  e -> Int -> Int
forall e. Unboxed e => e -> Int -> Int
sizeof (e -> Int -> Int) -> (proxy e -> e) -> proxy e -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy e -> e
forall (proxy :: * -> *) e. proxy e -> e
fromProxy

-- | @(* -> *)@ kind proxy version of 'newUnboxed'.
pnewUnboxed :: (Unboxed e) => proxy e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
pnewUnboxed :: proxy e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
pnewUnboxed =  e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall e s.
Unboxed e =>
e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed (e -> Int# -> State# s -> (# State# s, MutableByteArray# s #))
-> (proxy e -> e)
-> proxy e
-> Int#
-> State# s
-> (# State# s, MutableByteArray# s #)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy e -> e
forall (proxy :: * -> *) e. proxy e -> e
fromProxy

-- | @(* -> *)@ kind proxy version if 'copyUnboxed#'.
pcopyUnboxed :: (Unboxed e) => proxy e -> ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
pcopyUnboxed :: proxy e
-> ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
pcopyUnboxed =  e
-> ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall e s.
Unboxed e =>
e
-> ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyUnboxed# (e
 -> ByteArray#
 -> Int#
 -> MutableByteArray# s
 -> Int#
 -> Int#
 -> State# s
 -> State# s)
-> (proxy e -> e)
-> proxy e
-> ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy e -> e
forall (proxy :: * -> *) e. proxy e -> e
fromProxy

-- | Proxy version if 'copyUnboxedM#'.
pcopyUnboxedM :: (Unboxed e) => proxy e -> MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
pcopyUnboxedM :: proxy e
-> MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
pcopyUnboxedM =  e
-> MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall e s.
Unboxed e =>
e
-> MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyUnboxedM# (e
 -> MutableByteArray# s
 -> Int#
 -> MutableByteArray# s
 -> Int#
 -> Int#
 -> State# s
 -> State# s)
-> (proxy e -> e)
-> proxy e
-> MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy e -> e
forall (proxy :: * -> *) e. proxy e -> e
fromProxy

-- | Returns 'undefined' of suitable type.
fromProxy :: proxy e -> e
fromProxy :: proxy e -> e
fromProxy =  e -> proxy e -> e
forall a b. a -> b -> a
const e
forall a. HasCallStack => a
undefined

-- | @(* -> * -> *)@ kind proxy version of 'newUnboxed'.
pnewUnboxed1 :: (Unboxed e) => m (proxy e) -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
pnewUnboxed1 :: m (proxy e)
-> Int# -> State# s -> (# State# s, MutableByteArray# s #)
pnewUnboxed1 =  e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall e s.
Unboxed e =>
e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed (e -> Int# -> State# s -> (# State# s, MutableByteArray# s #))
-> (m (proxy e) -> e)
-> m (proxy e)
-> Int#
-> State# s
-> (# State# s, MutableByteArray# s #)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (proxy e) -> e
forall (m :: * -> *) (proxy :: * -> *) e. m (proxy e) -> e
fromProxy1

-- | @(* -> * -> *)@ kind proxy version if 'copyUnboxed#'.
pcopyUnboxed1 :: (Unboxed e) => m (proxy e) -> ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
pcopyUnboxed1 :: m (proxy e)
-> ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
pcopyUnboxed1 =  e
-> ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall e s.
Unboxed e =>
e
-> ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyUnboxed# (e
 -> ByteArray#
 -> Int#
 -> MutableByteArray# s
 -> Int#
 -> Int#
 -> State# s
 -> State# s)
-> (m (proxy e) -> e)
-> m (proxy e)
-> ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (proxy e) -> e
forall (m :: * -> *) (proxy :: * -> *) e. m (proxy e) -> e
fromProxy1

-- | @(* -> * -> *)@ kind proxy version if 'copyUnboxedM#'.
pcopyUnboxedM1 :: (Unboxed e) => m (proxy e) -> MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
pcopyUnboxedM1 :: m (proxy e)
-> MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
pcopyUnboxedM1 =  e
-> MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall e s.
Unboxed e =>
e
-> MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyUnboxedM# (e
 -> MutableByteArray# s
 -> Int#
 -> MutableByteArray# s
 -> Int#
 -> Int#
 -> State# s
 -> State# s)
-> (m (proxy e) -> e)
-> m (proxy e)
-> MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (proxy e) -> e
forall (m :: * -> *) (proxy :: * -> *) e. m (proxy e) -> e
fromProxy1

-- | Returns 'undefined' of suitable type.
fromProxy1 :: m (proxy e) -> e
fromProxy1 :: m (proxy e) -> e
fromProxy1 =  e -> m (proxy e) -> e
forall a b. a -> b -> a
const e
forall a. HasCallStack => a
undefined

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

{- Int instances. -}

instance Unboxed Int
  where
    {-# INLINE sizeof #-}
    sizeof :: Int -> Int -> Int
sizeof Int
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZEOF_HSWORD
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Int
!# Int#
i# = Int# -> Int
I# (ByteArray# -> Int# -> Int#
indexIntArray# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readIntArray# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Int#
e# #) -> (# State# s
s2#, Int# -> Int
I# Int#
e# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Int -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (I# Int#
e#) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeIntArray# MutableByteArray# s
mbytes# Int#
n# Int#
e#
    
    newUnboxed :: Int -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Int
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Int -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Int
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Int -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# (Int
0 :: Int) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance Unboxed Int8
  where
    {-# INLINE sizeof #-}
    sizeof :: Int8 -> Int -> Int
sizeof Int8
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Int8
!# Int#
i# = Int# -> Int8
I8# (ByteArray# -> Int# -> Int#
indexInt8Array# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8 #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readInt8Array# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Int#
e# #) -> (# State# s
s2#, Int# -> Int8
I8# Int#
e# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Int8 -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (I8#  Int#
e#) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt8Array# MutableByteArray# s
mbytes# Int#
n# Int#
e#
    
    newUnboxed :: Int8 -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Int8
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Int8 -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Int8
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Int8 -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# (Int8
0 :: Int8) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance Unboxed Int16
  where
    {-# INLINE sizeof #-}
    sizeof :: Int16 -> Int -> Int
sizeof Int16
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Int16
!# Int#
i# = Int# -> Int16
I16# (ByteArray# -> Int# -> Int#
indexInt16Array# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16 #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readInt16Array# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Int#
e# #) -> (# State# s
s2#, Int# -> Int16
I16# Int#
e# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Int16 -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (I16# Int#
e#) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt16Array# MutableByteArray# s
mbytes# Int#
n# Int#
e#
    
    newUnboxed :: Int16 -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Int16
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Int16 -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Int16
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Int16 -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# (Int16
0 :: Int16) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance Unboxed Int32
  where
    {-# INLINE sizeof #-}
    sizeof :: Int32 -> Int -> Int
sizeof Int32
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Int32
!# Int#
i# = Int# -> Int32
I32# (ByteArray# -> Int# -> Int#
indexInt32Array# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32 #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readInt32Array# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Int#
e# #) -> (# State# s
s2#, Int# -> Int32
I32# Int#
e# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Int32 -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (I32# Int#
e#) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt32Array# MutableByteArray# s
mbytes# Int#
n# Int#
e#
    
    newUnboxed :: Int32 -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Int32
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Int32 -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Int32
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Int32 -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# (Int32
0 :: Int32) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance Unboxed Int64
  where
    {-# INLINE sizeof #-}
    sizeof :: Int64 -> Int -> Int
sizeof Int64
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Int64
!# Int#
i# = Int# -> Int64
I64# (ByteArray# -> Int# -> Int#
indexInt64Array# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64 #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readInt64Array# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Int#
e# #) -> (# State# s
s2#, Int# -> Int64
I64# Int#
e# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Int64 -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (I64# Int#
e#) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt64Array# MutableByteArray# s
mbytes# Int#
n# Int#
e#
    
    newUnboxed :: Int64 -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Int64
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Int64 -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Int64
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Int64 -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# (Int64
0 :: Int64) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

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

{- Word instances. -}

instance Unboxed Word
  where
    {-# INLINE sizeof #-}
    sizeof :: Word -> Int -> Int
sizeof Word
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZEOF_HSWORD
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Word
!# Int#
i# = Word# -> Word
W# (ByteArray# -> Int# -> Word#
indexWordArray# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWordArray# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Word#
e# #) -> (# State# s
s2#, Word# -> Word
W# Word#
e# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Word -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (W#   Word#
e#) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWordArray# MutableByteArray# s
mbytes# Int#
n# Word#
e#
    
    newUnboxed :: Word -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Word
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Word -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Word
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Word -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# (Word
0 :: Word) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance Unboxed Word8
  where
    {-# INLINE sizeof #-}
    sizeof :: Word8 -> Int -> Int
sizeof Word8
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Word8
!# Int#
i# = Word# -> Word8
W8# (ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8 #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8Array# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Word#
e# #) -> (# State# s
s2#, Word# -> Word8
W8# Word#
e# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Word8 -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (W8#  Word#
e#) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mbytes# Int#
n# Word#
e#
    
    newUnboxed :: Word8 -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Word8
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Word8 -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Word8
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Word8 -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# (Word8
0 :: Word8) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance Unboxed Word16
  where
    {-# INLINE sizeof #-}
    sizeof :: Word16 -> Int -> Int
sizeof Word16
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Word16
!# Int#
i# = Word# -> Word16
W16# (ByteArray# -> Int# -> Word#
indexWord16Array# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16 #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord16Array# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Word#
e# #) -> (# State# s
s2#, Word# -> Word16
W16# Word#
e# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Word16 -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (W16# Word#
e#) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord16Array# MutableByteArray# s
mbytes# Int#
n# Word#
e#
    
    newUnboxed :: Word16 -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Word16
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Word16 -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Word16
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Word16 -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# (Word16
0 :: Word16) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance Unboxed Word32
  where
    {-# INLINE sizeof #-}
    sizeof :: Word32 -> Int -> Int
sizeof Word32
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Word32
!# Int#
i# = Word# -> Word32
W32# (ByteArray# -> Int# -> Word#
indexWord32Array# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32 #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord32Array# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Word#
e# #) -> (# State# s
s2#, Word# -> Word32
W32# Word#
e# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Word32 -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (W32# Word#
e#) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord32Array# MutableByteArray# s
mbytes# Int#
n# Word#
e#
    
    newUnboxed :: Word32 -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Word32
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Word32 -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Word32
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Word32 -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# (Word32
0 :: Word32) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance Unboxed Word64
  where
    {-# INLINE sizeof #-}
    sizeof :: Word64 -> Int -> Int
sizeof Word64
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Word64
!# Int#
i# = Word# -> Word64
W64# (ByteArray# -> Int# -> Word#
indexWord64Array# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64 #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord64Array# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Word#
e# #) -> (# State# s
s2#, Word# -> Word64
W64# Word#
e# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Word64 -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (W64# Word#
e#) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord64Array# MutableByteArray# s
mbytes# Int#
n# Word#
e#
    
    newUnboxed :: Word64 -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Word64
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Word64 -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Word64
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Word64 -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# (Word64
0 :: Word64) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

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

{- Pointer instances. -}

instance Unboxed (Ptr a)
  where
    {-# INLINE sizeof #-}
    sizeof :: Ptr a -> Int -> Int
sizeof Ptr a
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZEOF_HSWORD
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Ptr a
!# Int#
i# = Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Int# -> Addr#
indexAddrArray# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Ptr a #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Addr# #)
readAddrArray# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Addr#
e# #) -> (# State# s
s2#, Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
e# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Ptr a -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (Ptr Addr#
e) = MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Addr# -> State# d -> State# d
writeAddrArray# MutableByteArray# s
mbytes# Int#
n# Addr#
e
    
    newUnboxed :: Ptr a -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Ptr a
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Ptr a -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Ptr a
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Ptr Any -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# Ptr Any
forall a. Ptr a
nullPtr State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance Unboxed (FunPtr a)
  where
    {-# INLINE sizeof #-}
    sizeof :: FunPtr a -> Int -> Int
sizeof FunPtr a
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZEOF_HSWORD
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes#  !# :: ByteArray# -> Int# -> FunPtr a
!#  Int#
i# = Addr# -> FunPtr a
forall a. Addr# -> FunPtr a
FunPtr (ByteArray# -> Int# -> Addr#
indexAddrArray# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, FunPtr a #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Addr# #)
readAddrArray# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Addr#
e# #) -> (# State# s
s2#, Addr# -> FunPtr a
forall a. Addr# -> FunPtr a
FunPtr Addr#
e# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> FunPtr a -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (FunPtr Addr#
e) = MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Addr# -> State# d -> State# d
writeAddrArray# MutableByteArray# s
mbytes# Int#
n# Addr#
e
    
    newUnboxed :: FunPtr a -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed FunPtr a
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (FunPtr a -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# FunPtr a
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> FunPtr Any -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# FunPtr Any
forall a. FunPtr a
nullFunPtr State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance Unboxed (StablePtr a)
  where
    {-# INLINE sizeof #-}
    sizeof :: StablePtr a -> Int -> Int
sizeof StablePtr a
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZEOF_HSWORD
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> StablePtr a
!# Int#
i# = StablePtr# a -> StablePtr a
forall a. StablePtr# a -> StablePtr a
StablePtr (ByteArray# -> Int# -> StablePtr# a
forall a. ByteArray# -> Int# -> StablePtr# a
indexStablePtrArray# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, StablePtr a #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s
-> Int# -> State# s -> (# State# s, StablePtr# a #)
forall d a.
MutableByteArray# d
-> Int# -> State# d -> (# State# d, StablePtr# a #)
readStablePtrArray# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, StablePtr# a
e# #) -> (# State# s
s2#, StablePtr# a -> StablePtr a
forall a. StablePtr# a -> StablePtr a
StablePtr StablePtr# a
e# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> StablePtr a -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (StablePtr StablePtr# a
e) = MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s
forall d a.
MutableByteArray# d -> Int# -> StablePtr# a -> State# d -> State# d
writeStablePtrArray# MutableByteArray# s
mbytes# Int#
n# StablePtr# a
e
    
    newUnboxed :: StablePtr a
-> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed StablePtr a
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (StablePtr a -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# StablePtr a
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s
-> Int# -> StablePtr Any -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# StablePtr Any
forall a. StablePtr a
nullStablePtr State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

nullStablePtr :: StablePtr a
nullStablePtr :: StablePtr a
nullStablePtr =  StablePtr# a -> StablePtr a
forall a. StablePtr# a -> StablePtr a
StablePtr (Int# -> StablePtr# a
unsafeCoerce# Int#
0#)

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

{- Foreign C instances. -}

#define SDP_DERIVE_FOREIGN_UNBOXED(Type)\
instance Unboxed Type where\
{\
  sizeof e = sizeof (consSizeof Type e);\
  arr# !# i# = Type ( arr# !# i# );\
  marr# !># i# = \ s1# -> case (!>#) marr# i# s1# of {(# s2#, e #) -> (# s2#, Type e #)};\
  writeByteArray# marr# i# (Type e) = writeByteArray# marr# i# e;\
  fillByteArray#  marr# i# (Type e) = fillByteArray#  marr# i# e;\
  newUnboxed  (Type e) = newUnboxed  e;\
  newUnboxed' (Type e) = newUnboxed' e;\
}

SDP_DERIVE_FOREIGN_UNBOXED(CChar)
SDP_DERIVE_FOREIGN_UNBOXED(CSChar)
SDP_DERIVE_FOREIGN_UNBOXED(CWchar)
SDP_DERIVE_FOREIGN_UNBOXED(CShort)
SDP_DERIVE_FOREIGN_UNBOXED(CUShort)

SDP_DERIVE_FOREIGN_UNBOXED(CInt)
SDP_DERIVE_FOREIGN_UNBOXED(CUInt)
SDP_DERIVE_FOREIGN_UNBOXED(CLong)
SDP_DERIVE_FOREIGN_UNBOXED(CULong)
SDP_DERIVE_FOREIGN_UNBOXED(CLLong)
SDP_DERIVE_FOREIGN_UNBOXED(CULLong)
SDP_DERIVE_FOREIGN_UNBOXED(CIntPtr)
SDP_DERIVE_FOREIGN_UNBOXED(CUIntPtr)
SDP_DERIVE_FOREIGN_UNBOXED(CIntMax)
SDP_DERIVE_FOREIGN_UNBOXED(CUIntMax)
SDP_DERIVE_FOREIGN_UNBOXED(CPtrdiff)

SDP_DERIVE_FOREIGN_UNBOXED(CTime)
SDP_DERIVE_FOREIGN_UNBOXED(CClock)
SDP_DERIVE_FOREIGN_UNBOXED(CUSeconds)
SDP_DERIVE_FOREIGN_UNBOXED(CSUSeconds)

SDP_DERIVE_FOREIGN_UNBOXED(CSize)
SDP_DERIVE_FOREIGN_UNBOXED(CBool)
SDP_DERIVE_FOREIGN_UNBOXED(CFloat)
SDP_DERIVE_FOREIGN_UNBOXED(CDouble)
SDP_DERIVE_FOREIGN_UNBOXED(CSigAtomic)

#undef SDP_DERIVE_FOREIGN_UNBOXED

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

{- Other instances. -}

instance Unboxed ()
  where
    {-# INLINE sizeof #-}
    sizeof :: () -> Int -> Int
sizeof ()
_ Int
_ = Int
0
    
    {-# INLINE (!#) #-}
    !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, () #)
(!>#) = \ MutableByteArray# s
_ Int#
_ State# s
s# -> (# State# s
s#, () #)
    !# :: ByteArray# -> Int# -> ()
(!#)  = \ ByteArray#
_ Int#
_ -> ()
    
    newUnboxed :: () -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed  ()
_ Int#
_ = Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
0#
    newUnboxed' :: () -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed' ()
_ Int#
_ = Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
0#
    
    writeByteArray# :: MutableByteArray# s -> Int# -> () -> State# s -> State# s
writeByteArray# MutableByteArray# s
_ Int#
_ = \ ()
_ State# s
s# -> State# s
s#
    fillByteArray# :: MutableByteArray# s -> Int# -> () -> State# s -> State# s
fillByteArray#  MutableByteArray# s
_ Int#
_ = \ ()
_ State# s
s# -> State# s
s#

instance Unboxed Bool
  where
    {-# INLINE sizeof #-}
    sizeof :: Bool -> Int -> Int
sizeof Bool
_ Int
c = Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Int -> Int -> Int
forall a. Bool -> a -> a -> a
? Int
n (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 where (Int
n, Int
d) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
c Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
8
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Bool
!# Int#
i# = Int# -> Bool
isTrue# ((ByteArray# -> Int# -> Word#
indexWordArray# ByteArray#
bytes# (Int# -> Int#
bool_index Int#
i#) Word# -> Word# -> Word#
`and#` Int# -> Word#
bool_bit Int#
i#) Word# -> Word# -> Int#
`neWord#` Int# -> Word#
int2Word# Int#
0#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Bool #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWordArray# MutableByteArray# s
mbytes# (Int# -> Int#
bool_index Int#
i#) State# s
s1# of
      (# State# s
s2#, Word#
e# #) -> (# State# s
s2#, Int# -> Bool
isTrue# ((Word#
e# Word# -> Word# -> Word#
`and#` Int# -> Word#
bool_bit Int#
i#) Word# -> Word# -> Int#
`neWord#` Int# -> Word#
int2Word# Int#
0#) #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Bool -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# Bool
e = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWordArray# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
        (# State# s
s2#, Word#
old_byte# #) -> MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWordArray# MutableByteArray# s
mbytes# Int#
i# (Word# -> Word#
bitWrite Word#
old_byte#) State# s
s2#
      where
        bitWrite :: Word# -> Word#
bitWrite Word#
old_byte# = if Bool
e then Word#
old_byte# Word# -> Word# -> Word#
`or#` Int# -> Word#
bool_bit Int#
n# else Word#
old_byte# Word# -> Word# -> Word#
`and#` Int# -> Word#
bool_not_bit Int#
n#
        i# :: Int#
i# = Int# -> Int#
bool_index Int#
n#
    
    newUnboxed :: Bool -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Bool
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Bool -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Bool
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Bool -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# Bool
False State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)
    
    fillByteArray# :: MutableByteArray# s -> Int# -> Bool -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# Bool
e =
      MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> State# d
setByteArray# MutableByteArray# s
mbytes# Int#
0# (Int# -> Int#
bool_scale Int#
n#) (if Bool
e then Int#
0xff# else Int#
0#)
    
    copyUnboxed# :: Bool
-> ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyUnboxed# Bool
e ByteArray#
bytes# Int#
o1# MutableByteArray# s
mbytes# Int#
o2# Int#
c# = Int# -> Bool
isTrue# (Int#
c# Int# -> Int# -> Int#
<# Int#
1#) Bool
-> (State# s -> State# s)
-> (State# s -> State# s)
-> State# s
-> State# s
forall a. Bool -> a -> a -> a
? (\ State# s
s1# -> State# s
s1#) ((State# s -> State# s) -> State# s -> State# s)
-> (State# s -> State# s) -> State# s -> State# s
forall a b. (a -> b) -> a -> b
$
      \ State# s
s1# -> case MutableByteArray# s -> Int# -> Bool -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
o2# ((ByteArray#
bytes# ByteArray# -> Int# -> Bool
forall e. Unboxed e => ByteArray# -> Int# -> e
!# Int#
o1#) Bool -> Bool -> Bool
forall a. a -> a -> a
`asTypeOf` Bool
e) State# s
s1# of
        State# s
s2# -> Bool
-> ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall e s.
Unboxed e =>
e
-> ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyUnboxed# Bool
e ByteArray#
bytes# (Int#
o1# Int# -> Int# -> Int#
+# Int#
1#) MutableByteArray# s
mbytes# (Int#
o2# Int# -> Int# -> Int#
+# Int#
1#) (Int#
c# Int# -> Int# -> Int#
-# Int#
1#) State# s
s2#
    
    copyUnboxedM# :: Bool
-> MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyUnboxedM# Bool
e MutableByteArray# s
src# Int#
o1# MutableByteArray# s
mbytes# Int#
o2# Int#
n# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Bool #)
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, e #)
(!>#) MutableByteArray# s
src# Int#
o1# State# s
s1# of
      (# State# s
s2#, Bool
x #) -> case MutableByteArray# s -> Int# -> Bool -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
o2# (Bool
x Bool -> Bool -> Bool
forall a. a -> a -> a
`asTypeOf` Bool
e) State# s
s2# of
        State# s
s3# -> Bool
-> MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall e s.
Unboxed e =>
e
-> MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyUnboxedM# Bool
e MutableByteArray# s
src# (Int#
o1# Int# -> Int# -> Int#
+# Int#
1#) MutableByteArray# s
mbytes# (Int#
o2# Int# -> Int# -> Int#
+# Int#
1#) (Int#
n# Int# -> Int# -> Int#
-# Int#
1#) State# s
s3#
    
    hashUnboxedWith :: Bool -> Int# -> Int# -> ByteArray# -> Int# -> Int#
hashUnboxedWith Bool
e Int#
len# Int#
off# ByteArray#
bytes#
        | Int# -> Bool
isTrue#   (Int#
len# Int# -> Int# -> Int#
<# Int#
1#)    = \ Int#
salt# -> Int#
salt#
        | Int# -> Bool
isTrue#   (Int#
off# Int# -> Int# -> Int#
<# Int#
0#)    = Bool -> Int# -> Int# -> ByteArray# -> Int# -> Int#
forall e.
Unboxed e =>
e -> Int# -> Int# -> ByteArray# -> Int# -> Int#
hashUnboxedWith Bool
e Int#
len# Int#
0# ByteArray#
bytes#
        | Int# -> Bool
isTrue# (Int#
bit_off# Int# -> Int# -> Int#
==# Int#
0#) = Int# -> Int# -> Int# -> Int#
go0 Int#
byte_cnt# Int#
byte_off#
        |            Bool
True           = Int# -> Int# -> Word# -> Int# -> Int#
goo Int#
byte_cnt# (Int#
byte_off# Int# -> Int# -> Int#
+# Int#
1#) (ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
bytes# Int#
byte_off#)
      where
        go0 :: Int# -> Int# -> Int# -> Int#
go0 Int#
0# Int#
_  Int#
salt# = Int#
salt#
        go0 Int#
1# Int#
o# Int#
salt# = Int# -> Word# -> Int#
hash# Int#
salt# (ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
bytes# Int#
o# Word# -> Word# -> Word#
`and#` Word#
mask#)
        go0 Int#
n# Int#
o# Int#
salt# = Int# -> Int# -> Int# -> Int#
go0 (Int#
n# Int# -> Int# -> Int#
-# Int#
1#) (Int#
o# Int# -> Int# -> Int#
+# Int#
1#) (Int#
salt# Int# -> Word# -> Int#
`hash#` ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
bytes# Int#
o#)
        
        goo :: Int# -> Int# -> Word# -> Int# -> Int#
goo Int#
0# Int#
_    Word#
_   Int#
salt# = Int#
salt#
        goo Int#
1# Int#
_  Word#
temp# Int#
salt# = Int# -> Word# -> Int#
hash# Int#
salt# (Word# -> Int# -> Word#
shiftRL# Word#
temp# Int#
bit_off# Word# -> Word# -> Word#
`and#` Word#
mask#)
        goo Int#
n# Int#
o# Word#
temp# Int#
salt# = Int# -> Int# -> Word# -> Int# -> Int#
goo (Int#
n# Int# -> Int# -> Int#
-# Int#
1#) (Int#
o# Int# -> Int# -> Int#
+# Int#
1#) Word#
byte# (Int# -> Word# -> Int#
hash# Int#
salt# Word#
curr#)
          where
            curr# :: Word#
curr# = Word# -> Int# -> Word#
shiftRL# Word#
temp# Int#
bit_off# Word# -> Word# -> Word#
`or#` Word# -> Int# -> Word#
shiftL# Word#
byte# (Int#
8# Int# -> Int# -> Int#
-# Int#
bit_off#)
            byte# :: Word#
byte# = ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
bytes# Int#
o#
        
        hash# :: Int# -> Word# -> Int#
hash# = \ Int#
s# Word#
v# -> Word# -> Int#
word2Int# (Int# -> Word#
int2Word# (Int#
s# Int# -> Int# -> Int#
*# Int#
16777619#) Word# -> Word# -> Word#
`xor#` Word#
v#)
        mask# :: Word#
mask# = Int# -> Word#
int2Word# Int#
0xff# Word# -> Int# -> Word#
`shiftRL#` Int#
bit_rest#
        
        !(I# Int#
byte_off#, I# Int#
bit_off#) = Int# -> Int
I# Int#
off# Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
8
        !(I# Int#
bit_len#) = Int# -> Int
I# Int#
len# Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8
        
        bit_rest# :: Int#
bit_rest# = if Int# -> Bool
isTrue# (Int#
bit_len# Int# -> Int# -> Int#
==# Int#
0#) then Int#
0# else Int#
8# Int# -> Int# -> Int#
-# Int#
bit_len#
        byte_cnt# :: Int#
byte_cnt# = Bool -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Bool
e Int#
len#

instance Unboxed Char
  where
    {-# INLINE sizeof #-}
    sizeof :: Char -> Int -> Int
sizeof Char
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Char
!# Int#
i# = Char# -> Char
C# (ByteArray# -> Int# -> Char#
indexWideCharArray# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Char #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Char# #)
readWideCharArray# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Char#
c# #) -> (# State# s
s2#, Char# -> Char
C# Char#
c# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Char -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (C# Char#
e#) = MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
writeWideCharArray# MutableByteArray# s
mbytes# Int#
n# Char#
e#
    
    newUnboxed :: Char -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Char
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Char -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Char
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Char -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# Char
'\0' State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance Unboxed Float
  where
    {-# INLINE sizeof #-}
    sizeof :: Float -> Int -> Int
sizeof Float
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZEOF_HSFLOAT
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Float
!# Int#
i# = Float# -> Float
F# (ByteArray# -> Int# -> Float#
indexFloatArray# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Float #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Float# #)
readFloatArray# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Float#
f# #) -> (# State# s
s2#, Float# -> Float
F# Float#
f# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Float -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (F# Float#
e#) = MutableByteArray# s -> Int# -> Float# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
writeFloatArray# MutableByteArray# s
mbytes# Int#
n# Float#
e#
    
    newUnboxed :: Float -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Float
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Float -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Float
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Float -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# (Float
0 :: Float) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance Unboxed Double
  where
    {-# INLINE sizeof #-}
    sizeof :: Double -> Int -> Int
sizeof Double
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZEOF_HSDOUBLE
    
    {-# INLINE (!#) #-}
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Double
!# Int#
i# = Double# -> Double
D# (ByteArray# -> Int# -> Double#
indexDoubleArray# ByteArray#
bytes# Int#
i#)
    
    {-# INLINE (!>#) #-}
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Double #)
!># Int#
i# = \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Double# #)
readDoubleArray# MutableByteArray# s
mbytes# Int#
i# State# s
s1# of
      (# State# s
s2#, Double#
d# #) -> (# State# s
s2#, Double# -> Double
D# Double#
d# #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Double -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
n# (D# Double#
e#) = MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Double# -> State# d -> State# d
writeDoubleArray# MutableByteArray# s
mbytes# Int#
n# Double#
e#
    
    newUnboxed :: Double -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Double
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Double -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Double
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Double -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# (Double
0 :: Double) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance (Unboxed a, Integral a) => Unboxed (Ratio a)
  where
    sizeof :: Ratio a -> Int -> Int
sizeof Ratio a
e Int
n = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Ratio a -> Int -> Int
forall e (proxy :: * -> *). Unboxed e => proxy e -> Int -> Int
psizeof Ratio a
e Int
n
    
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Ratio a
!# Int#
i# = ByteArray#
bytes# ByteArray# -> Int# -> a
forall e. Unboxed e => ByteArray# -> Int# -> e
!# Int#
i2# a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
:% (ByteArray#
bytes# ByteArray# -> Int# -> a
forall e. Unboxed e => ByteArray# -> Int# -> e
!# (Int#
i2# Int# -> Int# -> Int#
+# Int#
1#)) where i2# :: Int#
i2# = Int#
2# Int# -> Int# -> Int#
*# Int#
i#
    
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Ratio a #)
!># Int#
i# = let i2# :: Int#
i2# = Int#
2# Int# -> Int# -> Int#
*# Int#
i# in \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, e #)
(!>#) MutableByteArray# s
mbytes# Int#
i2# State# s
s1# of
      (# State# s
s2#, a
n #) -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, e #)
(!>#) MutableByteArray# s
mbytes# (Int#
i2# Int# -> Int# -> Int#
+# Int#
1#) State# s
s2# of
        (# State# s
s3#, a
d #) -> (# State# s
s3#, a
n a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
:% a
d #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Ratio a -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
i# (a
n :% a
d) = let i2# :: Int#
i2# = Int#
2# Int# -> Int# -> Int#
*# Int#
i# in
      \ State# s
s1# -> case MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
i2# a
n State# s
s1# of
        State# s
s2# -> MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# (Int#
i2# Int# -> Int# -> Int#
+# Int#
1#) a
d State# s
s2#
    
    newUnboxed :: Ratio a -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Ratio a
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Ratio a -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Ratio a
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Ratio a -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# ((a
0 a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
:% a
0) Ratio a -> Ratio a -> Ratio a
forall a. a -> a -> a
`asTypeOf` Ratio a
e) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

instance (Unboxed a, Num a) => Unboxed (Complex a)
  where
    sizeof :: Complex a -> Int -> Int
sizeof Complex a
e Int
n = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Complex a -> Int -> Int
forall e (proxy :: * -> *). Unboxed e => proxy e -> Int -> Int
psizeof Complex a
e Int
n
    
    ByteArray#
bytes# !# :: ByteArray# -> Int# -> Complex a
!# Int#
i# = ByteArray#
bytes# ByteArray# -> Int# -> a
forall e. Unboxed e => ByteArray# -> Int# -> e
!# Int#
i2# a -> a -> Complex a
forall a. a -> a -> Complex a
:+ (ByteArray#
bytes# ByteArray# -> Int# -> a
forall e. Unboxed e => ByteArray# -> Int# -> e
!# (Int#
i2# Int# -> Int# -> Int#
+# Int#
1#)) where i2# :: Int#
i2# = Int#
2# Int# -> Int# -> Int#
*# Int#
i#
    
    MutableByteArray# s
mbytes# !># :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, Complex a #)
!># Int#
i# = let i2# :: Int#
i2# = Int#
2# Int# -> Int# -> Int#
*# Int#
i# in \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, e #)
(!>#) MutableByteArray# s
mbytes# Int#
i2# State# s
s1# of
      (# State# s
s2#, a
n #) -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, e #)
(!>#) MutableByteArray# s
mbytes# (Int#
i2# Int# -> Int# -> Int#
+# Int#
1#) State# s
s2# of
        (# State# s
s3#, a
d #) -> (# State# s
s3#, a
n a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
d #)
    
    writeByteArray# :: MutableByteArray# s -> Int# -> Complex a -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
i# (a
n :+ a
d) = let i2# :: Int#
i2# = Int#
2# Int# -> Int# -> Int#
*# Int#
i# in
      \ State# s
s1# -> case MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# Int#
i2# a
n State# s
s1# of
        State# s
s2# -> MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
writeByteArray# MutableByteArray# s
mbytes# (Int#
i2# Int# -> Int# -> Int#
+# Int#
1#) a
d State# s
s2#
    
    newUnboxed :: Complex a
-> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed Complex a
e Int#
n# = \ State# s
s1# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Complex a -> Int# -> Int#
forall e. Unboxed e => e -> Int# -> Int#
sizeof# Complex a
e Int#
n#) State# s
s1# of
      (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case MutableByteArray# s -> Int# -> Complex a -> State# s -> State# s
forall e s.
Unboxed e =>
MutableByteArray# s -> Int# -> e -> State# s -> State# s
fillByteArray# MutableByteArray# s
mbytes# Int#
n# ((a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0) Complex a -> Complex a -> Complex a
forall a. a -> a -> a
`asTypeOf` Complex a
e) State# s
s2# of
        State# s
s3# -> (# State# s
s3#, MutableByteArray# s
mbytes# #)

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

-- Just a wrapper, used once to lift ByteArray# from ST.
data Wrap = Wrap { Wrap -> ByteArray#
unwrap :: ByteArray# }

{- |
  @cloneUnboxed\# e o\# c\#@ creates byte array with @c\#@ elements of same type
  as @e@ beginning from @o\#@ elements.
-}
cloneUnboxed# :: (Unboxed e) => e -> ByteArray# -> Int# -> Int# -> ByteArray#
cloneUnboxed# :: e -> ByteArray# -> Int# -> Int# -> ByteArray#
cloneUnboxed# e
e ByteArray#
bytes# Int#
o# Int#
c# = Wrap -> ByteArray#
unwrap (Wrap -> ByteArray#) -> Wrap -> ByteArray#
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Wrap) -> Wrap
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Wrap) -> Wrap) -> (forall s. ST s Wrap) -> Wrap
forall a b. (a -> b) -> a -> b
$ STRep s Wrap -> ST s Wrap
forall s a. STRep s a -> ST s a
ST (STRep s Wrap -> ST s Wrap) -> STRep s Wrap -> ST s Wrap
forall a b. (a -> b) -> a -> b
$
  \ State# s
s1# -> case e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall e s.
Unboxed e =>
e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
newUnboxed e
e Int#
c# State# s
s1# of
    (# State# s
s2#, MutableByteArray# s
mbytes# #) -> case e
-> ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall e s.
Unboxed e =>
e
-> ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyUnboxed# e
e ByteArray#
bytes# Int#
o# MutableByteArray# s
mbytes# Int#
0# Int#
c# State# s
s2# of
      State# s
s3# -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mbytes# State# s
s3# of
        (# State# s
s4#, ByteArray#
bytes'# #) -> (# State# s
s4#, (ByteArray# -> Wrap
Wrap ByteArray#
bytes'#) #)

-- | @(* -> *)@ kind proxy version if 'cloneUnboxed#'.
cloneUnboxed1# :: (Unboxed e) => proxy e -> ByteArray# -> Int# -> Int# -> ByteArray#
cloneUnboxed1# :: proxy e -> ByteArray# -> Int# -> Int# -> ByteArray#
cloneUnboxed1# proxy e
proxy = e -> ByteArray# -> Int# -> Int# -> ByteArray#
forall e.
Unboxed e =>
e -> ByteArray# -> Int# -> Int# -> ByteArray#
cloneUnboxed# (proxy e -> e
forall (proxy :: * -> *) e. proxy e -> e
fromProxy proxy e
proxy)

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

{-# INLINE bool_scale #-}
bool_scale :: Int# -> Int#
bool_scale :: Int# -> Int#
bool_scale Int#
n# = (Int#
n# Int# -> Int# -> Int#
+# Int#
7#) Int# -> Int# -> Int#
`uncheckedIShiftRA#` Int#
3#

{-# INLINE bool_bit #-}
bool_bit :: Int# -> Word#
bool_bit :: Int# -> Word#
bool_bit Int#
n# = case (SIZEOF_HSWORD * 8 - 1) of !(W# mask#) -> int2Word# 1# `uncheckedShiftL#` word2Int# (int2Word# n# `and#` mask#)

{-# INLINE bool_not_bit #-}
bool_not_bit :: Int# -> Word#
bool_not_bit :: Int# -> Word#
bool_not_bit Int#
n# = case Word
forall a. Bounded a => a
maxBound of !(W# Word#
mb#) -> Int# -> Word#
bool_bit Int#
n# Word# -> Word# -> Word#
`xor#` Word#
mb#

{-# INLINE bool_index #-}
bool_index :: Int# -> Int#
#if   SIZEOF_HSWORD == 4
bool_index =  (`uncheckedIShiftRA#` 5#)
#elif SIZEOF_HSWORD == 8
bool_index :: Int# -> Int#
bool_index =  (Int# -> Int# -> Int#
`uncheckedIShiftRA#` Int#
6#)
#endif

consSizeof :: (a -> b) -> b -> a
consSizeof :: (a -> b) -> b -> a
consSizeof =  \ a -> b
_ b
_ -> a
forall a. HasCallStack => a
undefined