{-# 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 0 0)

allocArray :: Storable a => Int -> IO (ForeignPtr a)
allocArray :: Int -> IO (ForeignPtr a)
allocArray n :: 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 dummy :: 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 p :: ForeignPtr a
p newSize :: Int
newSize oldSize :: 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 dummy :: a
dummy src :: 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
$ \s :: 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
> 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
$ \d :: 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 c :: 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 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 a :: 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 dummy :: b
dummy (Array ref :: IORef (AC b)
ref) = do
    AC es :: ForeignPtr b
es len :: Int
len cap :: 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
$ \dest :: 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
$ \src :: 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 ref :: IORef (AC a)
ref) = do
    AC _ len :: Int
len _ <- 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 ref :: IORef (AC a)
ref) = do
    AC _ _ cap :: 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 ref :: IORef (AC a)
ref) ix :: Int
ix = do
    AC es :: ForeignPtr a
es _ cap :: 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
$ \p :: 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 ref :: IORef (AC a)
ref) ix :: Int
ix a :: 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 es :: ForeignPtr a
es _ cap :: Int
cap) ix :: Int
ix a :: 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
$ \p :: 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 ref :: IORef (AC a)
ref) load :: Ptr a -> Int -> IO Int
load = do
    AC es :: ForeignPtr a
es _ cap :: 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
$ \p :: 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 ref :: IORef (AC a)
ref) c :: Int
c = do
    ac :: AC a
ac@(AC _ _ cap :: Int
cap) <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
ref
    ac' :: AC a
ac'@(AC _ _ cap' :: 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 es :: ForeignPtr a
es len :: Int
len cap :: Int
cap) c :: 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 ref :: IORef (AC a)
ref) f :: Ptr a -> Int -> IO b
f = do
    AC es :: ForeignPtr a
es len :: Int
len _ <- 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
$ \p :: 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 ref :: IORef (AC a)
ref) e :: a
e = do
    ac :: AC a
ac@(AC _ len :: Int
len _) <- 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
+ 1
    ac' :: AC a
ac'@(AC es :: ForeignPtr a
es _ cap :: 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 ref :: 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 es :: ForeignPtr a
es _ cap :: Int
cap) ->
        (ForeignPtr a -> Int -> Int -> AC a
forall a. ForeignPtr a -> Int -> Int -> AC a
AC ForeignPtr a
es 0 Int
cap, ())

forM_ :: Storable a => Array a -> (a -> IO ()) -> IO ()
forM_ :: Array a -> (a -> IO ()) -> IO ()
forM_ ary :: Array a
ary g :: 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 ref :: IORef (AC b)
ref) f :: b -> IO ()
f dummy :: b
dummy = do
      AC es :: ForeignPtr b
es len :: Int
len _ <- 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
$ \p :: Ptr b
p -> do
        let go :: Int -> IO ()
go n :: 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 0

loop :: Storable a => Array a -> b -> (b -> a -> IO (b,Bool)) -> IO ()
loop :: Array a -> b -> (b -> a -> IO (b, Bool)) -> IO ()
loop ary :: Array a
ary z :: b
z g :: 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 ref :: IORef (AC b)
ref) y :: c
y f :: c -> b -> IO (c, Bool)
f dummy :: b
dummy = do
      AC es :: ForeignPtr b
es len :: Int
len _ <- 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
$ \p :: Ptr b
p -> do
        let go :: Int -> c -> IO ()
go n :: Int
n k :: 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
                      (k' :: c
k',cont :: 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 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 dummy :: b
dummy p :: b -> Bool
p (Array ref :: IORef (AC b)
ref) = do
    AC es :: ForeignPtr b
es len :: Int
len _ <- 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 :: 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
+ 1)
      in  Int -> Int -> IO (Maybe (Int, b))
forall t. Num t => Int -> t -> IO (Maybe (t, b))
go 0 0

concat :: Storable a => Array a -> Array a -> IO ()
concat :: Array a -> Array a -> IO ()
concat (Array d :: IORef (AC a)
d) (Array s :: IORef (AC a)
s) = do
  da :: AC a
da@(AC _ dlen :: Int
dlen _) <- IORef (AC a) -> IO (AC a)
forall a. IORef a -> IO a
readIORef IORef (AC a)
d
  sa :: AC a
sa@(AC _ slen :: Int
slen _) <- 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 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 d :: IORef (AC a)
d) dstart :: Int
dstart (Array s :: IORef (AC a)
s) sstart :: Int
sstart maxCount :: 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' d :: AC a
d dstart :: Int
dstart s :: AC a
s sstart :: Int
sstart maxCount :: 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 _ oldLen :: Int
oldLen _) (AC src :: ForeignPtr b
src slen :: Int
slen _) dummy :: 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
< 0 Bool -> Bool -> Bool
|| Int
dstart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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
< 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 "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
== 0
      then AC b -> IO (AC b)
forall (m :: * -> *) a. Monad m => a -> m a
return AC b
dac
      else do
        AC dst :: ForeignPtr b
dst dlen :: Int
dlen dcap :: 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
$ \dptr :: 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
$ \sptr :: 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 a :: Array a
a i :: 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 ary :: IORef (AC b)
ary) dummy :: b
dummy = do
    AC fp :: ForeignPtr b
fp oldLen :: Int
oldLen cap :: 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
< 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 "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
- 1
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
newLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 :: 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
+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
- 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` 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` 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` 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` 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` 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` 32)
    in Int
n7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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)