Compute length at compile time for literal strings

Changelog.md

@@ -8,6 +8,9 @@
  * Add `IsList` instances
  * Deprecate `Data.ByteString.Lazy.Builder`
  * Add `partition` to `Data.ByteString.Char8` and `Data.ByteString.Lazy.Char8`
+ * Add `unsafePackLiteral` to `Data.ByteString.Internal`. Where possible,
+   use known-key variant of C `strlen` from `GHC.CString` that supports
+   constant folding.
 
 0.10.10.1 – June 2020
 

Data/ByteString.hs

@@ -755,6 +755,7 @@ scanr1 f ps
 --
 -- This implemenation uses @memset(3)@
 replicate :: Int -> Word8 -> ByteString
+{-# INLINE replicate #-}
 replicate w c
     | w <= 0    = empty
     | otherwise = unsafeCreate w $ \ptr ->

Data/ByteString/Internal.hs

@@ -34,7 +34,7 @@ module Data.ByteString.Internal (
         packChars, packUptoLenChars, unsafePackLenChars,
         unpackBytes, unpackAppendBytesLazy, unpackAppendBytesStrict,
         unpackChars, unpackAppendCharsLazy, unpackAppendCharsStrict,
-        unsafePackAddress,
+        unsafePackAddress, unsafePackLiteral,
 
         -- * Low level imperative construction
         create,                 -- :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString
@@ -136,9 +136,16 @@ import GHC.IO                   (IO(IO),unsafeDupablePerformIO)
 import GHC.IOBase               (IO(IO),RawBuffer,unsafeDupablePerformIO)
 #endif
 
-import GHC.ForeignPtr           (ForeignPtr(ForeignPtr)
-                                ,newForeignPtr_, mallocPlainForeignPtrBytes)
+import GHC.ForeignPtr           (ForeignPtr(ForeignPtr), mallocPlainForeignPtrBytes)
+
+#if __GLASGOW_HASKELL__ >= 811
+import GHC.CString              (cstringLength#)
+import GHC.Exts                 (Int(I#))
+import GHC.ForeignPtr           (ForeignPtrContents(FinalPtr))
+#else
+import GHC.ForeignPtr           (newForeignPtr_)
 import GHC.Ptr                  (Ptr(..), castPtr)
+#endif
 
 -- CFILES stuff is Hugs only
 {-# CFILES cbits/fpstring.c #-}
@@ -195,6 +202,7 @@ instance IsList ByteString where
 #endif
 
 instance IsString ByteString where
+    {-# INLINE fromString #-}
     fromString = packChars
 
 instance Data ByteString where
@@ -216,7 +224,7 @@ packChars cs = unsafePackLenChars (List.length cs) cs
 
 {-# RULES
 "ByteString packChars/packAddress" forall s .
-   packChars (unpackCString# s) = accursedUnutterablePerformIO (unsafePackAddress s)
+   packChars (unpackCString# s) = unsafePackLiteral s
  #-}
 
 unsafePackLenBytes :: Int -> [Word8] -> ByteString
@@ -257,14 +265,33 @@ unsafePackLenChars len cs0 =
 --
 unsafePackAddress :: Addr# -> IO ByteString
 unsafePackAddress addr# = do
+#if __GLASGOW_HASKELL__ >= 811
+    return (PS (ForeignPtr addr# FinalPtr) 0 (I# (cstringLength# addr#)))
+#else
     p <- newForeignPtr_ (castPtr cstr)
     l <- c_strlen cstr
     return $ PS p 0 (fromIntegral l)
   where
     cstr :: CString
     cstr = Ptr addr#
+#endif
 {-# INLINE unsafePackAddress #-}
 
+-- | See 'unsafePackAddress'. This function has similar behavior. Prefer
+-- this function when the address in known to be an @Addr#@ literal. In
+-- that context, there is no need for the sequencing guarantees that 'IO'
+-- provides. On GHC 8.12 and up, this function uses the @FinalPtr@ data
+-- constructor for @ForeignPtrContents@.
+unsafePackLiteral :: Addr# -> ByteString
+unsafePackLiteral addr# =
+#if __GLASGOW_HASKELL__ >= 811
+  PS (ForeignPtr addr# FinalPtr) 0 (I# (cstringLength# addr#))
+#else
+  let len = accursedUnutterablePerformIO (c_strlen (Ptr addr#))
+   in PS (accursedUnutterablePerformIO (newForeignPtr_ (Ptr addr#))) 0 (fromIntegral len)
+#endif
+{-# INLINE unsafePackLiteral #-}
+
 
 packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8])
 packUptoLenBytes len xs0 =