5 files changed, 80 insertions(+), 116 deletions(-)

M Data/Text/Glyphize.hs
M Data/Text/Glyphize/Buffer.hs
M Data/Text/Glyphize/Font.hs
M bench/Main.hs
M harfbuzz-pure.cabal

@@ 33,7 33,7 @@ import Data.Text.Glyphize.Font
 import Data.Text.Glyphize.Buffer
 import Data.Text.Glyphize.Oom
 
-import System.IO.Unsafe (unsafePerformIO)
+import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO)
 import Foreign.Ptr (Ptr(..))
 import Foreign.ForeignPtr (withForeignPtr)
 import Foreign.Marshal.Alloc (alloca)


@@ 76,7 76,7 @@ guessSegmentProperties = unsafePerformIO . flip withBuffer thawBuffer
 foreign import ccall "hb_version" hb_version :: Ptr Int -> Ptr Int -> Ptr Int -> IO ()
 -- | Returns the library version as 3 integer components.
 version :: (Int, Int, Int)
-version = unsafePerformIO $
+version = unsafeDupablePerformIO $
     alloca $ \a' -> alloca $ \b' -> alloca $ \c' -> do
         hb_version a' b' c'
         a <- peek a'


@@ 88,4 88,4 @@ foreign import ccall "hb_version_atleast" versionAtLeast :: Int -> Int -> Int ->
 foreign import ccall "hb_version_string" hb_version_string :: CString
 -- | Returns library version as a string with 3 integer components.
 versionString :: String
-versionString = unsafePerformIO $ peekCString hb_version_string
+versionString = unsafeDupablePerformIO $ peekCString hb_version_string

@@ 1,5 1,4 @@
-{-# LANGUAGE MagicHash, UnboxedTuples #-}
-{-# LANGUAGE UnliftedFFITypes, DeriveGeneric #-}
+{-# LANGUAGE MagicHash, UnliftedFFITypes, DeriveGeneric #-}
 module Data.Text.Glyphize.Buffer where
 
 import qualified Data.Text.Internal.Lazy as Lazy


@@ 11,21 10,19 @@ import Control.Exception (bracket)
 import Control.DeepSeq (NFData)
 
 import Data.Text.Glyphize.Oom (throwFalse, throwNull)
+import Data.Text.Glyphize.Array (iterateLazy)
 
 import qualified Data.Text.Array as A
-import GHC.Exts (ByteArray#, sizeofByteArray#, Int#, realWorld#)
+import GHC.Exts (ByteArray#, sizeofByteArray#, Int#)
 import Data.Word (Word32)
 import Data.Int (Int32)
 import Data.Bits ((.|.), (.&.), shiftR, shiftL, testBit)
 
-import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO)
-import GHC.IO (IO(IO))
+import System.IO.Unsafe (unsafePerformIO)
 
 import Foreign.Marshal.Alloc (alloca, allocaBytes)
-import Foreign.Marshal.Array (peekArray, copyArray)
+import Foreign.Marshal.Array (peekArray)
 import Foreign.Ptr
-import Foreign.ForeignPtr (ForeignPtr,
-        withForeignPtr, plusForeignPtr, mallocForeignPtrArray)
 import Foreign.C.String (CString, withCString, peekCString)
 import Foreign.Storable (Storable(..))
 import GHC.Generics (Generic(..))


@@ 490,52 487,3 @@ foreign import ccall "hb_buffer_get_invisible_glyph" hb_buffer_get_invisible_gly
     :: Buffer' -> IO Word32
 foreign import ccall "hb_buffer_get_replacement_codepoint" hb_buffer_get_replacement_codepoint
     :: Buffer' -> IO Word32
-
---- Even more optimized peekArray
-
-clonePtr ptr l = do
-    ret <- mallocForeignPtrArray l
-    withForeignPtr ret $ \ptr' -> copyArray ptr ptr' l
-    return ret
-peekLazy :: Storable a => ForeignPtr a -> Int -> [a]
-peekLazy = peekLazy' 0
-peekLazy' n fp l
-    | n < l = x:peekLazy' (succ n) fp l
-    | otherwise = []
-  where x = accursedUnutterablePerformIO $ withForeignPtr fp $ flip peekElemOff n
-iterateLazy :: Storable a => Ptr a -> Int -> IO [a]
-iterateLazy ptr l = do
-    fp <- clonePtr ptr l
-    return $ peekLazy fp $ fromEnum l
-
--- | This \"function\" has a superficial similarity to 'System.IO.Unsafe.unsafePerformIO' but
--- it is in fact a malevolent agent of chaos. It unpicks the seams of reality
--- (and the 'IO' monad) so that the normal rules no longer apply. It lulls you
--- into thinking it is reasonable, but when you are not looking it stabs you
--- in the back and aliases all of your mutable buffers. The carcass of many a
--- seasoned Haskell programmer lie strewn at its feet.
---
--- Witness the trail of destruction:
---
--- * <https://github.com/haskell/bytestring/commit/71c4b438c675aa360c79d79acc9a491e7bbc26e7>
---
--- * <https://github.com/haskell/bytestring/commit/210c656390ae617d9ee3b8bcff5c88dd17cef8da>
---
--- * <https://github.com/haskell/aeson/commit/720b857e2e0acf2edc4f5512f2b217a89449a89d>
---
--- * <https://ghc.haskell.org/trac/ghc/ticket/3486>
---
--- * <https://ghc.haskell.org/trac/ghc/ticket/3487>
---
--- * <https://ghc.haskell.org/trac/ghc/ticket/7270>
---
--- * <https://gitlab.haskell.org/ghc/ghc/-/issues/22204>
---
--- Do not talk about \"safe\"! You do not know what is safe!
---
--- Yield not to its blasphemous call! Flee traveller! Flee or you will be
--- corrupted and devoured!
---
-{-# INLINE accursedUnutterablePerformIO #-}
-accursedUnutterablePerformIO :: IO a -> a
-accursedUnutterablePerformIO (IO m) = case m realWorld# of (# _, r #) -> r

@@ 14,11 14,11 @@ import Control.Monad (forM, unless)
 import Control.Exception (bracket)
 import Data.Maybe (fromMaybe)
 
-import System.IO.Unsafe (unsafePerformIO)
+import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO)
 import Foreign.ForeignPtr (ForeignPtr(..), withForeignPtr, newForeignPtr, newForeignPtr_)
 import Foreign.Ptr (Ptr(..), FunPtr(..), nullPtr, nullFunPtr, castPtr)
 import Foreign.Marshal.Alloc (alloca, allocaBytes)
-import Foreign.Marshal.Array (withArray, withArrayLen)
+import Foreign.Marshal.Array (withArray, withArrayLen, peekArray)
 import Foreign.Storable (Storable(..))
 import Foreign.Storable.Generic (GStorable(..))
 import GHC.Generics (Generic(..))


@@ 363,11 363,11 @@ foreign import ccall "hb_font_get_face" hb_font_get_face :: Font_ -> IO Face_
 -- with an optional variation selector.
 fontGlyph :: Font -> Char -> Maybe Char -> Maybe Word32
 fontGlyph font char var =
-    unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \ret -> do
+    unsafeDupablePerformIO $ withForeignPtr font $ \font' -> alloca $ \ret -> do
         success <- hb_font_get_glyph font' (c2w char) (c2w $ fromMaybe '\0' var) ret
         if success then return . Just =<< peek ret else return Nothing
 fontGlyph' font char var =
-    unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \ret -> do
+    unsafeDupablePerformIO $ withForeignPtr font $ \font' -> alloca $ \ret -> do
         throwFalse $ hb_font_get_glyph font' (c2w char) (c2w $ fromMaybe '\0' var) ret
         peek ret
 foreign import ccall "hb_font_get_glyph" hb_font_get_glyph


@@ 378,7 378,7 @@ foreign import ccall "hb_font_get_glyph" hb_font_get_glyph
 -- Calls the appropriate direction-specific variant (horizontal or vertical)
 -- depending on the value of direction .
 fontGlyphAdvance :: Font -> Word32 -> Maybe Direction -> (Int32, Int32)
-fontGlyphAdvance font glyph dir = unsafePerformIO $
+fontGlyphAdvance font glyph dir = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
         hb_font_get_glyph_advance_for_direction font' glyph (dir2int dir) x' y'
         x <- peek x'


@@ 391,7 391,7 @@ foreign import ccall "hb_font_get_glyph_advance_for_direction"
 -- | Fetches the (x,y) coordinates of a specified contour-point index
 -- in the specified glyph, within the specified font.
 fontGlyphContourPoint :: Font -> Word32 -> Int -> Maybe (Int32, Int32)
-fontGlyphContourPoint font glyph index = unsafePerformIO $
+fontGlyphContourPoint font glyph index = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
         success <- hb_font_get_glyph_contour_point font' glyph index x' y'
         if success


@@ 400,7 400,7 @@ fontGlyphContourPoint font glyph index = unsafePerformIO $
             y <- peek y'
             return $ Just (x, y)
         else return Nothing
-fontGlyphContourPoint' font glyph index = unsafePerformIO $
+fontGlyphContourPoint' font glyph index = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
         throwFalse $ hb_font_get_glyph_contour_point font' glyph index x' y'
         x <- peek x'


@@ 415,7 415,7 @@ foreign import ccall "hb_font_get_glyph_contour_point" hb_font_get_glyph_contour
 -- Calls the appropriate direction-specific variant (horizontal or vertical)
 -- depending on the value of direction .
 fontGlyphContourPointForOrigin :: Font -> Word32 -> Int -> Maybe Direction -> Maybe (Int32, Int32)
-fontGlyphContourPointForOrigin font glyph index dir = unsafePerformIO $
+fontGlyphContourPointForOrigin font glyph index dir = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
         success <- hb_font_get_glyph_contour_point_for_origin font' glyph index
                 (dir2int dir) x' y'


@@ 425,7 425,7 @@ fontGlyphContourPointForOrigin font glyph index dir = unsafePerformIO $
             y <- peek y'
             return $ Just (x, y)
         else return Nothing
-fontGlyphContourPointForOrigin' font glyph index dir = unsafePerformIO $
+fontGlyphContourPointForOrigin' font glyph index dir = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
         throwFalse $ hb_font_get_glyph_contour_point_for_origin font' glyph index
                 (dir2int dir) x' y'


@@ 451,13 451,13 @@ data GlyphExtents = GlyphExtents {
 instance GStorable GlyphExtents
 -- | Fetches the `GlyphExtents` data for a glyph ID in the specified `Font`.
 fontGlyphExtents :: Font -> Word32 -> Maybe GlyphExtents
-fontGlyphExtents font glyph = unsafePerformIO $
+fontGlyphExtents font glyph = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \ret -> do
         success <- hb_font_get_glyph_extents font' glyph ret
         if success
         then return . Just =<< peek ret
         else return Nothing
-fontGlyphExtents' font glyph = unsafePerformIO $
+fontGlyphExtents' font glyph = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \ret -> do
         throwFalse $ hb_font_get_glyph_extents font' glyph ret
         peek ret


@@ 469,13 469,13 @@ foreign import ccall "hb_font_get_glyph_extents" hb_font_get_glyph_extents
 -- Calls the appropriate direction-specific variant (horizontal or vertical)
 -- depending on the value of given `Direction`.
 fontGlyphExtentsForOrigin :: Font -> Word32 -> Maybe Direction -> Maybe GlyphExtents
-fontGlyphExtentsForOrigin font glyph dir = unsafePerformIO $
+fontGlyphExtentsForOrigin font glyph dir = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \ret -> do
         ok <- hb_font_get_glyph_extents_for_origin font' glyph (dir2int dir) ret
         if ok
         then return . Just =<< peek ret
         else return Nothing
-fontGlyphExtentsForOrigin' font glyph dir = unsafePerformIO $
+fontGlyphExtentsForOrigin' font glyph dir = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \ret -> do
         throwFalse $ hb_font_get_glyph_extents_for_origin font' glyph (dir2int dir) ret
         peek ret


@@ 485,14 485,14 @@ foreign import ccall "hb_font_get_glyph_extents_for_origin"
 
 -- | Fetches the glyph ID that corresponds to a name string in the specified `Font`.
 fontGlyphFromName :: Font -> String -> Maybe Word32
-fontGlyphFromName font name = unsafePerformIO $
+fontGlyphFromName font name = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \ret -> do
         success <- withCStringLen name $ \(name', len) ->
             hb_font_get_glyph_from_name font' name' len ret
         if success
         then return . Just =<< peek ret
         else return Nothing
-fontGlyphFromName' font name = unsafePerformIO $
+fontGlyphFromName' font name = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \ret -> do
         throwFalse $ withCStringLen name $ \(name', len) ->
             hb_font_get_glyph_from_name font' name' len ret


@@ 524,7 524,7 @@ foreign import ccall "hb_font_get_glyph_h_kerning" hb_font_get_glyph_h_kerning
 -- | Fetches the (X,Y) coordinate of the origin for a glyph ID in the specified `Font`,
 -- for horizontal text segments.
 fontGlyphHOrigin :: Font -> Word32 -> Maybe (Int32, Int32)
-fontGlyphHOrigin font glyph = unsafePerformIO $ withForeignPtr font $ \font' ->
+fontGlyphHOrigin font glyph = unsafeDupablePerformIO $ withForeignPtr font $ \font' ->
     alloca $ \x' -> alloca $ \y' -> do
         success <- hb_font_get_glyph_h_origin font' glyph x' y'
         if success


@@ 533,7 533,7 @@ fontGlyphHOrigin font glyph = unsafePerformIO $ withForeignPtr font $ \font' ->
             y <- peek y'
             return $ Just (x, y)
         else return Nothing
-fontGlyphHOrigin' font glyph = unsafePerformIO $ withForeignPtr font $ \font' ->
+fontGlyphHOrigin' font glyph = unsafeDupablePerformIO $ withForeignPtr font $ \font' ->
     alloca $ \x' -> alloca $ \y' -> do
         throwFalse $ hb_font_get_glyph_h_origin font' glyph x' y'
         x <- peek x'


@@ 545,7 545,7 @@ foreign import ccall "hb_font_get_glyph_h_origin" hb_font_get_glyph_h_origin ::
 -- | Fetches the (X,Y) coordinates of the origin for a glyph ID in the specified `Font`,
 -- for vertical text segments.
 fontGlyphVOrigin :: Font -> Word32 -> Maybe (Int32, Int32)
-fontGlyphVOrigin font glyph = unsafePerformIO $ withForeignPtr font $ \font' ->
+fontGlyphVOrigin font glyph = unsafeDupablePerformIO $ withForeignPtr font $ \font' ->
     alloca $ \x' -> alloca $ \y' -> do
         success <- hb_font_get_glyph_v_origin font' glyph x' y'
         if success


@@ 554,7 554,7 @@ fontGlyphVOrigin font glyph = unsafePerformIO $ withForeignPtr font $ \font' ->
             y <- peek y'
             return $ Just (x, y)
         else return Nothing
-fontGlyphVOrigin' font glyph = unsafePerformIO $ withForeignPtr font $ \font' ->
+fontGlyphVOrigin' font glyph = unsafeDupablePerformIO $ withForeignPtr font $ \font' ->
     alloca $ \x' -> alloca $ \y' -> do
         throwFalse $ hb_font_get_glyph_v_origin font' glyph x' y'
         x <- peek x'


@@ 567,7 567,7 @@ foreign import ccall "hb_font_get_glyph_v_origin" hb_font_get_glyph_v_origin ::
 -- Calls the appropriate direction-specific variant (horizontal or vertical)
 -- depending on the value of given `Direction`.
 fontGlyphKerningForDir :: Font -> Word32 -> Word32 -> Maybe Direction -> (Int32, Int32)
-fontGlyphKerningForDir font a b dir = unsafePerformIO $ withForeignPtr font $ \font' ->
+fontGlyphKerningForDir font a b dir = unsafeDupablePerformIO $ withForeignPtr font $ \font' ->
     alloca $ \x' -> alloca $ \y' -> do
         hb_font_get_glyph_kerning_for_direction font' a b (dir2int dir) x' y'
         x <- peek x'


@@ 584,13 584,13 @@ fontGlyphName' a b = fontGlyphName_' a b 32
 -- | Variant of `fontGlyphName` which lets you specify the maximum of the return value.
 -- Defaults to 32.
 fontGlyphName_ :: Font -> Word32 -> Int -> Maybe String
-fontGlyphName_ font glyph size = unsafePerformIO $ withForeignPtr font $ \font' ->
+fontGlyphName_ font glyph size = unsafeDupablePerformIO $ withForeignPtr font $ \font' ->
     allocaBytes size $ \name' -> do
         success <- hb_font_get_glyph_name font' glyph name' (toEnum size)
         if success
         then Just <$> peekCStringLen (name', size)
         else return Nothing
-fontGlyphName_' font glyph size = unsafePerformIO $ withForeignPtr font $ \font' ->
+fontGlyphName_' font glyph size = unsafeDupablePerformIO $ withForeignPtr font $ \font' ->
     allocaBytes size $ \name' -> do
         throwFalse $ hb_font_get_glyph_name font' glyph name' (toEnum size)
         peekCStringLen (name', size)


@@ 601,7 601,7 @@ foreign import ccall "hb_font_get_glyph_name" hb_font_get_glyph_name ::
 -- Calls the appropriate direction-specific variant (horizontal or vertical)
 -- depending on the value of given `Direction`.
 fontGlyphOriginForDir :: Font -> Word32 -> Maybe Direction -> (Int32, Int32)
-fontGlyphOriginForDir font glyph dir = unsafePerformIO $ withForeignPtr font $ \font' ->
+fontGlyphOriginForDir font glyph dir = unsafeDupablePerformIO $ withForeignPtr font $ \font' ->
     alloca $ \x' -> alloca $ \y' -> do
         hb_font_get_glyph_origin_for_direction font' glyph (dir2int dir) x' y'
         x <- peek x'


@@ 619,11 619,11 @@ foreign import ccall "hb_font_get_glyph_origin_for_direction"
 -- `fontVarGlyph` or use `fontGlyph`.
 fontNominalGlyph :: Font -> Char -> Maybe Word32
 fontNominalGlyph font c =
-    unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \glyph' -> do
+    unsafeDupablePerformIO $ withForeignPtr font $ \font' -> alloca $ \glyph' -> do
         success <- hb_font_get_nominal_glyph font' (c2w c) glyph'
         if success then Just <$> peek glyph' else return Nothing
 fontNominalGlyph' font c =
-    unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \glyph' -> do
+    unsafeDupablePerformIO $ withForeignPtr font $ \font' -> alloca $ \glyph' -> do
         throwFalse $ hb_font_get_nominal_glyph font' (c2w c) glyph'
         peek glyph'
 foreign import ccall "hb_font_get_nominal_glyph" hb_font_get_nominal_glyph ::


@@ 632,13 632,13 @@ foreign import ccall "hb_font_get_nominal_glyph" hb_font_get_nominal_glyph ::
 -- | Fetches the parent of the given `Font`.
 fontParent :: Font -> Font
 fontParent child =
-    unsafePerformIO (newForeignPtr_ =<< withForeignPtr child hb_font_get_parent)
+    unsafeDupablePerformIO (newForeignPtr_ =<< withForeignPtr child hb_font_get_parent)
 foreign import ccall "hb_font_get_parent" hb_font_get_parent :: Font_ -> IO Font_
 
 -- | Fetches the horizontal & vertical points-per-em (ppem) of a `Font`.
 fontPPEm :: Font -> (Word32, Word32)
 fontPPEm font =
-    unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
+    unsafeDupablePerformIO $ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
         hb_font_get_ppem font' x' y'
         x <- peek x'
         y <- peek y'


@@ 653,7 653,7 @@ foreign import ccall "hb_font_get_ptem" hb_font_get_ptem :: Font_ -> Float
 
 -- | Fetches the horizontal and vertical scale of a `Font`.
 fontScale :: Font -> (Int, Int)
-fontScale font = unsafePerformIO $
+fontScale font = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
         hb_font_get_scale font' x' y'
         x <- peek x' :: IO Int32


@@ 671,13 671,13 @@ foreign import ccall "hb_font_get_synthetic_slant" hb_font_get_synthetic_slant :
 -- | Fetches the glyph ID for a Unicode codepoint when followed by
 -- the specified variation-selector codepoint, in the specified `Font`.
 fontVarGlyph :: Font -> Word32 -> Word32 -> Maybe Word32
-fontVarGlyph font unicode varSel = unsafePerformIO $
+fontVarGlyph font unicode varSel = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \glyph' -> do
         success <- hb_font_get_variation_glyph font' unicode varSel glyph'
         if success
         then return . Just =<< peek glyph'
         else return Nothing
-fontVarGlyph' font unicode varSel = unsafePerformIO $
+fontVarGlyph' font unicode varSel = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \glyph' -> do
         throwFalse $ hb_font_get_variation_glyph font' unicode varSel glyph'
         peek glyph'


@@ 689,11 689,11 @@ foreign import ccall "hb_font_get_variation_glyph" hb_font_get_variation_glyph
 -- Note that this returned list may only contain values for some (or none) of the axes;
 -- ommitted axes effectively have their default values.
 fontVarCoordsDesign :: Font -> [Float]
-fontVarCoordsDesign font = unsafePerformIO $
+fontVarCoordsDesign font = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \length' -> do
         arr <- hb_font_get_var_coords_design font' length'
         length <- peek length'
-        forM [0..fromEnum length-1] $ peekElemOff arr
+        peekArray (fromEnum length) arr
 foreign import ccall "hb_font_get_var_coords_design"
     hb_font_get_var_coords_design :: Font_ -> Ptr Word -> IO (Ptr Float)
 


@@ 701,7 701,7 @@ foreign import ccall "hb_font_get_var_coords_design"
 -- Note that this returned list may only contain values for some (or none) of the axes;
 -- ommitted axes effectively have default values.
 fontVarCoordsNormalized :: Font -> [Int]
-fontVarCoordsNormalized font = unsafePerformIO $
+fontVarCoordsNormalized font = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \length' -> do
         arr <- throwNull $ hb_font_get_var_coords_normalized font' length'
         length <- peek length'


@@ 712,14 712,14 @@ foreign import ccall "hb_font_get_var_coords_normalized"
 -- | Fetches the glyph ID from given `Font` that matches the specified string.
 -- Strings of the format gidDDD or uniUUUU are parsed automatically.
 fontTxt2Glyph :: Font -> String -> Maybe Word32
-fontTxt2Glyph font str = unsafePerformIO $
+fontTxt2Glyph font str = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \ret -> do
         ok <- withCStringLen str $ \(str', len) ->
             hb_font_glyph_from_string font' str' len ret
         if ok
         then return . Just =<< peek ret
         else return Nothing
-fontTxt2Glyph' font str = unsafePerformIO $
+fontTxt2Glyph' font str = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> alloca $ \ret -> do
         throwFalse $ withCStringLen str $ \(str', len) ->
             hb_font_glyph_from_string font' str' len ret


@@ 731,7 731,7 @@ foreign import ccall "hb_font_glyph_from_string" hb_font_glyph_from_string
 -- If the glyph ID has no name in the `Font`, a string of the form gidDDD is generated
 -- with DDD being the glyph ID.
 fontGlyph2Str :: Font -> Word32 -> Int -> String
-fontGlyph2Str font glyph length = unsafePerformIO $
+fontGlyph2Str font glyph length = unsafeDupablePerformIO $
     withForeignPtr font $ \font' -> allocaBytes length $ \ret -> do
         hb_font_glyph_to_string font' glyph ret length
         peekCString ret


@@ 756,7 756,7 @@ instance GStorable FontExtents
 -- Calls the appropriate direction-specific variant (horizontal or vertical)
 -- depending on the value of direction .
 fontExtentsForDir :: Font -> Maybe Direction -> FontExtents
-fontExtentsForDir font dir = unsafePerformIO $ alloca $ \ret -> do
+fontExtentsForDir font dir = unsafeDupablePerformIO $ alloca $ \ret -> do
     withForeignPtr font $ \font' ->
         hb_font_get_extents_for_direction font' (dir2int dir) ret
     peek ret


@@ 764,24 764,24 @@ foreign import ccall "hb_font_get_extents_for_direction"
     hb_font_get_extents_for_direction :: Font_ -> Int -> Ptr FontExtents -> IO ()
 
 -- | Fetches the extents for a specified font, for horizontal text segments.
-fontHExtents font = unsafePerformIO $ alloca $ \ret -> do
+fontHExtents font = unsafeDupablePerformIO $ alloca $ \ret -> do
     ok <- withForeignPtr font $ \font' -> hb_font_get_h_extents font' ret
     if ok
     then return . Just =<< peek ret
     else return Nothing
-fontHExtents' font = unsafePerformIO $ alloca $ \ret -> do
+fontHExtents' font = unsafeDupablePerformIO $ alloca $ \ret -> do
     throwFalse $ withForeignPtr font $ \font' -> hb_font_get_h_extents font' ret
     peek ret
 foreign import ccall "hb_font_get_h_extents" hb_font_get_h_extents
     :: Font_ -> Ptr FontExtents -> IO Bool
 
 -- | Fetches the extents for a specified font, for vertical text segments.
-fontVExtents font = unsafePerformIO $ alloca $ \ret -> do
+fontVExtents font = unsafeDupablePerformIO $ alloca $ \ret -> do
     ok <- withForeignPtr font $ \font' -> hb_font_get_v_extents font' ret
     if ok
     then return . Just =<< peek ret
     else return Nothing
-fontVExtents' font = unsafePerformIO $ alloca $ \ret -> do
+fontVExtents' font = unsafeDupablePerformIO $ alloca $ \ret -> do
     throwFalse $ withForeignPtr font $ \font' -> hb_font_get_v_extents font' ret
     peek ret
 foreign import ccall "hb_font_get_v_extents" hb_font_get_v_extents


@@ 947,11 947,11 @@ foreign import ccall "hb_blob_destroy" hb_blob_destroy' :: Blob_ -> IO ()
 
 -- | Internal utility for defining trivial language bindings unwrapping `Face` foreign pointers.
 faceFunc :: (Face_ -> a) -> (Face -> a)
-faceFunc cb fce = unsafePerformIO $ withForeignPtr fce $ return . cb
+faceFunc cb fce = unsafeDupablePerformIO $ withForeignPtr fce $ return . cb
 
 -- | Internal utility for defining trivial language bindings unwrapping `Font` foreign pointers.
 fontFunc :: (Font_ -> a) -> (Font -> a)
-fontFunc cb fnt = unsafePerformIO $ withForeignPtr fnt $ return . cb
+fontFunc cb fnt = unsafeDupablePerformIO $ withForeignPtr fnt $ return . cb
 
 -- | Internal utility for exposing Harfbuzz functions that populate a bitset.
 -- Converts the populated bitset to a Haskell lazy linked-list.

@@ 2,8 2,7 @@
 module Main where
 import Criterion.Main
 import Data.Text.Glyphize
-import FileEmbedLzma (embedLazyText, embedByteString)
-import Data.FileEmbed (makeRelativeToProject)
+import Data.FileEmbed
 import System.FilePath ((</>))
 import qualified Data.Text.Foreign as Txt
 import qualified Data.Text.Lazy as Txt


@@ 12,19 11,17 @@ import Control.Parallel.Strategies (parMap, rdeepseq)
 import Data.Word (Word8)
 
 -- Benchmarking these as well...
-import Foreign.Marshal.Array (peekArray, copyArray)
-import Foreign.ForeignPtr (mallocForeignPtrArray, ForeignPtr)
-
-import Foreign.Ptr (Ptr)
-import Foreign.Storable (Storable(..))
-import System.IO.Unsafe (unsafePerformIO)
+import Foreign.Marshal.Array (peekArray)
+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray)
+import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO, unsafeInterleaveIO)
+import Data.Text.Glyphize.Array
 
 shapeStr txt = shape font defaultBuffer { text = txt } []
   where font = createFont $ createFace $(
                     makeRelativeToProject ("assets" </> "Lora-Regular.ttf") >>=
-                    embedByteString) 0
+                    embedFile) 0
 
-dracula = $(makeRelativeToProject ("bench" </> "dracula.txt") >>= embedLazyText)
+dracula = $(makeRelativeToProject ("bench" </> "dracula.txt") >>= embedStringFile)
 
 main = defaultMain [
     bgroup "Dracula" [


@@ 39,6 36,25 @@ main = defaultMain [
         bench "peekArray" $ whnfIO $ Txt.useAsPtr (Txt.toStrict dracula) $
             \ptr l -> peekArray (fromEnum l) ptr,
         bench "alloc foreign ptr" $ whnfIO (mallocForeignPtrArray $
-            fromEnum $ Txt.length dracula :: IO (ForeignPtr Word8))
+            fromEnum $ Txt.length dracula :: IO (ForeignPtr Word8)),
+        bench "clone ptr" $ whnfIO $ Txt.useAsPtr (Txt.toStrict dracula) $
+            \ptr l -> clonePtr ptr $ fromEnum l,
+        bench "peek lazy" $ whnfIO (Txt.asForeignPtr (Txt.toStrict dracula) >>=
+            \(ptr, l) -> return $ peekLazy ptr $ fromEnum l),
+        bench "iterate lazy" $ whnfIO $ Txt.useAsPtr (Txt.toStrict dracula) $
+            \ptr l -> iterateLazy ptr $ fromEnum l,
+        bench "peek lazy (NF)" $ nfIO $ (Txt.asForeignPtr (Txt.toStrict dracula) >>=
+            \(ptr, l) -> return $ peekLazy ptr $ fromEnum l),
+        bench "iterate lazy (NF)" $ nfIO $ Txt.useAsPtr (Txt.toStrict dracula) $
+            \ptr l -> iterateLazy ptr $ fromEnum l,
+        -- These benchmarks give unconfident results, thought they'd be interesting...
+        bench "unsafePerformIO" $ whnf unsafePerformIO $ return (),
+        bench "unsafeDupablePerformIO" $ whnf unsafeDupablePerformIO $ return (),
+        bench "unsafeInterleaveIO" $ whnfIO $ unsafeInterleaveIO $ return (),
+        bench "accursedUnutterablePerformIO" $ whnf accursedUnutterablePerformIO $ return (),
+        bench "peek kilo array" $ nfIO $ Txt.useAsPtr (Txt.toStrict $ Txt.take 1024 dracula) $
+            \ptr l -> peekArray (fromEnum l) ptr,
+        bench "lazy kilo array" $ nfIO (Txt.asForeignPtr (Txt.toStrict $ Txt.take 1024 dracula) >>=
+                \(ptr, l) -> return $ peekLazy ptr $ fromEnum l)
     ]
   ]

@@ 57,7 57,7 @@ source-repository head
 
 library
   -- Modules exported by the library.
-  exposed-modules:     Data.Text.Glyphize
+  exposed-modules:     Data.Text.Glyphize, Data.Text.Glyphize.Array
   
   -- Modules included in this library but not exported.
   other-modules:       Data.Text.Glyphize.Font, Data.Text.Glyphize.Buffer, Data.Text.Glyphize.Oom


@@ 95,6 95,6 @@ benchmark bench-harfbuzz
   type:             exitcode-stdio-1.0
   hs-source-dirs:   bench
   main-is:          Main.hs
-  build-depends:    base, harfbuzz-pure, file-embed-lzma, file-embed, criterion, filepath, text, parallel
+  build-depends:    base, harfbuzz-pure, file-embed, criterion, filepath, text, parallel
 
   ghc-options: -threaded