{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE DeriveDataTypeable #-}
--
-- Module      : Data.StorableVector.Base
-- License     : BSD-style
-- Maintainer  : dons@cse.unsw.edu.au
-- Stability   : experimental
-- Portability : portable, requires ffi and cpp
-- Tested with : GHC 6.4.1 and Hugs March 2005
-- 

-- | A module containing semi-public StorableVector internals. This exposes
-- the StorableVector representation and low level construction functions.
-- Modules which extend the StorableVector system will need to use this module
-- while ideally most users will be able to make do with the public interface
-- modules.
--
module Data.StorableVector.Base (

        -- * The @Vector@ type and representation
        Vector(..),             -- instances: Eq, Ord, Show, Read, Data, Typeable

        -- * Unchecked access
        unsafeHead,             -- :: Vector a -> a
        unsafeTail,             -- :: Vector a -> Vector a
        unsafeLast,             -- :: Vector a -> a
        unsafeInit,             -- :: Vector a -> Vector a
        unsafeIndex,            -- :: Vector a -> Int -> a
        unsafeTake,             -- :: Int -> Vector a -> Vector a
        unsafeDrop,             -- :: Int -> Vector a -> Vector a

        -- * Low level introduction and elimination
        create,                 -- :: Int -> (Ptr a -> IO ()) -> IO (Vector a)
        createAndTrim,          -- :: Int -> (Ptr a -> IO Int) -> IO (Vector a)
        createAndTrim',         -- :: Int -> (Ptr a -> IO (Int, Int, b)) -> IO (Vector a, b)

        unsafeCreate,           -- :: Int -> (Ptr a -> IO ()) ->  Vector a

        fromForeignPtr,         -- :: ForeignPtr a -> Int -> Vector a
        toForeignPtr,           -- :: Vector a -> (ForeignPtr a, Int, Int)
        withStartPtr,           -- :: Vector a -> (Ptr a -> Int -> IO b) -> IO b
        incPtr,                 -- :: Ptr a -> Ptr a

        inlinePerformIO

  ) where

import Foreign.Ptr              (Ptr)
import Foreign.ForeignPtr       (ForeignPtr, withForeignPtr, )
import Foreign.Marshal.Array    (advancePtr, copyArray)
import Foreign.Storable         (Storable(peekElemOff))

import Data.StorableVector.Memory (mallocForeignPtrArray, )

import Control.DeepSeq          (NFData, rnf)
import Control.Exception        (assert)

#if defined(__GLASGOW_HASKELL__)
import Data.Generics            (Data, Typeable)
import GHC.Base                 (realWorld#)
import GHC.IO                   (IO(IO), )
#endif

import qualified System.Unsafe as Unsafe

-- CFILES stuff is Hugs only
{-# CFILES cbits/fpstring.c #-}

-- -----------------------------------------------------------------------------

-- | A space-efficient representation of a vector, supporting many efficient
-- operations.
--
-- Instances of Eq, Ord, Read, Show, Data, Typeable
--
data Vector a = SV {-# UNPACK #-} !(ForeignPtr a)
                   {-# UNPACK #-} !Int                -- offset
                   {-# UNPACK #-} !Int                -- length
#if defined(__GLASGOW_HASKELL__)
    deriving (Vector a -> DataType
Vector a -> Constr
forall {a}. Data a => Typeable (Vector a)
forall a. Data a => Vector a -> DataType
forall a. Data a => Vector a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Vector a -> Vector a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Vector a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Vector a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Vector a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Vector a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Vector a -> m (Vector a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Vector a -> m (Vector a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Vector a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Vector a -> c (Vector a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Vector a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Vector a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Vector a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Vector a -> c (Vector a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Vector a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Vector a -> m (Vector a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Vector a -> m (Vector a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Vector a -> m (Vector a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Vector a -> m (Vector a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Vector a -> m (Vector a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Vector a -> m (Vector a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Vector a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Vector a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Vector a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Vector a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Vector a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Vector a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Vector a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Vector a -> r
gmapT :: (forall b. Data b => b -> b) -> Vector a -> Vector a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Vector a -> Vector a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Vector a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Vector a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Vector a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Vector a))
dataTypeOf :: Vector a -> DataType
$cdataTypeOf :: forall a. Data a => Vector a -> DataType
toConstr :: Vector a -> Constr
$ctoConstr :: forall a. Data a => Vector a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Vector a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Vector a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Vector a -> c (Vector a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Vector a -> c (Vector a)
Data, Typeable)
#endif


instance (Storable a) => NFData (Vector a) where
    rnf :: Vector a -> ()
rnf (SV ForeignPtr a
_ Int
_ Int
_) = ()


-- ---------------------------------------------------------------------
--
-- Extensions to the basic interface
--

-- | A variety of 'head' for non-empty Vectors. 'unsafeHead' omits the
-- check for the empty case, so there is an obligation on the programmer
-- to provide a proof that the Vector is non-empty.
unsafeHead :: (Storable a) => Vector a -> a
unsafeHead :: forall a. Storable a => Vector a -> a
unsafeHead (SV ForeignPtr a
x Int
s Int
l) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
    forall a. IO a -> a
inlinePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
p Int
s
{-# INLINE unsafeHead #-}

-- | A variety of 'tail' for non-empty Vectors. 'unsafeTail' omits the
-- check for the empty case. As with 'unsafeHead', the programmer must
-- provide a separate proof that the Vector is non-empty.
unsafeTail :: (Storable a) => Vector a -> Vector a
unsafeTail :: forall a. Storable a => Vector a -> Vector a
unsafeTail (SV ForeignPtr a
ps Int
s Int
l) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ forall a. ForeignPtr a -> Int -> Int -> Vector a
SV ForeignPtr a
ps (Int
sforall a. Num a => a -> a -> a
+Int
1) (Int
lforall a. Num a => a -> a -> a
-Int
1)
{-# INLINE unsafeTail #-}

-- | A variety of 'last' for non-empty Vectors. 'unsafeLast' omits the
-- check for the empty case, so there is an obligation on the programmer
-- to provide a proof that the Vector is non-empty.
unsafeLast :: (Storable a) => Vector a -> a
unsafeLast :: forall a. Storable a => Vector a -> a
unsafeLast (SV ForeignPtr a
x Int
s Int
l) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
    forall a. IO a -> a
inlinePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
p (Int
sforall a. Num a => a -> a -> a
+Int
lforall a. Num a => a -> a -> a
-Int
1)
{-# INLINE unsafeLast #-}

-- | A variety of 'init' for non-empty Vectors. 'unsafeInit' omits the
-- check for the empty case. As with 'unsafeLast', the programmer must
-- provide a separate proof that the Vector is non-empty.
unsafeInit :: (Storable a) => Vector a -> Vector a
unsafeInit :: forall a. Storable a => Vector a -> Vector a
unsafeInit (SV ForeignPtr a
ps Int
s Int
l) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ forall a. ForeignPtr a -> Int -> Int -> Vector a
SV ForeignPtr a
ps Int
s (Int
lforall a. Num a => a -> a -> a
-Int
1)
{-# INLINE unsafeInit #-}

-- | Unsafe 'Vector' index (subscript) operator, starting from 0, returning a
-- single element.  This omits the bounds check, which means there is an
-- accompanying obligation on the programmer to ensure the bounds are checked in
-- some other way.
unsafeIndex :: (Storable a) => Vector a -> Int -> a
unsafeIndex :: forall a. Storable a => Vector a -> Int -> a
unsafeIndex (SV ForeignPtr a
x Int
s Int
l) Int
i = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< Int
l) forall a b. (a -> b) -> a -> b
$
    forall a. IO a -> a
inlinePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
p (Int
sforall a. Num a => a -> a -> a
+Int
i)
{-# INLINE unsafeIndex #-}

-- | A variety of 'take' which omits the checks on @n@ so there is an
-- obligation on the programmer to provide a proof that @0 <= n <= 'length' xs@.
unsafeTake :: (Storable a) => Int -> Vector a -> Vector a
unsafeTake :: forall a. Storable a => Int -> Vector a -> Vector a
unsafeTake Int
n (SV ForeignPtr a
x Int
s Int
l) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
0 forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
l) forall a b. (a -> b) -> a -> b
$ forall a. ForeignPtr a -> Int -> Int -> Vector a
SV ForeignPtr a
x Int
s Int
n
{-# INLINE unsafeTake #-}

-- | A variety of 'drop' which omits the checks on @n@ so there is an
-- obligation on the programmer to provide a proof that @0 <= n <= 'length' xs@.
unsafeDrop :: (Storable a) => Int -> Vector a -> Vector a
unsafeDrop :: forall a. Storable a => Int -> Vector a -> Vector a
unsafeDrop Int
n (SV ForeignPtr a
x Int
s Int
l) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
0 forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
l) forall a b. (a -> b) -> a -> b
$ forall a. ForeignPtr a -> Int -> Int -> Vector a
SV ForeignPtr a
x (Int
sforall a. Num a => a -> a -> a
+Int
n) (Int
lforall a. Num a => a -> a -> a
-Int
n)
{-# INLINE unsafeDrop #-}


instance (Storable a, Show a) => Show (Vector a) where
   showsPrec :: Int -> Vector a -> ShowS
showsPrec Int
p xs :: Vector a
xs@(SV ForeignPtr a
_ Int
_ Int
l) =
      Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>=Int
10)
         (String -> ShowS
showString String
"Vector.pack " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Storable a => Vector a -> Int -> a
unsafeIndex Vector a
xs) [Int
0..(Int
lforall a. Num a => a -> a -> a
-Int
1)]))


-- ---------------------------------------------------------------------
-- Low level constructors

-- | /O(1)/ Build a Vector from a ForeignPtr
fromForeignPtr :: ForeignPtr a -> Int -> Vector a
fromForeignPtr :: forall a. ForeignPtr a -> Int -> Vector a
fromForeignPtr ForeignPtr a
fp Int
l = forall a. ForeignPtr a -> Int -> Int -> Vector a
SV ForeignPtr a
fp Int
0 Int
l

-- | /O(1)/ Deconstruct a ForeignPtr from a Vector
toForeignPtr :: Vector a -> (ForeignPtr a, Int, Int)
toForeignPtr :: forall a. Vector a -> (ForeignPtr a, Int, Int)
toForeignPtr (SV ForeignPtr a
ps Int
s Int
l) = (ForeignPtr a
ps, Int
s, Int
l)

-- | Run an action that is initialized
-- with a pointer to the first element to be used.
withStartPtr :: Storable a => Vector a -> (Ptr a -> Int -> IO b) -> IO b
withStartPtr :: forall a b.
Storable a =>
Vector a -> (Ptr a -> Int -> IO b) -> IO b
withStartPtr (SV ForeignPtr a
x Int
s Int
l) Ptr a -> Int -> IO b
f =
   forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> Ptr a -> Int -> IO b
f (Ptr a
p forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
s) Int
l
{-# INLINE withStartPtr #-}

incPtr :: (Storable a) => Ptr a -> Ptr a
incPtr :: forall a. Storable a => Ptr a -> Ptr a
incPtr Ptr a
v = forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
v Int
1
{-# INLINE incPtr #-}

-- | A way of creating Vectors outside the IO monad. The @Int@
-- argument gives the final size of the Vector. Unlike
-- 'createAndTrim' the Vector is not reallocated if the final size
-- is less than the estimated size.
unsafeCreate :: (Storable a) => Int -> (Ptr a -> IO ()) -> Vector a
unsafeCreate :: forall a. Storable a => Int -> (Ptr a -> IO ()) -> Vector a
unsafeCreate Int
l Ptr a -> IO ()
f = forall a. IO a -> a
Unsafe.performIO (forall a. Storable a => Int -> (Ptr a -> IO ()) -> IO (Vector a)
create Int
l Ptr a -> IO ()
f)
{-# INLINE unsafeCreate #-}

-- | Wrapper of mallocForeignPtrArray.
create :: (Storable a) => Int -> (Ptr a -> IO ()) -> IO (Vector a)
create :: forall a. Storable a => Int -> (Ptr a -> IO ()) -> IO (Vector a)
create Int
l Ptr a -> IO ()
f = do
    ForeignPtr a
fp <- forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray Int
l
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> Ptr a -> IO ()
f Ptr a
p
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. ForeignPtr a -> Int -> Int -> Vector a
SV ForeignPtr a
fp Int
0 Int
l

-- | Given the maximum size needed and a function to make the contents
-- of a Vector, createAndTrim makes the 'Vector'. The generating
-- function is required to return the actual final size (<= the maximum
-- size), and the resulting byte array is realloced to this size.
--
-- createAndTrim is the main mechanism for creating custom, efficient
-- Vector functions, using Haskell or C functions to fill the space.
--
createAndTrim :: (Storable a) => Int -> (Ptr a -> IO Int) -> IO (Vector a)
createAndTrim :: forall a. Storable a => Int -> (Ptr a -> IO Int) -> IO (Vector a)
createAndTrim Int
l Ptr a -> IO Int
f = do
    ForeignPtr a
fp <- forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray Int
l
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> do
        Int
l' <- Ptr a -> IO Int
f Ptr a
p
        if forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l' forall a. Ord a => a -> a -> Bool
<= Int
l) forall a b. (a -> b) -> a -> b
$ Int
l' forall a. Ord a => a -> a -> Bool
>= Int
l
            then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. ForeignPtr a -> Int -> Int -> Vector a
SV ForeignPtr a
fp Int
0 Int
l
            else forall a. Storable a => Int -> (Ptr a -> IO ()) -> IO (Vector a)
create Int
l' forall a b. (a -> b) -> a -> b
$ \Ptr a
p' -> forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr a
p' Ptr a
p Int
l'

createAndTrim' :: (Storable a) => Int 
                               -> (Ptr a -> IO (Int, Int, b))
                               -> IO (Vector a, b)
createAndTrim' :: forall a b.
Storable a =>
Int -> (Ptr a -> IO (Int, Int, b)) -> IO (Vector a, b)
createAndTrim' Int
l Ptr a -> IO (Int, Int, b)
f = do
    ForeignPtr a
fp <- forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray Int
l
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> do
        (Int
off, Int
l', b
res) <- Ptr a -> IO (Int, Int, b)
f Ptr a
p
        if forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l' forall a. Ord a => a -> a -> Bool
<= Int
l) forall a b. (a -> b) -> a -> b
$ Int
l' forall a. Ord a => a -> a -> Bool
>= Int
l
            then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (forall a. ForeignPtr a -> Int -> Int -> Vector a
SV ForeignPtr a
fp Int
0 Int
l, b
res)
            else do Vector a
ps <- forall a. Storable a => Int -> (Ptr a -> IO ()) -> IO (Vector a)
create Int
l' forall a b. (a -> b) -> a -> b
$ \Ptr a
p' -> forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr a
p' (Ptr a
p forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
off) Int
l'
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Vector a
ps, b
res)

-- | Just like Unsafe.performIO, but we inline it. Big performance gains as
-- it exposes lots of things to further inlining. /Very unsafe/. In
-- particular, you should do no memory allocation inside an
-- 'inlinePerformIO' block. On Hugs this is just @Unsafe.performIO@.
--
{-# INLINE inlinePerformIO #-}
inlinePerformIO :: IO a -> a
#if defined(__GLASGOW_HASKELL__)
inlinePerformIO :: forall a. IO a -> a
inlinePerformIO (IO State# RealWorld -> (# State# RealWorld, a #)
m) = case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
realWorld# of (# State# RealWorld
_, a
r #) -> a
r
#else
inlinePerformIO = Unsafe.performIO
#endif