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

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

import Data.Bits ((.|.), shiftR)
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)
import Data.Maybe
import Foreign.C.Types (CSize(..))
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (Ptr, nullPtr, plusPtr)
import Foreign.Storable (Storable(..))
import GHC.Base hiding (empty)
import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_, unsafeWithForeignPtr)
import GHC.Num (Num(..))
import GHC.Real (fromIntegral)
import GHC.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
  ForeignPtr a
p <- forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ forall a. Ptr a
nullPtr
  forall a. IORef (AC a) -> Array a
Array forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. a -> IO (IORef a)
newIORef (forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr a
p Int
0 Int
0)

allocArray :: Storable a => Int -> IO (ForeignPtr a)
allocArray :: forall a. Storable a => Int -> IO (ForeignPtr a)
allocArray Int
n = forall a. Storable a => a -> IO (ForeignPtr a)
allocHack 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 = forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes (Int
n forall a. Num a => a -> a -> a
* 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 = forall a. Storable a => a -> ForeignPtr a -> IO (ForeignPtr a)
reallocHack 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 = forall a. Storable a => a -> Int
sizeOf a
dummy
      ForeignPtr a
dst <- forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes (Int
newSize forall a. Num a => a -> a -> a
* Int
size)
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
src forall a b. (a -> b) -> a -> b
$ \Ptr a
s ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr a
s forall a. Eq a => a -> a -> Bool
/= forall a. Ptr a
nullPtr Bool -> Bool -> Bool
&& Int
oldSize forall a. Ord a => a -> a -> Bool
> Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
dst forall a b. (a -> b) -> a -> b
$ \Ptr a
d -> do
            Ptr a
_ <- forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memcpy Ptr a
d Ptr a
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
oldSize forall a. Num a => a -> a -> a
* Int
size))
            forall (m :: * -> *) a. Monad m => a -> m a
return ()
      forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr a
dst

new :: Storable a => Int -> IO (Array a)
new :: forall a. Storable a => Int -> IO (Array a)
new Int
c = do
    ForeignPtr a
es <- forall a. Storable a => Int -> IO (ForeignPtr a)
allocArray Int
cap
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. IORef (AC a) -> Array a
Array (forall a. a -> IO (IORef a)
newIORef (forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr a
es Int
0 Int
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 = forall b. Storable b => b -> Array b -> IO (Array b)
dupHack 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 ForeignPtr b
es Int
len Int
cap <- forall a. IORef a -> IO a
readIORef IORef (AC b)
ref
    ForeignPtr b
ary <- forall a. Storable a => Int -> IO (ForeignPtr a)
allocArray Int
cap
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr b
ary forall a b. (a -> b) -> a -> b
$ \Ptr b
dest ->
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr b
es forall a b. (a -> b) -> a -> b
$ \Ptr b
src -> do
        Ptr b
_ <- forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memcpy Ptr b
dest Ptr b
src (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
len forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf b
dummy))
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
    forall a. IORef (AC a) -> Array a
Array forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. a -> IO (IORef a)
newIORef (forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr b
ary Int
len Int
cap)

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

capacity :: Array a -> IO Int
capacity :: forall a. Array a -> IO Int
capacity (Array IORef (AC a)
ref) = do
    AC ForeignPtr a
_ Int
_ Int
cap <- forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    forall (m :: * -> *) a. Monad m => a -> m a
return Int
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 ForeignPtr a
es Int
_ Int
cap <- forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    CHECK_BOUNDS("unsafeRead",cap,ix)
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
es forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> 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 a
ac <- forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    forall a. Storable a => AC a -> Int -> a -> IO ()
unsafeWrite' AC a
ac Int
ix a
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)
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
es forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> 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 ForeignPtr a
es Int
_ Int
cap <- forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    Int
len' <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
es forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> Ptr a -> Int -> IO Int
load Ptr a
p Int
cap
    forall a. IORef a -> a -> IO ()
writeIORef IORef (AC a)
ref (forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr a
es Int
len' Int
cap)
    forall (m :: * -> *) a. Monad m => a -> m a
return Int
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 =
    forall a. IORef a -> IO a
readIORef IORef (AC a)
ref 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)
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
es forall a b. (a -> b) -> a -> b
$ \Ptr a
pdest -> do
      let size :: Int
size = forall a. Storable a => Ptr a -> a -> Int
sizeOfPtr Ptr a
sptr forall a. HasCallStack => a
undefined
      Ptr a
_ <- forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memcpy Ptr a
pdest Ptr a
sptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
n forall a. Num a => a -> a -> a
* Int
size)
      forall a. IORef a -> a -> IO ()
writeIORef IORef (AC a)
ref (forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr a
es Int
n Int
cap)
  where
    sizeOfPtr :: Storable a => Ptr a -> a -> Int
    sizeOfPtr :: forall a. Storable a => Ptr a -> a -> Int
sizeOfPtr Ptr a
_ a
a = 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 a
ac@(AC ForeignPtr a
_ Int
_ Int
cap) <- forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    ac' :: AC a
ac'@(AC ForeignPtr a
_ Int
_ Int
cap') <- forall a. Storable a => AC a -> Int -> IO (AC a)
ensureCapacity' AC a
ac Int
c
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
cap' forall a. Eq a => a -> a -> Bool
/= Int
cap) forall a b. (a -> b) -> a -> b
$
      forall a. IORef a -> a -> IO ()
writeIORef IORef (AC a)
ref AC a
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 forall a. Ord a => a -> a -> Bool
> Int
cap
      then do
        ForeignPtr a
es' <- forall a.
Storable a =>
ForeignPtr a -> Int -> Int -> IO (ForeignPtr a)
reallocArray ForeignPtr a
es Int
cap' Int
cap
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr a
es' Int
len Int
cap')
      else
        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 ForeignPtr a
es Int
len Int
_ <- forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
es forall a b. (a -> b) -> a -> b
$ \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 a
ac@(AC ForeignPtr a
_ Int
len Int
_) <- forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    let len' :: Int
len' = Int
len forall a. Num a => a -> a -> a
+ Int
1
    ac' :: AC a
ac'@(AC ForeignPtr a
es Int
_ Int
cap) <- forall a. Storable a => AC a -> Int -> IO (AC a)
ensureCapacity' AC a
ac Int
len'
    forall a. Storable a => AC a -> Int -> a -> IO ()
unsafeWrite' AC a
ac' Int
len a
e
    forall a. IORef a -> a -> IO ()
writeIORef IORef (AC a)
ref (forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr a
es Int
len' Int
cap)

clear :: Array a -> IO ()
clear :: forall a. Array a -> IO ()
clear (Array IORef (AC a)
ref) =
  forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (AC a)
ref forall a b. (a -> b) -> a -> b
$ \(AC ForeignPtr a
es Int
_ Int
cap) ->
        (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 = forall b. Storable b => Array b -> (b -> IO ()) -> b -> IO ()
forHack Array a
ary a -> IO ()
g 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 ForeignPtr b
es Int
len Int
_ <- forall a. IORef a -> IO a
readIORef IORef (AC b)
ref
      let size :: Int
size = forall a. Storable a => a -> Int
sizeOf b
dummy
          offset :: Int
offset = Int
len forall a. Num a => a -> a -> a
* Int
size
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr b
es forall a b. (a -> b) -> a -> b
$ \Ptr b
p -> do
        let go :: Int -> IO ()
go Int
n | Int
n forall a. Ord a => a -> a -> Bool
>= Int
offset = forall (m :: * -> *) a. Monad m => a -> m a
return ()
                 | Bool
otherwise = do
              b -> IO ()
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek (Ptr b
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n)
              Int -> IO ()
go (Int
n 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 = 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 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 ForeignPtr b
es Int
len Int
_ <- forall a. IORef a -> IO a
readIORef IORef (AC b)
ref
      let size :: Int
size = forall a. Storable a => a -> Int
sizeOf b
dummy
          offset :: Int
offset = Int
len forall a. Num a => a -> a -> a
* Int
size
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr b
es forall a b. (a -> b) -> a -> b
$ \Ptr b
p -> do
        let go :: Int -> c -> IO ()
go Int
n c
k
                | Int
n forall a. Ord a => a -> a -> Bool
>= Int
offset = forall (m :: * -> *) a. Monad m => a -> m a
return ()
                | Bool
otherwise = do
                      (c
k',Bool
cont) <- c -> b -> IO (c, Bool)
f c
k forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek (Ptr b
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n)
                      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cont forall a b. (a -> b) -> a -> b
$ Int -> c -> IO ()
go (Int
n forall a. Num a => a -> a -> a
+ Int
size) c
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 = forall b.
Storable b =>
b -> (b -> Bool) -> Array b -> IO (Maybe (Int, b))
findHack 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 ForeignPtr b
es Int
len Int
_ <- forall a. IORef a -> IO a
readIORef IORef (AC b)
ref
    let size :: Int
size   = forall a. Storable a => a -> Int
sizeOf b
dummy
        offset :: Int
offset = Int
len forall a. Num a => a -> a -> a
* Int
size
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr b
es forall a b. (a -> b) -> a -> b
$ \Ptr b
ptr ->
      let go :: Int -> t -> IO (Maybe (t, b))
go !Int
n !t
i
            | Int
n forall a. Ord a => a -> a -> Bool
>= Int
offset = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            | Bool
otherwise = do
                b
val <- forall a. Storable a => Ptr a -> IO a
peek (Ptr b
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n)
                if b -> Bool
p b
val
                  then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (t
i, b
val)
                  else Int -> t -> IO (Maybe (t, b))
go (Int
n forall a. Num a => a -> a -> a
+ Int
size) (t
i forall a. Num a => a -> a -> a
+ t
1)
      in  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 a
da@(AC ForeignPtr a
_ Int
dlen Int
_) <- forall a. IORef a -> IO a
readIORef IORef (AC a)
d
  sa :: AC a
sa@(AC ForeignPtr a
_ Int
slen Int
_) <- forall a. IORef a -> IO a
readIORef IORef (AC a)
s
  forall a. IORef a -> a -> IO ()
writeIORef IORef (AC a)
d forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a.
Storable a =>
AC a -> Int -> AC a -> Int -> Int -> IO (AC a)
copy' AC a
da Int
dlen AC a
sa Int
0 Int
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
  AC a
da <- forall a. IORef a -> IO a
readIORef IORef (AC a)
d
  AC a
sa <- forall a. IORef a -> IO a
readIORef IORef (AC a)
s
  forall a. IORef a -> a -> IO ()
writeIORef IORef (AC a)
d forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a.
Storable a =>
AC a -> Int -> AC a -> Int -> Int -> IO (AC a)
copy' AC a
da Int
dstart AC a
sa Int
sstart Int
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 = forall b. Storable b => AC b -> AC b -> b -> IO (AC b)
copyHack AC a
d AC a
s 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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
maxCount forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
dstart forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
dstart forall a. Ord a => a -> a -> Bool
> Int
oldLen Bool -> Bool -> Bool
|| Int
sstart forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
||
          Int
sstart forall a. Ord a => a -> a -> Bool
> Int
slen) forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> a
errorWithoutStackTrace [Char]
"copy: bad offsets or lengths"
    let size :: Int
size = forall a. Storable a => a -> Int
sizeOf b
dummy
        count :: Int
count = forall a. Ord a => a -> a -> a
min Int
maxCount (Int
slen forall a. Num a => a -> a -> a
- Int
sstart)
    if Int
count forall a. Eq a => a -> a -> Bool
== Int
0
      then forall (m :: * -> *) a. Monad m => a -> m a
return AC b
dac
      else do
        AC ForeignPtr b
dst Int
dlen Int
dcap <- forall a. Storable a => AC a -> Int -> IO (AC a)
ensureCapacity' AC b
dac (Int
dstart forall a. Num a => a -> a -> a
+ Int
count)
        forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr b
dst forall a b. (a -> b) -> a -> b
$ \Ptr b
dptr ->
          forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr b
src forall a b. (a -> b) -> a -> b
$ \Ptr b
sptr -> do
            Ptr Any
_ <- forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memcpy (Ptr b
dptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
dstart forall a. Num a => a -> a -> a
* Int
size))
                        (Ptr b
sptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
sstart forall a. Num a => a -> a -> a
* Int
size))
                        (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
count forall a. Num a => a -> a -> a
* Int
size))
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr b
dst (forall a. Ord a => a -> a -> a
max Int
dlen (Int
dstart forall a. Num a => a -> a -> a
+ Int
count)) Int
dcap

removeAt :: Storable a => Array a -> Int -> IO ()
removeAt :: forall a. Storable a => Array a -> Int -> IO ()
removeAt Array a
a Int
i = forall a. Storable a => Array a -> a -> IO ()
removeHack Array 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 ForeignPtr b
fp Int
oldLen Int
cap <- forall a. IORef a -> IO a
readIORef IORef (AC b)
ary
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i forall a. Ord a => a -> a -> Bool
>= Int
oldLen) forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> a
errorWithoutStackTrace [Char]
"removeAt: invalid index"
    let size :: Int
size   = forall a. Storable a => a -> Int
sizeOf b
dummy
        newLen :: Int
newLen = Int
oldLen forall a. Num a => a -> a -> a
- Int
1
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
newLen forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< Int
newLen) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr b
fp forall a b. (a -> b) -> a -> b
$ \Ptr b
ptr -> do
        Ptr Any
_ <- forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memmove (Ptr b
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
size forall a. Num a => a -> a -> a
* Int
i))
                     (Ptr b
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
size forall a. Num a => a -> a -> a
* (Int
iforall a. Num a => a -> a -> a
+Int
1)))
                     (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
size forall a. Num a => a -> a -> a
* (Int
newLenforall a. Num a => a -> a -> a
-Int
i)))
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
    forall a. IORef a -> a -> IO ()
writeIORef IORef (AC b)
ary (forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr b
fp Int
newLen Int
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 forall a. Num a => a -> a -> a
- Int
1
        !n2 :: Int
n2 = Int
n1 forall a. Bits a => a -> a -> a
.|. (Int
n1 forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
        !n3 :: Int
n3 = Int
n2 forall a. Bits a => a -> a -> a
.|. (Int
n2 forall a. Bits a => a -> Int -> a
`shiftR` Int
2)
        !n4 :: Int
n4 = Int
n3 forall a. Bits a => a -> a -> a
.|. (Int
n3 forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
        !n5 :: Int
n5 = Int
n4 forall a. Bits a => a -> a -> a
.|. (Int
n4 forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
        !n6 :: Int
n6 = Int
n5 forall a. Bits a => a -> a -> a
.|. (Int
n5 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 forall a. Bits a => a -> a -> a
.|. (Int
n6 forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
    in Int
n7 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)