Skip to content

Add rewrite rules to remove inlining. #24

Closed
wants to merge 1 commit into from
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 = ()
Something went wrong with that request. Please try again.