Share empty Text values

src/Data/Text/Foreign.hs

@@ -71,6 +71,7 @@ newtype I8 = I8 Int
 fromPtr :: Ptr Word8           -- ^ source array
         -> I8                  -- ^ length of source array (in 'Word8' units)
         -> IO Text
+fromPtr _   (I8 0)   = pure empty
 fromPtr ptr (I8 len) = unsafeSTToIO $ do
   dst <- A.new len
   A.copyFromPointer dst 0 ptr len

src/Data/Text/Internal.hs

@@ -37,7 +37,6 @@ module Data.Text.Internal
     , safe
     -- * Code that must be here for accessibility
     , empty
-    , empty_
     , append
     -- * Utilities
     , firstf
@@ -94,12 +93,7 @@ text_ arr off len =
 -- | /O(1)/ The empty 'Text'.
 empty :: Text
 empty = Text A.empty 0 0
-{-# INLINE [1] empty #-}
-
--- | A non-inlined version of 'empty'.
-empty_ :: Text
-empty_ = Text A.empty 0 0
-{-# NOINLINE empty_ #-}
+{-# NOINLINE empty #-}
 
 -- | /O(n)/ Appends one 'Text' to the other by copying both of them
 -- into a new 'Text'.
@@ -121,6 +115,7 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
 
 -- | Construct a 'Text' without invisibly pinning its byte array in
 -- memory if its length has dwindled to zero.
+-- It ensures that empty 'Text' values are shared.
 text ::
 #if defined(ASSERTS)
   HasCallStack =>
@@ -131,7 +126,7 @@ text ::
   -> Text
 text arr off len | len == 0  = empty
                  | otherwise = text_ arr off len
-{-# INLINE text #-}
+{-# INLINE [0] text #-}
 
 textP :: A.Array -> Int -> Int -> Text
 {-# DEPRECATED textP "Use text instead" #-}
@@ -251,6 +246,7 @@ int64ToInt32 = fromIntegral
 -- >>> Data.Text.unpack (pack "\55555")
 -- "\65533"
 pack :: String -> Text
+pack [] = empty
 pack xs = runST $ do
   -- It's tempting to allocate a buffer of 4 * length xs bytes,
   -- but not only it's wasteful for predominantly ASCII arguments,

src/Data/Text/Internal/Lazy.hs

@@ -47,6 +47,7 @@ import Data.Typeable (Typeable)
 import Foreign.Storable (sizeOf)
 import qualified Data.Text.Array as A
 import qualified Data.Text.Internal as T
+import qualified Data.Text as T
 
 data Text = Empty
           | Chunk {-# UNPACK #-} !T.Text Text
@@ -86,9 +87,16 @@ showStructure (Chunk t ts)    =
 
 -- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
 chunk :: T.Text -> Text -> Text
-{-# INLINE chunk #-}
-chunk t@(T.Text _ _ len) ts | len == 0 = ts
-                            | otherwise = Chunk t ts
+{-# INLINE [0] chunk #-}
+chunk t ts | T.null t = ts
+           | otherwise = Chunk t ts
+
+{-# RULES
+"TEXT chunk/text" forall arr off len.
+    chunk (T.text arr off len) = chunk (T.Text arr off len)
+"TEXT chunk/empty" forall ts.
+    chunk T.empty ts = ts
+#-}
 
 -- | Smart constructor for 'Empty'.
 empty :: Text

src/Data/Text/Internal/Reverse.hs

@@ -9,7 +9,7 @@
 {-# OPTIONS_HADDOCK not-home #-}
 
 -- | Implements 'reverse', using efficient C routines by default.
-module Data.Text.Internal.Reverse (reverse) where
+module Data.Text.Internal.Reverse (reverse, reverseNonEmpty) where
 
 #if !defined(PURE_HASKELL)
 import GHC.Exts as Exts
@@ -23,7 +23,7 @@ import Data.Text.Internal.Encoding.Utf8 (utf8LengthByLeader)
 import GHC.Stack (HasCallStack)
 #endif
 import Prelude hiding (reverse)
-import Data.Text.Internal (Text(..))
+import Data.Text.Internal (Text(..), empty)
 import Control.Monad.ST (runST)
 import qualified Data.Text.Array as A
 
@@ -39,8 +39,16 @@ reverse ::
   HasCallStack =>
 #endif
   Text -> Text
+reverse (Text _ _ 0) = empty
+reverse t            = reverseNonEmpty t
+{-# INLINE reverse #-}
+
+-- | /O(n)/ Reverse the characters of a string.
+-- Assume that the @Text@ is non-empty. The returned @Text@ is guaranteed to be non-empty.
+reverseNonEmpty ::
+  Text -> Text
 #if defined(PURE_HASKELL)
-reverse (Text src off len) = runST $ do
+reverseNonEmtpy (Text src off len) = runST $ do
     dest <- A.new len
     _ <- reversePoints src off dest len
     result <- A.unsafeFreeze dest
@@ -80,13 +88,13 @@ reversePoints src xx dest yy = go xx yy where
             A.copyI pLen dest yNext src x
             go (x + pLen) yNext
 #else
-reverse (Text (A.ByteArray ba) off len) = runST $ do
+reverseNonEmpty (Text (A.ByteArray ba) off len) = runST $ do
     marr@(A.MutableByteArray mba) <- A.new len
     unsafeIOToST $ c_reverse mba ba (fromIntegral off) (fromIntegral len)
     brr <- A.unsafeFreeze marr
     return $ Text brr 0 len
 #endif
-{-# INLINE reverse #-}
+{-# INLINE reverseNonEmpty #-}
 
 #if !defined(PURE_HASKELL)
 -- | The input buffer (src :: ByteArray#, off :: CSize, len :: CSize)