{-# 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.Data.Bits ((.|.), shiftR)
import GHC.Internal.Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)
import GHC.Internal.Data.Maybe
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 hiding (empty)
import GHC.Internal.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_, unsafeWithForeignPtr)
import GHC.Internal.Num (Num(..))
import GHC.Internal.Real (fromIntegral)
import GHC.Internal.Show (show)

#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 Any -> Ptr Any -> CSize -> IO (Ptr Any)
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memcpy (Ptr b
dptr Ptr b -> Int -> Ptr Any
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 Any
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 Any -> Ptr Any -> CSize -> IO (Ptr Any)
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memmove (Ptr b
ptr Ptr b -> Int -> Ptr Any
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 Any
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)