{-# 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)
#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
newtype Array a = Array (IORef (AC a))
data AC a = AC
!(ForeignPtr a)
!Int
!Int
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 :: 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' :: 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)
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)