{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE BangPatterns, CPP, NoImplicitPrelude #-}

module GHC.Internal.Event.Array
    (
      Array
    , capacity
    , clear
    , concat
    , copy
    , duplicate
    , empty
    , ensureCapacity
    , findIndex
    , forM_
    , length
    , loop
    , new
    , removeAt
    , snoc
    , unsafeLoad
    , unsafeCopyFromBuffer
    , unsafeRead
    , unsafeWrite
    , useAsPtr
    ) where

import GHC.Internal.Classes (Eq(..), Ord(..), (&&), (||))
import GHC.Internal.Data.Bits ((.|.), shiftR)
import GHC.Internal.Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)
import GHC.Internal.Data.Maybe
import GHC.Internal.Err (errorWithoutStackTrace, undefined)
import GHC.Internal.Foreign.C.Types (CSize(..))
import GHC.Internal.Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import GHC.Internal.Foreign.Ptr (Ptr, nullPtr, plusPtr)
import GHC.Internal.Foreign.Storable (Storable(..))
import GHC.Internal.Base (
    Monad(..), fmap, otherwise, when, ($), (.), (++), (=<<),
  )
import GHC.Internal.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_, unsafeWithForeignPtr)
import GHC.Internal.Num (Num(..))
import GHC.Internal.Real (fromIntegral)
import GHC.Internal.Show (show)
import GHC.Internal.Types (Bool, Int, IO)

#include "MachDeps.h"

#define BOUNDS_CHECKING 1

#if defined(BOUNDS_CHECKING)
-- This fugly hack is brought by GHC's apparent reluctance to deal
-- with MagicHash and UnboxedTuples when inferring types. Eek!
#define CHECK_BOUNDS(_func_,_len_,_k_) \
if (_k_) < 0 || (_k_) >= (_len_) then errorWithoutStackTrace ("GHC.Event.Array." ++ (_func_) ++ ": bounds error, index " ++ show (_k_) ++ ", capacity " ++ show (_len_)) else
#else
#define CHECK_BOUNDS(_func_,_len_,_k_)
#endif

-- Invariant: size <= capacity
newtype Array a = Array (IORef (AC a))

-- The actual array content.
data AC a = AC
    !(ForeignPtr a)  -- Elements
    !Int      -- Number of elements (length)
    !Int      -- Maximum number of elements (capacity)

empty :: IO (Array a)
empty :: forall a. IO (Array a)
empty = do
  p <- Ptr a -> IO (ForeignPtr a)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr a
forall a. Ptr a
nullPtr
  Array `fmap` newIORef (AC p 0 0)

allocArray :: Storable a => Int -> IO (ForeignPtr a)
allocArray :: forall a. Storable a => Int -> IO (ForeignPtr a)
allocArray Int
n = a -> IO (ForeignPtr a)
forall a. Storable a => a -> IO (ForeignPtr a)
allocHack a
forall a. HasCallStack => a
undefined
 where
  allocHack :: Storable a => a -> IO (ForeignPtr a)
  allocHack :: forall a. Storable a => a -> IO (ForeignPtr a)
allocHack a
dummy = Int -> IO (ForeignPtr a)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf a
dummy)

reallocArray :: Storable a => ForeignPtr a -> Int -> Int -> IO (ForeignPtr a)
reallocArray :: forall a.
Storable a =>
ForeignPtr a -> Int -> Int -> IO (ForeignPtr a)
reallocArray ForeignPtr a
p Int
newSize Int
oldSize = a -> ForeignPtr a -> IO (ForeignPtr a)
forall a. Storable a => a -> ForeignPtr a -> IO (ForeignPtr a)
reallocHack a
forall a. HasCallStack => a
undefined ForeignPtr a
p
 where
  reallocHack :: Storable a => a -> ForeignPtr a -> IO (ForeignPtr a)
  reallocHack :: forall a. Storable a => a -> ForeignPtr a -> IO (ForeignPtr a)
reallocHack a
dummy ForeignPtr a
src = do
      let size :: Int
size = a -> Int
forall a. Storable a => a -> Int
sizeOf a
dummy
      dst <- Int -> IO (ForeignPtr a)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes (Int
newSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size)
      unsafeWithForeignPtr src $ \Ptr a
s ->
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr a
s Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr a
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
&& Int
oldSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ())
-> ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
dst ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
d -> do
            _ <- Ptr a -> Ptr a -> CSize -> IO (Ptr a)
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memcpy Ptr a
d Ptr a
s (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size))
            return ()
      return dst

new :: Storable a => Int -> IO (Array a)
new :: forall a. Storable a => Int -> IO (Array a)
new Int
c = do
    es <- Int -> IO (ForeignPtr a)
forall a. Storable a => Int -> IO (ForeignPtr a)
allocArray Int
cap
    fmap Array (newIORef (AC es 0 cap))
  where
    cap :: Int
cap = Int -> Int
firstPowerOf2 Int
c

duplicate :: Storable a => Array a -> IO (Array a)
duplicate :: forall a. Storable a => Array a -> IO (Array a)
duplicate Array a
a = a -> Array a -> IO (Array a)
forall b. Storable b => b -> Array b -> IO (Array b)
dupHack a
forall a. HasCallStack => a
undefined Array a
a
 where
  dupHack :: Storable b => b -> Array b -> IO (Array b)
  dupHack :: forall b. Storable b => b -> Array b -> IO (Array b)
dupHack b
dummy (Array IORef (AC b)
ref) = do
    AC es len cap <- IORef (AC b) -> IO (AC b)
forall a. IORef a -> IO a
readIORef IORef (AC b)
ref
    ary <- allocArray cap
    unsafeWithForeignPtr ary $ \Ptr b
dest ->
      ForeignPtr b -> (Ptr b -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr b
es ((Ptr b -> IO ()) -> IO ()) -> (Ptr b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr b
src -> do
        _ <- Ptr b -> Ptr b -> CSize -> IO (Ptr b)
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memcpy Ptr b
dest Ptr b
src (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* b -> Int
forall a. Storable a => a -> Int
sizeOf b
dummy))
        return ()
    Array `fmap` newIORef (AC ary len cap)

length :: Array a -> IO Int
length :: forall a. Array a -> IO Int
length (Array IORef (AC a)
ref) = do
    AC _ len _ <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    return len

capacity :: Array a -> IO Int
capacity :: forall a. Array a -> IO Int
capacity (Array IORef (AC a)
ref) = do
    AC _ _ cap <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    return cap

unsafeRead :: Storable a => Array a -> Int -> IO a
unsafeRead :: forall a. Storable a => Array a -> Int -> IO a
unsafeRead (Array IORef (AC a)
ref) Int
ix = do
    AC es _ cap <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    CHECK_BOUNDS("unsafeRead",cap,ix)
      unsafeWithForeignPtr es $ \Ptr a
ptr -> Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
ptr Int
ix
        -- this is safe WRT #17760 as we assume that peekElemOff doesn't diverge

unsafeWrite :: Storable a => Array a -> Int -> a -> IO ()
unsafeWrite :: forall a. Storable a => Array a -> Int -> a -> IO ()
unsafeWrite (Array IORef (AC a)
ref) Int
ix a
a = do
    ac <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    unsafeWrite' ac ix a

unsafeWrite' :: Storable a => AC a -> Int -> a -> IO ()
unsafeWrite' :: forall a. Storable a => AC a -> Int -> a -> IO ()
unsafeWrite' (AC ForeignPtr a
es Int
_ Int
cap) Int
ix a
a =
    CHECK_BOUNDS("unsafeWrite'",cap,ix)
      ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
es ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
ptr Int
ix a
a
        -- this is safe WRT #17760 as we assume that peekElemOff doesn't diverge

-- | Precondition: continuation must not diverge due to use of
-- 'unsafeWithForeignPtr'.
unsafeLoad :: Array a -> (Ptr a -> Int -> IO Int) -> IO Int
unsafeLoad :: forall a. Array a -> (Ptr a -> Int -> IO Int) -> IO Int
unsafeLoad (Array IORef (AC a)
ref) Ptr a -> Int -> IO Int
load = do
    AC es _ cap <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    len' <- unsafeWithForeignPtr es $ \Ptr a
p -> Ptr a -> Int -> IO Int
load Ptr a
p Int
cap
    writeIORef ref (AC es len' cap)
    return len'

-- | Reads n elements from the pointer and copies them
-- into the array.
unsafeCopyFromBuffer :: Storable a => Array a -> Ptr a -> Int -> IO ()
unsafeCopyFromBuffer :: forall a. Storable a => Array a -> Ptr a -> Int -> IO ()
unsafeCopyFromBuffer (Array IORef (AC a)
ref) Ptr a
sptr Int
n =
    IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref IO (AC a) -> (AC a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(AC ForeignPtr a
es Int
_ Int
cap) ->
    CHECK_BOUNDS("unsafeCopyFromBuffer", cap, n)
    ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
es ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
pdest -> do
      let size :: Int
size = Ptr a -> a -> Int
forall a. Storable a => Ptr a -> a -> Int
sizeOfPtr Ptr a
sptr a
forall a. HasCallStack => a
undefined
      _ <- Ptr a -> Ptr a -> CSize -> IO (Ptr a)
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memcpy Ptr a
pdest Ptr a
sptr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size)
      writeIORef ref (AC es n cap)
  where
    sizeOfPtr :: Storable a => Ptr a -> a -> Int
    sizeOfPtr :: forall a. Storable a => Ptr a -> a -> Int
sizeOfPtr Ptr a
_ a
a = a -> Int
forall a. Storable a => a -> Int
sizeOf a
a

ensureCapacity :: Storable a => Array a -> Int -> IO ()
ensureCapacity :: forall a. Storable a => Array a -> Int -> IO ()
ensureCapacity (Array IORef (AC a)
ref) Int
c = do
    ac@(AC _ _ cap) <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    ac'@(AC _ _ cap') <- ensureCapacity' ac c
    when (cap' /= cap) $
      writeIORef ref ac'

ensureCapacity' :: Storable a => AC a -> Int -> IO (AC a)
ensureCapacity' :: forall a. Storable a => AC a -> Int -> IO (AC a)
ensureCapacity' ac :: AC a
ac@(AC ForeignPtr a
es Int
len Int
cap) Int
c =
    if Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
cap
      then do
        es' <- ForeignPtr a -> Int -> Int -> IO (ForeignPtr a)
forall a.
Storable a =>
ForeignPtr a -> Int -> Int -> IO (ForeignPtr a)
reallocArray ForeignPtr a
es Int
cap' Int
cap
        return (AC es' len cap')
      else
        AC a -> IO (AC a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AC a
ac
  where
    cap' :: Int
cap' = Int -> Int
firstPowerOf2 Int
c

useAsPtr :: Array a -> (Ptr a -> Int -> IO b) -> IO b
useAsPtr :: forall a b. Array a -> (Ptr a -> Int -> IO b) -> IO b
useAsPtr (Array IORef (AC a)
ref) Ptr a -> Int -> IO b
f = do
    AC es len _ <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    withForeignPtr es $ \Ptr a
p -> Ptr a -> Int -> IO b
f Ptr a
p Int
len

snoc :: Storable a => Array a -> a -> IO ()
snoc :: forall a. Storable a => Array a -> a -> IO ()
snoc (Array IORef (AC a)
ref) a
e = do
    ac@(AC _ len _) <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    let len' = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    ac'@(AC es _ cap) <- ensureCapacity' ac len'
    unsafeWrite' ac' len e
    writeIORef ref (AC es len' cap)

clear :: Array a -> IO ()
clear :: forall a. Array a -> IO ()
clear (Array IORef (AC a)
ref) =
  IORef (AC a) -> (AC a -> (AC a, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (AC a)
ref ((AC a -> (AC a, ())) -> IO ()) -> (AC a -> (AC a, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(AC ForeignPtr a
es Int
_ Int
cap) ->
        (ForeignPtr a -> Int -> Int -> AC a
forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr a
es Int
0 Int
cap, ())

forM_ :: Storable a => Array a -> (a -> IO ()) -> IO ()
forM_ :: forall a. Storable a => Array a -> (a -> IO ()) -> IO ()
forM_ Array a
ary a -> IO ()
g = Array a -> (a -> IO ()) -> a -> IO ()
forall b. Storable b => Array b -> (b -> IO ()) -> b -> IO ()
forHack Array a
ary a -> IO ()
g a
forall a. HasCallStack => a
undefined
  where
    forHack :: Storable b => Array b -> (b -> IO ()) -> b -> IO ()
    forHack :: forall b. Storable b => Array b -> (b -> IO ()) -> b -> IO ()
forHack (Array IORef (AC b)
ref) b -> IO ()
f b
dummy = do
      AC es len _ <- IORef (AC b) -> IO (AC b)
forall a. IORef a -> IO a
readIORef IORef (AC b)
ref
      let size = b -> Int
forall a. Storable a => a -> Int
sizeOf b
dummy
          offset = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size
      unsafeWithForeignPtr es $ \Ptr b
p -> do
        let go :: Int -> IO ()
go Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
offset = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                 | Bool
otherwise = do
              b -> IO ()
f (b -> IO ()) -> IO b -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek (Ptr b
p Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n)
              Int -> IO ()
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size)
        Int -> IO ()
go Int
0

loop :: Storable a => Array a -> b -> (b -> a -> IO (b,Bool)) -> IO ()
loop :: forall a b.
Storable a =>
Array a -> b -> (b -> a -> IO (b, Bool)) -> IO ()
loop Array a
ary b
z b -> a -> IO (b, Bool)
g = Array a -> b -> (b -> a -> IO (b, Bool)) -> a -> IO ()
forall b c.
Storable b =>
Array b -> c -> (c -> b -> IO (c, Bool)) -> b -> IO ()
loopHack Array a
ary b
z b -> a -> IO (b, Bool)
g a
forall a. HasCallStack => a
undefined
  where
    loopHack :: Storable b => Array b -> c -> (c -> b -> IO (c,Bool)) -> b
             -> IO ()
    loopHack :: forall b c.
Storable b =>
Array b -> c -> (c -> b -> IO (c, Bool)) -> b -> IO ()
loopHack (Array IORef (AC b)
ref) c
y c -> b -> IO (c, Bool)
f b
dummy = do
      AC es len _ <- IORef (AC b) -> IO (AC b)
forall a. IORef a -> IO a
readIORef IORef (AC b)
ref
      let size = b -> Int
forall a. Storable a => a -> Int
sizeOf b
dummy
          offset = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size
      withForeignPtr es $ \Ptr b
p -> do
        let go :: Int -> c -> IO ()
go Int
n c
k
                | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
offset = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                | Bool
otherwise = do
                      (k',cont) <- c -> b -> IO (c, Bool)
f c
k (b -> IO (c, Bool)) -> IO b -> IO (c, Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek (Ptr b
p Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n)
                      when cont $ go (n + size) k'
        Int -> c -> IO ()
go Int
0 c
y

findIndex :: Storable a => (a -> Bool) -> Array a -> IO (Maybe (Int,a))
findIndex :: forall a.
Storable a =>
(a -> Bool) -> Array a -> IO (Maybe (Int, a))
findIndex = a -> (a -> Bool) -> Array a -> IO (Maybe (Int, a))
forall b.
Storable b =>
b -> (b -> Bool) -> Array b -> IO (Maybe (Int, b))
findHack a
forall a. HasCallStack => a
undefined
 where
  findHack :: Storable b => b -> (b -> Bool) -> Array b -> IO (Maybe (Int,b))
  findHack :: forall b.
Storable b =>
b -> (b -> Bool) -> Array b -> IO (Maybe (Int, b))
findHack b
dummy b -> Bool
p (Array IORef (AC b)
ref) = do
    AC es len _ <- IORef (AC b) -> IO (AC b)
forall a. IORef a -> IO a
readIORef IORef (AC b)
ref
    let size   = b -> Int
forall a. Storable a => a -> Int
sizeOf b
dummy
        offset = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size
    withForeignPtr es $ \Ptr b
ptr ->
      let go :: Int -> t -> IO (Maybe (t, b))
go !Int
n !t
i
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
offset = Maybe (t, b) -> IO (Maybe (t, b))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (t, b)
forall a. Maybe a
Nothing
            | Bool
otherwise = do
                val <- Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek (Ptr b
ptr Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n)
                if p val
                  then return $ Just (i, val)
                  else go (n + size) (i + 1)
      in  Int -> Int -> IO (Maybe (Int, b))
forall {t}. Num t => Int -> t -> IO (Maybe (t, b))
go Int
0 Int
0

concat :: Storable a => Array a -> Array a -> IO ()
concat :: forall a. Storable a => Array a -> Array a -> IO ()
concat (Array IORef (AC a)
d) (Array IORef (AC a)
s) = do
  da@(AC _ dlen _) <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
d
  sa@(AC _ slen _) <- readIORef s
  writeIORef d =<< copy' da dlen sa 0 slen

-- | Copy part of the source array into the destination array. The
-- destination array is resized if not large enough.
copy :: Storable a => Array a -> Int -> Array a -> Int -> Int -> IO ()
copy :: forall a.
Storable a =>
Array a -> Int -> Array a -> Int -> Int -> IO ()
copy (Array IORef (AC a)
d) Int
dstart (Array IORef (AC a)
s) Int
sstart Int
maxCount = do
  da <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
d
  sa <- readIORef s
  writeIORef d =<< copy' da dstart sa sstart maxCount

-- | Copy part of the source array into the destination array. The
-- destination array is resized if not large enough.
copy' :: Storable a => AC a -> Int -> AC a -> Int -> Int -> IO (AC a)
copy' :: forall a.
Storable a =>
AC a -> Int -> AC a -> Int -> Int -> IO (AC a)
copy' AC a
d Int
dstart AC a
s Int
sstart Int
maxCount = AC a -> AC a -> a -> IO (AC a)
forall b. Storable b => AC b -> AC b -> b -> IO (AC b)
copyHack AC a
d AC a
s a
forall a. HasCallStack => a
undefined
 where
  copyHack :: Storable b => AC b -> AC b -> b -> IO (AC b)
  copyHack :: forall b. Storable b => AC b -> AC b -> b -> IO (AC b)
copyHack dac :: AC b
dac@(AC ForeignPtr b
_ Int
oldLen Int
_) (AC ForeignPtr b
src Int
slen Int
_) b
dummy = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
maxCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
dstart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
dstart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
oldLen Bool -> Bool -> Bool
|| Int
sstart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
||
          Int
sstart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
slen) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"copy: bad offsets or lengths"
    let size :: Int
size = b -> Int
forall a. Storable a => a -> Int
sizeOf b
dummy
        count :: Int
count = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxCount (Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sstart)
    if Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then AC b -> IO (AC b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AC b
dac
      else do
        AC dst dlen dcap <- AC b -> Int -> IO (AC b)
forall a. Storable a => AC a -> Int -> IO (AC a)
ensureCapacity' AC b
dac (Int
dstart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count)
        unsafeWithForeignPtr dst $ \Ptr b
dptr ->
          ForeignPtr b -> (Ptr b -> IO (AC b)) -> IO (AC b)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr b
src ((Ptr b -> IO (AC b)) -> IO (AC b))
-> (Ptr b -> IO (AC b)) -> IO (AC b)
forall a b. (a -> b) -> a -> b
$ \Ptr b
sptr -> do
            _ <- Ptr a_1 -> Ptr a_1 -> CSize -> IO (Ptr a_1)
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memcpy (Ptr b
dptr Ptr b -> Int -> Ptr a_1
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
dstart Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size))
                        (Ptr b
sptr Ptr b -> Int -> Ptr a_1
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
sstart Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size))
                        (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size))
            return $ AC dst (max dlen (dstart + count)) dcap

removeAt :: Storable a => Array a -> Int -> IO ()
removeAt :: forall a. Storable a => Array a -> Int -> IO ()
removeAt Array a
a Int
i = Array a -> a -> IO ()
forall a. Storable a => Array a -> a -> IO ()
removeHack Array a
a a
forall a. HasCallStack => a
undefined
 where
  removeHack :: Storable b => Array b -> b -> IO ()
  removeHack :: forall a. Storable a => Array a -> a -> IO ()
removeHack (Array IORef (AC b)
ary) b
dummy = do
    AC fp oldLen cap <- IORef (AC b) -> IO (AC b)
forall a. IORef a -> IO a
readIORef IORef (AC b)
ary
    when (i < 0 || i >= oldLen) $ errorWithoutStackTrace "removeAt: invalid index"
    let size   = b -> Int
forall a. Storable a => a -> Int
sizeOf b
dummy
        newLen = Int
oldLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    when (newLen > 0 && i < newLen) .
      unsafeWithForeignPtr fp $ \Ptr b
ptr -> do
        _ <- Ptr a_0 -> Ptr a_0 -> CSize -> IO (Ptr a_0)
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memmove (Ptr b
ptr Ptr b -> Int -> Ptr a_0
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i))
                     (Ptr b
ptr Ptr b -> Int -> Ptr a_0
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)))
                     (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
newLenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)))
        return ()
    writeIORef ary (AC fp newLen cap)

{-The firstPowerOf2 function works by setting all bits on the right-hand
side of the most significant flagged bit to 1, and then incrementing
the entire value at the end so it "rolls over" to the nearest power of
two.
-}

-- | Computes the next-highest power of two for a particular integer,
-- @n@.  If @n@ is already a power of two, returns @n@.  If @n@ is
-- zero, returns zero, even though zero is not a power of two.
firstPowerOf2 :: Int -> Int
firstPowerOf2 :: Int -> Int
firstPowerOf2 !Int
n =
    let !n1 :: Int
n1 = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        !n2 :: Int
n2 = Int
n1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
n1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
        !n3 :: Int
n3 = Int
n2 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
n2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
2)
        !n4 :: Int
n4 = Int
n3 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
n3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
        !n5 :: Int
n5 = Int
n4 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
n4 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
        !n6 :: Int
n6 = Int
n5 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
n5 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
#if WORD_SIZE_IN_BITS == 32
    in n6 + 1
#elif WORD_SIZE_IN_BITS == 64
        !n7 :: Int
n7 = Int
n6 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
n6 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
    in Int
n7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
#else
# error firstPowerOf2 not defined on this architecture
#endif

foreign import ccall unsafe "string.h memcpy"
    memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)

foreign import ccall unsafe "string.h memmove"
    memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)