{-# 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
    , 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_)
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 :: IO (Array a)
empty = do
  ForeignPtr a
p <- Ptr a -> IO (ForeignPtr a)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr a
forall a. Ptr a
nullPtr
  IORef (AC a) -> Array a
forall a. IORef (AC a) -> Array a
Array (IORef (AC a) -> Array a) -> IO (IORef (AC a)) -> IO (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` AC a -> IO (IORef (AC a))
forall a. a -> IO (IORef a)
newIORef (ForeignPtr a -> Int -> Int -> AC a
forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr a
p Int
0 Int
0)

allocArray :: Storable a => Int -> IO (ForeignPtr a)
allocArray :: 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 :: 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 :: 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 :: 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
      ForeignPtr a
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)
      ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
src ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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
withForeignPtr 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 -> 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))
            () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ForeignPtr a -> IO (ForeignPtr a)
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr a
dst

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

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

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

unsafeRead :: Storable a => Array a -> Int -> IO a
unsafeRead :: Array a -> Int -> IO a
unsafeRead (Array IORef (AC a)
ref) Int
ix = do
    AC ForeignPtr a
es Int
_ Int
cap <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    CHECK_BOUNDS("unsafeRead",cap,ix)
      ForeignPtr a -> (Ptr a -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
es ((Ptr a -> IO a) -> IO a) -> (Ptr a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr a
p ->
        Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
p Int
ix

unsafeWrite :: Storable a => Array a -> Int -> a -> IO ()
unsafeWrite :: Array a -> Int -> a -> IO ()
unsafeWrite (Array IORef (AC a)
ref) Int
ix a
a = do
    AC a
ac <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    AC a -> Int -> a -> IO ()
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' :: AC a -> Int -> a -> IO ()
unsafeWrite' (AC ForeignPtr a
es Int
_ Int
cap) Int
ix a
a = do
    CHECK_BOUNDS("unsafeWrite'",cap,ix)
      ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
es ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
p ->
        Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
p Int
ix a
a

unsafeLoad :: Array a -> (Ptr a -> Int -> IO Int) -> IO Int
unsafeLoad :: 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 <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    Int
len' <- ForeignPtr a -> (Ptr a -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
es ((Ptr a -> IO Int) -> IO Int) -> (Ptr a -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> Ptr a -> Int -> IO Int
load Ptr a
p Int
cap
    IORef (AC a) -> AC a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (AC a)
ref (ForeignPtr a -> Int -> Int -> AC a
forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr a
es Int
len' Int
cap)
    Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
len'

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

ensureCapacity' :: Storable a => AC a -> Int -> IO (AC a)
ensureCapacity' :: AC a -> Int -> IO (AC a)
ensureCapacity' ac :: AC a
ac@(AC ForeignPtr a
es Int
len Int
cap) Int
c = do
    if Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
cap
      then do
        ForeignPtr a
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
        AC a -> IO (AC a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr a -> Int -> Int -> AC a
forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr a
es' Int
len Int
cap')
      else
        AC a -> IO (AC 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 :: 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
_ <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    ForeignPtr a -> (Ptr a -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
es ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
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 :: Array a -> a -> IO ()
snoc (Array IORef (AC a)
ref) a
e = do
    ac :: AC a
ac@(AC ForeignPtr a
_ Int
len Int
_) <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    let len' :: Int
len' = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    ac' :: AC a
ac'@(AC ForeignPtr a
es Int
_ Int
cap) <- AC a -> Int -> IO (AC a)
forall a. Storable a => AC a -> Int -> IO (AC a)
ensureCapacity' AC a
ac Int
len'
    AC a -> Int -> a -> IO ()
forall a. Storable a => AC a -> Int -> a -> IO ()
unsafeWrite' AC a
ac' Int
len a
e
    IORef (AC a) -> AC a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (AC a)
ref (ForeignPtr a -> Int -> Int -> AC a
forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr a
es Int
len' Int
cap)

clear :: Array a -> IO ()
clear :: Array a -> IO ()
clear (Array IORef (AC a)
ref) = do
  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_ :: 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 :: 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
_ <- IORef (AC b) -> IO (AC b)
forall a. IORef a -> IO a
readIORef IORef (AC b)
ref
      let size :: Int
size = b -> Int
forall a. Storable a => a -> Int
sizeOf b
dummy
          offset :: Int
offset = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size
      ForeignPtr b -> (Ptr b -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr b
es ((Ptr b -> IO ()) -> IO ()) -> (Ptr b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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 (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 :: 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 :: 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
_ <- IORef (AC b) -> IO (AC b)
forall a. IORef a -> IO a
readIORef IORef (AC b)
ref
      let size :: Int
size = b -> Int
forall a. Storable a => a -> Int
sizeOf b
dummy
          offset :: Int
offset = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size
      ForeignPtr b -> (Ptr b -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr b
es ((Ptr b -> IO ()) -> IO ()) -> (Ptr b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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 (m :: * -> *) a. Monad m => a -> m a
return ()
                | Bool
otherwise = do
                      (c
k',Bool
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)
                      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cont (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> c -> IO ()
go (Int
n Int -> Int -> Int
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 :: (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 :: 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
_ <- IORef (AC b) -> IO (AC b)
forall a. IORef a -> IO a
readIORef IORef (AC b)
ref
    let size :: Int
size   = b -> Int
forall a. Storable a => a -> Int
sizeOf b
dummy
        offset :: Int
offset = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size
    ForeignPtr b
-> (Ptr b -> IO (Maybe (Int, b))) -> IO (Maybe (Int, b))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr b
es ((Ptr b -> IO (Maybe (Int, b))) -> IO (Maybe (Int, b)))
-> (Ptr b -> IO (Maybe (Int, b))) -> IO (Maybe (Int, b))
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
offset = Maybe (t, b) -> IO (Maybe (t, b))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (t, b)
forall a. Maybe a
Nothing
            | Bool
otherwise = do
                b
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 b -> Bool
p b
val
                  then Maybe (t, b) -> IO (Maybe (t, b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (t, b) -> IO (Maybe (t, b)))
-> Maybe (t, b) -> IO (Maybe (t, b))
forall a b. (a -> b) -> a -> b
$ (t, b) -> Maybe (t, b)
forall a. a -> Maybe a
Just (t
i, b
val)
                  else Int -> t -> IO (Maybe (t, b))
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size) (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
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 :: 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
_) <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
d
  sa :: AC a
sa@(AC ForeignPtr a
_ Int
slen Int
_) <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
s
  IORef (AC a) -> AC a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (AC a)
d (AC a -> IO ()) -> IO (AC a) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AC a -> Int -> AC a -> Int -> Int -> IO (AC a)
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 :: 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 <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
d
  AC a
sa <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
s
  IORef (AC a) -> AC a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (AC a)
d (AC a -> IO ()) -> IO (AC a) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AC a -> Int -> AC a -> Int -> Int -> IO (AC a)
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' :: 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 :: 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 (m :: * -> *) a. Monad m => a -> m a
return AC b
dac
      else do
        AC ForeignPtr b
dst Int
dlen Int
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)
        ForeignPtr b -> (Ptr b -> IO (AC b)) -> IO (AC b)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr b
dst ((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
dptr ->
          ForeignPtr b -> (Ptr b -> IO (AC b)) -> IO (AC b)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr 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 -> 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))
            AC b -> IO (AC b)
forall (m :: * -> *) a. Monad m => a -> m a
return (AC b -> IO (AC b)) -> AC b -> IO (AC b)
forall a b. (a -> b) -> a -> b
$ ForeignPtr b -> Int -> Int -> AC b
forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr b
dst (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
dlen (Int
dstart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count)) Int
dcap

removeAt :: Storable a => Array a -> Int -> IO ()
removeAt :: Array a -> Int -> IO ()
removeAt Array a
a Int
i = Array a -> a -> IO ()
forall b. Storable b => Array b -> b -> IO ()
removeHack Array a
a a
forall a. HasCallStack => a
undefined
 where
  removeHack :: Storable b => Array b -> b -> IO ()
  removeHack :: Array b -> b -> IO ()
removeHack (Array IORef (AC b)
ary) b
dummy = do
    AC ForeignPtr b
fp Int
oldLen Int
cap <- IORef (AC b) -> IO (AC b)
forall a. IORef a -> IO a
readIORef IORef (AC b)
ary
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
oldLen) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"removeAt: invalid index"
    let size :: Int
size   = b -> Int
forall a. Storable a => a -> Int
sizeOf b
dummy
        newLen :: Int
newLen = Int
oldLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
newLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
newLen) (IO () -> IO ())
-> ((Ptr b -> IO ()) -> IO ()) -> (Ptr b -> IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ForeignPtr b -> (Ptr b -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr b
fp ((Ptr b -> IO ()) -> IO ()) -> (Ptr b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr b
ptr -> do
        Ptr Any
_ <- 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)))
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    IORef (AC b) -> AC b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (AC b)
ary (ForeignPtr b -> Int -> Int -> AC b
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 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)