Speed up reverse

cbits/reverse.c

+/*
+ * Copyright (c) 2021 Andrew Lelechenko <andrew.lelechenko@gmail.com>
+ */
+
+#include <string.h>
+#include <stdint.h>
+
+/*
+  _hs_text_reverse takes a UTF-8 encoded buffer, specified by (src0, off, len),
+  and reverses it, writing output starting from dst0.
+
+  The input buffer (src0, off, len) must be a valid UTF-8 sequence,
+  this condition is not checked.
+*/
+void _hs_text_reverse(uint8_t *dst0, const uint8_t *src0, size_t off, size_t len)
+{
+  const uint8_t *src = src0 + off;
+  const uint8_t *srcend = src + len;
+  uint8_t *dst = dst0 + len - 1;
+
+  while (src < srcend){
+    uint8_t leadByte = *src++;
+    if (leadByte < 0x80){
+      *dst-- = leadByte;
+    } else if (leadByte < 0xe0){
+      *(dst-1) = leadByte;
+      *dst     = *src++;
+      dst-=2;
+    } else if (leadByte < 0xf0){
+      *(dst-2) = leadByte;
+      *(dst-1) = *src++;
+      *dst     = *src++;
+      dst-=3;
+    } else {
+      *(dst-3) = leadByte;
+      *(dst-2) = *src++;
+      *(dst-1) = *src++;
+      *dst     = *src++;
+      dst-=4;
+    }
+  }
+}

src/Data/Text.hs

@@ -216,7 +216,8 @@ import Data.Char (isSpace)
 import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
                   Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
 import Control.Monad (foldM)
-import Control.Monad.ST (ST)
+import Control.Monad.ST (ST, runST)
+import Control.Monad.ST.Unsafe (unsafeIOToST)
 import qualified Data.Text.Array as A
 import qualified Data.List as L
 import Data.Binary (Binary(get, put))
@@ -670,9 +671,18 @@ reverse ::
   HasCallStack =>
 #endif
   Text -> Text
-reverse t = S.reverse (stream t)
+reverse (Text (A.ByteArray ba) off len) = runST $ do
+    marr@(A.MutableByteArray mba) <- A.new len
+    unsafeIOToST $ c_reverse mba ba (intToCSize off) (intToCSize len)
+    brr <- A.unsafeFreeze marr
+    return $ Text brr 0 len
 {-# INLINE reverse #-}
 
+-- | The input buffer (src :: ByteArray#, off :: CSize, len :: CSize)
+-- must specify a valid UTF-8 sequence, this condition is not checked.
+foreign import ccall unsafe "_hs_text_reverse" c_reverse
+    :: Exts.MutableByteArray# s -> ByteArray# -> CSize -> CSize -> IO ()
+
 -- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
 -- @haystack@ with @replacement@.
 --

text.cabal

@@ -66,6 +66,7 @@ flag developer
 library
   c-sources:    cbits/cbits.c
                 cbits/measure_off.c
+                cbits/reverse.c
                 cbits/utils.c
   include-dirs: include
   hs-source-dirs: src