Changeset 10467

Timestamp:

06/03/06 08:13:11 (3 years ago)

Author:

audreyt

Message:

* Upgrade to FPS trunk for even faster list fusion.

Location:

third-party/fps/Data

Files:

• ByteString.hs (modified) (51 diffs)
• ByteString/Base.hs (modified) (13 diffs)
• ByteString/Char8.hs (modified) (5 diffs)
• ByteString/Fusion.hs (modified) (24 diffs)
• ByteString/Lazy.hs (modified) (22 diffs)
• ByteString/Lazy/Char8.hs (modified) (13 diffs)

third-party/fps/Data/ByteString.hs

@@ -88 +88 @@
         scanl,                  -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
         scanl1,                 -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
+        scanr,                  -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
+        scanr1,                 -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
 
         -- ** Accumulating maps
         mapAccumL,              -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
---      mapAccumR,              -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
+        mapAccumR,              -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
         mapIndexed,             -- :: (Int -> Word8 -> Word8) -> ByteString -> ByteString
 
@@ -186 +188 @@
         -- | These functions perform memcpy(3) operations
         copy,                   -- :: ByteString -> ByteString
-        copyCString,            -- :: CString -> ByteString
-        copyCStringLen,         -- :: CStringLen -> ByteString
+        copyCString,            -- :: CString -> IO ByteString
+        copyCStringLen,         -- :: CStringLen -> IO ByteString
 
         -- * I\/O with 'ByteString's
@@ -203 +205 @@
         readFile,               -- :: FilePath -> IO ByteString
         writeFile,              -- :: FilePath -> ByteString -> IO ()
+        appendFile,             -- :: FilePath -> ByteString -> IO ()
 --      mmapFile,               -- :: FilePath -> IO ByteString
 
@@ -220 +223 @@
         unpackList, -- eek, otherwise it gets thrown away by the simplifier
 #endif
+        lengthU, maximumU, minimumU
   ) where
 
@@ -228 +232 @@
                                 ,dropWhile,span,break,elem,filter,maximum
                                 ,minimum,all,concatMap,foldl1,foldr1
-                                ,scanl,scanl1,readFile,writeFile,replicate
+                                ,scanl,scanl1,scanr,scanr1
+                                ,readFile,writeFile,appendFile,replicate
                                 ,getContents,getLine,putStr,putStrLn
                                 ,zip,zipWith,unzip,notElem)
@@ -243 +248 @@
 
 -- Control.Exception.bracket not available in yhc or nhc
-import Control.Exception        (bracket)
+import Control.Exception        (bracket, assert)
 import Control.Monad            (when)
 
@@ -371 +376 @@
 -- | /O(1)/ The empty 'ByteString'
 empty :: ByteString
-empty = inlinePerformIO $ mallocByteString 1 >>= \fp -> return $ PS fp 0 0
+empty = unsafeCreate 0 $ const $ return ()
 {-# NOINLINE empty #-}
 
 -- | /O(1)/ Convert a 'Word8' into a 'ByteString'
 singleton :: Word8 -> ByteString
-singleton c = unsafePerformIO $ mallocByteString 2 >>= \fp -> do
-    withForeignPtr fp $ \p -> poke p c
-    return $ PS fp 0 1
+singleton c = unsafeCreate 1 $ \p -> poke p c
 {-# INLINE singleton #-}
 
@@ -408 +411 @@
 #if !defined(__GLASGOW_HASKELL__)
 
-pack str = create (P.length str) $ \p -> go p str
+pack str = unsafeCreate (P.length str) $ \p -> go p str
     where
         go _ []     = return ()
@@ -415 +418 @@
 #else /* hack away */
 
-pack str = create (P.length str) $ \(Ptr p) -> stToIO (go p 0# str)
+pack str = unsafeCreate (P.length str) $ \(Ptr p) -> stToIO (go p 0# str)
     where
         go _ _ []        = return ()
@@ -468 +471 @@
 
 -- TODO just use normal foldr here.
+--
+-- or
+-- unpack xs | null xs = []
+--           | otherwise = unsafeHead xs : unpack (unsafeTail xs)
+--
+-- ?
 
 #endif
@@ -476 +485 @@
 -- conversion function
 packWith :: (a -> Word8) -> [a] -> ByteString
-packWith k str = create (P.length str) $ \p -> go p str
+packWith k str = unsafeCreate (P.length str) $ \p -> go p str
     where
         STRICT2(go)
@@ -501 +510 @@
 -- | /O(1)/ Test whether a ByteString is empty.
 null :: ByteString -> Bool
-null (PS _ _ l) = l == 0
+null (PS _ _ l) = assert (l >= 0) $ l <= 0
 {-# INLINE null #-}
 
+-- ---------------------------------------------------------------------
 -- | /O(1)/ 'length' returns the length of a ByteString as an 'Int'.
 length :: ByteString -> Int
-length (PS _ _ l) = l
+length (PS _ _ l) = assert (l >= 0) $ l
+
+--
+-- length/loop fusion. When taking the length of any fuseable loop,
+-- rewrite it as a foldl', and thus avoid allocating the result buffer
+-- worth around 10% in speed testing.
+--
 
 #if defined(__GLASGOW_HASKELL__)
@@ -512 +528 @@
 #endif
 
-{-# 
-
--- Translate length into a loop. 
--- Performace ok, but allocates too much, so disable for now.
-
-  "length/loop" forall f acc s .
-  length (loopArr (loopU f acc s)) = foldl' (const . (+1)) (0::Int) (loopArr (loopU f acc s))
+lengthU :: ByteString -> Int
+lengthU = foldl' (const . (+1)) (0::Int)
+{-# INLINE lengthU #-}
+
+{-# RULES
+
+-- v2 fusion
+"length/loop" forall loop s .
+  length  (loopArr (loopWrapper loop s)) =
+  lengthU (loopArr (loopWrapper loop s))
 
   #-}
+
+------------------------------------------------------------------------
 
 -- | /O(n)/ 'cons' is analogous to (:) for lists, but of different
 -- complexity, as it requires a memcpy.
 cons :: Word8 -> ByteString -> ByteString
-cons c (PS x s l) = create (l+1) $ \p -> withForeignPtr x $ \f -> do
+cons c (PS x s l) = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do
         poke p c
         memcpy (p `plusPtr` 1) (f `plusPtr` s) (fromIntegral l)
 {-# INLINE cons #-}
 
--- todo fuse
-
 -- | /O(n)/ Append a byte to the end of a 'ByteString'
 snoc :: ByteString -> Word8 -> ByteString
-snoc (PS x s l) c = create (l+1) $ \p -> withForeignPtr x $ \f -> do
+snoc (PS x s l) c = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do
         memcpy p (f `plusPtr` s) (fromIntegral l)
         poke (p `plusPtr` l) c
@@ -542 +561 @@
 
 -- | /O(1)/ Extract the first element of a ByteString, which must be non-empty.
+-- An exception will be thrown in the case of an empty ByteString.
 head :: ByteString -> Word8
 head ps@(PS x s _)
@@ -549 +569 @@
 
 -- | /O(1)/ Extract the elements after the head of a ByteString, which must be non-empty.
+-- An exception will be thrown in the case of an empty ByteString.
 tail :: ByteString -> ByteString
 tail (PS p s l)
@@ -556 +577 @@
 
 -- | /O(1)/ Extract the last element of a ByteString, which must be finite and non-empty.
+-- An exception will be thrown in the case of an empty ByteString.
 last :: ByteString -> Word8
 last ps@(PS x s l)
@@ -563 +585 @@
 
 -- | /O(1)/ Return all the elements of a 'ByteString' except the last one.
+-- An exception will be thrown in the case of an empty ByteString.
 init :: ByteString -> ByteString
-init (PS p s l)
-    | l <= 0    = errorEmptyList "init"
+init ps@(PS p s l)
+    | null ps   = errorEmptyList "init"
     | otherwise = PS p s (l-1)
 {-# INLINE init #-}
@@ -582 +605 @@
 -- element of @xs@. This function is subject to array fusion.
 map :: (Word8 -> Word8) -> ByteString -> ByteString
+#if defined(LOOPU_FUSION)
 map f = loopArr . loopU (mapEFL f) NoAcc
+#elif defined(LOOPUP_FUSION)
+map f = loopArr . loopUp (mapEFL f) NoAcc
+#elif defined(LOOPNOACC_FUSION)
+map f = loopArr . loopNoAcc (mapEFL f)
+#else
+map f = loopArr . loopMap f
+#endif
 {-# INLINE map #-}
 
@@ -588 +619 @@
 -- slightly faster for one-shot cases.
 map' :: (Word8 -> Word8) -> ByteString -> ByteString
-map' f (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a -> do
-    np <- mallocByteString (len+1)
-    withForeignPtr np $ \p -> do
-        map_ 0 (a `plusPtr` s) p
-        return (PS np 0 len)
+map' f (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a ->
+    create len $ map_ 0 (a `plusPtr` s)
   where
-
     map_ :: Int -> Ptr Word8 -> Ptr Word8 -> IO ()
     STRICT3(map_)
@@ -607 +634 @@
 -- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order.
 reverse :: ByteString -> ByteString
-reverse (PS x s l) = create l $ \p -> withForeignPtr x $ \f ->
+reverse (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f ->
         c_reverse p (f `plusPtr` s) (fromIntegral l)
 
-{-
-reverse = pack . P.reverse . unpack
--}
+-- todo, fuseable version
 
 -- | /O(n)/ The 'intersperse' function takes a 'Word8' and a
@@ -621 +646 @@
 intersperse c ps@(PS x s l)
     | length ps < 2  = ps
-    | otherwise      = create (2*l-1) $ \p -> withForeignPtr x $ \f ->
+    | otherwise      = unsafeCreate (2*l-1) $ \p -> withForeignPtr x $ \f ->
         c_intersperse p (f `plusPtr` s) (fromIntegral l) c
 
@@ -641 +666 @@
 -- This function is subject to array fusion.
 foldl :: (a -> Word8 -> a) -> a -> ByteString -> a
+#if !defined(LOOPU_FUSION)
+foldl f z = loopAcc . loopUp (foldEFL f) z
+#else
 foldl f z = loopAcc . loopU (foldEFL f) z
+#endif
 {-# INLINE foldl #-}
 
@@ -659 +688 @@
 
 -- | 'foldl\'' is like 'foldl', but strict in the accumulator.
+-- Though actually foldl is also strict in the accumulator.
 foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a
-foldl' f z = loopAcc . loopU (foldEFL' f) z
+foldl' = foldl
+-- foldl' f z = loopAcc . loopU (foldEFL' f) z
 {-# INLINE foldl' #-}
 
@@ -667 +698 @@
 -- reduces the ByteString using the binary operator, from right to left.
 foldr :: (Word8 -> a -> a) -> a -> ByteString -> a
-foldr k z (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->
-        go (ptr `plusPtr` s) (ptr `plusPtr` (s+l))
-    where
-        STRICT2(go)
-        go p q | p == q    = return z
-               | otherwise = do c  <- peek p
-                                ws <- go (p `plusPtr` 1) q
-                                return $ c `k` ws
+foldr k z = loopAcc . loopDown (foldEFL (flip k)) z
+{-# INLINE foldr #-}
 
 -- | 'foldl1' is a variant of 'foldl' that has no starting value
 -- argument, and thus must be applied to non-empty 'ByteStrings'.
--- This function is subject to array fusion.
+-- This function is subject to array fusion. 
+-- An exception will be thrown in the case of an empty ByteString.
 foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
 foldl1 f ps
     | null ps   = errorEmptyList "foldl1"
     | otherwise = foldl f (unsafeHead ps) (unsafeTail ps)
+{-# INLINE foldl1 #-}
 
 -- | 'foldl1\'' is like 'foldl1', but strict in the accumulator.
+-- An exception will be thrown in the case of an empty ByteString.
 foldl1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
 foldl1' f ps
     | null ps   = errorEmptyList "foldl1'"
     | otherwise = foldl' f (unsafeHead ps) (unsafeTail ps)
+{-# INLINE foldl1' #-}
 
 -- | 'foldr1' is a variant of 'foldr' that has no starting value argument,
 -- and thus must be applied to non-empty 'ByteString's
+-- An exception will be thrown in the case of an empty ByteString.
 foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
 foldr1 f ps
     | null ps        = errorEmptyList "foldr1"
     | otherwise      = foldr f (last ps) (init ps)
+{-# INLINE foldr1 #-}
 
 -- ---------------------------------------------------------------------
@@ -704 +735 @@
 concat []     = empty
 concat [ps]   = ps
-concat xs     = create len $ \ptr -> go xs ptr
+concat xs     = unsafeCreate len $ \ptr -> go xs ptr
   where len = P.sum . P.map length $ xs
         STRICT2(go)
@@ -745 +776 @@
                                     then go (p `plusPtr` 1) q
                                     else return False
--- todo fuse
+
+------------------------------------------------------------------------
 
 -- | /O(n)/ 'maximum' returns the maximum value from a 'ByteString'
+-- This function will fuse.
+-- An exception will be thrown in the case of an empty ByteString.
 maximum :: ByteString -> Word8
 maximum xs@(PS x s l)
     | null xs   = errorEmptyList "maximum"
     | otherwise = inlinePerformIO $ withForeignPtr x $ \p ->
-                    return $ c_maximum (p `plusPtr` s) (fromIntegral l)
-{-# INLINE maximum #-}
+                      c_maximum (p `plusPtr` s) (fromIntegral l)
 
 -- | /O(n)/ 'minimum' returns the minimum value from a 'ByteString'
+-- This function will fuse.
+-- An exception will be thrown in the case of an empty ByteString.
 minimum :: ByteString -> Word8
 minimum xs@(PS x s l)
     | null xs   = errorEmptyList "minimum"
     | otherwise = inlinePerformIO $ withForeignPtr x $ \p ->
-                    return $ c_minimum (p `plusPtr` s) (fromIntegral l)
-{-# INLINE minimum #-}
-
--- fusion is too slow here (10x)
-
-{-
-maximum xs@(PS x s l)
-    | null xs   = errorEmptyList "maximum"
-    | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> do
-                        w <- peek p
-                        maximum_ (p `plusPtr` s) 0 l w
-
-maximum_ :: Ptr Word8 -> Int -> Int -> Word8 -> IO Word8
-STRICT4(maximum_)
-maximum_ ptr n m c
-    | n >= m    = return c
-    | otherwise = do w <- peekByteOff ptr n
-                     maximum_ ptr (n+1) m (if w > c then w else c)
-
-minimum xs@(PS x s l)
-    | null xs   = errorEmptyList "minimum"
-    | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> do
-                        w <- peek p
-                        minimum_ (p `plusPtr` s) 0 l w
-
-minimum_ :: Ptr Word8 -> Int -> Int -> Word8 -> IO Word8
-STRICT4(minimum_)
-minimum_ ptr n m c
-    | n >= m    = return c
-    | otherwise = do w <- peekByteOff ptr n
-                     minimum_ ptr (n+1) m (if w < c then w else c)
--}
+                      c_minimum (p `plusPtr` s) (fromIntegral l)
+
+--
+-- minimum/maximum/loop fusion. As for length (and other folds), when we
+-- see we're applied after a fuseable op, switch from using the C
+-- version, to the fuseable version. The result should then avoid
+-- allocating a buffer.
+--
+
+#if defined(__GLASGOW_HASKELL__)
+{-# INLINE [1] minimum #-}
+{-# INLINE [1] maximum #-}
+#endif
+
+maximumU :: ByteString -> Word8
+maximumU = foldl1' max
+{-# INLINE maximumU #-}
+
+minimumU :: ByteString -> Word8
+minimumU = foldl1' min
+{-# INLINE minimumU #-}
+
+{-# RULES
+
+"minimum/loop" forall loop s .
+  minimum  (loopArr (loopWrapper loop s)) =
+  minimumU (loopArr (loopWrapper loop s))
+
+"maximum/loop" forall loop s .
+  maximum  (loopArr (loopWrapper loop s)) =
+  maximumU (loopArr (loopWrapper loop s))
+
+  #-}
+
+------------------------------------------------------------------------
 
 mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
+#if !defined(LOOPU_FUSION)
+mapAccumL f z = unSP . loopUp (mapAccumEFL f) z
+#else
 mapAccumL f z = unSP . loopU (mapAccumEFL f) z
-
---mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
+#endif
+{-# INLINE mapAccumL #-}
+
+mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
+mapAccumR f z = unSP . loopDown (mapAccumEFL f) z
+{-# INLINE mapAccumR #-}
 
 -- | /O(n)/ map Word8 functions, provided with the index at each position
 mapIndexed :: (Int -> Word8 -> Word8) -> ByteString -> ByteString
-mapIndexed f = loopArr . loopU (mapIndexEFL f) 0
+mapIndexed f = loopArr . loopUp (mapIndexEFL f) 0
+{-# INLINE mapIndexed #-}
 
 -- ---------------------------------------------------------------------
@@ -814 +860 @@
 -- > last (scanl f z xs) == foldl f z xs.
 scanl :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
-scanl f z ps = loopArr . loopU (scanEFL f) z $ (ps `snoc` 0) -- extra space
+#if !defined(LOOPU_FUSION)
+scanl f z ps = loopArr . loopUp (scanEFL f) z $ (ps `snoc` 0)
+#else
+scanl f z ps = loopArr . loopU (scanEFL f) z $ (ps `snoc` 0)
+#endif
+
+    -- n.b. haskell's List scan returns a list one bigger than the
+    -- input, so we need to snoc here to get some extra space, however,
+    -- it breaks map/up fusion (i.e. scanl . map no longer fuses)
 {-# INLINE scanl #-}
 
@@ -827 +881 @@
 {-# INLINE scanl1 #-}
 
+-- | scanr is the right-to-left dual of scanl.
+scanr :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
+scanr f z ps = loopArr . loopDown (scanEFL (flip f)) z $ (0 `cons` ps) -- extra space
+{-# INLINE scanr #-}
+
+-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
+scanr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
+scanr1 f ps
+    | null ps   = empty
+    | otherwise = scanr f (last ps) (init ps) -- todo, unsafe versions
+{-# INLINE scanr1 #-}
+
 -- ---------------------------------------------------------------------
 -- Unfolds and replicates
@@ -837 +903 @@
 -- This implemenation uses @memset(3)@
 replicate :: Int -> Word8 -> ByteString
-replicate w c | w <= 0    = empty
-              | otherwise = create w $ \ptr -> memset ptr c (fromIntegral w) >> return ()
-
-{-
--- About 5x slower
-replicate w c = inlinePerformIO $ generate w $ \ptr -> go ptr w
-    where
-        STRICT2(go)
-        go _   0 = return w
-        go ptr n = poke ptr c >> go (ptr `plusPtr` 1) (n-1)
--}
+replicate w c
+    | w <= 0    = empty
+    | otherwise = unsafeCreate w $ \ptr ->
+                      memset ptr c (fromIntegral w) >> return ()
 
 -- | /O(n)/, where /n/ is the length of the result.  The 'unfoldr' 
@@ -880 +939 @@
 unfoldrN i f x0
     | i < 0     = (empty, Just x0)
-    | otherwise = inlinePerformIO $ do
-                    fp <- mallocByteString i
-                    withForeignPtr fp (\p -> go fp p x0 0)
-  where STRICT4(go)
-        go fp p x n =
+    | otherwise = unsafePerformIO $ createAndTrim' i $ \p -> go p x0 0
+  where STRICT3(go)
+        go p x n =
           case f x of
-            Nothing      -> let s = copy (PS fp 0 n)
-                             in s `seq` return (s, Nothing)
+            Nothing      -> return (0, n, Nothing)
             Just (w,x')
-             | n == i    -> return (PS fp 0 i, Just x)
+             | n == i    -> return (0, n, Just x)
              | otherwise -> do poke p w
-                               go fp (p `plusPtr` 1) x' (n+1)
+                               go (p `plusPtr` 1) x' (n+1)
 
 -- ---------------------------------------------------------------------
@@ -1063 +1119 @@
 
         STRICT1(loop)
-        loop n = do
-            let q = memchr (ptr `plusPtr` n) w (fromIntegral (l-n))
-            if q == nullPtr
+        loop n =
+            let q = inlinePerformIO $ memchr (ptr `plusPtr` n)
+                                           w (fromIntegral (l-n))
+            in if q == nullPtr
                 then [PS x (s+n) (l-n)]
                 else let i = q `minusPtr` ptr in PS x (s+n) (i-n) : loop (i+1)
@@ -1143 +1200 @@
 --
 joinWithByte :: Word8 -> ByteString -> ByteString -> ByteString
-joinWithByte c f@(PS ffp s l) g@(PS fgp t m) = create len $ \ptr ->
+joinWithByte c f@(PS ffp s l) g@(PS fgp t m) = unsafeCreate len $ \ptr ->
     withForeignPtr ffp $ \fp ->
     withForeignPtr fgp $ \gp -> do
@@ -1172 +1229 @@
 elemIndex c (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do
     let p' = p `plusPtr` s
-        q  = memchr p' c (fromIntegral l)
+    q <- memchr p' c (fromIntegral l)
     return $ if q == nullPtr then Nothing else Just $! q `minusPtr` p'
 {-# INLINE elemIndex #-}
@@ -1204 +1261 @@
 
         STRICT1(loop)
-        loop n = let q = memchr (ptr `plusPtr` n) w (fromIntegral (l - n))
+        loop n = let q = inlinePerformIO $ memchr (ptr `plusPtr` n)
+                                                w (fromIntegral (l - n))
                  in if q == nullPtr
                         then []
@@ -1229 +1287 @@
 count :: Word8 -> ByteString -> Int
 count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p ->
-    return $ fromIntegral $ c_count (p `plusPtr` s) (fromIntegral m) w
+    fmap fromIntegral $ c_count (p `plusPtr` s) (fromIntegral m) w
 {-# INLINE count #-}
 
@@ -1242 +1300 @@
         STRICT3(go)
         go p l i = do
-            let q = memchr p w l
+            q <- memchr p w l
             if q == nullPtr
                 then return i
@@ -1303 +1361 @@
 -- predicate. This function is subject to array fusion.
 filter :: (Word8 -> Bool) -> ByteString -> ByteString
+#if defined(LOOPU_FUSION)
 filter p  = loopArr . loopU (filterEFL p) NoAcc
+#elif defined(LOOPUP_FUSION)
+filter p  = loopArr . loopUp (filterEFL p) NoAcc
+#elif defined(LOOPNOACC_FUSION)
+filter p  = loopArr . loopNoAcc (filterEFL p)
+#else
+filter f = loopArr . loopFilter f
+#endif
 {-# INLINE filter #-}
 
@@ -1311 +1377 @@
 filter' k ps@(PS x s l)
     | null ps   = ps
-    | otherwise = inlinePerformIO $ generate l $ \p -> withForeignPtr x $ \f -> do
+    | otherwise = unsafePerformIO $ createAndTrim l $ \p -> withForeignPtr x $ \f -> do
         t <- go (f `plusPtr` s) p (f `plusPtr` (s + l))
         return (t `minusPtr` p) -- actual length
@@ -1490 +1556 @@
 -- | /O(n)/ Sort a ByteString efficiently, using counting sort.
 sort :: ByteString -> ByteString
-sort (PS input s l) = create l $ \p -> allocaArray 256 $ \arr -> do
+sort (PS input s l) = unsafeCreate l $ \p -> allocaArray 256 $ \arr -> do
 
     memset (castPtr arr) 0 (256 * fromIntegral (sizeOf (undefined :: CSize)))
@@ -1504 +1570 @@
 {-
 sort :: ByteString -> ByteString
-sort (PS x s l) = create l $ \p -> withForeignPtr x $ \f -> do
+sort (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f -> do
         memcpy p (f `plusPtr` s) l
         c_qsort p l -- inplace
@@ -1528 +1594 @@
 -- /strlen(3)/, and thus the complexity is a /O(n)/.
 packCString :: CString -> ByteString
-packCString cstr = inlinePerformIO $ do
+packCString cstr = unsafePerformIO $ do
     fp <- newForeignPtr_ (castPtr cstr)
-    return $ PS fp 0 (fromIntegral $ c_strlen cstr)
+    l <- c_strlen cstr
+    return $ PS fp 0 (fromIntegral l)
 
 -- | /O(1)/ Build a @ByteString@ from a @CStringLen@. This value will
@@ -1537 +1604 @@
 -- required.
 packCStringLen :: CStringLen -> ByteString
-packCStringLen (ptr,len) = inlinePerformIO $ do
+packCStringLen (ptr,len) = unsafePerformIO $ do
     fp <- newForeignPtr_ (castPtr ptr)
     return $ PS fp 0 (fromIntegral len)
@@ -1544 +1611 @@
 -- have a @free(3)@ finalizer associated to it.
 packMallocCString :: CString -> ByteString
-packMallocCString cstr = inlinePerformIO $ do
+packMallocCString cstr = unsafePerformIO $ do
     fp <- newForeignFreePtr (castPtr cstr)
-    return $ PS fp 0 (fromIntegral $ c_strlen cstr)
+    len <- c_strlen cstr
+    return $ PS fp 0 (fromIntegral len)
 
 -- | /O(n) construction/ Use a @ByteString@ with a function requiring a null-terminated @CString@.