{-# LANGUAGE MagicHash, UnboxedTuples #-}
module Data.Text.Glyphize.Array where
import Foreign.Storable (Storable(..))
import Foreign.ForeignPtr (ForeignPtr, plusForeignPtr, withForeignPtr, mallocForeignPtrArray)
import Foreign.Ptr
import Foreign.Marshal.Array (copyArray)
import GHC.IO (IO(IO))
import GHC.Exts (realWorld#, oneShot)
clonePtr :: Storable a => Ptr a -> Int -> IO (ForeignPtr a)
clonePtr :: forall a. Storable a => Ptr a -> Int -> IO (ForeignPtr a)
clonePtr Ptr a
ptr Int
l = do
ForeignPtr a
ret <- 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
ret forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr' -> forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr a
ptr' Ptr a
ptr Int
l
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr a
ret
peekLazy :: Storable a => ForeignPtr a -> Int -> [a]
peekLazy :: forall a. Storable a => ForeignPtr a -> Int -> [a]
peekLazy ForeignPtr a
fp Int
0 = []
peekLazy ForeignPtr a
fp Int
n
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
chunkSize = forall {c}. (Ptr a -> IO c) -> c
withFP forall a b. (a -> b) -> a -> b
$ forall a. Storable a => [a] -> Int -> Ptr a -> IO [a]
peekEager [] Int
n
| Bool
otherwise = forall {c}. (Ptr a -> IO c) -> c
withFP forall a b. (a -> b) -> a -> b
$ forall a. Storable a => [a] -> Int -> Ptr a -> IO [a]
peekEager (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr a
fp Int
chunkSize forall a. Storable a => ForeignPtr a -> Int -> [a]
`peekLazy` (-) Int
n Int
chunkSize) Int
chunkSize
where withFP :: (Ptr a -> IO c) -> c
withFP = forall a. IO a -> a
accursedUnutterablePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp
peekEager :: Storable a => [a] -> Int -> Ptr a -> IO [a]
peekEager :: forall a. Storable a => [a] -> Int -> Ptr a -> IO [a]
peekEager [a]
acc Int
0 Ptr a
ptr = forall (m :: * -> *) a. Monad m => a -> m a
return [a]
acc
peekEager [a]
acc Int
n Ptr a
ptr = let n' :: Int
n' = forall a. Enum a => a -> a
pred Int
n in do
a
e <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
ptr Int
n'
forall a. Storable a => [a] -> Int -> Ptr a -> IO [a]
peekEager (a
eforall a. a -> [a] -> [a]
:[a]
acc) Int
n' Ptr a
ptr
chunkSize :: Int
chunkSize :: Int
chunkSize = Int
1024
iterateLazy :: Storable a => Ptr a -> Int -> IO [a]
iterateLazy :: forall a. Storable a => Ptr a -> Int -> IO [a]
iterateLazy Ptr a
ptr Int
l
| Int
l forall a. Ord a => a -> a -> Bool
< Int
0 = String -> IO ()
putStrLn (String
"Invalid array length: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
l) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return []
| Int
l forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = do
ForeignPtr a
fp <- forall a. Storable a => Ptr a -> Int -> IO (ForeignPtr a)
clonePtr Ptr a
ptr Int
l
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> a -> b
noCache forall a. Storable a => ForeignPtr a -> Int -> [a]
peekLazy ForeignPtr a
fp forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Int
l
{-# INLINE accursedUnutterablePerformIO #-}
accursedUnutterablePerformIO :: IO a -> a
accursedUnutterablePerformIO :: forall a. IO a -> a
accursedUnutterablePerformIO (IO State# RealWorld -> (# State# RealWorld, a #)
m) = case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
realWorld# of (# State# RealWorld
_, a
r #) -> a
r
noCache :: (a -> b) -> a -> b
noCache :: forall a b. (a -> b) -> a -> b
noCache = oneShot :: forall a b. (a -> b) -> a -> b
oneShot