Skip to content
Browse files

Add rewrite rules to remove inlining.

Literals generate a huge amount of code for almost no benefit (in fact,
the literals are converted from an array of bytes to a list back to
text). Add rules to fix this and make generated core much nicer.
  • Loading branch information...
1 parent 0d6d979 commit 2ddf0a8c475318239284fca4d462049b423f9741 @jhance committed
Showing with 30 additions and 4 deletions.
  1. +14 −3 Data/Text.hs
  2. +16 −1 Data/Text/Lazy.hs
View
17 Data/Text.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, CPP, Rank2Types, UnboxedTuples #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
@@ -201,18 +201,20 @@ import Data.Data (mkNoRepType)
import Data.Data (mkNorepType)
#endif
import Control.Monad (foldM)
+import Data.ByteString.Unsafe (unsafePackAddress)
import qualified Data.Text.Array as A
import qualified Data.List as L
import Data.Monoid (Monoid(..))
import Data.String (IsString(..))
+import Data.Text.Encoding (decodeUtf8)
import qualified Data.Text.Fusion as S
import qualified Data.Text.Fusion.Common as S
import Data.Text.Fusion (stream, reverseStream, unstream)
import Data.Text.Private (span_)
import Data.Text.Internal (Text(..), empty, firstf, safe, text, textP)
import qualified Prelude as P
-import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
- unsafeHead, unsafeTail)
+import Data.Text.Unsafe (Iter(..), iter, iter_, inlinePerformIO, lengthWord16,
+ reverseIter, unsafeHead, unsafeTail)
import Data.Text.UnsafeChar (unsafeChr)
import qualified Data.Text.Util as U
import qualified Data.Text.Encoding.Utf16 as U16
@@ -222,6 +224,8 @@ import Data.ByteString (ByteString)
import qualified Data.Text.Lazy as L
import Data.Int (Int64)
#endif
+import GHC.CString (unpackCString#, unpackCStringUtf8#)
+import GHC.Prim
-- $strict
--
@@ -318,6 +322,13 @@ instance Monoid Text where
instance IsString Text where
fromString = pack
+textLiteral# :: Addr# -> Text
+textLiteral# addr# = inlinePerformIO $ unsafePackAddress addr# P.>>= return . decodeUtf8
+
+{-# RULES "Overloaded literal strings" forall s. unstream (S.streamList (P.map safe (unpackCString# s))) = textLiteral# s #-}
+
+{-# RULES "Overloaded literal strings utf8" forall s. unstream (S.streamList (P.map safe (unpackCStringUtf8# s))) = textLiteral# s #-}
+
#if defined(HAVE_DEEPSEQ)
instance NFData Text
#endif
View
17 Data/Text/Lazy.hs
@@ -1,5 +1,5 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE BangPatterns, CPP #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash #-}
-- |
-- Module : Data.Text.Lazy
-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
@@ -195,6 +195,8 @@ import qualified Prelude as P
#if defined(HAVE_DEEPSEQ)
import Control.DeepSeq (NFData(..))
#endif
+import qualified Data.ByteString.Lazy as B (fromChunks)
+import Data.ByteString.Unsafe (unsafePackAddress)
import Data.Int (Int64)
import qualified Data.List as L
import Data.Char (isSpace)
@@ -212,11 +214,14 @@ import qualified Data.Text.Fusion.Common as S
import qualified Data.Text.Unsafe as T
import qualified Data.Text.Lazy.Fusion as S
import Data.Text.Fusion.Internal (PairS(..))
+import Data.Text.Lazy.Encoding (decodeUtf8)
import Data.Text.Lazy.Fusion (stream, unstream)
import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldlChunks, foldrChunks)
import Data.Text.Internal (firstf, safe, textP)
import qualified Data.Text.Util as U
import Data.Text.Lazy.Search (indices)
+import GHC.CString
+import GHC.Prim
-- $fusion
--
@@ -322,6 +327,16 @@ instance Monoid Text where
instance IsString Text where
fromString = pack
+textLiteral# :: Addr# -> Text
+textLiteral# addr# = T.inlinePerformIO $ do
+ bytesStrict <- unsafePackAddress addr#
+ let bytesLazy = B.fromChunks [bytesStrict]
+ P.return $ decodeUtf8 bytesLazy
+
+{-# RULES "Overloaded literal strings" forall s. unstream (S.streamList (P.map safe (unpackCString# s))) = textLiteral# s #-}
+
+{-# RULES "Overloaded literal strings utf8" forall s. unstream (S.streamList (P.map safe (unpackCStringUtf8# s))) = textLiteral# s #-}
+
#if defined(HAVE_DEEPSEQ)
instance NFData Text where
rnf Empty = ()

1 comment on commit 2ddf0a8

@bos

You're barking up a pretty good tree here, but this patch has some problems.

  1. It doesn't follow the coding style of the surrounding code. Lines too long, indentation wrong, and unqualified, unlimited imports, just from what I can see in my browser window.
  2. There are no tests. If there were, you'd see that this patch does not work for strings containing ASCII NUL.
Please sign in to comment.
Something went wrong with that request. Please try again.