text 1.0.0.1 → 1.1.0.0
raw patch · 74 files changed
+4657/−4376 lines, 74 filesdep ~bytestring
Dependency ranges changed: bytestring
Files
- Data/Text.hs +11/−12
- Data/Text/Array.hs +3/−4
- Data/Text/Encoding.hs +116/−69
- Data/Text/Encoding/Error.hs +1/−2
- Data/Text/Encoding/Fusion.hs +0/−205
- Data/Text/Encoding/Fusion/Common.hs +0/−121
- Data/Text/Encoding/Utf16.hs +0/−42
- Data/Text/Encoding/Utf32.hs +0/−23
- Data/Text/Encoding/Utf8.hs +0/−161
- Data/Text/Foreign.hs +1/−2
- Data/Text/Fusion.hs +0/−231
- Data/Text/Fusion/CaseMapping.hs +0/−570
- Data/Text/Fusion/Common.hs +0/−947
- Data/Text/Fusion/Internal.hs +0/−124
- Data/Text/Fusion/Size.hs +0/−146
- Data/Text/IO.hs +3/−3
- Data/Text/IO/Internal.hs +0/−162
- Data/Text/Internal.hs +2/−3
- Data/Text/Internal/Builder.hs +325/−0
- Data/Text/Internal/Builder/Functions.hs +39/−0
- Data/Text/Internal/Builder/Int/Digits.hs +26/−0
- Data/Text/Internal/Builder/RealFloat/Functions.hs +29/−0
- Data/Text/Internal/Encoding/Fusion.hs +208/−0
- Data/Text/Internal/Encoding/Fusion/Common.hs +123/−0
- Data/Text/Internal/Encoding/Utf16.hs +45/−0
- Data/Text/Internal/Encoding/Utf32.hs +26/−0
- Data/Text/Internal/Encoding/Utf8.hs +168/−0
- Data/Text/Internal/Functions.hs +31/−0
- Data/Text/Internal/Fusion.hs +234/−0
- Data/Text/Internal/Fusion/CaseMapping.hs +570/−0
- Data/Text/Internal/Fusion/Common.hs +950/−0
- Data/Text/Internal/Fusion/Size.hs +149/−0
- Data/Text/Internal/Fusion/Types.hs +127/−0
- Data/Text/Internal/IO.hs +166/−0
- Data/Text/Internal/Lazy.hs +117/−0
- Data/Text/Internal/Lazy/Encoding/Fusion.hs +324/−0
- Data/Text/Internal/Lazy/Fusion.hs +120/−0
- Data/Text/Internal/Lazy/Search.hs +134/−0
- Data/Text/Internal/Private.hs +37/−0
- Data/Text/Internal/Search.hs +89/−0
- Data/Text/Internal/Unsafe.hs +54/−0
- Data/Text/Internal/Unsafe/Char.hs +95/−0
- Data/Text/Internal/Unsafe/Shift.hs +72/−0
- Data/Text/Lazy.hs +9/−10
- Data/Text/Lazy/Builder.hs +2/−2
- Data/Text/Lazy/Builder/Functions.hs +0/−35
- Data/Text/Lazy/Builder/Int.hs +3/−3
- Data/Text/Lazy/Builder/Int/Digits.hs +0/−22
- Data/Text/Lazy/Builder/Internal.hs +0/−321
- Data/Text/Lazy/Builder/RealFloat.hs +2/−2
- Data/Text/Lazy/Builder/RealFloat/Functions.hs +0/−25
- Data/Text/Lazy/Encoding.hs +41/−5
- Data/Text/Lazy/Encoding/Fusion.hs +0/−321
- Data/Text/Lazy/Fusion.hs +0/−117
- Data/Text/Lazy/IO.hs +2/−2
- Data/Text/Lazy/Internal.hs +7/−105
- Data/Text/Lazy/Search.hs +0/−131
- Data/Text/Private.hs +0/−37
- Data/Text/Read.hs +1/−1
- Data/Text/Search.hs +0/−90
- Data/Text/Unsafe.hs +4/−5
- Data/Text/Unsafe/Base.hs +0/−51
- Data/Text/UnsafeChar.hs +0/−92
- Data/Text/UnsafeShift.hs +0/−69
- Data/Text/Util.hs +0/−27
- benchmarks/haskell/Benchmarks.hs +4/−1
- benchmarks/haskell/Benchmarks/Stream.hs +6/−6
- cbits/cbits.c +67/−0
- changelog +20/−0
- scripts/CaseMapping.hs +1/−1
- tests/Tests/Properties.hs +9/−9
- tests/Tests/QuickCheckUtils.hs +25/−6
- tests/text-tests.cabal +27/−25
- text.cabal +32/−28
Data/Text.hs view
@@ -11,8 +11,7 @@ -- (c) 2008, 2009 Tom Harper -- -- License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org+-- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : GHC --@@ -208,18 +207,18 @@ import qualified Data.List as L import Data.Monoid (Monoid(..)) import Data.String (IsString(..))-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 qualified Data.Text.Internal.Fusion as S+import qualified Data.Text.Internal.Fusion.Common as S+import Data.Text.Internal.Fusion (stream, reverseStream, unstream)+import Data.Text.Internal.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.UnsafeChar (unsafeChr)-import qualified Data.Text.Util as U-import qualified Data.Text.Encoding.Utf16 as U16-import Data.Text.Search (indices)+import Data.Text.Internal.Unsafe.Char (unsafeChr)+import qualified Data.Text.Internal.Functions as F+import qualified Data.Text.Internal.Encoding.Utf16 as U16+import Data.Text.Internal.Search (indices) #if defined(__HADDOCK__) import Data.ByteString (ByteString) import qualified Data.Text.Lazy as L@@ -372,7 +371,7 @@ pack = unstream . S.map safe . S.streamList {-# INLINE [1] pack #-} --- | /O(n)/ Convert a Text into a String. Subject to fusion.+-- | /O(n)/ Convert a 'Text' into a 'String'. Subject to fusion. unpack :: Text -> String unpack = S.unstreamList . stream {-# INLINE [1] unpack #-}@@ -597,7 +596,7 @@ -- 'Text's and concatenates the list after interspersing the first -- argument between each element of the list. intercalate :: Text -> [Text] -> Text-intercalate t = concat . (U.intersperse t)+intercalate t = concat . (F.intersperse t) {-# INLINE intercalate #-} -- | /O(n)/ The 'intersperse' function takes a character and places it
Data/Text/Array.hs view
@@ -6,8 +6,7 @@ -- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan -- -- License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org+-- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable --@@ -66,8 +65,8 @@ import Control.Monad.ST (unsafeIOToST) #endif import Data.Bits ((.&.), xor)-import Data.Text.Unsafe.Base (inlinePerformIO)-import Data.Text.UnsafeShift (shiftL, shiftR)+import Data.Text.Internal.Unsafe (inlinePerformIO)+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR) #if __GLASGOW_HASKELL__ >= 703 import Foreign.C.Types (CInt(CInt), CSize(CSize)) #else
Data/Text/Encoding.hs view
@@ -10,8 +10,7 @@ -- (c) 2008, 2009 Tom Harper -- -- License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org+-- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable --@@ -55,36 +54,54 @@ , encodeUtf16BE , encodeUtf32LE , encodeUtf32BE++#if MIN_VERSION_bytestring(0,10,4)+ -- * Encoding Text using ByteString Builders+ -- | /Note/ that these functions are only available if built against+ -- @bytestring >= 0.10.4.0@.+ , encodeUtf8Builder+ , encodeUtf8BuilderEscaped+#endif ) where -import Control.Exception (evaluate, try) #if __GLASGOW_HASKELL__ >= 702 import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO) #else import Control.Monad.ST (unsafeIOToST, unsafeSTToIO) #endif-import Control.Monad.ST (runST)++#if MIN_VERSION_bytestring(0,10,4) import Data.Bits ((.&.))+import Data.Text.Internal.Unsafe.Char (ord)+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Extra as B+import qualified Data.ByteString.Builder.Internal as B hiding (empty)+import qualified Data.ByteString.Builder.Prim as BP+import qualified Data.ByteString.Builder.Prim.Internal as BP+import qualified Data.Text.Internal.Encoding.Utf16 as U16+#endif++import Control.Exception (evaluate, try)+import Control.Monad.ST (runST) import Data.ByteString as B-import Data.ByteString.Internal as B+import Data.ByteString.Internal as B hiding (c2w) import Data.Text () import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode) import Data.Text.Internal (Text(..), safe, textP)-import Data.Text.Private (runText)-import Data.Text.UnsafeChar (ord, unsafeWrite)-import Data.Text.UnsafeShift (shiftL, shiftR)+import Data.Text.Internal.Private (runText)+import Data.Text.Internal.Unsafe.Char (unsafeWrite)+import Data.Text.Internal.Unsafe.Shift (shiftR)+import Data.Text.Unsafe (unsafeDupablePerformIO) import Data.Word (Word8, Word32)-import Foreign.C.Types (CSize)+import Foreign.C.Types (CSize(..)) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Marshal.Utils (with) import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr) import Foreign.Storable (Storable, peek, poke)-import GHC.Base (MutableByteArray#)+import GHC.Base (ByteArray#, MutableByteArray#) import qualified Data.Text.Array as A-import qualified Data.Text.Encoding.Fusion as E-import qualified Data.Text.Encoding.Utf16 as U16-import qualified Data.Text.Fusion as F-import Data.Text.Unsafe (unsafeDupablePerformIO)+import qualified Data.Text.Internal.Encoding.Fusion as E+import qualified Data.Text.Internal.Fusion as F #include "text_cbits.h" @@ -146,7 +163,7 @@ loop (ptr `plusPtr` off) (unsafeIOToST . go) =<< A.new len where- desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"+ desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream" {- INLINE[0] decodeUtf8With #-} -- $stream@@ -267,7 +284,7 @@ return $ Some chunkText (B.drop left bs) (decodeChunk codepoint state) in loop (ptr `plusPtr` off)- desc = "Data.Text.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"+ desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream" -- | Decode a 'ByteString' containing UTF-8 encoded text that is known -- to be valid.@@ -290,61 +307,88 @@ decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode {-# INLINE decodeUtf8' #-} +#if MIN_VERSION_bytestring(0,10,4)++-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.+encodeUtf8Builder :: Text -> B.Builder+encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)++-- | Encode text using UTF-8 encoding and escape the ASCII characters using+-- a 'BP.BoundedPrim'.+--+-- Use this function is to implement efficient encoders for text-based formats+-- like JSON or HTML.+{-# INLINE encodeUtf8BuilderEscaped #-}+-- TODO: Extend documentation with references to source code in @blaze-html@+-- or @aeson@ that uses this function.+encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder+encodeUtf8BuilderEscaped be =+ -- manual eta-expansion to ensure inlining works as expected+ \txt -> B.builder (mkBuildstep txt)+ where+ bound = max 4 $ BP.sizeBound be++ mkBuildstep (Text arr off len) !k =+ outerLoop off+ where+ iend = off + len++ outerLoop !i0 !br@(B.BufferRange op0 ope)+ | i0 >= iend = k br+ | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)+ -- TODO: Use a loop with an integrated bound's check if outRemaining+ -- is smaller than 8, as this will save on divisions.+ | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)+ where+ outRemaining = (ope `minusPtr` op0) `div` bound+ inpRemaining = iend - i0++ goPartial !iendTmp = go i0 op0+ where+ go !i !op+ | i < iendTmp = case A.unsafeIndex arr i of+ w | w <= 0x7F -> do+ BP.runB be (fromIntegral w) op >>= go (i + 1)+ | w <= 0x7FF -> do+ poke8 0 $ (w `shiftR` 6) + 0xC0+ poke8 1 $ (w .&. 0x3f) + 0x80+ go (i + 1) (op `plusPtr` 2)+ | 0xD800 <= w && w <= 0xDBFF -> do+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))+ poke8 0 $ (c `shiftR` 18) + 0xF0+ poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80+ poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80+ poke8 3 $ (c .&. 0x3F) + 0x80+ go (i + 2) (op `plusPtr` 4)+ | otherwise -> do+ poke8 0 $ (w `shiftR` 12) + 0xE0+ poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80+ poke8 2 $ (w .&. 0x3F) + 0x80+ go (i + 1) (op `plusPtr` 3)+ | otherwise =+ outerLoop i (B.BufferRange op ope)+ where+ poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)+#endif+ -- | Encode text using UTF-8 encoding. encodeUtf8 :: Text -> ByteString-encodeUtf8 (Text arr off len) = unsafeDupablePerformIO $ do- let size0 = max len 4- mallocByteString size0 >>= start size0 off 0- where- start size n0 m0 fp = withForeignPtr fp $ loop n0 m0- where- loop n1 m1 ptr = go n1 m1- where- offLen = off + len- go !n !m- | n == offLen = return (PS fp 0 m)- | otherwise = do- let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)- ensure k act- | size-m >= k = act- | otherwise = {-# SCC "resizeUtf8/ensure" #-} do- let newSize = size `shiftL` 1- fp' <- mallocByteString newSize- withForeignPtr fp' $ \ptr' ->- memcpy ptr' ptr (fromIntegral m)- start newSize n m fp'- {-# INLINE ensure #-}- case A.unsafeIndex arr n of- w| w <= 0x7F -> ensure 1 $ do- poke (ptr `plusPtr` m) (fromIntegral w :: Word8)- -- A single ASCII octet is likely to start a run of- -- them. We see better performance when we- -- special-case this assumption.- let end = ptr `plusPtr` size- ascii !t !u- | t == offLen || u == end || v >= 0x80 =- go t (u `minusPtr` ptr)- | otherwise = do- poke u (fromIntegral v :: Word8)- ascii (t+1) (u `plusPtr` 1)- where v = A.unsafeIndex arr t- ascii (n+1) (ptr `plusPtr` (m+1))- | w <= 0x7FF -> ensure 2 $ do- poke8 m $ (w `shiftR` 6) + 0xC0- poke8 (m+1) $ (w .&. 0x3f) + 0x80- go (n+1) (m+2)- | 0xD800 <= w && w <= 0xDBFF -> ensure 4 $ do- let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))- poke8 m $ (c `shiftR` 18) + 0xF0- poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80- poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80- poke8 (m+3) $ (c .&. 0x3F) + 0x80- go (n+2) (m+4)- | otherwise -> ensure 3 $ do- poke8 m $ (w `shiftR` 12) + 0xE0- poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80- poke8 (m+2) $ (w .&. 0x3F) + 0x80- go (n+1) (m+3)+encodeUtf8 (Text arr off len)+ | len == 0 = B.empty+ | otherwise = unsafeDupablePerformIO $ do+ fp <- mallocByteString (len*4)+ withForeignPtr fp $ \ptr ->+ with ptr $ \destPtr -> do+ c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)+ newDest <- peek destPtr+ let utf8len = newDest `minusPtr` ptr+ if utf8len >= len `shiftR` 1+ then return (PS fp 0 utf8len)+ else do+ fp' <- mallocByteString utf8len+ withForeignPtr fp' $ \ptr' -> do+ memcpy ptr' ptr (fromIntegral utf8len)+ return (PS fp' 0 utf8len) -- | Decode text from little endian UTF-16 encoding. decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text@@ -433,3 +477,6 @@ foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()++foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8+ :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
Data/Text/Encoding/Error.hs view
@@ -7,8 +7,7 @@ -- Copyright : (c) Bryan O'Sullivan 2009 -- -- License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org+-- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : GHC --
− Data/Text/Encoding/Fusion.hs
@@ -1,205 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}---- |--- Module : Data.Text.Encoding.Fusion--- Copyright : (c) Tom Harper 2008-2009,--- (c) Bryan O'Sullivan 2009,--- (c) Duncan Coutts 2009------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : portable------ Fusible 'Stream'-oriented functions for converting between 'Text'--- and several common encodings.--module Data.Text.Encoding.Fusion- (- -- * Streaming- streamASCII- , streamUtf8- , streamUtf16LE- , streamUtf16BE- , streamUtf32LE- , streamUtf32BE-- -- * Unstreaming- , unstream-- , module Data.Text.Encoding.Fusion.Common- ) where--#if defined(ASSERTS)-import Control.Exception (assert)-#endif-import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)-import Data.Text.Fusion (Step(..), Stream(..))-import Data.Text.Fusion.Size-import Data.Text.Encoding.Error-import Data.Text.Encoding.Fusion.Common-import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)-import Data.Text.UnsafeShift (shiftL, shiftR)-import Data.Word (Word8, Word16, Word32)-import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)-import Foreign.Storable (pokeByteOff)-import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as B-import qualified Data.Text.Encoding.Utf8 as U8-import qualified Data.Text.Encoding.Utf16 as U16-import qualified Data.Text.Encoding.Utf32 as U32-import Data.Text.Unsafe (unsafeDupablePerformIO)--streamASCII :: ByteString -> Stream Char-streamASCII bs = Stream next 0 (maxSize l)- where- l = B.length bs- {-# INLINE next #-}- next i- | i >= l = Done- | otherwise = Yield (unsafeChr8 x1) (i+1)- where- x1 = B.unsafeIndex bs i-{-# DEPRECATED streamASCII "Do not use this function" #-}-{-# INLINE [0] streamASCII #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8--- encoding.-streamUtf8 :: OnDecodeError -> ByteString -> Stream Char-streamUtf8 onErr bs = Stream next 0 (maxSize l)- where- l = B.length bs- next i- | i >= l = Done- | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)- | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)- | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)- | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)- | otherwise = decodeError "streamUtf8" "UTF-8" onErr (Just x1) (i+1)- where- x1 = idx i- x2 = idx (i + 1)- x3 = idx (i + 2)- x4 = idx (i + 3)- idx = B.unsafeIndex bs-{-# INLINE [0] streamUtf8 #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little--- endian UTF-16 encoding.-streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char-streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))- where- l = B.length bs- {-# INLINE next #-}- next i- | i >= l = Done- | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)- | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)- | otherwise = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing (i+1)- where- x1 = idx i + (idx (i + 1) `shiftL` 8)- x2 = idx (i + 2) + (idx (i + 3) `shiftL` 8)- idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16-{-# INLINE [0] streamUtf16LE #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big--- endian UTF-16 encoding.-streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char-streamUtf16BE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))- where- l = B.length bs- {-# INLINE next #-}- next i- | i >= l = Done- | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)- | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)- | otherwise = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing (i+1)- where- x1 = (idx i `shiftL` 8) + idx (i + 1)- x2 = (idx (i + 2) `shiftL` 8) + idx (i + 3)- idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16-{-# INLINE [0] streamUtf16BE #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big--- endian UTF-32 encoding.-streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char-streamUtf32BE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))- where- l = B.length bs- {-# INLINE next #-}- next i- | i >= l = Done- | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)- | otherwise = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing (i+1)- where- x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4- x1 = idx i- x2 = idx (i+1)- x3 = idx (i+2)- x4 = idx (i+3)- idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32-{-# INLINE [0] streamUtf32BE #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little--- endian UTF-32 encoding.-streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char-streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))- where- l = B.length bs- {-# INLINE next #-}- next i- | i >= l = Done- | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)- | otherwise = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing (i+1)- where- x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1- x1 = idx i- x2 = idx $ i+1- x3 = idx $ i+2- x4 = idx $ i+3- idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32-{-# INLINE [0] streamUtf32LE #-}---- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.-unstream :: Stream Word8 -> ByteString-unstream (Stream next s0 len) = unsafeDupablePerformIO $ do- let mlen = upperBound 4 len- mallocByteString mlen >>= loop mlen 0 s0- where- loop !n !off !s fp = case next s of- Done -> trimUp fp n off- Skip s' -> loop n off s' fp- Yield x s'- | off == n -> realloc fp n off s' x- | otherwise -> do- withForeignPtr fp $ \p -> pokeByteOff p off x- loop n (off+1) s' fp- {-# NOINLINE realloc #-}- realloc fp n off s x = do- let n' = n+n- fp' <- copy0 fp n n'- withForeignPtr fp' $ \p -> pokeByteOff p off x- loop n' (off+1) s fp'- {-# NOINLINE trimUp #-}- trimUp fp _ off = return $! PS fp 0 off- copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)- copy0 !src !srcLen !destLen =-#if defined(ASSERTS)- assert (srcLen <= destLen) $-#endif- do- dest <- mallocByteString destLen- withForeignPtr src $ \src' ->- withForeignPtr dest $ \dest' ->- memcpy dest' src' (fromIntegral srcLen)- return dest--decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8- -> s -> Step s Char-decodeError func kind onErr mb i =- case onErr desc mb of- Nothing -> Skip i- Just c -> Yield c i- where desc = "Data.Text.Encoding.Fusion." ++ func ++ ": Invalid " ++- kind ++ " stream"
− Data/Text/Encoding/Fusion/Common.hs
@@ -1,121 +0,0 @@-{-# LANGUAGE BangPatterns #-}---- |--- Module : Data.Text.Encoding.Fusion.Common--- Copyright : (c) Tom Harper 2008-2009,--- (c) Bryan O'Sullivan 2009,--- (c) Duncan Coutts 2009,--- (c) Jasper Van der Jeugt 2011------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : portable------ Fusible 'Stream'-oriented functions for converting between 'Text'--- and several common encodings.--module Data.Text.Encoding.Fusion.Common- (- -- * Restreaming- -- Restreaming is the act of converting from one 'Stream'- -- representation to another.- restreamUtf16LE- , restreamUtf16BE- , restreamUtf32LE- , restreamUtf32BE- ) where--import Data.Bits ((.&.))-import Data.Text.Fusion (Step(..), Stream(..))-import Data.Text.Fusion.Internal (RS(..))-import Data.Text.UnsafeChar (ord)-import Data.Text.UnsafeShift (shiftR)-import Data.Word (Word8)--restreamUtf16BE :: Stream Char -> Stream Word8-restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)- where- next (RS0 s) = case next0 s of- Done -> Done- Skip s' -> Skip (RS0 s')- Yield x s'- | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $- RS1 s' (fromIntegral n)- | otherwise -> Yield c1 $ RS3 s' c2 c3 c4- where- n = ord x- n1 = n - 0x10000- c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)- c2 = fromIntegral (n1 `shiftR` 10)- n2 = n1 .&. 0x3FF- c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)- c4 = fromIntegral n2- next (RS1 s x2) = Yield x2 (RS0 s)- next (RS2 s x2 x3) = Yield x2 (RS1 s x3)- next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)- {-# INLINE next #-}-{-# INLINE restreamUtf16BE #-}--restreamUtf16LE :: Stream Char -> Stream Word8-restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)- where- next (RS0 s) = case next0 s of- Done -> Done- Skip s' -> Skip (RS0 s')- Yield x s'- | n < 0x10000 -> Yield (fromIntegral n) $- RS1 s' (fromIntegral $ shiftR n 8)- | otherwise -> Yield c1 $ RS3 s' c2 c3 c4- where- n = ord x- n1 = n - 0x10000- c2 = fromIntegral (shiftR n1 18 + 0xD8)- c1 = fromIntegral (shiftR n1 10)- n2 = n1 .&. 0x3FF- c4 = fromIntegral (shiftR n2 8 + 0xDC)- c3 = fromIntegral n2- next (RS1 s x2) = Yield x2 (RS0 s)- next (RS2 s x2 x3) = Yield x2 (RS1 s x3)- next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)- {-# INLINE next #-}-{-# INLINE restreamUtf16LE #-}--restreamUtf32BE :: Stream Char -> Stream Word8-restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)- where- next (RS0 s) = case next0 s of- Done -> Done- Skip s' -> Skip (RS0 s')- Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)- where- n = ord x- c1 = fromIntegral $ shiftR n 24- c2 = fromIntegral $ shiftR n 16- c3 = fromIntegral $ shiftR n 8- c4 = fromIntegral n- next (RS1 s x2) = Yield x2 (RS0 s)- next (RS2 s x2 x3) = Yield x2 (RS1 s x3)- next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)- {-# INLINE next #-}-{-# INLINE restreamUtf32BE #-}--restreamUtf32LE :: Stream Char -> Stream Word8-restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)- where- next (RS0 s) = case next0 s of- Done -> Done- Skip s' -> Skip (RS0 s')- Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)- where- n = ord x- c4 = fromIntegral $ shiftR n 24- c3 = fromIntegral $ shiftR n 16- c2 = fromIntegral $ shiftR n 8- c1 = fromIntegral n- next (RS1 s x2) = Yield x2 (RS0 s)- next (RS2 s x2 x3) = Yield x2 (RS1 s x3)- next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)- {-# INLINE next #-}-{-# INLINE restreamUtf32LE #-}
− Data/Text/Encoding/Utf16.hs
@@ -1,42 +0,0 @@-{-# LANGUAGE MagicHash, BangPatterns #-}---- |--- Module : Data.Text.Encoding.Utf16--- Copyright : (c) 2008, 2009 Tom Harper,--- (c) 2009 Bryan O'Sullivan,--- (c) 2009 Duncan Coutts------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : GHC------ Basic UTF-16 validation and character manipulation.-module Data.Text.Encoding.Utf16- (- chr2- , validate1- , validate2- ) where--import GHC.Exts-import GHC.Word (Word16(..))--chr2 :: Word16 -> Word16 -> Char-chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))- where- !x# = word2Int# a#- !y# = word2Int# b#- !upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#- !lower# = y# -# 0xDC00#-{-# INLINE chr2 #-}--validate1 :: Word16 -> Bool-validate1 x1 = x1 < 0xD800 || x1 > 0xDFFF-{-# INLINE validate1 #-}--validate2 :: Word16 -> Word16 -> Bool-validate2 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&- x2 >= 0xDC00 && x2 <= 0xDFFF-{-# INLINE validate2 #-}
− Data/Text/Encoding/Utf32.hs
@@ -1,23 +0,0 @@--- |--- Module : Data.Text.Encoding.Utf32--- Copyright : (c) 2008, 2009 Tom Harper,--- (c) 2009, 2010 Bryan O'Sullivan,--- (c) 2009 Duncan Coutts------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : portable------ Basic UTF-32 validation.-module Data.Text.Encoding.Utf32- (- validate- ) where--import Data.Word (Word32)--validate :: Word32 -> Bool-validate x1 = x1 < 0xD800 || (x1 > 0xDFFF && x1 <= 0x10FFFF)-{-# INLINE validate #-}
− Data/Text/Encoding/Utf8.hs
@@ -1,161 +0,0 @@-{-# LANGUAGE CPP, MagicHash, BangPatterns #-}---- |--- Module : Data.Text.Encoding.Utf8--- Copyright : (c) 2008, 2009 Tom Harper,--- (c) 2009, 2010 Bryan O'Sullivan,--- (c) 2009 Duncan Coutts------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : GHC------ Basic UTF-8 validation and character manipulation.-module Data.Text.Encoding.Utf8- (- -- Decomposition- ord2- , ord3- , ord4- -- Construction- , chr2- , chr3- , chr4- -- * Validation- , validate1- , validate2- , validate3- , validate4- ) where--#if defined(ASSERTS)-import Control.Exception (assert)-#endif-import Data.Bits ((.&.))-import Data.Text.UnsafeChar (ord)-import Data.Text.UnsafeShift (shiftR)-import GHC.Exts-import GHC.Word (Word8(..))--default(Int)--between :: Word8 -- ^ byte to check- -> Word8 -- ^ lower bound- -> Word8 -- ^ upper bound- -> Bool-between x y z = x >= y && x <= z-{-# INLINE between #-}--ord2 :: Char -> (Word8,Word8)-ord2 c =-#if defined(ASSERTS)- assert (n >= 0x80 && n <= 0x07ff)-#endif- (x1,x2)- where- n = ord c- x1 = fromIntegral $ (n `shiftR` 6) + 0xC0- x2 = fromIntegral $ (n .&. 0x3F) + 0x80--ord3 :: Char -> (Word8,Word8,Word8)-ord3 c =-#if defined(ASSERTS)- assert (n >= 0x0800 && n <= 0xffff)-#endif- (x1,x2,x3)- where- n = ord c- x1 = fromIntegral $ (n `shiftR` 12) + 0xE0- x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80- x3 = fromIntegral $ (n .&. 0x3F) + 0x80--ord4 :: Char -> (Word8,Word8,Word8,Word8)-ord4 c =-#if defined(ASSERTS)- assert (n >= 0x10000)-#endif- (x1,x2,x3,x4)- where- n = ord c- x1 = fromIntegral $ (n `shiftR` 18) + 0xF0- x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80- x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80- x4 = fromIntegral $ (n .&. 0x3F) + 0x80--chr2 :: Word8 -> Word8 -> Char-chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))- where- !y1# = word2Int# x1#- !y2# = word2Int# x2#- !z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#- !z2# = y2# -# 0x80#-{-# INLINE chr2 #-}--chr3 :: Word8 -> Word8 -> Word8 -> Char-chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))- where- !y1# = word2Int# x1#- !y2# = word2Int# x2#- !y3# = word2Int# x3#- !z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#- !z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#- !z3# = y3# -# 0x80#-{-# INLINE chr3 #-}--chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char-chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =- C# (chr# (z1# +# z2# +# z3# +# z4#))- where- !y1# = word2Int# x1#- !y2# = word2Int# x2#- !y3# = word2Int# x3#- !y4# = word2Int# x4#- !z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#- !z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#- !z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#- !z4# = y4# -# 0x80#-{-# INLINE chr4 #-}--validate1 :: Word8 -> Bool-validate1 x1 = x1 <= 0x7F-{-# INLINE validate1 #-}--validate2 :: Word8 -> Word8 -> Bool-validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF-{-# INLINE validate2 #-}--validate3 :: Word8 -> Word8 -> Word8 -> Bool-{-# INLINE validate3 #-}-validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4- where- validate3_1 = (x1 == 0xE0) &&- between x2 0xA0 0xBF &&- between x3 0x80 0xBF- validate3_2 = between x1 0xE1 0xEC &&- between x2 0x80 0xBF &&- between x3 0x80 0xBF- validate3_3 = x1 == 0xED &&- between x2 0x80 0x9F &&- between x3 0x80 0xBF- validate3_4 = between x1 0xEE 0xEF &&- between x2 0x80 0xBF &&- between x3 0x80 0xBF--validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool-{-# INLINE validate4 #-}-validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3- where- validate4_1 = x1 == 0xF0 &&- between x2 0x90 0xBF &&- between x3 0x80 0xBF &&- between x4 0x80 0xBF- validate4_2 = between x1 0xF1 0xF3 &&- between x2 0x80 0xBF &&- between x3 0x80 0xBF &&- between x4 0x80 0xBF- validate4_3 = x1 == 0xF4 &&- between x2 0x80 0x8F &&- between x3 0x80 0xBF &&- between x4 0x80 0xBF
Data/Text/Foreign.hs view
@@ -4,8 +4,7 @@ -- Copyright : (c) 2009, 2010 Bryan O'Sullivan -- -- License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org+-- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : GHC --
− Data/Text/Fusion.hs
@@ -1,231 +0,0 @@-{-# LANGUAGE BangPatterns, MagicHash #-}---- |--- Module : Data.Text.Fusion--- Copyright : (c) Tom Harper 2008-2009,--- (c) Bryan O'Sullivan 2009-2010,--- (c) Duncan Coutts 2009------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : GHC------ Text manipulation functions represented as fusible operations over--- streams.-module Data.Text.Fusion- (- -- * Types- Stream(..)- , Step(..)-- -- * Creation and elimination- , stream- , unstream- , reverseStream-- , length-- -- * Transformations- , reverse-- -- * Construction- -- ** Scans- , reverseScanr-- -- ** Accumulating maps- , mapAccumL-- -- ** Generation and unfolding- , unfoldrN-- -- * Indexing- , index- , findIndex- , countChar- ) where--import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,- Num(..), Ord(..), ($), (&&),- fromIntegral, otherwise)-import Data.Bits ((.&.))-import Data.Text.Internal (Text(..))-import Data.Text.Private (runText)-import Data.Text.UnsafeChar (ord, unsafeChr, unsafeWrite)-import Data.Text.UnsafeShift (shiftL, shiftR)-import qualified Data.Text.Array as A-import qualified Data.Text.Fusion.Common as S-import Data.Text.Fusion.Internal-import Data.Text.Fusion.Size-import qualified Data.Text.Internal as I-import qualified Data.Text.Encoding.Utf16 as U16--default(Int)---- | /O(n)/ Convert a 'Text' into a 'Stream Char'.-stream :: Text -> Stream Char-stream (Text arr off len) = Stream next off (maxSize len)- where- !end = off+len- next !i- | i >= end = Done- | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)- | otherwise = Yield (unsafeChr n) (i + 1)- where- n = A.unsafeIndex arr i- n2 = A.unsafeIndex arr (i + 1)-{-# INLINE [0] stream #-}---- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate--- backwards.-reverseStream :: Text -> Stream Char-reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)- where- {-# INLINE next #-}- next !i- | i < off = Done- | n >= 0xDC00 && n <= 0xDFFF = Yield (U16.chr2 n2 n) (i - 2)- | otherwise = Yield (unsafeChr n) (i - 1)- where- n = A.unsafeIndex arr i- n2 = A.unsafeIndex arr (i - 1)-{-# INLINE [0] reverseStream #-}---- | /O(n)/ Convert a 'Stream Char' into a 'Text'.-unstream :: Stream Char -> Text-unstream (Stream next0 s0 len) = runText $ \done -> do- let mlen = upperBound 4 len- arr0 <- A.new mlen- let outer arr top = loop- where- loop !s !i =- case next0 s of- Done -> done arr i- Skip s' -> loop s' i- Yield x s'- | j >= top -> {-# SCC "unstream/resize" #-} do- let top' = (top + 1) `shiftL` 1- arr' <- A.new top'- A.copyM arr' 0 arr 0 top- outer arr' top' s i- | otherwise -> do d <- unsafeWrite arr i x- loop s' (i+d)- where j | ord x < 0x10000 = i- | otherwise = i + 1- outer arr0 mlen s0 0-{-# INLINE [0] unstream #-}-{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}----- ------------------------------------------------------------------------------- * Basic stream functions--length :: Stream Char -> Int-length = S.lengthI-{-# INLINE[0] length #-}---- | /O(n)/ Reverse the characters of a string.-reverse :: Stream Char -> Text-reverse (Stream next s len0)- | isEmpty len0 = I.empty- | otherwise = I.textP arr off' len'- where- len0' = upperBound 4 (larger len0 4)- (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')- loop !s0 !i !len marr =- case next s0 of- Done -> return (marr, (j, len-j))- where j = i + 1- Skip s1 -> loop s1 i len marr- Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do- let newLen = len `shiftL` 1- marr' <- A.new newLen- A.copyM marr' (newLen-len) marr 0 len- write s1 (len+i) newLen marr'- | otherwise -> write s1 i len marr- where n = ord x- least | n < 0x10000 = 0- | otherwise = 1- m = n - 0x10000- lo = fromIntegral $ (m `shiftR` 10) + 0xD800- hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00- write t j l mar- | n < 0x10000 = do- A.unsafeWrite mar j (fromIntegral n)- loop t (j-1) l mar- | otherwise = do- A.unsafeWrite mar (j-1) lo- A.unsafeWrite mar j hi- loop t (j-2) l mar-{-# INLINE [0] reverse #-}---- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with--- the input and result reversed.-reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char-reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low- where- {-# INLINE next #-}- next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)- next (S2 :*: z :*: s) = case next0 s of- Yield x s' -> let !x' = f x z- in Yield x' (S2 :*: x' :*: s')- Skip s' -> Skip (S2 :*: z :*: s')- Done -> Done-{-# INLINE reverseScanr #-}---- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed--- value. However, the length of the result is limited by the--- first argument to 'unfoldrN'. This function is more efficient than--- 'unfoldr' when the length of the result is known.-unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char-unfoldrN n = S.unfoldrNI n-{-# INLINE [0] unfoldrN #-}------------------------------------------------------------------------------------ ** Indexing streams---- | /O(n)/ stream index (subscript) operator, starting from 0.-index :: Stream Char -> Int -> Char-index = S.indexI-{-# INLINE [0] index #-}---- | The 'findIndex' function takes a predicate and a stream and--- returns the index of the first element in the stream--- satisfying the predicate.-findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int-findIndex = S.findIndexI-{-# INLINE [0] findIndex #-}---- | /O(n)/ The 'count' function returns the number of times the query--- element appears in the given stream.-countChar :: Char -> Stream Char -> Int-countChar = S.countCharI-{-# INLINE [0] countChar #-}---- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a--- function to each element of a 'Text', passing an accumulating--- parameter from left to right, and returns a final 'Text'.-mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)-mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)- where- (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)- where mlen = upperBound 4 len- outer arr top = loop- where- loop !z !s !i =- case next0 s of- Done -> return (arr, (z,i))- Skip s' -> loop z s' i- Yield x s'- | j >= top -> {-# SCC "mapAccumL/resize" #-} do- let top' = (top + 1) `shiftL` 1- arr' <- A.new top'- A.copyM arr' 0 arr 0 top- outer arr' top' z s i- | otherwise -> do d <- unsafeWrite arr i c- loop z' s' (i+d)- where (z',c) = f z x- j | ord c < 0x10000 = i- | otherwise = i + 1-{-# INLINE [0] mapAccumL #-}
− Data/Text/Fusion/CaseMapping.hs
@@ -1,570 +0,0 @@-{-# LANGUAGE Rank2Types #-}--- AUTOMATICALLY GENERATED - DO NOT EDIT--- Generated by scripts/SpecialCasing.hs--- CaseFolding-6.3.0.txt--- Date: 2012-12-20, 22:14:35 GMT [MD]--- SpecialCasing-6.3.0.txt--- Date: 2013-05-08, 13:54:51 GMT [MD]--module Data.Text.Fusion.CaseMapping where-import Data.Char-import Data.Text.Fusion.Internal--upperMapping :: forall s. Char -> s -> Step (CC s) Char-{-# INLINE upperMapping #-}--- LATIN SMALL LETTER SHARP S-upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')--- LATIN SMALL LIGATURE FF-upperMapping '\xfb00' s = Yield '\x0046' (CC s '\x0046' '\x0000')--- LATIN SMALL LIGATURE FI-upperMapping '\xfb01' s = Yield '\x0046' (CC s '\x0049' '\x0000')--- LATIN SMALL LIGATURE FL-upperMapping '\xfb02' s = Yield '\x0046' (CC s '\x004c' '\x0000')--- LATIN SMALL LIGATURE FFI-upperMapping '\xfb03' s = Yield '\x0046' (CC s '\x0046' '\x0049')--- LATIN SMALL LIGATURE FFL-upperMapping '\xfb04' s = Yield '\x0046' (CC s '\x0046' '\x004c')--- LATIN SMALL LIGATURE LONG S T-upperMapping '\xfb05' s = Yield '\x0053' (CC s '\x0054' '\x0000')--- LATIN SMALL LIGATURE ST-upperMapping '\xfb06' s = Yield '\x0053' (CC s '\x0054' '\x0000')--- ARMENIAN SMALL LIGATURE ECH YIWN-upperMapping '\x0587' s = Yield '\x0535' (CC s '\x0552' '\x0000')--- ARMENIAN SMALL LIGATURE MEN NOW-upperMapping '\xfb13' s = Yield '\x0544' (CC s '\x0546' '\x0000')--- ARMENIAN SMALL LIGATURE MEN ECH-upperMapping '\xfb14' s = Yield '\x0544' (CC s '\x0535' '\x0000')--- ARMENIAN SMALL LIGATURE MEN INI-upperMapping '\xfb15' s = Yield '\x0544' (CC s '\x053b' '\x0000')--- ARMENIAN SMALL LIGATURE VEW NOW-upperMapping '\xfb16' s = Yield '\x054e' (CC s '\x0546' '\x0000')--- ARMENIAN SMALL LIGATURE MEN XEH-upperMapping '\xfb17' s = Yield '\x0544' (CC s '\x053d' '\x0000')--- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE-upperMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS-upperMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS-upperMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')--- LATIN SMALL LETTER J WITH CARON-upperMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')--- LATIN SMALL LETTER H WITH LINE BELOW-upperMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')--- LATIN SMALL LETTER T WITH DIAERESIS-upperMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')--- LATIN SMALL LETTER W WITH RING ABOVE-upperMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')--- LATIN SMALL LETTER Y WITH RING ABOVE-upperMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')--- LATIN SMALL LETTER A WITH RIGHT HALF RING-upperMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PSILI-upperMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA-upperMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')--- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA-upperMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')--- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI-upperMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')--- GREEK SMALL LETTER ALPHA WITH PERISPOMENI-upperMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER ETA WITH PERISPOMENI-upperMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA-upperMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA-upperMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER IOTA WITH PERISPOMENI-upperMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI-upperMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA-upperMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA-upperMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER RHO WITH PSILI-upperMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PERISPOMENI-upperMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI-upperMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')--- GREEK SMALL LETTER OMEGA WITH PERISPOMENI-upperMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI-upperMapping '\x1f80' s = Yield '\x1f08' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI-upperMapping '\x1f81' s = Yield '\x1f09' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI-upperMapping '\x1f82' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI-upperMapping '\x1f83' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI-upperMapping '\x1f84' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI-upperMapping '\x1f85' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1f86' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1f87' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI-upperMapping '\x1f88' s = Yield '\x1f08' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI-upperMapping '\x1f89' s = Yield '\x1f09' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI-upperMapping '\x1f8a' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI-upperMapping '\x1f8b' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI-upperMapping '\x1f8c' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI-upperMapping '\x1f8d' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI-upperMapping '\x1f8e' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI-upperMapping '\x1f8f' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI-upperMapping '\x1f90' s = Yield '\x1f28' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI-upperMapping '\x1f91' s = Yield '\x1f29' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI-upperMapping '\x1f92' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI-upperMapping '\x1f93' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI-upperMapping '\x1f94' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI-upperMapping '\x1f95' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1f96' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1f97' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI-upperMapping '\x1f98' s = Yield '\x1f28' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI-upperMapping '\x1f99' s = Yield '\x1f29' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI-upperMapping '\x1f9a' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI-upperMapping '\x1f9b' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI-upperMapping '\x1f9c' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI-upperMapping '\x1f9d' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI-upperMapping '\x1f9e' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI-upperMapping '\x1f9f' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI-upperMapping '\x1fa0' s = Yield '\x1f68' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI-upperMapping '\x1fa1' s = Yield '\x1f69' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI-upperMapping '\x1fa2' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI-upperMapping '\x1fa3' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI-upperMapping '\x1fa4' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI-upperMapping '\x1fa5' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1fa6' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1fa7' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI-upperMapping '\x1fa8' s = Yield '\x1f68' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI-upperMapping '\x1fa9' s = Yield '\x1f69' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI-upperMapping '\x1faa' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI-upperMapping '\x1fab' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI-upperMapping '\x1fac' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI-upperMapping '\x1fad' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI-upperMapping '\x1fae' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI-upperMapping '\x1faf' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI-upperMapping '\x1fb3' s = Yield '\x0391' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI-upperMapping '\x1fbc' s = Yield '\x0391' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI-upperMapping '\x1fc3' s = Yield '\x0397' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI-upperMapping '\x1fcc' s = Yield '\x0397' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI-upperMapping '\x1ff3' s = Yield '\x03a9' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI-upperMapping '\x1ffc' s = Yield '\x03a9' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI-upperMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI-upperMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI-upperMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI-upperMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI-upperMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI-upperMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0399')--- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')--- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')-upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')-lowerMapping :: forall s. Char -> s -> Step (CC s) Char-{-# INLINE lowerMapping #-}--- LATIN CAPITAL LETTER I WITH DOT ABOVE-lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')-lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')-titleMapping :: forall s. Char -> s -> Step (CC s) Char-{-# INLINE titleMapping #-}--- LATIN SMALL LETTER SHARP S-titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')--- LATIN SMALL LIGATURE FF-titleMapping '\xfb00' s = Yield '\x0046' (CC s '\x0066' '\x0000')--- LATIN SMALL LIGATURE FI-titleMapping '\xfb01' s = Yield '\x0046' (CC s '\x0069' '\x0000')--- LATIN SMALL LIGATURE FL-titleMapping '\xfb02' s = Yield '\x0046' (CC s '\x006c' '\x0000')--- LATIN SMALL LIGATURE FFI-titleMapping '\xfb03' s = Yield '\x0046' (CC s '\x0066' '\x0069')--- LATIN SMALL LIGATURE FFL-titleMapping '\xfb04' s = Yield '\x0046' (CC s '\x0066' '\x006c')--- LATIN SMALL LIGATURE LONG S T-titleMapping '\xfb05' s = Yield '\x0053' (CC s '\x0074' '\x0000')--- LATIN SMALL LIGATURE ST-titleMapping '\xfb06' s = Yield '\x0053' (CC s '\x0074' '\x0000')--- ARMENIAN SMALL LIGATURE ECH YIWN-titleMapping '\x0587' s = Yield '\x0535' (CC s '\x0582' '\x0000')--- ARMENIAN SMALL LIGATURE MEN NOW-titleMapping '\xfb13' s = Yield '\x0544' (CC s '\x0576' '\x0000')--- ARMENIAN SMALL LIGATURE MEN ECH-titleMapping '\xfb14' s = Yield '\x0544' (CC s '\x0565' '\x0000')--- ARMENIAN SMALL LIGATURE MEN INI-titleMapping '\xfb15' s = Yield '\x0544' (CC s '\x056b' '\x0000')--- ARMENIAN SMALL LIGATURE VEW NOW-titleMapping '\xfb16' s = Yield '\x054e' (CC s '\x0576' '\x0000')--- ARMENIAN SMALL LIGATURE MEN XEH-titleMapping '\xfb17' s = Yield '\x0544' (CC s '\x056d' '\x0000')--- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE-titleMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS-titleMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS-titleMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')--- LATIN SMALL LETTER J WITH CARON-titleMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')--- LATIN SMALL LETTER H WITH LINE BELOW-titleMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')--- LATIN SMALL LETTER T WITH DIAERESIS-titleMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')--- LATIN SMALL LETTER W WITH RING ABOVE-titleMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')--- LATIN SMALL LETTER Y WITH RING ABOVE-titleMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')--- LATIN SMALL LETTER A WITH RIGHT HALF RING-titleMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PSILI-titleMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA-titleMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')--- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA-titleMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')--- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI-titleMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')--- GREEK SMALL LETTER ALPHA WITH PERISPOMENI-titleMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER ETA WITH PERISPOMENI-titleMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA-titleMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA-titleMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER IOTA WITH PERISPOMENI-titleMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI-titleMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA-titleMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA-titleMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER RHO WITH PSILI-titleMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PERISPOMENI-titleMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI-titleMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')--- GREEK SMALL LETTER OMEGA WITH PERISPOMENI-titleMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI-titleMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0345' '\x0000')--- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI-titleMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0345' '\x0000')--- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI-titleMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0345' '\x0000')--- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI-titleMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0345' '\x0000')--- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI-titleMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0345' '\x0000')--- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI-titleMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0345' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI-titleMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0345')--- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI-titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')--- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI-titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')-titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')-foldMapping :: forall s. Char -> s -> Step (CC s) Char-{-# INLINE foldMapping #-}--- MICRO SIGN-foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')--- LATIN SMALL LETTER SHARP S-foldMapping '\x00df' s = Yield '\x0073' (CC s '\x0073' '\x0000')--- LATIN CAPITAL LETTER I WITH DOT ABOVE-foldMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')--- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE-foldMapping '\x0149' s = Yield '\x02bc' (CC s '\x006e' '\x0000')--- LATIN SMALL LETTER LONG S-foldMapping '\x017f' s = Yield '\x0073' (CC s '\x0000' '\x0000')--- LATIN SMALL LETTER J WITH CARON-foldMapping '\x01f0' s = Yield '\x006a' (CC s '\x030c' '\x0000')--- COMBINING GREEK YPOGEGRAMMENI-foldMapping '\x0345' s = Yield '\x03b9' (CC s '\x0000' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS-foldMapping '\x0390' s = Yield '\x03b9' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS-foldMapping '\x03b0' s = Yield '\x03c5' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER FINAL SIGMA-foldMapping '\x03c2' s = Yield '\x03c3' (CC s '\x0000' '\x0000')--- GREEK BETA SYMBOL-foldMapping '\x03d0' s = Yield '\x03b2' (CC s '\x0000' '\x0000')--- GREEK THETA SYMBOL-foldMapping '\x03d1' s = Yield '\x03b8' (CC s '\x0000' '\x0000')--- GREEK PHI SYMBOL-foldMapping '\x03d5' s = Yield '\x03c6' (CC s '\x0000' '\x0000')--- GREEK PI SYMBOL-foldMapping '\x03d6' s = Yield '\x03c0' (CC s '\x0000' '\x0000')--- GREEK KAPPA SYMBOL-foldMapping '\x03f0' s = Yield '\x03ba' (CC s '\x0000' '\x0000')--- GREEK RHO SYMBOL-foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')--- GREEK LUNATE EPSILON SYMBOL-foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')--- ARMENIAN SMALL LIGATURE ECH YIWN-foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')--- GEORGIAN CAPITAL LETTER YN-foldMapping '\x10c7' s = Yield '\x2d27' (CC s '\x0000' '\x0000')--- GEORGIAN CAPITAL LETTER AEN-foldMapping '\x10cd' s = Yield '\x2d2d' (CC s '\x0000' '\x0000')--- LATIN SMALL LETTER H WITH LINE BELOW-foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')--- LATIN SMALL LETTER T WITH DIAERESIS-foldMapping '\x1e97' s = Yield '\x0074' (CC s '\x0308' '\x0000')--- LATIN SMALL LETTER W WITH RING ABOVE-foldMapping '\x1e98' s = Yield '\x0077' (CC s '\x030a' '\x0000')--- LATIN SMALL LETTER Y WITH RING ABOVE-foldMapping '\x1e99' s = Yield '\x0079' (CC s '\x030a' '\x0000')--- LATIN SMALL LETTER A WITH RIGHT HALF RING-foldMapping '\x1e9a' s = Yield '\x0061' (CC s '\x02be' '\x0000')--- LATIN SMALL LETTER LONG S WITH DOT ABOVE-foldMapping '\x1e9b' s = Yield '\x1e61' (CC s '\x0000' '\x0000')--- LATIN CAPITAL LETTER SHARP S-foldMapping '\x1e9e' s = Yield '\x0073' (CC s '\x0073' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PSILI-foldMapping '\x1f50' s = Yield '\x03c5' (CC s '\x0313' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA-foldMapping '\x1f52' s = Yield '\x03c5' (CC s '\x0313' '\x0300')--- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA-foldMapping '\x1f54' s = Yield '\x03c5' (CC s '\x0313' '\x0301')--- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI-foldMapping '\x1f56' s = Yield '\x03c5' (CC s '\x0313' '\x0342')--- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI-foldMapping '\x1f80' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI-foldMapping '\x1f81' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI-foldMapping '\x1f82' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI-foldMapping '\x1f83' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI-foldMapping '\x1f84' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI-foldMapping '\x1f85' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1f86' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1f87' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI-foldMapping '\x1f88' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI-foldMapping '\x1f89' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI-foldMapping '\x1f8a' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI-foldMapping '\x1f8b' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI-foldMapping '\x1f8c' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI-foldMapping '\x1f8d' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI-foldMapping '\x1f8e' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI-foldMapping '\x1f8f' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI-foldMapping '\x1f90' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI-foldMapping '\x1f91' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI-foldMapping '\x1f92' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI-foldMapping '\x1f93' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI-foldMapping '\x1f94' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI-foldMapping '\x1f95' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1f96' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1f97' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI-foldMapping '\x1f98' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI-foldMapping '\x1f99' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI-foldMapping '\x1f9a' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI-foldMapping '\x1f9b' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI-foldMapping '\x1f9c' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI-foldMapping '\x1f9d' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI-foldMapping '\x1f9e' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI-foldMapping '\x1f9f' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI-foldMapping '\x1fa0' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI-foldMapping '\x1fa1' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI-foldMapping '\x1fa2' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI-foldMapping '\x1fa3' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI-foldMapping '\x1fa4' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI-foldMapping '\x1fa5' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1fa6' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1fa7' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI-foldMapping '\x1fa8' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI-foldMapping '\x1fa9' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI-foldMapping '\x1faa' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI-foldMapping '\x1fab' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI-foldMapping '\x1fac' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI-foldMapping '\x1fad' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI-foldMapping '\x1fae' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI-foldMapping '\x1faf' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI-foldMapping '\x1fb2' s = Yield '\x1f70' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI-foldMapping '\x1fb3' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI-foldMapping '\x1fb4' s = Yield '\x03ac' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PERISPOMENI-foldMapping '\x1fb6' s = Yield '\x03b1' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1fb7' s = Yield '\x03b1' (CC s '\x0342' '\x03b9')--- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI-foldMapping '\x1fbc' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')--- GREEK PROSGEGRAMMENI-foldMapping '\x1fbe' s = Yield '\x03b9' (CC s '\x0000' '\x0000')--- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI-foldMapping '\x1fc2' s = Yield '\x1f74' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI-foldMapping '\x1fc3' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI-foldMapping '\x1fc4' s = Yield '\x03ae' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH PERISPOMENI-foldMapping '\x1fc6' s = Yield '\x03b7' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1fc7' s = Yield '\x03b7' (CC s '\x0342' '\x03b9')--- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI-foldMapping '\x1fcc' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA-foldMapping '\x1fd2' s = Yield '\x03b9' (CC s '\x0308' '\x0300')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA-foldMapping '\x1fd3' s = Yield '\x03b9' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER IOTA WITH PERISPOMENI-foldMapping '\x1fd6' s = Yield '\x03b9' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI-foldMapping '\x1fd7' s = Yield '\x03b9' (CC s '\x0308' '\x0342')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA-foldMapping '\x1fe2' s = Yield '\x03c5' (CC s '\x0308' '\x0300')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA-foldMapping '\x1fe3' s = Yield '\x03c5' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER RHO WITH PSILI-foldMapping '\x1fe4' s = Yield '\x03c1' (CC s '\x0313' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PERISPOMENI-foldMapping '\x1fe6' s = Yield '\x03c5' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI-foldMapping '\x1fe7' s = Yield '\x03c5' (CC s '\x0308' '\x0342')--- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI-foldMapping '\x1ff2' s = Yield '\x1f7c' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI-foldMapping '\x1ff3' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI-foldMapping '\x1ff4' s = Yield '\x03ce' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PERISPOMENI-foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')--- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI-foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')--- COPTIC CAPITAL LETTER BOHAIRIC KHEI-foldMapping '\x2cf2' s = Yield '\x2cf3' (CC s '\x0000' '\x0000')--- LATIN CAPITAL LETTER C WITH BAR-foldMapping '\xa792' s = Yield '\xa793' (CC s '\x0000' '\x0000')--- LATIN CAPITAL LETTER H WITH HOOK-foldMapping '\xa7aa' s = Yield '\x0266' (CC s '\x0000' '\x0000')--- LATIN SMALL LIGATURE FF-foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')--- LATIN SMALL LIGATURE FI-foldMapping '\xfb01' s = Yield '\x0066' (CC s '\x0069' '\x0000')--- LATIN SMALL LIGATURE FL-foldMapping '\xfb02' s = Yield '\x0066' (CC s '\x006c' '\x0000')--- LATIN SMALL LIGATURE FFI-foldMapping '\xfb03' s = Yield '\x0066' (CC s '\x0066' '\x0069')--- LATIN SMALL LIGATURE FFL-foldMapping '\xfb04' s = Yield '\x0066' (CC s '\x0066' '\x006c')--- LATIN SMALL LIGATURE LONG S T-foldMapping '\xfb05' s = Yield '\x0073' (CC s '\x0074' '\x0000')--- LATIN SMALL LIGATURE ST-foldMapping '\xfb06' s = Yield '\x0073' (CC s '\x0074' '\x0000')--- ARMENIAN SMALL LIGATURE MEN NOW-foldMapping '\xfb13' s = Yield '\x0574' (CC s '\x0576' '\x0000')--- ARMENIAN SMALL LIGATURE MEN ECH-foldMapping '\xfb14' s = Yield '\x0574' (CC s '\x0565' '\x0000')--- ARMENIAN SMALL LIGATURE MEN INI-foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')--- ARMENIAN SMALL LIGATURE VEW NOW-foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')--- ARMENIAN SMALL LIGATURE MEN XEH-foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')-foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
− Data/Text/Fusion/Common.hs
@@ -1,947 +0,0 @@-{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}--- |--- Module : Data.Text.Fusion.Common--- Copyright : (c) Bryan O'Sullivan 2009, 2012------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : GHC------ Common stream fusion functionality for text.--module Data.Text.Fusion.Common- (- -- * Creation and elimination- singleton- , streamList- , unstreamList- , streamCString#-- -- * Basic interface- , cons- , snoc- , append- , head- , uncons- , last- , tail- , init- , null- , lengthI- , compareLengthI- , isSingleton-- -- * Transformations- , map- , intercalate- , intersperse-- -- ** Case conversion- -- $case- , toCaseFold- , toLower- , toTitle- , toUpper-- -- ** Justification- , justifyLeftI-- -- * Folds- , foldl- , foldl'- , foldl1- , foldl1'- , foldr- , foldr1-- -- ** Special folds- , concat- , concatMap- , any- , all- , maximum- , minimum-- -- * Construction- -- ** Scans- , scanl-- -- ** Accumulating maps- -- , mapAccumL-- -- ** Generation and unfolding- , replicateCharI- , replicateI- , unfoldr- , unfoldrNI-- -- * Substrings- -- ** Breaking strings- , take- , drop- , takeWhile- , dropWhile-- -- * Predicates- , isPrefixOf-- -- * Searching- , elem- , filter-- -- * Indexing- , findBy- , indexI- , findIndexI- , countCharI-- -- * Zipping and unzipping- , zipWith- ) where--import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),- Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),- (&&), fromIntegral, not, otherwise)-import qualified Data.List as L-import qualified Prelude as P-import Data.Bits (shiftL)-import Data.Char (isLetter)-import Data.Int (Int64)-import Data.Text.Fusion.Internal-import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,- upperMapping)-import Data.Text.Fusion.Size-import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)-import GHC.Types (Char(..), Int(..))--singleton :: Char -> Stream Char-singleton c = Stream next False 1- where next False = Yield c True- next True = Done-{-# INLINE singleton #-}--streamList :: [a] -> Stream a-{-# INLINE [0] streamList #-}-streamList s = Stream next s unknownSize- where next [] = Done- next (x:xs) = Yield x xs--unstreamList :: Stream a -> [a]-unstreamList (Stream next s0 _len) = unfold s0- where unfold !s = case next s of- Done -> []- Skip s' -> unfold s'- Yield x s' -> x : unfold s'-{-# INLINE [0] unstreamList #-}--{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}---- | Stream the UTF-8-like packed encoding used by GHC to represent--- constant strings in generated code.------ This encoding uses the byte sequence "\xc0\x80" to represent NUL,--- and the string is NUL-terminated.-streamCString# :: Addr# -> Stream Char-streamCString# addr = Stream step 0 unknownSize- where- step !i- | b == 0 = Done- | b <= 0x7f = Yield (C# b#) (i+1)- | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1- in Yield c (i+2)- | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +- (next 1 `shiftL` 6) +- next 2- in Yield c (i+3)- | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +- (next 1 `shiftL` 12) +- (next 2 `shiftL` 6) +- next 3- in Yield c (i+4)- where b = I# (ord# b#)- next n = I# (ord# (at# (i+n))) - 0x80- !b# = at# i- at# (I# i#) = indexCharOffAddr# addr i#- chr (I# i#) = C# (chr# i#)-{-# INLINE [0] streamCString# #-}---- ------------------------------------------------------------------------------- * Basic stream functions--data C s = C0 !s- | C1 !s---- | /O(n)/ Adds a character to the front of a Stream Char.-cons :: Char -> Stream Char -> Stream Char-cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)- where- next (C1 s) = Yield w (C0 s)- next (C0 s) = case next0 s of- Done -> Done- Skip s' -> Skip (C0 s')- Yield x s' -> Yield x (C0 s')-{-# INLINE [0] cons #-}---- | /O(n)/ Adds a character to the end of a stream.-snoc :: Stream Char -> Char -> Stream Char-snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)- where- next (J xs) = case next0 xs of- Done -> Yield w N- Skip xs' -> Skip (J xs')- Yield x xs' -> Yield x (J xs')- next N = Done-{-# INLINE [0] snoc #-}--data E l r = L !l- | R !r---- | /O(n)/ Appends one Stream to the other.-append :: Stream Char -> Stream Char -> Stream Char-append (Stream next0 s01 len1) (Stream next1 s02 len2) =- Stream next (L s01) (len1 + len2)- where- next (L s1) = case next0 s1 of- Done -> Skip (R s02)- Skip s1' -> Skip (L s1')- Yield x s1' -> Yield x (L s1')- next (R s2) = case next1 s2 of- Done -> Done- Skip s2' -> Skip (R s2')- Yield x s2' -> Yield x (R s2')-{-# INLINE [0] append #-}---- | /O(1)/ Returns the first character of a Text, which must be non-empty.--- Subject to array fusion.-head :: Stream Char -> Char-head (Stream next s0 _len) = loop_head s0- where- loop_head !s = case next s of- Yield x _ -> x- Skip s' -> loop_head s'- Done -> head_empty-{-# INLINE [0] head #-}--head_empty :: a-head_empty = streamError "head" "Empty stream"-{-# NOINLINE head_empty #-}---- | /O(1)/ Returns the first character and remainder of a 'Stream--- Char', or 'Nothing' if empty. Subject to array fusion.-uncons :: Stream Char -> Maybe (Char, Stream Char)-uncons (Stream next s0 len) = loop_uncons s0- where- loop_uncons !s = case next s of- Yield x s1 -> Just (x, Stream next s1 (len-1))- Skip s' -> loop_uncons s'- Done -> Nothing-{-# INLINE [0] uncons #-}---- | /O(n)/ Returns the last character of a 'Stream Char', which must--- be non-empty.-last :: Stream Char -> Char-last (Stream next s0 _len) = loop0_last s0- where- loop0_last !s = case next s of- Done -> emptyError "last"- Skip s' -> loop0_last s'- Yield x s' -> loop_last x s'- loop_last !x !s = case next s of- Done -> x- Skip s' -> loop_last x s'- Yield x' s' -> loop_last x' s'-{-# INLINE[0] last #-}---- | /O(1)/ Returns all characters after the head of a Stream Char, which must--- be non-empty.-tail :: Stream Char -> Stream Char-tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)- where- next (C0 s) = case next0 s of- Done -> emptyError "tail"- Skip s' -> Skip (C0 s')- Yield _ s' -> Skip (C1 s')- next (C1 s) = case next0 s of- Done -> Done- Skip s' -> Skip (C1 s')- Yield x s' -> Yield x (C1 s')-{-# INLINE [0] tail #-}--data Init s = Init0 !s- | Init1 {-# UNPACK #-} !Char !s---- | /O(1)/ Returns all but the last character of a Stream Char, which--- must be non-empty.-init :: Stream Char -> Stream Char-init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)- where- next (Init0 s) = case next0 s of- Done -> emptyError "init"- Skip s' -> Skip (Init0 s')- Yield x s' -> Skip (Init1 x s')- next (Init1 x s) = case next0 s of- Done -> Done- Skip s' -> Skip (Init1 x s')- Yield x' s' -> Yield x (Init1 x' s')-{-# INLINE [0] init #-}---- | /O(1)/ Tests whether a Stream Char is empty or not.-null :: Stream Char -> Bool-null (Stream next s0 _len) = loop_null s0- where- loop_null !s = case next s of- Done -> True- Yield _ _ -> False- Skip s' -> loop_null s'-{-# INLINE[0] null #-}---- | /O(n)/ Returns the number of characters in a string.-lengthI :: Integral a => Stream Char -> a-lengthI (Stream next s0 _len) = loop_length 0 s0- where- loop_length !z s = case next s of- Done -> z- Skip s' -> loop_length z s'- Yield _ s' -> loop_length (z + 1) s'-{-# INLINE[0] lengthI #-}---- | /O(n)/ Compares the count of characters in a string to a number.--- Subject to fusion.------ This function gives the same answer as comparing against the result--- of 'lengthI', but can short circuit if the count of characters is--- greater than the number, and hence be more efficient.-compareLengthI :: Integral a => Stream Char -> a -> Ordering-compareLengthI (Stream next s0 len) n =- case exactly len of- Nothing -> loop_cmp 0 s0- Just i -> compare (fromIntegral i) n- where- loop_cmp !z s = case next s of- Done -> compare z n- Skip s' -> loop_cmp z s'- Yield _ s' | z > n -> GT- | otherwise -> loop_cmp (z + 1) s'-{-# INLINE[0] compareLengthI #-}---- | /O(n)/ Indicate whether a string contains exactly one element.-isSingleton :: Stream Char -> Bool-isSingleton (Stream next s0 _len) = loop 0 s0- where- loop !z s = case next s of- Done -> z == (1::Int)- Skip s' -> loop z s'- Yield _ s'- | z >= 1 -> False- | otherwise -> loop (z+1) s'-{-# INLINE[0] isSingleton #-}---- ------------------------------------------------------------------------------- * Stream transformations---- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@--- to each element of @xs@.-map :: (Char -> Char) -> Stream Char -> Stream Char-map f (Stream next0 s0 len) = Stream next s0 len- where- next !s = case next0 s of- Done -> Done- Skip s' -> Skip s'- Yield x s' -> Yield (f x) s'-{-# INLINE [0] map #-}--{-#- RULES "STREAM map/map fusion" forall f g s.- map f (map g s) = map (\x -> f (g x)) s- #-}--data I s = I1 !s- | I2 !s {-# UNPACK #-} !Char- | I3 !s---- | /O(n)/ Take a character and place it between each of the--- characters of a 'Stream Char'.-intersperse :: Char -> Stream Char -> Stream Char-intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len- where- next (I1 s) = case next0 s of- Done -> Done- Skip s' -> Skip (I1 s')- Yield x s' -> Skip (I2 s' x)- next (I2 s x) = Yield x (I3 s)- next (I3 s) = case next0 s of- Done -> Done- Skip s' -> Skip (I3 s')- Yield x s' -> Yield c (I2 s' x)-{-# INLINE [0] intersperse #-}---- ------------------------------------------------------------------------------- ** Case conversions (folds)---- $case------ With Unicode text, it is incorrect to use combinators like @map--- toUpper@ to case convert each character of a string individually.--- Instead, use the whole-string case conversion functions from this--- module. For correctness in different writing systems, these--- functions may map one input character to two or three output--- characters.--caseConvert :: (forall s. Char -> s -> Step (CC s) Char)- -> Stream Char -> Stream Char-caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len- where- next (CC s '\0' _) =- case next0 s of- Done -> Done- Skip s' -> Skip (CC s' '\0' '\0')- Yield c s' -> remap c s'- next (CC s a b) = Yield a (CC s b '\0')---- | /O(n)/ Convert a string to folded case. This function is mainly--- useful for performing caseless (or case insensitive) string--- comparisons.------ A string @x@ is a caseless match for a string @y@ if and only if:------ @toCaseFold x == toCaseFold y@------ The result string may be longer than the input string, and may--- differ from applying 'toLower' to the input string. For instance,--- the Armenian small ligature men now (U+FB13) is case folded to the--- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is--- case folded to the Greek small letter letter mu (U+03BC) instead of--- itself.-toCaseFold :: Stream Char -> Stream Char-toCaseFold = caseConvert foldMapping-{-# INLINE [0] toCaseFold #-}---- | /O(n)/ Convert a string to upper case, using simple case--- conversion. The result string may be longer than the input string.--- For instance, the German eszett (U+00DF) maps to the two-letter--- sequence SS.-toUpper :: Stream Char -> Stream Char-toUpper = caseConvert upperMapping-{-# INLINE [0] toUpper #-}---- | /O(n)/ Convert a string to lower case, using simple case--- conversion. The result string may be longer than the input string.--- For instance, the Latin capital letter I with dot above (U+0130)--- maps to the sequence Latin small letter i (U+0069) followed by--- combining dot above (U+0307).-toLower :: Stream Char -> Stream Char-toLower = caseConvert lowerMapping-{-# INLINE [0] toLower #-}---- | /O(n)/ Convert a string to title case, using simple case--- conversion.------ The first letter of the input is converted to title case, as is--- every subsequent letter that immediately follows a non-letter.--- Every letter that immediately follows another letter is converted--- to lower case.------ The result string may be longer than the input string. For example,--- the Latin small ligature fl (U+FB02) is converted to the--- sequence Latin capital letter F (U+0046) followed by Latin small--- letter l (U+006C).------ /Note/: this function does not take language or culture specific--- rules into account. For instance, in English, different style--- guides disagree on whether the book name \"The Hill of the Red--- Fox\" is correctly title cased—but this function will--- capitalize /every/ word.-toTitle :: Stream Char -> Stream Char-toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len- where- next (CC (letter :*: s) '\0' _) =- case next0 s of- Done -> Done- Skip s' -> Skip (CC (letter :*: s') '\0' '\0')- Yield c s'- | letter' -> if letter- then lowerMapping c (letter' :*: s')- else titleMapping c (letter' :*: s')- | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')- where letter' = isLetter c- next (CC s a b) = Yield a (CC s b '\0')-{-# INLINE [0] toTitle #-}--justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char-justifyLeftI k c (Stream next0 s0 len) =- Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)- where- next (s :*: S1 :*: n) =- case next0 s of- Done -> next (s :*: S2 :*: n)- Skip s' -> Skip (s' :*: S1 :*: n)- Yield x s' -> Yield x (s' :*: S1 :*: n+1)- next (s :*: S2 :*: n)- | n < k = Yield c (s :*: S2 :*: n+1)- | otherwise = Done- {-# INLINE next #-}-{-# INLINE [0] justifyLeftI #-}---- ------------------------------------------------------------------------------- * Reducing Streams (folds)---- | foldl, applied to a binary operator, a starting value (typically the--- left-identity of the operator), and a Stream, reduces the Stream using the--- binary operator, from left to right.-foldl :: (b -> Char -> b) -> b -> Stream Char -> b-foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0- where- loop_foldl z !s = case next s of- Done -> z- Skip s' -> loop_foldl z s'- Yield x s' -> loop_foldl (f z x) s'-{-# INLINE [0] foldl #-}---- | A strict version of foldl.-foldl' :: (b -> Char -> b) -> b -> Stream Char -> b-foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0- where- loop_foldl' !z !s = case next s of- Done -> z- Skip s' -> loop_foldl' z s'- Yield x s' -> loop_foldl' (f z x) s'-{-# INLINE [0] foldl' #-}---- | foldl1 is a variant of foldl that has no starting value argument,--- and thus must be applied to non-empty Streams.-foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char-foldl1 f (Stream next s0 _len) = loop0_foldl1 s0- where- loop0_foldl1 !s = case next s of- Skip s' -> loop0_foldl1 s'- Yield x s' -> loop_foldl1 x s'- Done -> emptyError "foldl1"- loop_foldl1 z !s = case next s of- Done -> z- Skip s' -> loop_foldl1 z s'- Yield x s' -> loop_foldl1 (f z x) s'-{-# INLINE [0] foldl1 #-}---- | A strict version of foldl1.-foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char-foldl1' f (Stream next s0 _len) = loop0_foldl1' s0- where- loop0_foldl1' !s = case next s of- Skip s' -> loop0_foldl1' s'- Yield x s' -> loop_foldl1' x s'- Done -> emptyError "foldl1"- loop_foldl1' !z !s = case next s of- Done -> z- Skip s' -> loop_foldl1' z s'- Yield x s' -> loop_foldl1' (f z x) s'-{-# INLINE [0] foldl1' #-}---- | 'foldr', applied to a binary operator, a starting value (typically the--- right-identity of the operator), and a stream, reduces the stream using the--- binary operator, from right to left.-foldr :: (Char -> b -> b) -> b -> Stream Char -> b-foldr f z (Stream next s0 _len) = loop_foldr s0- where- loop_foldr !s = case next s of- Done -> z- Skip s' -> loop_foldr s'- Yield x s' -> f x (loop_foldr s')-{-# INLINE [0] foldr #-}---- | foldr1 is a variant of 'foldr' that has no starting value argument,--- and thus must be applied to non-empty streams.--- Subject to array fusion.-foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char-foldr1 f (Stream next s0 _len) = loop0_foldr1 s0- where- loop0_foldr1 !s = case next s of- Done -> emptyError "foldr1"- Skip s' -> loop0_foldr1 s'- Yield x s' -> loop_foldr1 x s'-- loop_foldr1 x !s = case next s of- Done -> x- Skip s' -> loop_foldr1 x s'- Yield x' s' -> f x (loop_foldr1 x' s')-{-# INLINE [0] foldr1 #-}--intercalate :: Stream Char -> [Stream Char] -> Stream Char-intercalate s = concat . (L.intersperse s)-{-# INLINE [0] intercalate #-}---- ------------------------------------------------------------------------------- ** Special folds---- | /O(n)/ Concatenate a list of streams. Subject to array fusion.-concat :: [Stream Char] -> Stream Char-concat = L.foldr append empty-{-# INLINE [0] concat #-}---- | Map a function over a stream that results in a stream and concatenate the--- results.-concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char-concatMap f = foldr (append . f) empty-{-# INLINE [0] concatMap #-}---- | /O(n)/ any @p @xs determines if any character in the stream--- @xs@ satisifes the predicate @p@.-any :: (Char -> Bool) -> Stream Char -> Bool-any p (Stream next0 s0 _len) = loop_any s0- where- loop_any !s = case next0 s of- Done -> False- Skip s' -> loop_any s'- Yield x s' | p x -> True- | otherwise -> loop_any s'-{-# INLINE [0] any #-}---- | /O(n)/ all @p @xs determines if all characters in the 'Text'--- @xs@ satisify the predicate @p@.-all :: (Char -> Bool) -> Stream Char -> Bool-all p (Stream next0 s0 _len) = loop_all s0- where- loop_all !s = case next0 s of- Done -> True- Skip s' -> loop_all s'- Yield x s' | p x -> loop_all s'- | otherwise -> False-{-# INLINE [0] all #-}---- | /O(n)/ maximum returns the maximum value from a stream, which must be--- non-empty.-maximum :: Stream Char -> Char-maximum (Stream next0 s0 _len) = loop0_maximum s0- where- loop0_maximum !s = case next0 s of- Done -> emptyError "maximum"- Skip s' -> loop0_maximum s'- Yield x s' -> loop_maximum x s'- loop_maximum !z !s = case next0 s of- Done -> z- Skip s' -> loop_maximum z s'- Yield x s'- | x > z -> loop_maximum x s'- | otherwise -> loop_maximum z s'-{-# INLINE [0] maximum #-}---- | /O(n)/ minimum returns the minimum value from a 'Text', which must be--- non-empty.-minimum :: Stream Char -> Char-minimum (Stream next0 s0 _len) = loop0_minimum s0- where- loop0_minimum !s = case next0 s of- Done -> emptyError "minimum"- Skip s' -> loop0_minimum s'- Yield x s' -> loop_minimum x s'- loop_minimum !z !s = case next0 s of- Done -> z- Skip s' -> loop_minimum z s'- Yield x s'- | x < z -> loop_minimum x s'- | otherwise -> loop_minimum z s'-{-# INLINE [0] minimum #-}---- -------------------------------------------------------------------------------- * Building streams--scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char-scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low- where- {-# INLINE next #-}- next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)- next (S2 :*: z :*: s) = case next0 s of- Yield x s' -> let !x' = f z x- in Yield x' (S2 :*: x' :*: s')- Skip s' -> Skip (S2 :*: z :*: s')- Done -> Done-{-# INLINE [0] scanl #-}---- -------------------------------------------------------------------------------- ** Accumulating maps--{---- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a--- function to each element of a stream, passing an accumulating--- parameter from left to right, and returns a final stream.------ /Note/: Unlike the version over lists, this function does not--- return a final value for the accumulator, because the nature of--- streams precludes it.-mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b-mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f- where- {-# INLINE next #-}- next (s :*: z) = case next0 s of- Yield x s' -> let (z',y) = f z x- in Yield y (s' :*: z')- Skip s' -> Skip (s' :*: z)- Done -> Done-{-# INLINE [0] mapAccumL #-}--}---- -------------------------------------------------------------------------------- ** Generating and unfolding streams--replicateCharI :: Integral a => a -> Char -> Stream Char-replicateCharI n c- | n < 0 = empty- | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low- where- next i | i >= n = Done- | otherwise = Yield c (i + 1)-{-# INLINE [0] replicateCharI #-}--data RI s = RI !s {-# UNPACK #-} !Int64--replicateI :: Int64 -> Stream Char -> Stream Char-replicateI n (Stream next0 s0 len) =- Stream next (RI s0 0) (fromIntegral (max 0 n) * len)- where- next (RI s k)- | k >= n = Done- | otherwise = case next0 s of- Done -> Skip (RI s0 (k+1))- Skip s' -> Skip (RI s' k)- Yield x s' -> Yield x (RI s' k)-{-# INLINE [0] replicateI #-}---- | /O(n)/, where @n@ is the length of the result. The unfoldr function--- is analogous to the List 'unfoldr'. unfoldr builds a stream--- from a seed value. The function takes the element and returns--- Nothing if it is done producing the stream or returns Just--- (a,b), in which case, a is the next Char in the string, and b is--- the seed value for further production.-unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char-unfoldr f s0 = Stream next s0 1 -- HINT maybe too low- where- {-# INLINE next #-}- next !s = case f s of- Nothing -> Done- Just (w, s') -> Yield w s'-{-# INLINE [0] unfoldr #-}---- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed--- value. However, the length of the result is limited by the--- first argument to 'unfoldrNI'. This function is more efficient than--- 'unfoldr' when the length of the result is known.-unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char-unfoldrNI n f s0 | n < 0 = empty- | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high- where- {-# INLINE next #-}- next (z :*: s) = case f s of- Nothing -> Done- Just (w, s') | z >= n -> Done- | otherwise -> Yield w ((z + 1) :*: s')-{-# INLINE unfoldrNI #-}------------------------------------------------------------------------------------ * Substreams---- | /O(n)/ take n, applied to a stream, returns the prefix of the--- stream of length @n@, or the stream itself if @n@ is greater than the--- length of the stream.-take :: Integral a => a -> Stream Char -> Stream Char-take n0 (Stream next0 s0 len) =- Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))- where- {-# INLINE next #-}- next (n :*: s) | n <= 0 = Done- | otherwise = case next0 s of- Done -> Done- Skip s' -> Skip (n :*: s')- Yield x s' -> Yield x ((n-1) :*: s')-{-# INLINE [0] take #-}---- | /O(n)/ drop n, applied to a stream, returns the suffix of the--- stream after the first @n@ characters, or the empty stream if @n@--- is greater than the length of the stream.-drop :: Integral a => a -> Stream Char -> Stream Char-drop n0 (Stream next0 s0 len) =- Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))- where- {-# INLINE next #-}- next (J n :*: s)- | n <= 0 = Skip (N :*: s)- | otherwise = case next0 s of- Done -> Done- Skip s' -> Skip (J n :*: s')- Yield _ s' -> Skip (J (n-1) :*: s')- next (N :*: s) = case next0 s of- Done -> Done- Skip s' -> Skip (N :*: s')- Yield x s' -> Yield x (N :*: s')-{-# INLINE [0] drop #-}---- | takeWhile, applied to a predicate @p@ and a stream, returns the--- longest prefix (possibly empty) of elements that satisfy p.-takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char-takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high- where- {-# INLINE next #-}- next !s = case next0 s of- Done -> Done- Skip s' -> Skip s'- Yield x s' | p x -> Yield x s'- | otherwise -> Done-{-# INLINE [0] takeWhile #-}---- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.-dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char-dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high- where- {-# INLINE next #-}- next (S1 :*: s) = case next0 s of- Done -> Done- Skip s' -> Skip (S1 :*: s')- Yield x s' | p x -> Skip (S1 :*: s')- | otherwise -> Yield x (S2 :*: s')- next (S2 :*: s) = case next0 s of- Done -> Done- Skip s' -> Skip (S2 :*: s')- Yield x s' -> Yield x (S2 :*: s')-{-# INLINE [0] dropWhile #-}---- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns--- 'True' iff the first is a prefix of the second.-isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool-isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)- where- loop Done _ = True- loop _ Done = False- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')- loop (Skip s1') x2 = loop (next1 s1') x2- loop x1 (Skip s2') = loop x1 (next2 s2')- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&- loop (next1 s1') (next2 s2')-{-# INLINE [0] isPrefixOf #-}---- ------------------------------------------------------------------------------- * Searching------------------------------------------------------------------------------------ ** Searching by equality---- | /O(n)/ elem is the stream membership predicate.-elem :: Char -> Stream Char -> Bool-elem w (Stream next s0 _len) = loop_elem s0- where- loop_elem !s = case next s of- Done -> False- Skip s' -> loop_elem s'- Yield x s' | x == w -> True- | otherwise -> loop_elem s'-{-# INLINE [0] elem #-}------------------------------------------------------------------------------------ ** Searching with a predicate---- | /O(n)/ The 'findBy' function takes a predicate and a stream,--- and returns the first element in matching the predicate, or 'Nothing'--- if there is no such element.--findBy :: (Char -> Bool) -> Stream Char -> Maybe Char-findBy p (Stream next s0 _len) = loop_find s0- where- loop_find !s = case next s of- Done -> Nothing- Skip s' -> loop_find s'- Yield x s' | p x -> Just x- | otherwise -> loop_find s'-{-# INLINE [0] findBy #-}---- | /O(n)/ Stream index (subscript) operator, starting from 0.-indexI :: Integral a => Stream Char -> a -> Char-indexI (Stream next s0 _len) n0- | n0 < 0 = streamError "index" "Negative index"- | otherwise = loop_index n0 s0- where- loop_index !n !s = case next s of- Done -> streamError "index" "Index too large"- Skip s' -> loop_index n s'- Yield x s' | n == 0 -> x- | otherwise -> loop_index (n-1) s'-{-# INLINE [0] indexI #-}---- | /O(n)/ 'filter', applied to a predicate and a stream,--- returns a stream containing those characters that satisfy the--- predicate.-filter :: (Char -> Bool) -> Stream Char -> Stream Char-filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high- where- next !s = case next0 s of- Done -> Done- Skip s' -> Skip s'- Yield x s' | p x -> Yield x s'- | otherwise -> Skip s'-{-# INLINE [0] filter #-}--{-# RULES- "STREAM filter/filter fusion" forall p q s.- filter p (filter q s) = filter (\x -> q x && p x) s- #-}---- | The 'findIndexI' function takes a predicate and a stream and--- returns the index of the first element in the stream satisfying the--- predicate.-findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a-findIndexI p s = case findIndicesI p s of- (i:_) -> Just i- _ -> Nothing-{-# INLINE [0] findIndexI #-}---- | The 'findIndicesI' function takes a predicate and a stream and--- returns all indices of the elements in the stream satisfying the--- predicate.-findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]-findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0- where- loop_findIndex !i !s = case next s of- Done -> []- Skip s' -> loop_findIndex i s' -- hmm. not caught by QC- Yield x s' | p x -> i : loop_findIndex (i+1) s'- | otherwise -> loop_findIndex (i+1) s'-{-# INLINE [0] findIndicesI #-}------------------------------------------------------------------------------------ * Zipping---- | zipWith generalises 'zip' by zipping with the function given as--- the first argument, instead of a tupling function.-zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b-zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =- Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)- where- next (sa :*: sb :*: N) = case next0 sa of- Done -> Done- Skip sa' -> Skip (sa' :*: sb :*: N)- Yield a sa' -> Skip (sa' :*: sb :*: J a)-- next (sa' :*: sb :*: J a) = case next1 sb of- Done -> Done- Skip sb' -> Skip (sa' :*: sb' :*: J a)- Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)-{-# INLINE [0] zipWith #-}---- | /O(n)/ The 'countCharI' function returns the number of times the--- query element appears in the given stream.-countCharI :: Integral a => Char -> Stream Char -> a-countCharI a (Stream next s0 _len) = loop 0 s0- where- loop !i !s = case next s of- Done -> i- Skip s' -> loop i s'- Yield x s' | a == x -> loop (i+1) s'- | otherwise -> loop i s'-{-# INLINE [0] countCharI #-}--streamError :: String -> String -> a-streamError func msg = P.error $ "Data.Text.Fusion.Common." ++ func ++ ": " ++ msg--emptyError :: String -> a-emptyError func = internalError func "Empty input"--internalError :: String -> a-internalError func = streamError func "Internal error"
− Data/Text/Fusion/Internal.hs
@@ -1,124 +0,0 @@-{-# LANGUAGE BangPatterns, ExistentialQuantification #-}--- |--- Module : Data.Text.Fusion.Internal--- Copyright : (c) Tom Harper 2008-2009,--- (c) Bryan O'Sullivan 2009,--- (c) Duncan Coutts 2009,--- (c) Jasper Van der Jeugt 2011------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : GHC------ Core stream fusion functionality for text.--module Data.Text.Fusion.Internal- (- CC(..)- , M(..)- , M8- , PairS(..)- , RS(..)- , Step(..)- , Stream(..)- , Switch(..)- , empty- ) where--import Data.Text.Fusion.Size-import Data.Word (Word8)---- | Specialised tuple for case conversion.-data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char---- | Specialised, strict Maybe-like type.-data M a = N- | J !a--type M8 = M Word8---- Restreaming state.-data RS s- = RS0 !s- | RS1 !s {-# UNPACK #-} !Word8- | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8- | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8--infixl 2 :*:-data PairS a b = !a :*: !b- -- deriving (Eq, Ord, Show)---- | Allow a function over a stream to switch between two states.-data Switch = S1 | S2--data Step s a = Done- | Skip !s- | Yield !a !s--{--instance (Show a) => Show (Step s a)- where show Done = "Done"- show (Skip _) = "Skip"- show (Yield x _) = "Yield " ++ show x--}--instance (Eq a) => Eq (Stream a) where- (==) = eq--instance (Ord a) => Ord (Stream a) where- compare = cmp---- The length hint in a Stream has two roles. If its value is zero,--- we trust it, and treat the stream as empty. Otherwise, we treat it--- as a hint: it should usually be accurate, so we use it when--- unstreaming to decide what size array to allocate. However, the--- unstreaming functions must be able to cope with the hint being too--- small or too large.------ The size hint tries to track the UTF-16 code points in a stream,--- but often counts the number of characters instead. It can easily--- undercount if, for instance, a transformed stream contains astral--- plane characters (those above 0x10000).--data Stream a =- forall s. Stream- (s -> Step s a) -- stepper function- !s -- current state- !Size -- size hint---- | /O(n)/ Determines if two streams are equal.-eq :: (Eq a) => Stream a -> Stream a -> Bool-eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)- where- loop Done Done = True- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')- loop (Skip s1') x2 = loop (next1 s1') x2- loop x1 (Skip s2') = loop x1 (next2 s2')- loop Done _ = False- loop _ Done = False- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&- loop (next1 s1') (next2 s2')-{-# INLINE [0] eq #-}--cmp :: (Ord a) => Stream a -> Stream a -> Ordering-cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)- where- loop Done Done = EQ- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')- loop (Skip s1') x2 = loop (next1 s1') x2- loop x1 (Skip s2') = loop x1 (next2 s2')- loop Done _ = LT- loop _ Done = GT- loop (Yield x1 s1') (Yield x2 s2') =- case compare x1 x2 of- EQ -> loop (next1 s1') (next2 s2')- other -> other-{-# INLINE [0] cmp #-}---- | The empty stream.-empty :: Stream a-empty = Stream next () 0- where next _ = Done-{-# INLINE [0] empty #-}
− Data/Text/Fusion/Size.hs
@@ -1,146 +0,0 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-missing-methods #-}--- |--- Module : Data.Text.Fusion.Internal--- Copyright : (c) Roman Leshchinskiy 2008,--- (c) Bryan O'Sullivan 2009------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : portable------ Size hints.--module Data.Text.Fusion.Size- (- Size- , exactly- , exactSize- , maxSize- , unknownSize- , smaller- , larger- , upperBound- , isEmpty- ) where--#if defined(ASSERTS)-import Control.Exception (assert)-#endif--data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.- | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.- | Unknown -- ^ Unknown size.- deriving (Eq, Show)--exactly :: Size -> Maybe Int-exactly (Exact n) = Just n-exactly _ = Nothing-{-# INLINE exactly #-}--exactSize :: Int -> Size-exactSize n =-#if defined(ASSERTS)- assert (n >= 0)-#endif- Exact n-{-# INLINE exactSize #-}--maxSize :: Int -> Size-maxSize n =-#if defined(ASSERTS)- assert (n >= 0)-#endif- Max n-{-# INLINE maxSize #-}--unknownSize :: Size-unknownSize = Unknown-{-# INLINE unknownSize #-}--instance Num Size where- (+) = addSize- (-) = subtractSize- (*) = mulSize-- fromInteger = f where f = Exact . fromInteger- {-# INLINE f #-}--add :: Int -> Int -> Int-add m n | mn >= 0 = mn- | otherwise = overflowError- where mn = m + n-{-# INLINE add #-}--addSize :: Size -> Size -> Size-addSize (Exact m) (Exact n) = Exact (add m n)-addSize (Exact m) (Max n) = Max (add m n)-addSize (Max m) (Exact n) = Max (add m n)-addSize (Max m) (Max n) = Max (add m n)-addSize _ _ = Unknown-{-# INLINE addSize #-}--subtractSize :: Size -> Size -> Size-subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)-subtractSize (Exact m) (Max _) = Max m-subtractSize (Max m) (Exact n) = Max (max (m-n) 0)-subtractSize a@(Max _) (Max _) = a-subtractSize a@(Max _) Unknown = a-subtractSize _ _ = Unknown-{-# INLINE subtractSize #-}--mul :: Int -> Int -> Int-mul m n- | m <= maxBound `quot` n = m * n- | otherwise = overflowError-{-# INLINE mul #-}--mulSize :: Size -> Size -> Size-mulSize (Exact m) (Exact n) = Exact (mul m n)-mulSize (Exact m) (Max n) = Max (mul m n)-mulSize (Max m) (Exact n) = Max (mul m n)-mulSize (Max m) (Max n) = Max (mul m n)-mulSize _ _ = Unknown-{-# INLINE mulSize #-}---- | Minimum of two size hints.-smaller :: Size -> Size -> Size-smaller (Exact m) (Exact n) = Exact (m `min` n)-smaller (Exact m) (Max n) = Max (m `min` n)-smaller (Exact m) Unknown = Max m-smaller (Max m) (Exact n) = Max (m `min` n)-smaller (Max m) (Max n) = Max (m `min` n)-smaller a@(Max _) Unknown = a-smaller Unknown (Exact n) = Max n-smaller Unknown (Max n) = Max n-smaller Unknown Unknown = Unknown-{-# INLINE smaller #-}---- | Maximum of two size hints.-larger :: Size -> Size -> Size-larger (Exact m) (Exact n) = Exact (m `max` n)-larger a@(Exact m) b@(Max n) | m >= n = a- | otherwise = b-larger a@(Max m) b@(Exact n) | n >= m = b- | otherwise = a-larger (Max m) (Max n) = Max (m `max` n)-larger _ _ = Unknown-{-# INLINE larger #-}---- | Compute the maximum size from a size hint, if possible.-upperBound :: Int -> Size -> Int-upperBound _ (Exact n) = n-upperBound _ (Max n) = n-upperBound k _ = k-{-# INLINE upperBound #-}--isEmpty :: Size -> Bool-isEmpty (Exact n) = n <= 0-isEmpty (Max n) = n <= 0-isEmpty _ = False-{-# INLINE isEmpty #-}--overflowError :: Int-overflowError = error "Data.Text.Fusion.Size: size overflow"
Data/Text/IO.hs view
@@ -50,9 +50,9 @@ import Control.Monad (liftM2, when) import Data.IORef (readIORef, writeIORef) import qualified Data.Text as T-import Data.Text.Fusion (stream)-import Data.Text.Fusion.Internal (Step(..), Stream(..))-import Data.Text.IO.Internal (hGetLineWith, readChunk)+import Data.Text.Internal.Fusion (stream)+import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))+import Data.Text.Internal.IO (hGetLineWith, readChunk) import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer, RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer, writeCharBuf)
− Data/Text/IO/Internal.hs
@@ -1,162 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}--- |--- Module : Data.Text.IO.Internal--- Copyright : (c) 2009, 2010 Bryan O'Sullivan,--- (c) 2009 Simon Marlow--- License : BSD-style--- Maintainer : bos@serpentine.com--- Stability : experimental--- Portability : GHC------ Low-level support for text I\/O.--module Data.Text.IO.Internal- (- hGetLineWith- , readChunk- ) where--import qualified Control.Exception as E-import Data.IORef (readIORef, writeIORef)-import Data.Text (Text)-import Data.Text.Fusion (unstream)-import Data.Text.Fusion.Internal (Step(..), Stream(..))-import Data.Text.Fusion.Size (exactSize, maxSize)-import Data.Text.Unsafe (inlinePerformIO)-import Foreign.Storable (peekElemOff)-import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,- bufferElems, charSize, isEmptyBuffer, readCharBuf,- withRawBuffer, writeCharBuf)-import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_)-import GHC.IO.Handle.Types (Handle__(..), Newline(..))-import System.IO (Handle)-import System.IO.Error (isEOFError)-import qualified Data.Text as T---- | Read a single line of input from a handle, constructing a list of--- decoded chunks as we go. When we're done, transform them into the--- destination type.-hGetLineWith :: ([Text] -> t) -> Handle -> IO t-hGetLineWith f h = wantReadableHandle_ "hGetLine" h go- where- go hh@Handle__{..} = readIORef haCharBuffer >>= fmap f . hGetLineLoop hh []--hGetLineLoop :: Handle__ -> [Text] -> CharBuffer -> IO [Text]-hGetLineLoop hh@Handle__{..} = go where- go ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do- let findEOL raw r | r == w = return (False, w)- | otherwise = do- (c,r') <- readCharBuf raw r- if c == '\n'- then return (True, r)- else findEOL raw r'- (eol, off) <- findEOL raw0 r0- (t,r') <- if haInputNL == CRLF- then unpack_nl raw0 r0 off- else do t <- unpack raw0 r0 off- return (t,off)- if eol- then do writeIORef haCharBuffer (bufferAdjustL (off+1) buf)- return $ reverse (t:ts)- else do- let buf1 = bufferAdjustL r' buf- maybe_buf <- maybeFillReadBuffer hh buf1- case maybe_buf of- -- Nothing indicates we caught an EOF, and we may have a- -- partial line to return.- Nothing -> do- -- we reached EOF. There might be a lone \r left- -- in the buffer, so check for that and- -- append it to the line if necessary.- let pre | isEmptyBuffer buf1 = T.empty- | otherwise = T.singleton '\r'- writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }- let str = reverse . filter (not . T.null) $ pre:t:ts- if null str- then ioe_EOF- else return str- Just new_buf -> go (t:ts) new_buf---- This function is lifted almost verbatim from GHC.IO.Handle.Text.-maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)-maybeFillReadBuffer handle_ buf- = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->- if isEOFError e- then return Nothing- else ioError e--unpack :: RawCharBuffer -> Int -> Int -> IO Text-unpack !buf !r !w- | charSize /= 4 = sizeError "unpack"- | r >= w = return T.empty- | otherwise = withRawBuffer buf go- where- go pbuf = return $! unstream (Stream next r (exactSize (w-r)))- where- next !i | i >= w = Done- | otherwise = Yield (ix i) (i+1)- ix i = inlinePerformIO $ peekElemOff pbuf i--unpack_nl :: RawCharBuffer -> Int -> Int -> IO (Text, Int)-unpack_nl !buf !r !w- | charSize /= 4 = sizeError "unpack_nl"- | r >= w = return (T.empty, 0)- | otherwise = withRawBuffer buf $ go- where- go pbuf = do- let !t = unstream (Stream next r (maxSize (w-r)))- w' = w - 1- return $ if ix w' == '\r'- then (t,w')- else (t,w)- where- next !i | i >= w = Done- | c == '\r' = let i' = i + 1- in if i' < w- then if ix i' == '\n'- then Yield '\n' (i+2)- else Yield '\n' i'- else Done- | otherwise = Yield c (i+1)- where c = ix i- ix i = inlinePerformIO $ peekElemOff pbuf i---- This function is completely lifted from GHC.IO.Handle.Text.-getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer-getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =- case bufferElems buf of- -- buffer empty: read some more- 0 -> {-# SCC "readTextDevice" #-} readTextDevice handle_ buf-- -- if the buffer has a single '\r' in it and we're doing newline- -- translation: read some more- 1 | haInputNL == CRLF -> do- (c,_) <- readCharBuf bufRaw bufL- if c == '\r'- then do -- shuffle the '\r' to the beginning. This is only safe- -- if we're about to call readTextDevice, otherwise it- -- would mess up flushCharBuffer.- -- See [note Buffer Flushing], GHC.IO.Handle.Types- _ <- writeCharBuf bufRaw 0 '\r'- let buf' = buf{ bufL=0, bufR=1 }- readTextDevice handle_ buf'- else do- return buf-- -- buffer has some chars in it already: just return it- _otherwise -> {-# SCC "otherwise" #-} return buf---- | Read a single chunk of strict text from a buffer. Used by both--- the strict and lazy implementations of hGetContents.-readChunk :: Handle__ -> CharBuffer -> IO Text-readChunk hh@Handle__{..} buf = do- buf'@Buffer{..} <- getSomeCharacters hh buf- (t,r) <- if haInputNL == CRLF- then unpack_nl bufRaw bufL bufR- else do t <- unpack bufRaw bufL bufR- return (t,bufR)- writeIORef haCharBuffer (bufferAdjustL r buf')- return t--sizeError :: String -> a-sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"
Data/Text/Internal.hs view
@@ -7,8 +7,7 @@ -- (c) 2009 Duncan Coutts -- -- License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org+-- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : GHC --@@ -43,7 +42,7 @@ #endif import Data.Bits ((.&.)) import qualified Data.Text.Array as A-import Data.Text.UnsafeChar (ord)+import Data.Text.Internal.Unsafe.Char (ord) import Data.Typeable (Typeable) -- | A space efficient, packed, unboxed Unicode text type.
+ Data/Text/Internal/Builder.hs view
@@ -0,0 +1,325 @@+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Text.Internal.Builder+-- Copyright : (c) 2013 Bryan O'Sullivan+-- (c) 2010 Johan Tibell+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Johan Tibell <johan.tibell@gmail.com>+-- Stability : experimental+-- Portability : portable to Hugs and GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Efficient construction of lazy @Text@ values. The principal+-- operations on a @Builder@ are @singleton@, @fromText@, and+-- @fromLazyText@, which construct new builders, and 'mappend', which+-- concatenates two builders.+--+-- To get maximum performance when building lazy @Text@ values using a+-- builder, associate @mappend@ calls to the right. For example,+-- prefer+--+-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')+--+-- to+--+-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'+--+-- as the latter associates @mappend@ to the left.+--+-----------------------------------------------------------------------------++module Data.Text.Internal.Builder+ ( -- * Public API+ -- ** The Builder type+ Builder+ , toLazyText+ , toLazyTextWith++ -- ** Constructing Builders+ , singleton+ , fromText+ , fromLazyText+ , fromString++ -- ** Flushing the buffer state+ , flush++ -- * Internal functions+ , append'+ , ensureFree+ , writeN+ ) where++import Control.Monad.ST (ST, runST)+import Data.Bits ((.&.))+import Data.Monoid (Monoid(..))+import Data.Text.Internal (Text(..))+import Data.Text.Internal.Lazy (smallChunkSize)+import Data.Text.Unsafe (inlineInterleaveST)+import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)+import Data.Text.Internal.Unsafe.Shift (shiftR)+import Prelude hiding (map, putChar)++import qualified Data.String as String+import qualified Data.Text as S+import qualified Data.Text.Array as A+import qualified Data.Text.Lazy as L++------------------------------------------------------------------------++-- | A @Builder@ is an efficient way to build lazy @Text@ values.+-- There are several functions for constructing builders, but only one+-- to inspect them: to extract any data, you have to turn them into+-- lazy @Text@ values using @toLazyText@.+--+-- Internally, a builder constructs a lazy @Text@ by filling arrays+-- piece by piece. As each buffer is filled, it is \'popped\' off, to+-- become a new chunk of the resulting lazy @Text@. All this is+-- hidden from the user of the @Builder@.+newtype Builder = Builder {+ -- Invariant (from Data.Text.Lazy):+ -- The lists include no null Texts.+ runBuilder :: forall s. (Buffer s -> ST s [S.Text])+ -> Buffer s+ -> ST s [S.Text]+ }++instance Monoid Builder where+ mempty = empty+ {-# INLINE mempty #-}+ mappend = append+ {-# INLINE mappend #-}+ mconcat = foldr mappend mempty+ {-# INLINE mconcat #-}++instance String.IsString Builder where+ fromString = fromString+ {-# INLINE fromString #-}++instance Show Builder where+ show = show . toLazyText++instance Eq Builder where+ a == b = toLazyText a == toLazyText b++instance Ord Builder where+ a <= b = toLazyText a <= toLazyText b++------------------------------------------------------------------------++-- | /O(1)./ The empty @Builder@, satisfying+--+-- * @'toLazyText' 'empty' = 'L.empty'@+--+empty :: Builder+empty = Builder (\ k buf -> k buf)+{-# INLINE empty #-}++-- | /O(1)./ A @Builder@ taking a single character, satisfying+--+-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@+--+singleton :: Char -> Builder+singleton c = writeAtMost 2 $ \ marr o ->+ if n < 0x10000+ then A.unsafeWrite marr o (fromIntegral n) >> return 1+ else do+ A.unsafeWrite marr o lo+ A.unsafeWrite marr (o+1) hi+ return 2+ where n = ord c+ m = n - 0x10000+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00+{-# INLINE singleton #-}++------------------------------------------------------------------------++-- | /O(1)./ The concatenation of two builders, an associative+-- operation with identity 'empty', satisfying+--+-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@+--+append :: Builder -> Builder -> Builder+append (Builder f) (Builder g) = Builder (f . g)+{-# INLINE [0] append #-}++-- TODO: Experiment to find the right threshold.+copyLimit :: Int+copyLimit = 128++-- This function attempts to merge small @Text@ values instead of+-- treating each value as its own chunk. We may not always want this.++-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying+--+-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@+--+fromText :: S.Text -> Builder+fromText t@(Text arr off l)+ | S.null t = empty+ | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)+ | otherwise = flush `append` mapBuilder (t :)+{-# INLINE [1] fromText #-}++{-# RULES+"fromText/pack" forall s .+ fromText (S.pack s) = fromString s+ #-}++-- | /O(1)./ A Builder taking a @String@, satisfying+--+-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@+--+fromString :: String -> Builder+fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->+ let loop !marr !o !u !l [] = k (Buffer marr o u l)+ loop marr o u l s@(c:cs)+ | l <= 1 = do+ arr <- A.unsafeFreeze marr+ let !t = Text arr o u+ marr' <- A.new chunkSize+ ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)+ return $ t : ts+ | otherwise = do+ n <- unsafeWrite marr (o+u) c+ loop marr o (u+n) (l-n) cs+ in loop p0 o0 u0 l0 str+ where+ chunkSize = smallChunkSize+{-# INLINE fromString #-}++-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying+--+-- * @'toLazyText' ('fromLazyText' t) = t@+--+fromLazyText :: L.Text -> Builder+fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)+{-# INLINE fromLazyText #-}++------------------------------------------------------------------------++-- Our internal buffer type+data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)+ {-# UNPACK #-} !Int -- offset+ {-# UNPACK #-} !Int -- used units+ {-# UNPACK #-} !Int -- length left++------------------------------------------------------------------------++-- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default+-- buffer size. The construction work takes place if and when the+-- relevant part of the lazy @Text@ is demanded.+toLazyText :: Builder -> L.Text+toLazyText = toLazyTextWith smallChunkSize++-- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given+-- size for the initial buffer. The construction work takes place if+-- and when the relevant part of the lazy @Text@ is demanded.+--+-- If the initial buffer is too small to hold all data, subsequent+-- buffers will be the default buffer size.+toLazyTextWith :: Int -> Builder -> L.Text+toLazyTextWith chunkSize m = L.fromChunks (runST $+ newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))++-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,+-- yielding a new chunk in the result lazy @Text@.+flush :: Builder+flush = Builder $ \ k buf@(Buffer p o u l) ->+ if u == 0+ then k buf+ else do arr <- A.unsafeFreeze p+ let !b = Buffer p (o+u) 0 l+ !t = Text arr o u+ ts <- inlineInterleaveST (k b)+ return $! t : ts++------------------------------------------------------------------------++-- | Sequence an ST operation on the buffer+withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder+withBuffer f = Builder $ \k buf -> f buf >>= k+{-# INLINE withBuffer #-}++-- | Get the size of the buffer+withSize :: (Int -> Builder) -> Builder+withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->+ runBuilder (f l) k buf+{-# INLINE withSize #-}++-- | Map the resulting list of texts.+mapBuilder :: ([S.Text] -> [S.Text]) -> Builder+mapBuilder f = Builder (fmap f .)++------------------------------------------------------------------------++-- | Ensure that there are at least @n@ many elements available.+ensureFree :: Int -> Builder+ensureFree !n = withSize $ \ l ->+ if n <= l+ then empty+ else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))+{-# INLINE [0] ensureFree #-}++writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder+writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)+{-# INLINE [0] writeAtMost #-}++-- | Ensure that @n@ many elements are available, and then use @f@ to+-- write some elements into the memory.+writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder+writeN n f = writeAtMost n (\ p o -> f p o >> return n)+{-# INLINE writeN #-}++writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)+writeBuffer f (Buffer p o u l) = do+ n <- f p (o+u)+ return $! Buffer p o (u+n) (l-n)+{-# INLINE writeBuffer #-}++newBuffer :: Int -> ST s (Buffer s)+newBuffer size = do+ arr <- A.new size+ return $! Buffer arr 0 0 size+{-# INLINE newBuffer #-}++------------------------------------------------------------------------+-- Some nice rules for Builder++-- This function makes GHC understand that 'writeN' and 'ensureFree'+-- are *not* recursive in the precense of the rewrite rules below.+-- This is not needed with GHC 7+.+append' :: Builder -> Builder -> Builder+append' (Builder f) (Builder g) = Builder (f . g)+{-# INLINE append' #-}++{-# RULES++"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)+ (g::forall s. A.MArray s -> Int -> ST s Int) ws.+ append (writeAtMost a f) (append (writeAtMost b g) ws) =+ append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->+ g marr (o+n) >>= \ m ->+ let s = n+m in s `seq` return s)) ws++"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)+ (g::forall s. A.MArray s -> Int -> ST s Int).+ append (writeAtMost a f) (writeAtMost b g) =+ writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->+ g marr (o+n) >>= \ m ->+ let s = n+m in s `seq` return s)++"ensureFree/ensureFree" forall a b .+ append (ensureFree a) (ensureFree b) = ensureFree (max a b)++"flush/flush"+ append flush flush = flush++ #-}
+ Data/Text/Internal/Builder/Functions.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE MagicHash #-}++-- |+-- Module : Data.Text.Internal.Builder.Functions+-- Copyright : (c) 2011 MailRank, Inc.+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Useful functions and combinators.++module Data.Text.Internal.Builder.Functions+ (+ (<>)+ , i2d+ ) where++import Data.Monoid (mappend)+import Data.Text.Lazy.Builder (Builder)+import GHC.Base++-- | Unsafe conversion for decimal digits.+{-# INLINE i2d #-}+i2d :: Int -> Char+i2d (I# i#) = C# (chr# (ord# '0'# +# i#))++-- | The normal 'mappend' function with right associativity instead of+-- left.+(<>) :: Builder -> Builder -> Builder+(<>) = mappend+{-# INLINE (<>) #-}++infixr 4 <>
+ Data/Text/Internal/Builder/Int/Digits.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings #-}++-- Module: Data.Text.Internal.Builder.Int.Digits+-- Copyright: (c) 2013 Bryan O'Sullivan+-- License: BSD3+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>+-- Stability: experimental+-- Portability: portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- This module exists because the C preprocessor does things that we+-- shall not speak of when confronted with Haskell multiline strings.++module Data.Text.Internal.Builder.Int.Digits (digits) where++import Data.ByteString.Char8 (ByteString)++digits :: ByteString+digits = "0001020304050607080910111213141516171819\+ \2021222324252627282930313233343536373839\+ \4041424344454647484950515253545556575859\+ \6061626364656667686970717273747576777879\+ \8081828384858687888990919293949596979899"
+ Data/Text/Internal/Builder/RealFloat/Functions.hs view
@@ -0,0 +1,29 @@+-- |+-- Module: Data.Text.Internal.Builder.RealFloat.Functions+-- Copyright: (c) The University of Glasgow 1994-2002+-- License: see libraries/base/LICENSE+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!++module Data.Text.Internal.Builder.RealFloat.Functions+ (+ roundTo+ ) where++roundTo :: Int -> [Int] -> (Int,[Int])+roundTo d is =+ case f d is of+ x@(0,_) -> x+ (1,xs) -> (1, 1:xs)+ _ -> error "roundTo: bad Value"+ where+ f n [] = (0, replicate n 0)+ f 0 (x:_) = (if x >= 5 then 1 else 0, [])+ f n (i:xs)+ | i' == 10 = (1,0:ds)+ | otherwise = (0,i':ds)+ where+ (c,ds) = f (n-1) xs+ i' = c + i
+ Data/Text/Internal/Encoding/Fusion.hs view
@@ -0,0 +1,208 @@+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}++-- |+-- Module : Data.Text.Internal.Encoding.Fusion+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Fusible 'Stream'-oriented functions for converting between 'Text'+-- and several common encodings.++module Data.Text.Internal.Encoding.Fusion+ (+ -- * Streaming+ streamASCII+ , streamUtf8+ , streamUtf16LE+ , streamUtf16BE+ , streamUtf32LE+ , streamUtf32BE++ -- * Unstreaming+ , unstream++ , module Data.Text.Internal.Encoding.Fusion.Common+ ) where++#if defined(ASSERTS)+import Control.Exception (assert)+#endif+import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)+import Data.Text.Internal.Fusion (Step(..), Stream(..))+import Data.Text.Internal.Fusion.Size+import Data.Text.Encoding.Error+import Data.Text.Internal.Encoding.Fusion.Common+import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)+import Data.Word (Word8, Word16, Word32)+import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)+import Foreign.Storable (pokeByteOff)+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import qualified Data.Text.Internal.Encoding.Utf8 as U8+import qualified Data.Text.Internal.Encoding.Utf16 as U16+import qualified Data.Text.Internal.Encoding.Utf32 as U32+import Data.Text.Unsafe (unsafeDupablePerformIO)++streamASCII :: ByteString -> Stream Char+streamASCII bs = Stream next 0 (maxSize l)+ where+ l = B.length bs+ {-# INLINE next #-}+ next i+ | i >= l = Done+ | otherwise = Yield (unsafeChr8 x1) (i+1)+ where+ x1 = B.unsafeIndex bs i+{-# DEPRECATED streamASCII "Do not use this function" #-}+{-# INLINE [0] streamASCII #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8+-- encoding.+streamUtf8 :: OnDecodeError -> ByteString -> Stream Char+streamUtf8 onErr bs = Stream next 0 (maxSize l)+ where+ l = B.length bs+ next i+ | i >= l = Done+ | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)+ | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)+ | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)+ | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)+ | otherwise = decodeError "streamUtf8" "UTF-8" onErr (Just x1) (i+1)+ where+ x1 = idx i+ x2 = idx (i + 1)+ x3 = idx (i + 2)+ x4 = idx (i + 3)+ idx = B.unsafeIndex bs+{-# INLINE [0] streamUtf8 #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little+-- endian UTF-16 encoding.+streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char+streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))+ where+ l = B.length bs+ {-# INLINE next #-}+ next i+ | i >= l = Done+ | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)+ | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)+ | otherwise = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing (i+1)+ where+ x1 = idx i + (idx (i + 1) `shiftL` 8)+ x2 = idx (i + 2) + (idx (i + 3) `shiftL` 8)+ idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16+{-# INLINE [0] streamUtf16LE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big+-- endian UTF-16 encoding.+streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char+streamUtf16BE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))+ where+ l = B.length bs+ {-# INLINE next #-}+ next i+ | i >= l = Done+ | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)+ | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)+ | otherwise = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing (i+1)+ where+ x1 = (idx i `shiftL` 8) + idx (i + 1)+ x2 = (idx (i + 2) `shiftL` 8) + idx (i + 3)+ idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16+{-# INLINE [0] streamUtf16BE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big+-- endian UTF-32 encoding.+streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char+streamUtf32BE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))+ where+ l = B.length bs+ {-# INLINE next #-}+ next i+ | i >= l = Done+ | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)+ | otherwise = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing (i+1)+ where+ x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4+ x1 = idx i+ x2 = idx (i+1)+ x3 = idx (i+2)+ x4 = idx (i+3)+ idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32+{-# INLINE [0] streamUtf32BE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little+-- endian UTF-32 encoding.+streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char+streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))+ where+ l = B.length bs+ {-# INLINE next #-}+ next i+ | i >= l = Done+ | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)+ | otherwise = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing (i+1)+ where+ x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1+ x1 = idx i+ x2 = idx $ i+1+ x3 = idx $ i+2+ x4 = idx $ i+3+ idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32+{-# INLINE [0] streamUtf32LE #-}++-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.+unstream :: Stream Word8 -> ByteString+unstream (Stream next s0 len) = unsafeDupablePerformIO $ do+ let mlen = upperBound 4 len+ mallocByteString mlen >>= loop mlen 0 s0+ where+ loop !n !off !s fp = case next s of+ Done -> trimUp fp n off+ Skip s' -> loop n off s' fp+ Yield x s'+ | off == n -> realloc fp n off s' x+ | otherwise -> do+ withForeignPtr fp $ \p -> pokeByteOff p off x+ loop n (off+1) s' fp+ {-# NOINLINE realloc #-}+ realloc fp n off s x = do+ let n' = n+n+ fp' <- copy0 fp n n'+ withForeignPtr fp' $ \p -> pokeByteOff p off x+ loop n' (off+1) s fp'+ {-# NOINLINE trimUp #-}+ trimUp fp _ off = return $! PS fp 0 off+ copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)+ copy0 !src !srcLen !destLen =+#if defined(ASSERTS)+ assert (srcLen <= destLen) $+#endif+ do+ dest <- mallocByteString destLen+ withForeignPtr src $ \src' ->+ withForeignPtr dest $ \dest' ->+ memcpy dest' src' (fromIntegral srcLen)+ return dest++decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8+ -> s -> Step s Char+decodeError func kind onErr mb i =+ case onErr desc mb of+ Nothing -> Skip i+ Just c -> Yield c i+ where desc = "Data.Text.Internal.Encoding.Fusion." ++ func ++ ": Invalid " +++ kind ++ " stream"
+ Data/Text/Internal/Encoding/Fusion/Common.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE BangPatterns #-}++-- |+-- Module : Data.Text.Internal.Encoding.Fusion.Common+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009,+-- (c) Jasper Van der Jeugt 2011+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Use at your own risk!+--+-- Fusible 'Stream'-oriented functions for converting between 'Text'+-- and several common encodings.++module Data.Text.Internal.Encoding.Fusion.Common+ (+ -- * Restreaming+ -- Restreaming is the act of converting from one 'Stream'+ -- representation to another.+ restreamUtf16LE+ , restreamUtf16BE+ , restreamUtf32LE+ , restreamUtf32BE+ ) where++import Data.Bits ((.&.))+import Data.Text.Internal.Fusion (Step(..), Stream(..))+import Data.Text.Internal.Fusion.Types (RS(..))+import Data.Text.Internal.Unsafe.Char (ord)+import Data.Text.Internal.Unsafe.Shift (shiftR)+import Data.Word (Word8)++restreamUtf16BE :: Stream Char -> Stream Word8+restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)+ where+ next (RS0 s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (RS0 s')+ Yield x s'+ | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $+ RS1 s' (fromIntegral n)+ | otherwise -> Yield c1 $ RS3 s' c2 c3 c4+ where+ n = ord x+ n1 = n - 0x10000+ c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)+ c2 = fromIntegral (n1 `shiftR` 10)+ n2 = n1 .&. 0x3FF+ c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)+ c4 = fromIntegral n2+ next (RS1 s x2) = Yield x2 (RS0 s)+ next (RS2 s x2 x3) = Yield x2 (RS1 s x3)+ next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)+ {-# INLINE next #-}+{-# INLINE restreamUtf16BE #-}++restreamUtf16LE :: Stream Char -> Stream Word8+restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)+ where+ next (RS0 s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (RS0 s')+ Yield x s'+ | n < 0x10000 -> Yield (fromIntegral n) $+ RS1 s' (fromIntegral $ shiftR n 8)+ | otherwise -> Yield c1 $ RS3 s' c2 c3 c4+ where+ n = ord x+ n1 = n - 0x10000+ c2 = fromIntegral (shiftR n1 18 + 0xD8)+ c1 = fromIntegral (shiftR n1 10)+ n2 = n1 .&. 0x3FF+ c4 = fromIntegral (shiftR n2 8 + 0xDC)+ c3 = fromIntegral n2+ next (RS1 s x2) = Yield x2 (RS0 s)+ next (RS2 s x2 x3) = Yield x2 (RS1 s x3)+ next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)+ {-# INLINE next #-}+{-# INLINE restreamUtf16LE #-}++restreamUtf32BE :: Stream Char -> Stream Word8+restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)+ where+ next (RS0 s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (RS0 s')+ Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)+ where+ n = ord x+ c1 = fromIntegral $ shiftR n 24+ c2 = fromIntegral $ shiftR n 16+ c3 = fromIntegral $ shiftR n 8+ c4 = fromIntegral n+ next (RS1 s x2) = Yield x2 (RS0 s)+ next (RS2 s x2 x3) = Yield x2 (RS1 s x3)+ next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)+ {-# INLINE next #-}+{-# INLINE restreamUtf32BE #-}++restreamUtf32LE :: Stream Char -> Stream Word8+restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)+ where+ next (RS0 s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (RS0 s')+ Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)+ where+ n = ord x+ c4 = fromIntegral $ shiftR n 24+ c3 = fromIntegral $ shiftR n 16+ c2 = fromIntegral $ shiftR n 8+ c1 = fromIntegral n+ next (RS1 s x2) = Yield x2 (RS0 s)+ next (RS2 s x2 x3) = Yield x2 (RS1 s x3)+ next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)+ {-# INLINE next #-}+{-# INLINE restreamUtf32LE #-}
+ Data/Text/Internal/Encoding/Utf16.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE MagicHash, BangPatterns #-}++-- |+-- Module : Data.Text.Internal.Encoding.Utf16+-- Copyright : (c) 2008, 2009 Tom Harper,+-- (c) 2009 Bryan O'Sullivan,+-- (c) 2009 Duncan Coutts+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Basic UTF-16 validation and character manipulation.+module Data.Text.Internal.Encoding.Utf16+ (+ chr2+ , validate1+ , validate2+ ) where++import GHC.Exts+import GHC.Word (Word16(..))++chr2 :: Word16 -> Word16 -> Char+chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))+ where+ !x# = word2Int# a#+ !y# = word2Int# b#+ !upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#+ !lower# = y# -# 0xDC00#+{-# INLINE chr2 #-}++validate1 :: Word16 -> Bool+validate1 x1 = x1 < 0xD800 || x1 > 0xDFFF+{-# INLINE validate1 #-}++validate2 :: Word16 -> Word16 -> Bool+validate2 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&+ x2 >= 0xDC00 && x2 <= 0xDFFF+{-# INLINE validate2 #-}
+ Data/Text/Internal/Encoding/Utf32.hs view
@@ -0,0 +1,26 @@+-- |+-- Module : Data.Text.Internal.Encoding.Utf32+-- Copyright : (c) 2008, 2009 Tom Harper,+-- (c) 2009, 2010 Bryan O'Sullivan,+-- (c) 2009 Duncan Coutts+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Basic UTF-32 validation.+module Data.Text.Internal.Encoding.Utf32+ (+ validate+ ) where++import Data.Word (Word32)++validate :: Word32 -> Bool+validate x1 = x1 < 0xD800 || (x1 > 0xDFFF && x1 <= 0x10FFFF)+{-# INLINE validate #-}
+ Data/Text/Internal/Encoding/Utf8.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE CPP, MagicHash, BangPatterns #-}++-- |+-- Module : Data.Text.Internal.Encoding.Utf8+-- Copyright : (c) 2008, 2009 Tom Harper,+-- (c) 2009, 2010 Bryan O'Sullivan,+-- (c) 2009 Duncan Coutts+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Basic UTF-8 validation and character manipulation.+module Data.Text.Internal.Encoding.Utf8+ (+ -- Decomposition+ ord2+ , ord3+ , ord4+ -- Construction+ , chr2+ , chr3+ , chr4+ -- * Validation+ , validate1+ , validate2+ , validate3+ , validate4+ ) where++#if defined(TEST_SUITE)+# undef ASSERTS+#endif++#if defined(ASSERTS)+import Control.Exception (assert)+#endif+import Data.Bits ((.&.))+import Data.Text.Internal.Unsafe.Char (ord)+import Data.Text.Internal.Unsafe.Shift (shiftR)+import GHC.Exts+import GHC.Word (Word8(..))++default(Int)++between :: Word8 -- ^ byte to check+ -> Word8 -- ^ lower bound+ -> Word8 -- ^ upper bound+ -> Bool+between x y z = x >= y && x <= z+{-# INLINE between #-}++ord2 :: Char -> (Word8,Word8)+ord2 c =+#if defined(ASSERTS)+ assert (n >= 0x80 && n <= 0x07ff)+#endif+ (x1,x2)+ where+ n = ord c+ x1 = fromIntegral $ (n `shiftR` 6) + 0xC0+ x2 = fromIntegral $ (n .&. 0x3F) + 0x80++ord3 :: Char -> (Word8,Word8,Word8)+ord3 c =+#if defined(ASSERTS)+ assert (n >= 0x0800 && n <= 0xffff)+#endif+ (x1,x2,x3)+ where+ n = ord c+ x1 = fromIntegral $ (n `shiftR` 12) + 0xE0+ x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80+ x3 = fromIntegral $ (n .&. 0x3F) + 0x80++ord4 :: Char -> (Word8,Word8,Word8,Word8)+ord4 c =+#if defined(ASSERTS)+ assert (n >= 0x10000)+#endif+ (x1,x2,x3,x4)+ where+ n = ord c+ x1 = fromIntegral $ (n `shiftR` 18) + 0xF0+ x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80+ x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80+ x4 = fromIntegral $ (n .&. 0x3F) + 0x80++chr2 :: Word8 -> Word8 -> Char+chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))+ where+ !y1# = word2Int# x1#+ !y2# = word2Int# x2#+ !z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#+ !z2# = y2# -# 0x80#+{-# INLINE chr2 #-}++chr3 :: Word8 -> Word8 -> Word8 -> Char+chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))+ where+ !y1# = word2Int# x1#+ !y2# = word2Int# x2#+ !y3# = word2Int# x3#+ !z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#+ !z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#+ !z3# = y3# -# 0x80#+{-# INLINE chr3 #-}++chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char+chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =+ C# (chr# (z1# +# z2# +# z3# +# z4#))+ where+ !y1# = word2Int# x1#+ !y2# = word2Int# x2#+ !y3# = word2Int# x3#+ !y4# = word2Int# x4#+ !z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#+ !z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#+ !z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#+ !z4# = y4# -# 0x80#+{-# INLINE chr4 #-}++validate1 :: Word8 -> Bool+validate1 x1 = x1 <= 0x7F+{-# INLINE validate1 #-}++validate2 :: Word8 -> Word8 -> Bool+validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF+{-# INLINE validate2 #-}++validate3 :: Word8 -> Word8 -> Word8 -> Bool+{-# INLINE validate3 #-}+validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4+ where+ validate3_1 = (x1 == 0xE0) &&+ between x2 0xA0 0xBF &&+ between x3 0x80 0xBF+ validate3_2 = between x1 0xE1 0xEC &&+ between x2 0x80 0xBF &&+ between x3 0x80 0xBF+ validate3_3 = x1 == 0xED &&+ between x2 0x80 0x9F &&+ between x3 0x80 0xBF+ validate3_4 = between x1 0xEE 0xEF &&+ between x2 0x80 0xBF &&+ between x3 0x80 0xBF++validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool+{-# INLINE validate4 #-}+validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3+ where+ validate4_1 = x1 == 0xF0 &&+ between x2 0x90 0xBF &&+ between x3 0x80 0xBF &&+ between x4 0x80 0xBF+ validate4_2 = between x1 0xF1 0xF3 &&+ between x2 0x80 0xBF &&+ between x3 0x80 0xBF &&+ between x4 0x80 0xBF+ validate4_3 = x1 == 0xF4 &&+ between x2 0x80 0x8F &&+ between x3 0x80 0xBF &&+ between x4 0x80 0xBF
+ Data/Text/Internal/Functions.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE CPP, DeriveDataTypeable #-}++-- |+-- Module : Data.Text.Internal.Functions+-- Copyright : 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Useful functions.++module Data.Text.Internal.Functions+ (+ intersperse+ ) where++-- | A lazier version of Data.List.intersperse. The other version+-- causes space leaks!+intersperse :: a -> [a] -> [a]+intersperse _ [] = []+intersperse sep (x:xs) = x : go xs+ where+ go [] = []+ go (y:ys) = sep : y: go ys+{-# INLINE intersperse #-}
+ Data/Text/Internal/Fusion.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE BangPatterns, MagicHash #-}++-- |+-- Module : Data.Text.Internal.Fusion+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009-2010,+-- (c) Duncan Coutts 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Text manipulation functions represented as fusible operations over+-- streams.+module Data.Text.Internal.Fusion+ (+ -- * Types+ Stream(..)+ , Step(..)++ -- * Creation and elimination+ , stream+ , unstream+ , reverseStream++ , length++ -- * Transformations+ , reverse++ -- * Construction+ -- ** Scans+ , reverseScanr++ -- ** Accumulating maps+ , mapAccumL++ -- ** Generation and unfolding+ , unfoldrN++ -- * Indexing+ , index+ , findIndex+ , countChar+ ) where++import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,+ Num(..), Ord(..), ($), (&&),+ fromIntegral, otherwise)+import Data.Bits ((.&.))+import Data.Text.Internal (Text(..))+import Data.Text.Internal.Private (runText)+import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)+import qualified Data.Text.Array as A+import qualified Data.Text.Internal.Fusion.Common as S+import Data.Text.Internal.Fusion.Types+import Data.Text.Internal.Fusion.Size+import qualified Data.Text.Internal as I+import qualified Data.Text.Internal.Encoding.Utf16 as U16++default(Int)++-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.+stream :: Text -> Stream Char+stream (Text arr off len) = Stream next off (maxSize len)+ where+ !end = off+len+ next !i+ | i >= end = Done+ | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)+ | otherwise = Yield (unsafeChr n) (i + 1)+ where+ n = A.unsafeIndex arr i+ n2 = A.unsafeIndex arr (i + 1)+{-# INLINE [0] stream #-}++-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate+-- backwards.+reverseStream :: Text -> Stream Char+reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)+ where+ {-# INLINE next #-}+ next !i+ | i < off = Done+ | n >= 0xDC00 && n <= 0xDFFF = Yield (U16.chr2 n2 n) (i - 2)+ | otherwise = Yield (unsafeChr n) (i - 1)+ where+ n = A.unsafeIndex arr i+ n2 = A.unsafeIndex arr (i - 1)+{-# INLINE [0] reverseStream #-}++-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.+unstream :: Stream Char -> Text+unstream (Stream next0 s0 len) = runText $ \done -> do+ let mlen = upperBound 4 len+ arr0 <- A.new mlen+ let outer arr top = loop+ where+ loop !s !i =+ case next0 s of+ Done -> done arr i+ Skip s' -> loop s' i+ Yield x s'+ | j >= top -> {-# SCC "unstream/resize" #-} do+ let top' = (top + 1) `shiftL` 1+ arr' <- A.new top'+ A.copyM arr' 0 arr 0 top+ outer arr' top' s i+ | otherwise -> do d <- unsafeWrite arr i x+ loop s' (i+d)+ where j | ord x < 0x10000 = i+ | otherwise = i + 1+ outer arr0 mlen s0 0+{-# INLINE [0] unstream #-}+{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}+++-- ----------------------------------------------------------------------------+-- * Basic stream functions++length :: Stream Char -> Int+length = S.lengthI+{-# INLINE[0] length #-}++-- | /O(n)/ Reverse the characters of a string.+reverse :: Stream Char -> Text+reverse (Stream next s len0)+ | isEmpty len0 = I.empty+ | otherwise = I.textP arr off' len'+ where+ len0' = upperBound 4 (larger len0 4)+ (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')+ loop !s0 !i !len marr =+ case next s0 of+ Done -> return (marr, (j, len-j))+ where j = i + 1+ Skip s1 -> loop s1 i len marr+ Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do+ let newLen = len `shiftL` 1+ marr' <- A.new newLen+ A.copyM marr' (newLen-len) marr 0 len+ write s1 (len+i) newLen marr'+ | otherwise -> write s1 i len marr+ where n = ord x+ least | n < 0x10000 = 0+ | otherwise = 1+ m = n - 0x10000+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00+ write t j l mar+ | n < 0x10000 = do+ A.unsafeWrite mar j (fromIntegral n)+ loop t (j-1) l mar+ | otherwise = do+ A.unsafeWrite mar (j-1) lo+ A.unsafeWrite mar j hi+ loop t (j-2) l mar+{-# INLINE [0] reverse #-}++-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with+-- the input and result reversed.+reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char+reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low+ where+ {-# INLINE next #-}+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)+ next (S2 :*: z :*: s) = case next0 s of+ Yield x s' -> let !x' = f x z+ in Yield x' (S2 :*: x' :*: s')+ Skip s' -> Skip (S2 :*: z :*: s')+ Done -> Done+{-# INLINE reverseScanr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed+-- value. However, the length of the result is limited by the+-- first argument to 'unfoldrN'. This function is more efficient than+-- 'unfoldr' when the length of the result is known.+unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char+unfoldrN n = S.unfoldrNI n+{-# INLINE [0] unfoldrN #-}++-------------------------------------------------------------------------------+-- ** Indexing streams++-- | /O(n)/ stream index (subscript) operator, starting from 0.+index :: Stream Char -> Int -> Char+index = S.indexI+{-# INLINE [0] index #-}++-- | The 'findIndex' function takes a predicate and a stream and+-- returns the index of the first element in the stream+-- satisfying the predicate.+findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int+findIndex = S.findIndexI+{-# INLINE [0] findIndex #-}++-- | /O(n)/ The 'count' function returns the number of times the query+-- element appears in the given stream.+countChar :: Char -> Stream Char -> Int+countChar = S.countCharI+{-# INLINE [0] countChar #-}++-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a+-- function to each element of a 'Text', passing an accumulating+-- parameter from left to right, and returns a final 'Text'.+mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)+mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)+ where+ (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)+ where mlen = upperBound 4 len+ outer arr top = loop+ where+ loop !z !s !i =+ case next0 s of+ Done -> return (arr, (z,i))+ Skip s' -> loop z s' i+ Yield x s'+ | j >= top -> {-# SCC "mapAccumL/resize" #-} do+ let top' = (top + 1) `shiftL` 1+ arr' <- A.new top'+ A.copyM arr' 0 arr 0 top+ outer arr' top' z s i+ | otherwise -> do d <- unsafeWrite arr i c+ loop z' s' (i+d)+ where (z',c) = f z x+ j | ord c < 0x10000 = i+ | otherwise = i + 1+{-# INLINE [0] mapAccumL #-}
+ Data/Text/Internal/Fusion/CaseMapping.hs view
@@ -0,0 +1,570 @@+{-# LANGUAGE Rank2Types #-}+-- AUTOMATICALLY GENERATED - DO NOT EDIT+-- Generated by scripts/SpecialCasing.hs+-- CaseFolding-6.3.0.txt+-- Date: 2012-12-20, 22:14:35 GMT [MD]+-- SpecialCasing-6.3.0.txt+-- Date: 2013-05-08, 13:54:51 GMT [MD]++module Data.Text.Internal.Fusion.CaseMapping where+import Data.Char+import Data.Text.Internal.Fusion.Types++upperMapping :: forall s. Char -> s -> Step (CC s) Char+{-# INLINE upperMapping #-}+-- LATIN SMALL LETTER SHARP S+upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')+-- LATIN SMALL LIGATURE FF+upperMapping '\xfb00' s = Yield '\x0046' (CC s '\x0046' '\x0000')+-- LATIN SMALL LIGATURE FI+upperMapping '\xfb01' s = Yield '\x0046' (CC s '\x0049' '\x0000')+-- LATIN SMALL LIGATURE FL+upperMapping '\xfb02' s = Yield '\x0046' (CC s '\x004c' '\x0000')+-- LATIN SMALL LIGATURE FFI+upperMapping '\xfb03' s = Yield '\x0046' (CC s '\x0046' '\x0049')+-- LATIN SMALL LIGATURE FFL+upperMapping '\xfb04' s = Yield '\x0046' (CC s '\x0046' '\x004c')+-- LATIN SMALL LIGATURE LONG S T+upperMapping '\xfb05' s = Yield '\x0053' (CC s '\x0054' '\x0000')+-- LATIN SMALL LIGATURE ST+upperMapping '\xfb06' s = Yield '\x0053' (CC s '\x0054' '\x0000')+-- ARMENIAN SMALL LIGATURE ECH YIWN+upperMapping '\x0587' s = Yield '\x0535' (CC s '\x0552' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN NOW+upperMapping '\xfb13' s = Yield '\x0544' (CC s '\x0546' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN ECH+upperMapping '\xfb14' s = Yield '\x0544' (CC s '\x0535' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN INI+upperMapping '\xfb15' s = Yield '\x0544' (CC s '\x053b' '\x0000')+-- ARMENIAN SMALL LIGATURE VEW NOW+upperMapping '\xfb16' s = Yield '\x054e' (CC s '\x0546' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN XEH+upperMapping '\xfb17' s = Yield '\x0544' (CC s '\x053d' '\x0000')+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE+upperMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS+upperMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS+upperMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- LATIN SMALL LETTER J WITH CARON+upperMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')+-- LATIN SMALL LETTER H WITH LINE BELOW+upperMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')+-- LATIN SMALL LETTER T WITH DIAERESIS+upperMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')+-- LATIN SMALL LETTER W WITH RING ABOVE+upperMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER Y WITH RING ABOVE+upperMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER A WITH RIGHT HALF RING+upperMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI+upperMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA+upperMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA+upperMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI+upperMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI+upperMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI+upperMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA+upperMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA+upperMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI+upperMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI+upperMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA+upperMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA+upperMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER RHO WITH PSILI+upperMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI+upperMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI+upperMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI+upperMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI+upperMapping '\x1f80' s = Yield '\x1f08' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI+upperMapping '\x1f81' s = Yield '\x1f09' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1f82' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1f83' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1f84' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1f85' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1f86' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1f87' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI+upperMapping '\x1f88' s = Yield '\x1f08' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI+upperMapping '\x1f89' s = Yield '\x1f09' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1f8a' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1f8b' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1f8c' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1f8d' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1f8e' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1f8f' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI+upperMapping '\x1f90' s = Yield '\x1f28' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI+upperMapping '\x1f91' s = Yield '\x1f29' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1f92' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1f93' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1f94' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1f95' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1f96' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1f97' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI+upperMapping '\x1f98' s = Yield '\x1f28' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI+upperMapping '\x1f99' s = Yield '\x1f29' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1f9a' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1f9b' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1f9c' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1f9d' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1f9e' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1f9f' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI+upperMapping '\x1fa0' s = Yield '\x1f68' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI+upperMapping '\x1fa1' s = Yield '\x1f69' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1fa2' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1fa3' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1fa4' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1fa5' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1fa6' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1fa7' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI+upperMapping '\x1fa8' s = Yield '\x1f68' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI+upperMapping '\x1fa9' s = Yield '\x1f69' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1faa' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1fab' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1fac' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1fad' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1fae' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1faf' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI+upperMapping '\x1fb3' s = Yield '\x0391' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI+upperMapping '\x1fbc' s = Yield '\x0391' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI+upperMapping '\x1fc3' s = Yield '\x0397' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI+upperMapping '\x1fcc' s = Yield '\x0397' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI+upperMapping '\x1ff3' s = Yield '\x03a9' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI+upperMapping '\x1ffc' s = Yield '\x03a9' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI+upperMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI+upperMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI+upperMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI+upperMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI+upperMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI+upperMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0399')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')+upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')+lowerMapping :: forall s. Char -> s -> Step (CC s) Char+{-# INLINE lowerMapping #-}+-- LATIN CAPITAL LETTER I WITH DOT ABOVE+lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')+lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')+titleMapping :: forall s. Char -> s -> Step (CC s) Char+{-# INLINE titleMapping #-}+-- LATIN SMALL LETTER SHARP S+titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')+-- LATIN SMALL LIGATURE FF+titleMapping '\xfb00' s = Yield '\x0046' (CC s '\x0066' '\x0000')+-- LATIN SMALL LIGATURE FI+titleMapping '\xfb01' s = Yield '\x0046' (CC s '\x0069' '\x0000')+-- LATIN SMALL LIGATURE FL+titleMapping '\xfb02' s = Yield '\x0046' (CC s '\x006c' '\x0000')+-- LATIN SMALL LIGATURE FFI+titleMapping '\xfb03' s = Yield '\x0046' (CC s '\x0066' '\x0069')+-- LATIN SMALL LIGATURE FFL+titleMapping '\xfb04' s = Yield '\x0046' (CC s '\x0066' '\x006c')+-- LATIN SMALL LIGATURE LONG S T+titleMapping '\xfb05' s = Yield '\x0053' (CC s '\x0074' '\x0000')+-- LATIN SMALL LIGATURE ST+titleMapping '\xfb06' s = Yield '\x0053' (CC s '\x0074' '\x0000')+-- ARMENIAN SMALL LIGATURE ECH YIWN+titleMapping '\x0587' s = Yield '\x0535' (CC s '\x0582' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN NOW+titleMapping '\xfb13' s = Yield '\x0544' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN ECH+titleMapping '\xfb14' s = Yield '\x0544' (CC s '\x0565' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN INI+titleMapping '\xfb15' s = Yield '\x0544' (CC s '\x056b' '\x0000')+-- ARMENIAN SMALL LIGATURE VEW NOW+titleMapping '\xfb16' s = Yield '\x054e' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN XEH+titleMapping '\xfb17' s = Yield '\x0544' (CC s '\x056d' '\x0000')+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE+titleMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS+titleMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS+titleMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- LATIN SMALL LETTER J WITH CARON+titleMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')+-- LATIN SMALL LETTER H WITH LINE BELOW+titleMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')+-- LATIN SMALL LETTER T WITH DIAERESIS+titleMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')+-- LATIN SMALL LETTER W WITH RING ABOVE+titleMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER Y WITH RING ABOVE+titleMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER A WITH RIGHT HALF RING+titleMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI+titleMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA+titleMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA+titleMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI+titleMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI+titleMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI+titleMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA+titleMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA+titleMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI+titleMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI+titleMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA+titleMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA+titleMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER RHO WITH PSILI+titleMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI+titleMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI+titleMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI+titleMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0345')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')+titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')+foldMapping :: forall s. Char -> s -> Step (CC s) Char+{-# INLINE foldMapping #-}+-- MICRO SIGN+foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')+-- LATIN SMALL LETTER SHARP S+foldMapping '\x00df' s = Yield '\x0073' (CC s '\x0073' '\x0000')+-- LATIN CAPITAL LETTER I WITH DOT ABOVE+foldMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE+foldMapping '\x0149' s = Yield '\x02bc' (CC s '\x006e' '\x0000')+-- LATIN SMALL LETTER LONG S+foldMapping '\x017f' s = Yield '\x0073' (CC s '\x0000' '\x0000')+-- LATIN SMALL LETTER J WITH CARON+foldMapping '\x01f0' s = Yield '\x006a' (CC s '\x030c' '\x0000')+-- COMBINING GREEK YPOGEGRAMMENI+foldMapping '\x0345' s = Yield '\x03b9' (CC s '\x0000' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS+foldMapping '\x0390' s = Yield '\x03b9' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS+foldMapping '\x03b0' s = Yield '\x03c5' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER FINAL SIGMA+foldMapping '\x03c2' s = Yield '\x03c3' (CC s '\x0000' '\x0000')+-- GREEK BETA SYMBOL+foldMapping '\x03d0' s = Yield '\x03b2' (CC s '\x0000' '\x0000')+-- GREEK THETA SYMBOL+foldMapping '\x03d1' s = Yield '\x03b8' (CC s '\x0000' '\x0000')+-- GREEK PHI SYMBOL+foldMapping '\x03d5' s = Yield '\x03c6' (CC s '\x0000' '\x0000')+-- GREEK PI SYMBOL+foldMapping '\x03d6' s = Yield '\x03c0' (CC s '\x0000' '\x0000')+-- GREEK KAPPA SYMBOL+foldMapping '\x03f0' s = Yield '\x03ba' (CC s '\x0000' '\x0000')+-- GREEK RHO SYMBOL+foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')+-- GREEK LUNATE EPSILON SYMBOL+foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')+-- ARMENIAN SMALL LIGATURE ECH YIWN+foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')+-- GEORGIAN CAPITAL LETTER YN+foldMapping '\x10c7' s = Yield '\x2d27' (CC s '\x0000' '\x0000')+-- GEORGIAN CAPITAL LETTER AEN+foldMapping '\x10cd' s = Yield '\x2d2d' (CC s '\x0000' '\x0000')+-- LATIN SMALL LETTER H WITH LINE BELOW+foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')+-- LATIN SMALL LETTER T WITH DIAERESIS+foldMapping '\x1e97' s = Yield '\x0074' (CC s '\x0308' '\x0000')+-- LATIN SMALL LETTER W WITH RING ABOVE+foldMapping '\x1e98' s = Yield '\x0077' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER Y WITH RING ABOVE+foldMapping '\x1e99' s = Yield '\x0079' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER A WITH RIGHT HALF RING+foldMapping '\x1e9a' s = Yield '\x0061' (CC s '\x02be' '\x0000')+-- LATIN SMALL LETTER LONG S WITH DOT ABOVE+foldMapping '\x1e9b' s = Yield '\x1e61' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER SHARP S+foldMapping '\x1e9e' s = Yield '\x0073' (CC s '\x0073' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI+foldMapping '\x1f50' s = Yield '\x03c5' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA+foldMapping '\x1f52' s = Yield '\x03c5' (CC s '\x0313' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA+foldMapping '\x1f54' s = Yield '\x03c5' (CC s '\x0313' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI+foldMapping '\x1f56' s = Yield '\x03c5' (CC s '\x0313' '\x0342')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI+foldMapping '\x1f80' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI+foldMapping '\x1f81' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1f82' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1f83' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1f84' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1f85' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1f86' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1f87' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI+foldMapping '\x1f88' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI+foldMapping '\x1f89' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1f8a' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1f8b' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1f8c' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1f8d' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1f8e' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1f8f' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI+foldMapping '\x1f90' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI+foldMapping '\x1f91' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1f92' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1f93' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1f94' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1f95' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1f96' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1f97' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI+foldMapping '\x1f98' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI+foldMapping '\x1f99' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1f9a' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1f9b' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1f9c' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1f9d' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1f9e' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1f9f' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI+foldMapping '\x1fa0' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI+foldMapping '\x1fa1' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1fa2' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1fa3' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1fa4' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1fa5' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1fa6' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1fa7' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI+foldMapping '\x1fa8' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI+foldMapping '\x1fa9' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1faa' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1fab' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1fac' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1fad' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1fae' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1faf' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI+foldMapping '\x1fb2' s = Yield '\x1f70' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI+foldMapping '\x1fb3' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI+foldMapping '\x1fb4' s = Yield '\x03ac' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI+foldMapping '\x1fb6' s = Yield '\x03b1' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1fb7' s = Yield '\x03b1' (CC s '\x0342' '\x03b9')+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI+foldMapping '\x1fbc' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')+-- GREEK PROSGEGRAMMENI+foldMapping '\x1fbe' s = Yield '\x03b9' (CC s '\x0000' '\x0000')+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI+foldMapping '\x1fc2' s = Yield '\x1f74' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI+foldMapping '\x1fc3' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI+foldMapping '\x1fc4' s = Yield '\x03ae' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI+foldMapping '\x1fc6' s = Yield '\x03b7' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1fc7' s = Yield '\x03b7' (CC s '\x0342' '\x03b9')+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI+foldMapping '\x1fcc' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA+foldMapping '\x1fd2' s = Yield '\x03b9' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA+foldMapping '\x1fd3' s = Yield '\x03b9' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI+foldMapping '\x1fd6' s = Yield '\x03b9' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI+foldMapping '\x1fd7' s = Yield '\x03b9' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA+foldMapping '\x1fe2' s = Yield '\x03c5' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA+foldMapping '\x1fe3' s = Yield '\x03c5' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER RHO WITH PSILI+foldMapping '\x1fe4' s = Yield '\x03c1' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI+foldMapping '\x1fe6' s = Yield '\x03c5' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI+foldMapping '\x1fe7' s = Yield '\x03c5' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI+foldMapping '\x1ff2' s = Yield '\x1f7c' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI+foldMapping '\x1ff3' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI+foldMapping '\x1ff4' s = Yield '\x03ce' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI+foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI+foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')+-- COPTIC CAPITAL LETTER BOHAIRIC KHEI+foldMapping '\x2cf2' s = Yield '\x2cf3' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER C WITH BAR+foldMapping '\xa792' s = Yield '\xa793' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER H WITH HOOK+foldMapping '\xa7aa' s = Yield '\x0266' (CC s '\x0000' '\x0000')+-- LATIN SMALL LIGATURE FF+foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')+-- LATIN SMALL LIGATURE FI+foldMapping '\xfb01' s = Yield '\x0066' (CC s '\x0069' '\x0000')+-- LATIN SMALL LIGATURE FL+foldMapping '\xfb02' s = Yield '\x0066' (CC s '\x006c' '\x0000')+-- LATIN SMALL LIGATURE FFI+foldMapping '\xfb03' s = Yield '\x0066' (CC s '\x0066' '\x0069')+-- LATIN SMALL LIGATURE FFL+foldMapping '\xfb04' s = Yield '\x0066' (CC s '\x0066' '\x006c')+-- LATIN SMALL LIGATURE LONG S T+foldMapping '\xfb05' s = Yield '\x0073' (CC s '\x0074' '\x0000')+-- LATIN SMALL LIGATURE ST+foldMapping '\xfb06' s = Yield '\x0073' (CC s '\x0074' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN NOW+foldMapping '\xfb13' s = Yield '\x0574' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN ECH+foldMapping '\xfb14' s = Yield '\x0574' (CC s '\x0565' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN INI+foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')+-- ARMENIAN SMALL LIGATURE VEW NOW+foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN XEH+foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')+foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
+ Data/Text/Internal/Fusion/Common.hs view
@@ -0,0 +1,950 @@+{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}+-- |+-- Module : Data.Text.Internal.Fusion.Common+-- Copyright : (c) Bryan O'Sullivan 2009, 2012+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Common stream fusion functionality for text.++module Data.Text.Internal.Fusion.Common+ (+ -- * Creation and elimination+ singleton+ , streamList+ , unstreamList+ , streamCString#++ -- * Basic interface+ , cons+ , snoc+ , append+ , head+ , uncons+ , last+ , tail+ , init+ , null+ , lengthI+ , compareLengthI+ , isSingleton++ -- * Transformations+ , map+ , intercalate+ , intersperse++ -- ** Case conversion+ -- $case+ , toCaseFold+ , toLower+ , toTitle+ , toUpper++ -- ** Justification+ , justifyLeftI++ -- * Folds+ , foldl+ , foldl'+ , foldl1+ , foldl1'+ , foldr+ , foldr1++ -- ** Special folds+ , concat+ , concatMap+ , any+ , all+ , maximum+ , minimum++ -- * Construction+ -- ** Scans+ , scanl++ -- ** Accumulating maps+ -- , mapAccumL++ -- ** Generation and unfolding+ , replicateCharI+ , replicateI+ , unfoldr+ , unfoldrNI++ -- * Substrings+ -- ** Breaking strings+ , take+ , drop+ , takeWhile+ , dropWhile++ -- * Predicates+ , isPrefixOf++ -- * Searching+ , elem+ , filter++ -- * Indexing+ , findBy+ , indexI+ , findIndexI+ , countCharI++ -- * Zipping and unzipping+ , zipWith+ ) where++import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),+ Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),+ (&&), fromIntegral, not, otherwise)+import qualified Data.List as L+import qualified Prelude as P+import Data.Bits (shiftL)+import Data.Char (isLetter)+import Data.Int (Int64)+import Data.Text.Internal.Fusion.Types+import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,+ upperMapping)+import Data.Text.Internal.Fusion.Size+import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)+import GHC.Types (Char(..), Int(..))++singleton :: Char -> Stream Char+singleton c = Stream next False 1+ where next False = Yield c True+ next True = Done+{-# INLINE singleton #-}++streamList :: [a] -> Stream a+{-# INLINE [0] streamList #-}+streamList s = Stream next s unknownSize+ where next [] = Done+ next (x:xs) = Yield x xs++unstreamList :: Stream a -> [a]+unstreamList (Stream next s0 _len) = unfold s0+ where unfold !s = case next s of+ Done -> []+ Skip s' -> unfold s'+ Yield x s' -> x : unfold s'+{-# INLINE [0] unstreamList #-}++{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}++-- | Stream the UTF-8-like packed encoding used by GHC to represent+-- constant strings in generated code.+--+-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,+-- and the string is NUL-terminated.+streamCString# :: Addr# -> Stream Char+streamCString# addr = Stream step 0 unknownSize+ where+ step !i+ | b == 0 = Done+ | b <= 0x7f = Yield (C# b#) (i+1)+ | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1+ in Yield c (i+2)+ | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) ++ (next 1 `shiftL` 6) ++ next 2+ in Yield c (i+3)+ | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) ++ (next 1 `shiftL` 12) ++ (next 2 `shiftL` 6) ++ next 3+ in Yield c (i+4)+ where b = I# (ord# b#)+ next n = I# (ord# (at# (i+n))) - 0x80+ !b# = at# i+ at# (I# i#) = indexCharOffAddr# addr i#+ chr (I# i#) = C# (chr# i#)+{-# INLINE [0] streamCString# #-}++-- ----------------------------------------------------------------------------+-- * Basic stream functions++data C s = C0 !s+ | C1 !s++-- | /O(n)/ Adds a character to the front of a Stream Char.+cons :: Char -> Stream Char -> Stream Char+cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)+ where+ next (C1 s) = Yield w (C0 s)+ next (C0 s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (C0 s')+ Yield x s' -> Yield x (C0 s')+{-# INLINE [0] cons #-}++-- | /O(n)/ Adds a character to the end of a stream.+snoc :: Stream Char -> Char -> Stream Char+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)+ where+ next (J xs) = case next0 xs of+ Done -> Yield w N+ Skip xs' -> Skip (J xs')+ Yield x xs' -> Yield x (J xs')+ next N = Done+{-# INLINE [0] snoc #-}++data E l r = L !l+ | R !r++-- | /O(n)/ Appends one Stream to the other.+append :: Stream Char -> Stream Char -> Stream Char+append (Stream next0 s01 len1) (Stream next1 s02 len2) =+ Stream next (L s01) (len1 + len2)+ where+ next (L s1) = case next0 s1 of+ Done -> Skip (R s02)+ Skip s1' -> Skip (L s1')+ Yield x s1' -> Yield x (L s1')+ next (R s2) = case next1 s2 of+ Done -> Done+ Skip s2' -> Skip (R s2')+ Yield x s2' -> Yield x (R s2')+{-# INLINE [0] append #-}++-- | /O(1)/ Returns the first character of a Text, which must be non-empty.+-- Subject to array fusion.+head :: Stream Char -> Char+head (Stream next s0 _len) = loop_head s0+ where+ loop_head !s = case next s of+ Yield x _ -> x+ Skip s' -> loop_head s'+ Done -> head_empty+{-# INLINE [0] head #-}++head_empty :: a+head_empty = streamError "head" "Empty stream"+{-# NOINLINE head_empty #-}++-- | /O(1)/ Returns the first character and remainder of a 'Stream+-- Char', or 'Nothing' if empty. Subject to array fusion.+uncons :: Stream Char -> Maybe (Char, Stream Char)+uncons (Stream next s0 len) = loop_uncons s0+ where+ loop_uncons !s = case next s of+ Yield x s1 -> Just (x, Stream next s1 (len-1))+ Skip s' -> loop_uncons s'+ Done -> Nothing+{-# INLINE [0] uncons #-}++-- | /O(n)/ Returns the last character of a 'Stream Char', which must+-- be non-empty.+last :: Stream Char -> Char+last (Stream next s0 _len) = loop0_last s0+ where+ loop0_last !s = case next s of+ Done -> emptyError "last"+ Skip s' -> loop0_last s'+ Yield x s' -> loop_last x s'+ loop_last !x !s = case next s of+ Done -> x+ Skip s' -> loop_last x s'+ Yield x' s' -> loop_last x' s'+{-# INLINE[0] last #-}++-- | /O(1)/ Returns all characters after the head of a Stream Char, which must+-- be non-empty.+tail :: Stream Char -> Stream Char+tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)+ where+ next (C0 s) = case next0 s of+ Done -> emptyError "tail"+ Skip s' -> Skip (C0 s')+ Yield _ s' -> Skip (C1 s')+ next (C1 s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (C1 s')+ Yield x s' -> Yield x (C1 s')+{-# INLINE [0] tail #-}++data Init s = Init0 !s+ | Init1 {-# UNPACK #-} !Char !s++-- | /O(1)/ Returns all but the last character of a Stream Char, which+-- must be non-empty.+init :: Stream Char -> Stream Char+init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)+ where+ next (Init0 s) = case next0 s of+ Done -> emptyError "init"+ Skip s' -> Skip (Init0 s')+ Yield x s' -> Skip (Init1 x s')+ next (Init1 x s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (Init1 x s')+ Yield x' s' -> Yield x (Init1 x' s')+{-# INLINE [0] init #-}++-- | /O(1)/ Tests whether a Stream Char is empty or not.+null :: Stream Char -> Bool+null (Stream next s0 _len) = loop_null s0+ where+ loop_null !s = case next s of+ Done -> True+ Yield _ _ -> False+ Skip s' -> loop_null s'+{-# INLINE[0] null #-}++-- | /O(n)/ Returns the number of characters in a string.+lengthI :: Integral a => Stream Char -> a+lengthI (Stream next s0 _len) = loop_length 0 s0+ where+ loop_length !z s = case next s of+ Done -> z+ Skip s' -> loop_length z s'+ Yield _ s' -> loop_length (z + 1) s'+{-# INLINE[0] lengthI #-}++-- | /O(n)/ Compares the count of characters in a string to a number.+-- Subject to fusion.+--+-- This function gives the same answer as comparing against the result+-- of 'lengthI', but can short circuit if the count of characters is+-- greater than the number, and hence be more efficient.+compareLengthI :: Integral a => Stream Char -> a -> Ordering+compareLengthI (Stream next s0 len) n =+ case exactly len of+ Nothing -> loop_cmp 0 s0+ Just i -> compare (fromIntegral i) n+ where+ loop_cmp !z s = case next s of+ Done -> compare z n+ Skip s' -> loop_cmp z s'+ Yield _ s' | z > n -> GT+ | otherwise -> loop_cmp (z + 1) s'+{-# INLINE[0] compareLengthI #-}++-- | /O(n)/ Indicate whether a string contains exactly one element.+isSingleton :: Stream Char -> Bool+isSingleton (Stream next s0 _len) = loop 0 s0+ where+ loop !z s = case next s of+ Done -> z == (1::Int)+ Skip s' -> loop z s'+ Yield _ s'+ | z >= 1 -> False+ | otherwise -> loop (z+1) s'+{-# INLINE[0] isSingleton #-}++-- ----------------------------------------------------------------------------+-- * Stream transformations++-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@+-- to each element of @xs@.+map :: (Char -> Char) -> Stream Char -> Stream Char+map f (Stream next0 s0 len) = Stream next s0 len+ where+ next !s = case next0 s of+ Done -> Done+ Skip s' -> Skip s'+ Yield x s' -> Yield (f x) s'+{-# INLINE [0] map #-}++{-#+ RULES "STREAM map/map fusion" forall f g s.+ map f (map g s) = map (\x -> f (g x)) s+ #-}++data I s = I1 !s+ | I2 !s {-# UNPACK #-} !Char+ | I3 !s++-- | /O(n)/ Take a character and place it between each of the+-- characters of a 'Stream Char'.+intersperse :: Char -> Stream Char -> Stream Char+intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len+ where+ next (I1 s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (I1 s')+ Yield x s' -> Skip (I2 s' x)+ next (I2 s x) = Yield x (I3 s)+ next (I3 s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (I3 s')+ Yield x s' -> Yield c (I2 s' x)+{-# INLINE [0] intersperse #-}++-- ----------------------------------------------------------------------------+-- ** Case conversions (folds)++-- $case+--+-- With Unicode text, it is incorrect to use combinators like @map+-- toUpper@ to case convert each character of a string individually.+-- Instead, use the whole-string case conversion functions from this+-- module. For correctness in different writing systems, these+-- functions may map one input character to two or three output+-- characters.++caseConvert :: (forall s. Char -> s -> Step (CC s) Char)+ -> Stream Char -> Stream Char+caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len+ where+ next (CC s '\0' _) =+ case next0 s of+ Done -> Done+ Skip s' -> Skip (CC s' '\0' '\0')+ Yield c s' -> remap c s'+ next (CC s a b) = Yield a (CC s b '\0')++-- | /O(n)/ Convert a string to folded case. This function is mainly+-- useful for performing caseless (or case insensitive) string+-- comparisons.+--+-- A string @x@ is a caseless match for a string @y@ if and only if:+--+-- @toCaseFold x == toCaseFold y@+--+-- The result string may be longer than the input string, and may+-- differ from applying 'toLower' to the input string. For instance,+-- the Armenian small ligature men now (U+FB13) is case folded to the+-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is+-- case folded to the Greek small letter letter mu (U+03BC) instead of+-- itself.+toCaseFold :: Stream Char -> Stream Char+toCaseFold = caseConvert foldMapping+{-# INLINE [0] toCaseFold #-}++-- | /O(n)/ Convert a string to upper case, using simple case+-- conversion. The result string may be longer than the input string.+-- For instance, the German eszett (U+00DF) maps to the two-letter+-- sequence SS.+toUpper :: Stream Char -> Stream Char+toUpper = caseConvert upperMapping+{-# INLINE [0] toUpper #-}++-- | /O(n)/ Convert a string to lower case, using simple case+-- conversion. The result string may be longer than the input string.+-- For instance, the Latin capital letter I with dot above (U+0130)+-- maps to the sequence Latin small letter i (U+0069) followed by+-- combining dot above (U+0307).+toLower :: Stream Char -> Stream Char+toLower = caseConvert lowerMapping+{-# INLINE [0] toLower #-}++-- | /O(n)/ Convert a string to title case, using simple case+-- conversion.+--+-- The first letter of the input is converted to title case, as is+-- every subsequent letter that immediately follows a non-letter.+-- Every letter that immediately follows another letter is converted+-- to lower case.+--+-- The result string may be longer than the input string. For example,+-- the Latin small ligature fl (U+FB02) is converted to the+-- sequence Latin capital letter F (U+0046) followed by Latin small+-- letter l (U+006C).+--+-- /Note/: this function does not take language or culture specific+-- rules into account. For instance, in English, different style+-- guides disagree on whether the book name \"The Hill of the Red+-- Fox\" is correctly title cased—but this function will+-- capitalize /every/ word.+toTitle :: Stream Char -> Stream Char+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len+ where+ next (CC (letter :*: s) '\0' _) =+ case next0 s of+ Done -> Done+ Skip s' -> Skip (CC (letter :*: s') '\0' '\0')+ Yield c s'+ | letter' -> if letter+ then lowerMapping c (letter' :*: s')+ else titleMapping c (letter' :*: s')+ | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')+ where letter' = isLetter c+ next (CC s a b) = Yield a (CC s b '\0')+{-# INLINE [0] toTitle #-}++justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char+justifyLeftI k c (Stream next0 s0 len) =+ Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)+ where+ next (s :*: S1 :*: n) =+ case next0 s of+ Done -> next (s :*: S2 :*: n)+ Skip s' -> Skip (s' :*: S1 :*: n)+ Yield x s' -> Yield x (s' :*: S1 :*: n+1)+ next (s :*: S2 :*: n)+ | n < k = Yield c (s :*: S2 :*: n+1)+ | otherwise = Done+ {-# INLINE next #-}+{-# INLINE [0] justifyLeftI #-}++-- ----------------------------------------------------------------------------+-- * Reducing Streams (folds)++-- | foldl, applied to a binary operator, a starting value (typically the+-- left-identity of the operator), and a Stream, reduces the Stream using the+-- binary operator, from left to right.+foldl :: (b -> Char -> b) -> b -> Stream Char -> b+foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0+ where+ loop_foldl z !s = case next s of+ Done -> z+ Skip s' -> loop_foldl z s'+ Yield x s' -> loop_foldl (f z x) s'+{-# INLINE [0] foldl #-}++-- | A strict version of foldl.+foldl' :: (b -> Char -> b) -> b -> Stream Char -> b+foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0+ where+ loop_foldl' !z !s = case next s of+ Done -> z+ Skip s' -> loop_foldl' z s'+ Yield x s' -> loop_foldl' (f z x) s'+{-# INLINE [0] foldl' #-}++-- | foldl1 is a variant of foldl that has no starting value argument,+-- and thus must be applied to non-empty Streams.+foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char+foldl1 f (Stream next s0 _len) = loop0_foldl1 s0+ where+ loop0_foldl1 !s = case next s of+ Skip s' -> loop0_foldl1 s'+ Yield x s' -> loop_foldl1 x s'+ Done -> emptyError "foldl1"+ loop_foldl1 z !s = case next s of+ Done -> z+ Skip s' -> loop_foldl1 z s'+ Yield x s' -> loop_foldl1 (f z x) s'+{-# INLINE [0] foldl1 #-}++-- | A strict version of foldl1.+foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char+foldl1' f (Stream next s0 _len) = loop0_foldl1' s0+ where+ loop0_foldl1' !s = case next s of+ Skip s' -> loop0_foldl1' s'+ Yield x s' -> loop_foldl1' x s'+ Done -> emptyError "foldl1"+ loop_foldl1' !z !s = case next s of+ Done -> z+ Skip s' -> loop_foldl1' z s'+ Yield x s' -> loop_foldl1' (f z x) s'+{-# INLINE [0] foldl1' #-}++-- | 'foldr', applied to a binary operator, a starting value (typically the+-- right-identity of the operator), and a stream, reduces the stream using the+-- binary operator, from right to left.+foldr :: (Char -> b -> b) -> b -> Stream Char -> b+foldr f z (Stream next s0 _len) = loop_foldr s0+ where+ loop_foldr !s = case next s of+ Done -> z+ Skip s' -> loop_foldr s'+ Yield x s' -> f x (loop_foldr s')+{-# INLINE [0] foldr #-}++-- | foldr1 is a variant of 'foldr' that has no starting value argument,+-- and thus must be applied to non-empty streams.+-- Subject to array fusion.+foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char+foldr1 f (Stream next s0 _len) = loop0_foldr1 s0+ where+ loop0_foldr1 !s = case next s of+ Done -> emptyError "foldr1"+ Skip s' -> loop0_foldr1 s'+ Yield x s' -> loop_foldr1 x s'++ loop_foldr1 x !s = case next s of+ Done -> x+ Skip s' -> loop_foldr1 x s'+ Yield x' s' -> f x (loop_foldr1 x' s')+{-# INLINE [0] foldr1 #-}++intercalate :: Stream Char -> [Stream Char] -> Stream Char+intercalate s = concat . (L.intersperse s)+{-# INLINE [0] intercalate #-}++-- ----------------------------------------------------------------------------+-- ** Special folds++-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.+concat :: [Stream Char] -> Stream Char+concat = L.foldr append empty+{-# INLINE [0] concat #-}++-- | Map a function over a stream that results in a stream and concatenate the+-- results.+concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char+concatMap f = foldr (append . f) empty+{-# INLINE [0] concatMap #-}++-- | /O(n)/ any @p @xs determines if any character in the stream+-- @xs@ satisifes the predicate @p@.+any :: (Char -> Bool) -> Stream Char -> Bool+any p (Stream next0 s0 _len) = loop_any s0+ where+ loop_any !s = case next0 s of+ Done -> False+ Skip s' -> loop_any s'+ Yield x s' | p x -> True+ | otherwise -> loop_any s'+{-# INLINE [0] any #-}++-- | /O(n)/ all @p @xs determines if all characters in the 'Text'+-- @xs@ satisify the predicate @p@.+all :: (Char -> Bool) -> Stream Char -> Bool+all p (Stream next0 s0 _len) = loop_all s0+ where+ loop_all !s = case next0 s of+ Done -> True+ Skip s' -> loop_all s'+ Yield x s' | p x -> loop_all s'+ | otherwise -> False+{-# INLINE [0] all #-}++-- | /O(n)/ maximum returns the maximum value from a stream, which must be+-- non-empty.+maximum :: Stream Char -> Char+maximum (Stream next0 s0 _len) = loop0_maximum s0+ where+ loop0_maximum !s = case next0 s of+ Done -> emptyError "maximum"+ Skip s' -> loop0_maximum s'+ Yield x s' -> loop_maximum x s'+ loop_maximum !z !s = case next0 s of+ Done -> z+ Skip s' -> loop_maximum z s'+ Yield x s'+ | x > z -> loop_maximum x s'+ | otherwise -> loop_maximum z s'+{-# INLINE [0] maximum #-}++-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be+-- non-empty.+minimum :: Stream Char -> Char+minimum (Stream next0 s0 _len) = loop0_minimum s0+ where+ loop0_minimum !s = case next0 s of+ Done -> emptyError "minimum"+ Skip s' -> loop0_minimum s'+ Yield x s' -> loop_minimum x s'+ loop_minimum !z !s = case next0 s of+ Done -> z+ Skip s' -> loop_minimum z s'+ Yield x s'+ | x < z -> loop_minimum x s'+ | otherwise -> loop_minimum z s'+{-# INLINE [0] minimum #-}++-- -----------------------------------------------------------------------------+-- * Building streams++scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char+scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low+ where+ {-# INLINE next #-}+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)+ next (S2 :*: z :*: s) = case next0 s of+ Yield x s' -> let !x' = f z x+ in Yield x' (S2 :*: x' :*: s')+ Skip s' -> Skip (S2 :*: z :*: s')+ Done -> Done+{-# INLINE [0] scanl #-}++-- -----------------------------------------------------------------------------+-- ** Accumulating maps++{-+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a+-- function to each element of a stream, passing an accumulating+-- parameter from left to right, and returns a final stream.+--+-- /Note/: Unlike the version over lists, this function does not+-- return a final value for the accumulator, because the nature of+-- streams precludes it.+mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b+mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f+ where+ {-# INLINE next #-}+ next (s :*: z) = case next0 s of+ Yield x s' -> let (z',y) = f z x+ in Yield y (s' :*: z')+ Skip s' -> Skip (s' :*: z)+ Done -> Done+{-# INLINE [0] mapAccumL #-}+-}++-- -----------------------------------------------------------------------------+-- ** Generating and unfolding streams++replicateCharI :: Integral a => a -> Char -> Stream Char+replicateCharI n c+ | n < 0 = empty+ | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low+ where+ next i | i >= n = Done+ | otherwise = Yield c (i + 1)+{-# INLINE [0] replicateCharI #-}++data RI s = RI !s {-# UNPACK #-} !Int64++replicateI :: Int64 -> Stream Char -> Stream Char+replicateI n (Stream next0 s0 len) =+ Stream next (RI s0 0) (fromIntegral (max 0 n) * len)+ where+ next (RI s k)+ | k >= n = Done+ | otherwise = case next0 s of+ Done -> Skip (RI s0 (k+1))+ Skip s' -> Skip (RI s' k)+ Yield x s' -> Yield x (RI s' k)+{-# INLINE [0] replicateI #-}++-- | /O(n)/, where @n@ is the length of the result. The unfoldr function+-- is analogous to the List 'unfoldr'. unfoldr builds a stream+-- from a seed value. The function takes the element and returns+-- Nothing if it is done producing the stream or returns Just+-- (a,b), in which case, a is the next Char in the string, and b is+-- the seed value for further production.+unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char+unfoldr f s0 = Stream next s0 1 -- HINT maybe too low+ where+ {-# INLINE next #-}+ next !s = case f s of+ Nothing -> Done+ Just (w, s') -> Yield w s'+{-# INLINE [0] unfoldr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed+-- value. However, the length of the result is limited by the+-- first argument to 'unfoldrNI'. This function is more efficient than+-- 'unfoldr' when the length of the result is known.+unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char+unfoldrNI n f s0 | n < 0 = empty+ | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high+ where+ {-# INLINE next #-}+ next (z :*: s) = case f s of+ Nothing -> Done+ Just (w, s') | z >= n -> Done+ | otherwise -> Yield w ((z + 1) :*: s')+{-# INLINE unfoldrNI #-}++-------------------------------------------------------------------------------+-- * Substreams++-- | /O(n)/ take n, applied to a stream, returns the prefix of the+-- stream of length @n@, or the stream itself if @n@ is greater than the+-- length of the stream.+take :: Integral a => a -> Stream Char -> Stream Char+take n0 (Stream next0 s0 len) =+ Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))+ where+ {-# INLINE next #-}+ next (n :*: s) | n <= 0 = Done+ | otherwise = case next0 s of+ Done -> Done+ Skip s' -> Skip (n :*: s')+ Yield x s' -> Yield x ((n-1) :*: s')+{-# INLINE [0] take #-}++-- | /O(n)/ drop n, applied to a stream, returns the suffix of the+-- stream after the first @n@ characters, or the empty stream if @n@+-- is greater than the length of the stream.+drop :: Integral a => a -> Stream Char -> Stream Char+drop n0 (Stream next0 s0 len) =+ Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))+ where+ {-# INLINE next #-}+ next (J n :*: s)+ | n <= 0 = Skip (N :*: s)+ | otherwise = case next0 s of+ Done -> Done+ Skip s' -> Skip (J n :*: s')+ Yield _ s' -> Skip (J (n-1) :*: s')+ next (N :*: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (N :*: s')+ Yield x s' -> Yield x (N :*: s')+{-# INLINE [0] drop #-}++-- | takeWhile, applied to a predicate @p@ and a stream, returns the+-- longest prefix (possibly empty) of elements that satisfy p.+takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char+takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high+ where+ {-# INLINE next #-}+ next !s = case next0 s of+ Done -> Done+ Skip s' -> Skip s'+ Yield x s' | p x -> Yield x s'+ | otherwise -> Done+{-# INLINE [0] takeWhile #-}++-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.+dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char+dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high+ where+ {-# INLINE next #-}+ next (S1 :*: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S1 :*: s')+ Yield x s' | p x -> Skip (S1 :*: s')+ | otherwise -> Yield x (S2 :*: s')+ next (S2 :*: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S2 :*: s')+ Yield x s' -> Yield x (S2 :*: s')+{-# INLINE [0] dropWhile #-}++-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns+-- 'True' iff the first is a prefix of the second.+isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool+isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)+ where+ loop Done _ = True+ loop _ Done = False+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')+ loop (Skip s1') x2 = loop (next1 s1') x2+ loop x1 (Skip s2') = loop x1 (next2 s2')+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&+ loop (next1 s1') (next2 s2')+{-# INLINE [0] isPrefixOf #-}++-- ----------------------------------------------------------------------------+-- * Searching++-------------------------------------------------------------------------------+-- ** Searching by equality++-- | /O(n)/ elem is the stream membership predicate.+elem :: Char -> Stream Char -> Bool+elem w (Stream next s0 _len) = loop_elem s0+ where+ loop_elem !s = case next s of+ Done -> False+ Skip s' -> loop_elem s'+ Yield x s' | x == w -> True+ | otherwise -> loop_elem s'+{-# INLINE [0] elem #-}++-------------------------------------------------------------------------------+-- ** Searching with a predicate++-- | /O(n)/ The 'findBy' function takes a predicate and a stream,+-- and returns the first element in matching the predicate, or 'Nothing'+-- if there is no such element.++findBy :: (Char -> Bool) -> Stream Char -> Maybe Char+findBy p (Stream next s0 _len) = loop_find s0+ where+ loop_find !s = case next s of+ Done -> Nothing+ Skip s' -> loop_find s'+ Yield x s' | p x -> Just x+ | otherwise -> loop_find s'+{-# INLINE [0] findBy #-}++-- | /O(n)/ Stream index (subscript) operator, starting from 0.+indexI :: Integral a => Stream Char -> a -> Char+indexI (Stream next s0 _len) n0+ | n0 < 0 = streamError "index" "Negative index"+ | otherwise = loop_index n0 s0+ where+ loop_index !n !s = case next s of+ Done -> streamError "index" "Index too large"+ Skip s' -> loop_index n s'+ Yield x s' | n == 0 -> x+ | otherwise -> loop_index (n-1) s'+{-# INLINE [0] indexI #-}++-- | /O(n)/ 'filter', applied to a predicate and a stream,+-- returns a stream containing those characters that satisfy the+-- predicate.+filter :: (Char -> Bool) -> Stream Char -> Stream Char+filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high+ where+ next !s = case next0 s of+ Done -> Done+ Skip s' -> Skip s'+ Yield x s' | p x -> Yield x s'+ | otherwise -> Skip s'+{-# INLINE [0] filter #-}++{-# RULES+ "STREAM filter/filter fusion" forall p q s.+ filter p (filter q s) = filter (\x -> q x && p x) s+ #-}++-- | The 'findIndexI' function takes a predicate and a stream and+-- returns the index of the first element in the stream satisfying the+-- predicate.+findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a+findIndexI p s = case findIndicesI p s of+ (i:_) -> Just i+ _ -> Nothing+{-# INLINE [0] findIndexI #-}++-- | The 'findIndicesI' function takes a predicate and a stream and+-- returns all indices of the elements in the stream satisfying the+-- predicate.+findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]+findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0+ where+ loop_findIndex !i !s = case next s of+ Done -> []+ Skip s' -> loop_findIndex i s' -- hmm. not caught by QC+ Yield x s' | p x -> i : loop_findIndex (i+1) s'+ | otherwise -> loop_findIndex (i+1) s'+{-# INLINE [0] findIndicesI #-}++-------------------------------------------------------------------------------+-- * Zipping++-- | zipWith generalises 'zip' by zipping with the function given as+-- the first argument, instead of a tupling function.+zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =+ Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)+ where+ next (sa :*: sb :*: N) = case next0 sa of+ Done -> Done+ Skip sa' -> Skip (sa' :*: sb :*: N)+ Yield a sa' -> Skip (sa' :*: sb :*: J a)++ next (sa' :*: sb :*: J a) = case next1 sb of+ Done -> Done+ Skip sb' -> Skip (sa' :*: sb' :*: J a)+ Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)+{-# INLINE [0] zipWith #-}++-- | /O(n)/ The 'countCharI' function returns the number of times the+-- query element appears in the given stream.+countCharI :: Integral a => Char -> Stream Char -> a+countCharI a (Stream next s0 _len) = loop 0 s0+ where+ loop !i !s = case next s of+ Done -> i+ Skip s' -> loop i s'+ Yield x s' | a == x -> loop (i+1) s'+ | otherwise -> loop i s'+{-# INLINE [0] countCharI #-}++streamError :: String -> String -> a+streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg++emptyError :: String -> a+emptyError func = internalError func "Empty input"++internalError :: String -> a+internalError func = streamError func "Internal error"
+ Data/Text/Internal/Fusion/Size.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-missing-methods #-}+-- |+-- Module : Data.Text.Internal.Fusion.Internal+-- Copyright : (c) Roman Leshchinskiy 2008,+-- (c) Bryan O'Sullivan 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Size hints.++module Data.Text.Internal.Fusion.Size+ (+ Size+ , exactly+ , exactSize+ , maxSize+ , unknownSize+ , smaller+ , larger+ , upperBound+ , isEmpty+ ) where++#if defined(ASSERTS)+import Control.Exception (assert)+#endif++data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.+ | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.+ | Unknown -- ^ Unknown size.+ deriving (Eq, Show)++exactly :: Size -> Maybe Int+exactly (Exact n) = Just n+exactly _ = Nothing+{-# INLINE exactly #-}++exactSize :: Int -> Size+exactSize n =+#if defined(ASSERTS)+ assert (n >= 0)+#endif+ Exact n+{-# INLINE exactSize #-}++maxSize :: Int -> Size+maxSize n =+#if defined(ASSERTS)+ assert (n >= 0)+#endif+ Max n+{-# INLINE maxSize #-}++unknownSize :: Size+unknownSize = Unknown+{-# INLINE unknownSize #-}++instance Num Size where+ (+) = addSize+ (-) = subtractSize+ (*) = mulSize++ fromInteger = f where f = Exact . fromInteger+ {-# INLINE f #-}++add :: Int -> Int -> Int+add m n | mn >= 0 = mn+ | otherwise = overflowError+ where mn = m + n+{-# INLINE add #-}++addSize :: Size -> Size -> Size+addSize (Exact m) (Exact n) = Exact (add m n)+addSize (Exact m) (Max n) = Max (add m n)+addSize (Max m) (Exact n) = Max (add m n)+addSize (Max m) (Max n) = Max (add m n)+addSize _ _ = Unknown+{-# INLINE addSize #-}++subtractSize :: Size -> Size -> Size+subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)+subtractSize (Exact m) (Max _) = Max m+subtractSize (Max m) (Exact n) = Max (max (m-n) 0)+subtractSize a@(Max _) (Max _) = a+subtractSize a@(Max _) Unknown = a+subtractSize _ _ = Unknown+{-# INLINE subtractSize #-}++mul :: Int -> Int -> Int+mul m n+ | m <= maxBound `quot` n = m * n+ | otherwise = overflowError+{-# INLINE mul #-}++mulSize :: Size -> Size -> Size+mulSize (Exact m) (Exact n) = Exact (mul m n)+mulSize (Exact m) (Max n) = Max (mul m n)+mulSize (Max m) (Exact n) = Max (mul m n)+mulSize (Max m) (Max n) = Max (mul m n)+mulSize _ _ = Unknown+{-# INLINE mulSize #-}++-- | Minimum of two size hints.+smaller :: Size -> Size -> Size+smaller (Exact m) (Exact n) = Exact (m `min` n)+smaller (Exact m) (Max n) = Max (m `min` n)+smaller (Exact m) Unknown = Max m+smaller (Max m) (Exact n) = Max (m `min` n)+smaller (Max m) (Max n) = Max (m `min` n)+smaller a@(Max _) Unknown = a+smaller Unknown (Exact n) = Max n+smaller Unknown (Max n) = Max n+smaller Unknown Unknown = Unknown+{-# INLINE smaller #-}++-- | Maximum of two size hints.+larger :: Size -> Size -> Size+larger (Exact m) (Exact n) = Exact (m `max` n)+larger a@(Exact m) b@(Max n) | m >= n = a+ | otherwise = b+larger a@(Max m) b@(Exact n) | n >= m = b+ | otherwise = a+larger (Max m) (Max n) = Max (m `max` n)+larger _ _ = Unknown+{-# INLINE larger #-}++-- | Compute the maximum size from a size hint, if possible.+upperBound :: Int -> Size -> Int+upperBound _ (Exact n) = n+upperBound _ (Max n) = n+upperBound k _ = k+{-# INLINE upperBound #-}++isEmpty :: Size -> Bool+isEmpty (Exact n) = n <= 0+isEmpty (Max n) = n <= 0+isEmpty _ = False+{-# INLINE isEmpty #-}++overflowError :: Int+overflowError = error "Data.Text.Internal.Fusion.Size: size overflow"
+ Data/Text/Internal/Fusion/Types.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE BangPatterns, ExistentialQuantification #-}+-- |+-- Module : Data.Text.Internal.Fusion.Types+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009,+-- (c) Jasper Van der Jeugt 2011+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Core stream fusion functionality for text.++module Data.Text.Internal.Fusion.Types+ (+ CC(..)+ , M(..)+ , M8+ , PairS(..)+ , RS(..)+ , Step(..)+ , Stream(..)+ , Switch(..)+ , empty+ ) where++import Data.Text.Internal.Fusion.Size+import Data.Word (Word8)++-- | Specialised tuple for case conversion.+data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char++-- | Specialised, strict Maybe-like type.+data M a = N+ | J !a++type M8 = M Word8++-- Restreaming state.+data RS s+ = RS0 !s+ | RS1 !s {-# UNPACK #-} !Word8+ | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8+ | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8++infixl 2 :*:+data PairS a b = !a :*: !b+ -- deriving (Eq, Ord, Show)++-- | Allow a function over a stream to switch between two states.+data Switch = S1 | S2++data Step s a = Done+ | Skip !s+ | Yield !a !s++{-+instance (Show a) => Show (Step s a)+ where show Done = "Done"+ show (Skip _) = "Skip"+ show (Yield x _) = "Yield " ++ show x+-}++instance (Eq a) => Eq (Stream a) where+ (==) = eq++instance (Ord a) => Ord (Stream a) where+ compare = cmp++-- The length hint in a Stream has two roles. If its value is zero,+-- we trust it, and treat the stream as empty. Otherwise, we treat it+-- as a hint: it should usually be accurate, so we use it when+-- unstreaming to decide what size array to allocate. However, the+-- unstreaming functions must be able to cope with the hint being too+-- small or too large.+--+-- The size hint tries to track the UTF-16 code points in a stream,+-- but often counts the number of characters instead. It can easily+-- undercount if, for instance, a transformed stream contains astral+-- plane characters (those above 0x10000).++data Stream a =+ forall s. Stream+ (s -> Step s a) -- stepper function+ !s -- current state+ !Size -- size hint++-- | /O(n)/ Determines if two streams are equal.+eq :: (Eq a) => Stream a -> Stream a -> Bool+eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)+ where+ loop Done Done = True+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')+ loop (Skip s1') x2 = loop (next1 s1') x2+ loop x1 (Skip s2') = loop x1 (next2 s2')+ loop Done _ = False+ loop _ Done = False+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&+ loop (next1 s1') (next2 s2')+{-# INLINE [0] eq #-}++cmp :: (Ord a) => Stream a -> Stream a -> Ordering+cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)+ where+ loop Done Done = EQ+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')+ loop (Skip s1') x2 = loop (next1 s1') x2+ loop x1 (Skip s2') = loop x1 (next2 s2')+ loop Done _ = LT+ loop _ Done = GT+ loop (Yield x1 s1') (Yield x2 s2') =+ case compare x1 x2 of+ EQ -> loop (next1 s1') (next2 s2')+ other -> other+{-# INLINE [0] cmp #-}++-- | The empty stream.+empty :: Stream a+empty = Stream next () 0+ where next _ = Done+{-# INLINE [0] empty #-}
+ Data/Text/Internal/IO.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}+-- |+-- Module : Data.Text.Internal.IO+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan,+-- (c) 2009 Simon Marlow+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Low-level support for text I\/O.++module Data.Text.Internal.IO+ (+ hGetLineWith+ , readChunk+ ) where++import qualified Control.Exception as E+import Data.IORef (readIORef, writeIORef)+import Data.Text (Text)+import Data.Text.Internal.Fusion (unstream)+import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))+import Data.Text.Internal.Fusion.Size (exactSize, maxSize)+import Data.Text.Unsafe (inlinePerformIO)+import Foreign.Storable (peekElemOff)+import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,+ bufferElems, charSize, isEmptyBuffer, readCharBuf,+ withRawBuffer, writeCharBuf)+import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_)+import GHC.IO.Handle.Types (Handle__(..), Newline(..))+import System.IO (Handle)+import System.IO.Error (isEOFError)+import qualified Data.Text as T++-- | Read a single line of input from a handle, constructing a list of+-- decoded chunks as we go. When we're done, transform them into the+-- destination type.+hGetLineWith :: ([Text] -> t) -> Handle -> IO t+hGetLineWith f h = wantReadableHandle_ "hGetLine" h go+ where+ go hh@Handle__{..} = readIORef haCharBuffer >>= fmap f . hGetLineLoop hh []++hGetLineLoop :: Handle__ -> [Text] -> CharBuffer -> IO [Text]+hGetLineLoop hh@Handle__{..} = go where+ go ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do+ let findEOL raw r | r == w = return (False, w)+ | otherwise = do+ (c,r') <- readCharBuf raw r+ if c == '\n'+ then return (True, r)+ else findEOL raw r'+ (eol, off) <- findEOL raw0 r0+ (t,r') <- if haInputNL == CRLF+ then unpack_nl raw0 r0 off+ else do t <- unpack raw0 r0 off+ return (t,off)+ if eol+ then do writeIORef haCharBuffer (bufferAdjustL (off+1) buf)+ return $ reverse (t:ts)+ else do+ let buf1 = bufferAdjustL r' buf+ maybe_buf <- maybeFillReadBuffer hh buf1+ case maybe_buf of+ -- Nothing indicates we caught an EOF, and we may have a+ -- partial line to return.+ Nothing -> do+ -- we reached EOF. There might be a lone \r left+ -- in the buffer, so check for that and+ -- append it to the line if necessary.+ let pre | isEmptyBuffer buf1 = T.empty+ | otherwise = T.singleton '\r'+ writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }+ let str = reverse . filter (not . T.null) $ pre:t:ts+ if null str+ then ioe_EOF+ else return str+ Just new_buf -> go (t:ts) new_buf++-- This function is lifted almost verbatim from GHC.IO.Handle.Text.+maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)+maybeFillReadBuffer handle_ buf+ = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->+ if isEOFError e+ then return Nothing+ else ioError e++unpack :: RawCharBuffer -> Int -> Int -> IO Text+unpack !buf !r !w+ | charSize /= 4 = sizeError "unpack"+ | r >= w = return T.empty+ | otherwise = withRawBuffer buf go+ where+ go pbuf = return $! unstream (Stream next r (exactSize (w-r)))+ where+ next !i | i >= w = Done+ | otherwise = Yield (ix i) (i+1)+ ix i = inlinePerformIO $ peekElemOff pbuf i++unpack_nl :: RawCharBuffer -> Int -> Int -> IO (Text, Int)+unpack_nl !buf !r !w+ | charSize /= 4 = sizeError "unpack_nl"+ | r >= w = return (T.empty, 0)+ | otherwise = withRawBuffer buf $ go+ where+ go pbuf = do+ let !t = unstream (Stream next r (maxSize (w-r)))+ w' = w - 1+ return $ if ix w' == '\r'+ then (t,w')+ else (t,w)+ where+ next !i | i >= w = Done+ | c == '\r' = let i' = i + 1+ in if i' < w+ then if ix i' == '\n'+ then Yield '\n' (i+2)+ else Yield '\n' i'+ else Done+ | otherwise = Yield c (i+1)+ where c = ix i+ ix i = inlinePerformIO $ peekElemOff pbuf i++-- This function is completely lifted from GHC.IO.Handle.Text.+getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer+getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =+ case bufferElems buf of+ -- buffer empty: read some more+ 0 -> {-# SCC "readTextDevice" #-} readTextDevice handle_ buf++ -- if the buffer has a single '\r' in it and we're doing newline+ -- translation: read some more+ 1 | haInputNL == CRLF -> do+ (c,_) <- readCharBuf bufRaw bufL+ if c == '\r'+ then do -- shuffle the '\r' to the beginning. This is only safe+ -- if we're about to call readTextDevice, otherwise it+ -- would mess up flushCharBuffer.+ -- See [note Buffer Flushing], GHC.IO.Handle.Types+ _ <- writeCharBuf bufRaw 0 '\r'+ let buf' = buf{ bufL=0, bufR=1 }+ readTextDevice handle_ buf'+ else do+ return buf++ -- buffer has some chars in it already: just return it+ _otherwise -> {-# SCC "otherwise" #-} return buf++-- | Read a single chunk of strict text from a buffer. Used by both+-- the strict and lazy implementations of hGetContents.+readChunk :: Handle__ -> CharBuffer -> IO Text+readChunk hh@Handle__{..} buf = do+ buf'@Buffer{..} <- getSomeCharacters hh buf+ (t,r) <- if haInputNL == CRLF+ then unpack_nl bufRaw bufL bufR+ else do t <- unpack bufRaw bufL bufR+ return (t,bufR)+ writeIORef haCharBuffer (bufferAdjustL r buf')+ return t++sizeError :: String -> a+sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"
+ Data/Text/Internal/Lazy.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}+-- |+-- Module : Data.Text.Internal.Lazy+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- A module containing private 'Text' internals. This exposes the+-- 'Text' representation and low level construction functions.+-- Modules which extend the 'Text' system may need to use this module.++module Data.Text.Internal.Lazy+ (+ Text(..)+ , chunk+ , empty+ , foldrChunks+ , foldlChunks+ -- * Data type invariant and abstraction functions++ -- $invariant+ , strictInvariant+ , lazyInvariant+ , showStructure++ -- * Chunk allocation sizes+ , defaultChunkSize+ , smallChunkSize+ , chunkOverhead+ ) where++import Data.Text ()+import Data.Text.Internal.Unsafe.Shift (shiftL)+import Data.Typeable (Typeable)+import Foreign.Storable (sizeOf)+import qualified Data.Text.Internal as T++data Text = Empty+ | Chunk {-# UNPACK #-} !T.Text Text+ deriving (Typeable)++-- $invariant+--+-- The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or+-- consists of non-null 'T.Text's. All functions must preserve this,+-- and the QC properties must check this.++-- | Check the invariant strictly.+strictInvariant :: Text -> Bool+strictInvariant Empty = True+strictInvariant x@(Chunk (T.Text _ _ len) cs)+ | len > 0 = strictInvariant cs+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "+ ++ showStructure x++-- | Check the invariant lazily.+lazyInvariant :: Text -> Text+lazyInvariant Empty = Empty+lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)+ | len > 0 = Chunk c (lazyInvariant cs)+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "+ ++ showStructure x++-- | Display the internal structure of a lazy 'Text'.+showStructure :: Text -> String+showStructure Empty = "Empty"+showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"+showStructure (Chunk t ts) =+ "Chunk " ++ show t ++ " (" ++ showStructure 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++-- | Smart constructor for 'Empty'.+empty :: Text+{-# INLINE [0] empty #-}+empty = Empty++-- | Consume the chunks of a lazy 'Text' with a natural right fold.+foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a+foldrChunks f z = go+ where go Empty = z+ go (Chunk c cs) = f c (go cs)+{-# INLINE foldrChunks #-}++-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,+-- accumulating left fold.+foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a+foldlChunks f z = go z+ where go !a Empty = a+ go !a (Chunk c cs) = go (f a c) cs+{-# INLINE foldlChunks #-}++-- | Currently set to 16 KiB, less the memory management overhead.+defaultChunkSize :: Int+defaultChunkSize = 16384 - chunkOverhead+{-# INLINE defaultChunkSize #-}++-- | Currently set to 128 bytes, less the memory management overhead.+smallChunkSize :: Int+smallChunkSize = 128 - chunkOverhead+{-# INLINE smallChunkSize #-}++-- | The memory management overhead. Currently this is tuned for GHC only.+chunkOverhead :: Int+chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1+{-# INLINE chunkOverhead #-}
+ Data/Text/Internal/Lazy/Encoding/Fusion.hs view
@@ -0,0 +1,324 @@+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}++-- |+-- Module : Data.Text.Lazy.Encoding.Fusion+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Fusible 'Stream'-oriented functions for converting between lazy+-- 'Text' and several common encodings.++module Data.Text.Internal.Lazy.Encoding.Fusion+ (+ -- * Streaming+ -- streamASCII+ streamUtf8+ , streamUtf16LE+ , streamUtf16BE+ , streamUtf32LE+ , streamUtf32BE++ -- * Unstreaming+ , unstream++ , module Data.Text.Internal.Encoding.Fusion.Common+ ) where++import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import Data.Text.Internal.Encoding.Fusion.Common+import Data.Text.Encoding.Error+import Data.Text.Internal.Fusion (Step(..), Stream(..))+import Data.Text.Internal.Fusion.Size+import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)+import Data.Text.Internal.Unsafe.Shift (shiftL)+import Data.Word (Word8, Word16, Word32)+import qualified Data.Text.Internal.Encoding.Utf8 as U8+import qualified Data.Text.Internal.Encoding.Utf16 as U16+import qualified Data.Text.Internal.Encoding.Utf32 as U32+import Data.Text.Unsafe (unsafeDupablePerformIO)+import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)+import Foreign.Storable (pokeByteOff)+import Data.ByteString.Internal (mallocByteString, memcpy)+#if defined(ASSERTS)+import Control.Exception (assert)+#endif+import qualified Data.ByteString.Internal as B++data S = S0+ | S1 {-# UNPACK #-} !Word8+ | S2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8+ | S3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8+ | S4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8++data T = T !ByteString !S {-# UNPACK #-} !Int++-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using+-- UTF-8 encoding.+streamUtf8 :: OnDecodeError -> ByteString -> Stream Char+streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize+ where+ next (T bs@(Chunk ps _) S0 i)+ | i < len && U8.validate1 a =+ Yield (unsafeChr8 a) (T bs S0 (i+1))+ | i + 1 < len && U8.validate2 a b =+ Yield (U8.chr2 a b) (T bs S0 (i+2))+ | i + 2 < len && U8.validate3 a b c =+ Yield (U8.chr3 a b c) (T bs S0 (i+3))+ | i + 3 < len && U8.validate4 a b c d =+ Yield (U8.chr4 a b c d) (T bs S0 (i+4))+ where len = B.length ps+ a = B.unsafeIndex ps i+ b = B.unsafeIndex ps (i+1)+ c = B.unsafeIndex ps (i+2)+ d = B.unsafeIndex ps (i+3)+ next st@(T bs s i) =+ case s of+ S1 a | U8.validate1 a -> Yield (unsafeChr8 a) es+ S2 a b | U8.validate2 a b -> Yield (U8.chr2 a b) es+ S3 a b c | U8.validate3 a b c -> Yield (U8.chr3 a b c) es+ S4 a b c d | U8.validate4 a b c d -> Yield (U8.chr4 a b c d) es+ _ -> consume st+ where es = T bs S0 i+ consume (T bs@(Chunk ps rest) s i)+ | i >= B.length ps = consume (T rest s 0)+ | otherwise =+ case s of+ S0 -> next (T bs (S1 x) (i+1))+ S1 a -> next (T bs (S2 a x) (i+1))+ S2 a b -> next (T bs (S3 a b x) (i+1))+ S3 a b c -> next (T bs (S4 a b c x) (i+1))+ S4 a b c d -> decodeError "streamUtf8" "UTF-8" onErr (Just a)+ (T bs (S3 b c d) (i+1))+ where x = B.unsafeIndex ps i+ consume (T Empty S0 _) = Done+ consume st = decodeError "streamUtf8" "UTF-8" onErr Nothing st+{-# INLINE [0] streamUtf8 #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little+-- endian UTF-16 encoding.+streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char+streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize+ where+ next (T bs@(Chunk ps _) S0 i)+ | i + 1 < len && U16.validate1 x1 =+ Yield (unsafeChr x1) (T bs S0 (i+2))+ | i + 3 < len && U16.validate2 x1 x2 =+ Yield (U16.chr2 x1 x2) (T bs S0 (i+4))+ where len = B.length ps+ x1 = c (idx i) (idx (i + 1))+ x2 = c (idx (i + 2)) (idx (i + 3))+ c w1 w2 = w1 + (w2 `shiftL` 8)+ idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16+ next st@(T bs s i) =+ case s of+ S2 w1 w2 | U16.validate1 (c w1 w2) ->+ Yield (unsafeChr (c w1 w2)) es+ S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->+ Yield (U16.chr2 (c w1 w2) (c w3 w4)) es+ _ -> consume st+ where es = T bs S0 i+ c :: Word8 -> Word8 -> Word16+ c w1 w2 = fromIntegral w1 + (fromIntegral w2 `shiftL` 8)+ consume (T bs@(Chunk ps rest) s i)+ | i >= B.length ps = consume (T rest s 0)+ | otherwise =+ case s of+ S0 -> next (T bs (S1 x) (i+1))+ S1 w1 -> next (T bs (S2 w1 x) (i+1))+ S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))+ S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))+ S4 w1 w2 w3 w4 -> decodeError "streamUtf16LE" "UTF-16LE" onErr (Just w1)+ (T bs (S3 w2 w3 w4) (i+1))+ where x = B.unsafeIndex ps i+ consume (T Empty S0 _) = Done+ consume st = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing st+{-# INLINE [0] streamUtf16LE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big+-- endian UTF-16 encoding.+streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char+streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize+ where+ next (T bs@(Chunk ps _) S0 i)+ | i + 1 < len && U16.validate1 x1 =+ Yield (unsafeChr x1) (T bs S0 (i+2))+ | i + 3 < len && U16.validate2 x1 x2 =+ Yield (U16.chr2 x1 x2) (T bs S0 (i+4))+ where len = B.length ps+ x1 = c (idx i) (idx (i + 1))+ x2 = c (idx (i + 2)) (idx (i + 3))+ c w1 w2 = (w1 `shiftL` 8) + w2+ idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16+ next st@(T bs s i) =+ case s of+ S2 w1 w2 | U16.validate1 (c w1 w2) ->+ Yield (unsafeChr (c w1 w2)) es+ S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->+ Yield (U16.chr2 (c w1 w2) (c w3 w4)) es+ _ -> consume st+ where es = T bs S0 i+ c :: Word8 -> Word8 -> Word16+ c w1 w2 = (fromIntegral w1 `shiftL` 8) + fromIntegral w2+ consume (T bs@(Chunk ps rest) s i)+ | i >= B.length ps = consume (T rest s 0)+ | otherwise =+ case s of+ S0 -> next (T bs (S1 x) (i+1))+ S1 w1 -> next (T bs (S2 w1 x) (i+1))+ S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))+ S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))+ S4 w1 w2 w3 w4 -> decodeError "streamUtf16BE" "UTF-16BE" onErr (Just w1)+ (T bs (S3 w2 w3 w4) (i+1))+ where x = B.unsafeIndex ps i+ consume (T Empty S0 _) = Done+ consume st = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing st+{-# INLINE [0] streamUtf16BE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big+-- endian UTF-32 encoding.+streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char+streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize+ where+ next (T bs@(Chunk ps _) S0 i)+ | i + 3 < len && U32.validate x =+ Yield (unsafeChr32 x) (T bs S0 (i+4))+ where len = B.length ps+ x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4+ x1 = idx i+ x2 = idx (i+1)+ x3 = idx (i+2)+ x4 = idx (i+3)+ idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32+ next st@(T bs s i) =+ case s of+ S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->+ Yield (unsafeChr32 (c w1 w2 w3 w4)) es+ _ -> consume st+ where es = T bs S0 i+ c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32+ c w1 w2 w3 w4 = shifted+ where+ shifted = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4+ x1 = fromIntegral w1+ x2 = fromIntegral w2+ x3 = fromIntegral w3+ x4 = fromIntegral w4+ consume (T bs@(Chunk ps rest) s i)+ | i >= B.length ps = consume (T rest s 0)+ | otherwise =+ case s of+ S0 -> next (T bs (S1 x) (i+1))+ S1 w1 -> next (T bs (S2 w1 x) (i+1))+ S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))+ S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))+ S4 w1 w2 w3 w4 -> decodeError "streamUtf32BE" "UTF-32BE" onErr (Just w1)+ (T bs (S3 w2 w3 w4) (i+1))+ where x = B.unsafeIndex ps i+ consume (T Empty S0 _) = Done+ consume st = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing st+{-# INLINE [0] streamUtf32BE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little+-- endian UTF-32 encoding.+streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char+streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize+ where+ next (T bs@(Chunk ps _) S0 i)+ | i + 3 < len && U32.validate x =+ Yield (unsafeChr32 x) (T bs S0 (i+4))+ where len = B.length ps+ x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1+ x1 = idx i+ x2 = idx (i+1)+ x3 = idx (i+2)+ x4 = idx (i+3)+ idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32+ next st@(T bs s i) =+ case s of+ S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->+ Yield (unsafeChr32 (c w1 w2 w3 w4)) es+ _ -> consume st+ where es = T bs S0 i+ c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32+ c w1 w2 w3 w4 = shifted+ where+ shifted = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1+ x1 = fromIntegral w1+ x2 = fromIntegral w2+ x3 = fromIntegral w3+ x4 = fromIntegral w4+ consume (T bs@(Chunk ps rest) s i)+ | i >= B.length ps = consume (T rest s 0)+ | otherwise =+ case s of+ S0 -> next (T bs (S1 x) (i+1))+ S1 w1 -> next (T bs (S2 w1 x) (i+1))+ S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))+ S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))+ S4 w1 w2 w3 w4 -> decodeError "streamUtf32LE" "UTF-32LE" onErr (Just w1)+ (T bs (S3 w2 w3 w4) (i+1))+ where x = B.unsafeIndex ps i+ consume (T Empty S0 _) = Done+ consume st = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing st+{-# INLINE [0] streamUtf32LE #-}++-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.+unstreamChunks :: Int -> Stream Word8 -> ByteString+unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)+ where chunk s1 len1 = unsafeDupablePerformIO $ do+ let len = max 4 (min len1 chunkSize)+ mallocByteString len >>= loop len 0 s1+ where+ loop !n !off !s fp = case next s of+ Done | off == 0 -> return Empty+ | otherwise -> return $! Chunk (trimUp fp off) Empty+ Skip s' -> loop n off s' fp+ Yield x s'+ | off == chunkSize -> do+ let !newLen = n - off+ return $! Chunk (trimUp fp off) (chunk s newLen)+ | off == n -> realloc fp n off s' x+ | otherwise -> do+ withForeignPtr fp $ \p -> pokeByteOff p off x+ loop n (off+1) s' fp+ {-# NOINLINE realloc #-}+ realloc fp n off s x = do+ let n' = min (n+n) chunkSize+ fp' <- copy0 fp n n'+ withForeignPtr fp' $ \p -> pokeByteOff p off x+ loop n' (off+1) s fp'+ trimUp fp off = B.PS fp 0 off+ copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)+ copy0 !src !srcLen !destLen =+#if defined(ASSERTS)+ assert (srcLen <= destLen) $+#endif+ do+ dest <- mallocByteString destLen+ withForeignPtr src $ \src' ->+ withForeignPtr dest $ \dest' ->+ memcpy dest' src' (fromIntegral srcLen)+ return dest++-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.+unstream :: Stream Word8 -> ByteString+unstream = unstreamChunks defaultChunkSize++decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8+ -> s -> Step s Char+decodeError func kind onErr mb i =+ case onErr desc mb of+ Nothing -> Skip i+ Just c -> Yield c i+ where desc = "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Invalid " +++ kind ++ " stream"
+ Data/Text/Internal/Lazy/Fusion.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE BangPatterns #-}+-- |+-- Module : Data.Text.Lazy.Fusion+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Core stream fusion functionality for text.++module Data.Text.Internal.Lazy.Fusion+ (+ stream+ , unstream+ , unstreamChunks+ , length+ , unfoldrN+ , index+ , countChar+ ) where++import Prelude hiding (length)+import qualified Data.Text.Internal.Fusion.Common as S+import Control.Monad.ST (runST)+import Data.Text.Internal.Fusion.Types+import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)+import Data.Text.Internal.Lazy+import qualified Data.Text.Internal as I+import qualified Data.Text.Array as A+import Data.Text.Internal.Unsafe.Char (unsafeWrite)+import Data.Text.Internal.Unsafe.Shift (shiftL)+import Data.Text.Unsafe (Iter(..), iter)+import Data.Int (Int64)++default(Int64)++-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.+stream :: Text -> Stream Char+stream text = Stream next (text :*: 0) unknownSize+ where+ next (Empty :*: _) = Done+ next (txt@(Chunk t@(I.Text _ _ len) ts) :*: i)+ | i >= len = next (ts :*: 0)+ | otherwise = Yield c (txt :*: i+d)+ where Iter c d = iter t i+{-# INLINE [0] stream #-}++-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given+-- chunk size.+unstreamChunks :: Int -> Stream Char -> Text+unstreamChunks !chunkSize (Stream next s0 len0)+ | isEmpty len0 = Empty+ | otherwise = outer s0+ where+ outer so = {-# SCC "unstreamChunks/outer" #-}+ case next so of+ Done -> Empty+ Skip s' -> outer s'+ Yield x s' -> runST $ do+ a <- A.new unknownLength+ unsafeWrite a 0 x >>= inner a unknownLength s'+ where unknownLength = 4+ where+ inner marr !len s !i+ | i + 1 >= chunkSize = finish marr i s+ | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do+ let newLen = min (len `shiftL` 1) chunkSize+ marr' <- A.new newLen+ A.copyM marr' 0 marr 0 len+ inner marr' newLen s i+ | otherwise =+ {-# SCC "unstreamChunks/inner" #-}+ case next s of+ Done -> finish marr i s+ Skip s' -> inner marr len s' i+ Yield x s' -> do d <- unsafeWrite marr i x+ inner marr len s' (i+d)+ finish marr len s' = do+ arr <- A.unsafeFreeze marr+ return (I.Text arr 0 len `Chunk` outer s')+{-# INLINE [0] unstreamChunks #-}++-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using+-- 'defaultChunkSize'.+unstream :: Stream Char -> Text+unstream = unstreamChunks defaultChunkSize+{-# INLINE [0] unstream #-}++-- | /O(n)/ Returns the number of characters in a text.+length :: Stream Char -> Int64+length = S.lengthI+{-# INLINE[0] length #-}++{-# RULES "LAZY STREAM stream/unstream fusion" forall s.+ stream (unstream s) = s #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed+-- value. However, the length of the result is limited by the+-- first argument to 'unfoldrN'. This function is more efficient than+-- 'unfoldr' when the length of the result is known.+unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char+unfoldrN n = S.unfoldrNI n+{-# INLINE [0] unfoldrN #-}++-- | /O(n)/ stream index (subscript) operator, starting from 0.+index :: Stream Char -> Int64 -> Char+index = S.indexI+{-# INLINE [0] index #-}++-- | /O(n)/ The 'count' function returns the number of times the query+-- element appears in the given stream.+countChar :: Char -> Stream Char -> Int64+countChar = S.countCharI+{-# INLINE [0] countChar #-}
+ Data/Text/Internal/Lazy/Search.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}++-- |+-- Module : Data.Text.Lazy.Search+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Fast substring search for lazy 'Text', based on work by Boyer,+-- Moore, Horspool, Sunday, and Lundh. Adapted from the strict+-- implementation.++module Data.Text.Internal.Lazy.Search+ (+ indices+ ) where++import qualified Data.Text.Array as A+import Data.Int (Int64)+import Data.Word (Word16, Word64)+import qualified Data.Text.Internal as T+import Data.Text.Internal.Fusion.Types (PairS(..))+import Data.Text.Internal.Lazy (Text(..), foldlChunks)+import Data.Bits ((.|.), (.&.))+import Data.Text.Internal.Unsafe.Shift (shiftL)++-- | /O(n+m)/ Find the offsets of all non-overlapping indices of+-- @needle@ within @haystack@.+--+-- This function is strict in @needle@, and lazy (as far as possible)+-- in the chunks of @haystack@.+--+-- In (unlikely) bad cases, this algorithm's complexity degrades+-- towards /O(n*m)/.+indices :: Text -- ^ Substring to search for (@needle@)+ -> Text -- ^ Text to search in (@haystack@)+ -> [Int64]+indices needle@(Chunk n ns) _haystack@(Chunk k ks)+ | nlen <= 0 = []+ | nlen == 1 = indicesOne (nindex 0) 0 k ks+ | otherwise = advance k ks 0 0+ where+ advance x@(T.Text _ _ l) xs = scan+ where+ scan !g !i+ | i >= m = case xs of+ Empty -> []+ Chunk y ys -> advance y ys g (i-m)+ | lackingHay (i + nlen) x xs = []+ | c == z && candidateMatch 0 = g : scan (g+nlen) (i+nlen)+ | otherwise = scan (g+delta) (i+delta)+ where+ m = fromIntegral l+ c = hindex (i + nlast)+ delta | nextInPattern = nlen + 1+ | c == z = skip + 1+ | otherwise = 1+ nextInPattern = mask .&. swizzle (hindex (i+nlen)) == 0+ candidateMatch !j+ | j >= nlast = True+ | hindex (i+j) /= nindex j = False+ | otherwise = candidateMatch (j+1)+ hindex = index x xs+ nlen = wordLength needle+ nlast = nlen - 1+ nindex = index n ns+ z = foldlChunks fin 0 needle+ where fin _ (T.Text farr foff flen) = A.unsafeIndex farr (foff+flen-1)+ (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)+ swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)+ buildTable (T.Text xarr xoff xlen) xs = go+ where+ go !(g::Int64) !i !msk !skp+ | i >= xlast = case xs of+ Empty -> (msk .|. swizzle z) :*: skp+ Chunk y ys -> buildTable y ys g 0 msk' skp'+ | otherwise = go (g+1) (i+1) msk' skp'+ where c = A.unsafeIndex xarr (xoff+i)+ msk' = msk .|. swizzle c+ skp' | c == z = nlen - g - 2+ | otherwise = skp+ xlast = xlen - 1+ -- | Check whether an attempt to index into the haystack at the+ -- given offset would fail.+ lackingHay q = go 0+ where+ go p (T.Text _ _ l) ps = p' < q && case ps of+ Empty -> True+ Chunk r rs -> go p' r rs+ where p' = p + fromIntegral l+indices _ _ = []++-- | Fast index into a partly unpacked 'Text'. We take into account+-- the possibility that the caller might try to access one element+-- past the end.+index :: T.Text -> Text -> Int64 -> Word16+index (T.Text arr off len) xs !i+ | j < len = A.unsafeIndex arr (off+j)+ | otherwise = case xs of+ Empty+ -- out of bounds, but legal+ | j == len -> 0+ -- should never happen, due to lackingHay above+ | otherwise -> emptyError "index"+ Chunk c cs -> index c cs (i-fromIntegral len)+ where j = fromIntegral i++-- | A variant of 'indices' that scans linearly for a single 'Word16'.+indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]+indicesOne c = chunk+ where+ chunk !i (T.Text oarr ooff olen) os = go 0+ where+ go h | h >= olen = case os of+ Empty -> []+ Chunk y ys -> chunk (i+fromIntegral olen) y ys+ | on == c = i + fromIntegral h : go (h+1)+ | otherwise = go (h+1)+ where on = A.unsafeIndex oarr (ooff+h)++-- | The number of 'Word16' values in a 'Text'.+wordLength :: Text -> Int64+wordLength = foldlChunks sumLength 0+ where sumLength i (T.Text _ _ l) = i + fromIntegral l++emptyError :: String -> a+emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
+ Data/Text/Internal/Private.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}++-- |+-- Module : Data.Text.Internal.Private+-- Copyright : (c) 2011 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC++module Data.Text.Internal.Private+ (+ runText+ , span_+ ) where++import Control.Monad.ST (ST, runST)+import Data.Text.Internal (Text(..), textP)+import Data.Text.Unsafe (Iter(..), iter)+import qualified Data.Text.Array as A++span_ :: (Char -> Bool) -> Text -> (# Text, Text #)+span_ p t@(Text arr off len) = (# hd,tl #)+ where hd = textP arr off k+ tl = textP arr (off+k) (len-k)+ !k = loop 0+ loop !i | i < len && p c = loop (i+d)+ | otherwise = i+ where Iter c d = iter t i+{-# INLINE span_ #-}++runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text+runText act = runST (act $ \ !marr !len -> do+ arr <- A.unsafeFreeze marr+ return $! textP arr 0 len)+{-# INLINE runText #-}
+ Data/Text/Internal/Search.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}++-- |+-- Module : Data.Text.Internal.Search+-- Copyright : (c) Bryan O'Sullivan 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- Fast substring search for 'Text', based on work by Boyer, Moore,+-- Horspool, Sunday, and Lundh.+--+-- References:+--+-- * R. S. Boyer, J. S. Moore: A Fast String Searching Algorithm.+-- Communications of the ACM, 20, 10, 762-772 (1977)+--+-- * R. N. Horspool: Practical Fast Searching in Strings. Software -+-- Practice and Experience 10, 501-506 (1980)+--+-- * D. M. Sunday: A Very Fast Substring Search Algorithm.+-- Communications of the ACM, 33, 8, 132-142 (1990)+--+-- * F. Lundh: The Fast Search Algorithm.+-- <http://effbot.org/zone/stringlib.htm> (2006)++module Data.Text.Internal.Search+ (+ indices+ ) where++import qualified Data.Text.Array as A+import Data.Word (Word64)+import Data.Text.Internal (Text(..))+import Data.Bits ((.|.), (.&.))+import Data.Text.Internal.Unsafe.Shift (shiftL)++data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int++-- | /O(n+m)/ Find the offsets of all non-overlapping indices of+-- @needle@ within @haystack@. The offsets returned represent+-- uncorrected indices in the low-level \"needle\" array, to which its+-- offset must be added.+--+-- In (unlikely) bad cases, this algorithm's complexity degrades+-- towards /O(n*m)/.+indices :: Text -- ^ Substring to search for (@needle@)+ -> Text -- ^ Text to search in (@haystack@)+ -> [Int]+indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)+ | nlen == 1 = scanOne (nindex 0)+ | nlen <= 0 || ldiff < 0 = []+ | otherwise = scan 0+ where+ ldiff = hlen - nlen+ nlast = nlen - 1+ z = nindex nlast+ nindex k = A.unsafeIndex narr (noff+k)+ hindex k = A.unsafeIndex harr (hoff+k)+ hindex' k | k == hlen = 0+ | otherwise = A.unsafeIndex harr (hoff+k)+ buildTable !i !msk !skp+ | i >= nlast = (msk .|. swizzle z) :* skp+ | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'+ where c = nindex i+ skp' | c == z = nlen - i - 2+ | otherwise = skp+ swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)+ scan !i+ | i > ldiff = []+ | c == z && candidateMatch 0 = i : scan (i + nlen)+ | otherwise = scan (i + delta)+ where c = hindex (i + nlast)+ candidateMatch !j+ | j >= nlast = True+ | hindex (i+j) /= nindex j = False+ | otherwise = candidateMatch (j+1)+ delta | nextInPattern = nlen + 1+ | c == z = skip + 1+ | otherwise = 1+ where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0+ !(mask :* skip) = buildTable 0 0 (nlen-2)+ scanOne c = loop 0+ where loop !i | i >= hlen = []+ | hindex i == c = i : loop (i+1)+ | otherwise = loop (i+1)+{-# INLINE indices #-}
+ Data/Text/Internal/Unsafe.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}+-- |+-- Module : Data.Text.Internal.Unsafe+-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- A module containing /unsafe/ operations, for /very very careful/ use+-- in /heavily tested/ code.+module Data.Text.Internal.Unsafe+ (+ inlineInterleaveST+ , inlinePerformIO+ ) where++import GHC.ST (ST(..))+#if defined(__GLASGOW_HASKELL__)+import GHC.IO (IO(IO))+import GHC.Base (realWorld#)+#endif+++-- | Just like unsafePerformIO, but we inline it. Big performance gains as+-- it exposes lots of things to further inlining. /Very unsafe/. In+-- particular, you should do no memory allocation inside an+-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.+--+{-# INLINE inlinePerformIO #-}+inlinePerformIO :: IO a -> a+#if defined(__GLASGOW_HASKELL__)+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r+#else+inlinePerformIO = unsafePerformIO+#endif++-- | Allow an 'ST' computation to be deferred lazily. When passed an+-- action of type 'ST' @s@ @a@, the action will only be performed when+-- the value of @a@ is demanded.+--+-- This function is identical to the normal unsafeInterleaveST, but is+-- inlined and hence faster.+--+-- /Note/: This operation is highly unsafe, as it can introduce+-- externally visible non-determinism into an 'ST' action.+inlineInterleaveST :: ST s a -> ST s a+inlineInterleaveST (ST m) = ST $ \ s ->+ let r = case m s of (# _, res #) -> res in (# s, r #)+{-# INLINE inlineInterleaveST #-}
+ Data/Text/Internal/Unsafe/Char.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE CPP, MagicHash #-}++-- |+-- Module : Data.Text.Internal.Unsafe.Char+-- Copyright : (c) 2008, 2009 Tom Harper,+-- (c) 2009, 2010 Bryan O'Sullivan,+-- (c) 2009 Duncan Coutts+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Fast character manipulation functions.+module Data.Text.Internal.Unsafe.Char+ (+ ord+ , unsafeChr+ , unsafeChr8+ , unsafeChr32+ , unsafeWrite+ -- , unsafeWriteRev+ ) where++#ifdef ASSERTS+import Control.Exception (assert)+#endif+import Control.Monad.ST (ST)+import Data.Bits ((.&.))+import Data.Text.Internal.Unsafe.Shift (shiftR)+import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)+import GHC.Word (Word8(..), Word16(..), Word32(..))+import qualified Data.Text.Array as A++ord :: Char -> Int+ord (C# c#) = I# (ord# c#)+{-# INLINE ord #-}++unsafeChr :: Word16 -> Char+unsafeChr (W16# w#) = C# (chr# (word2Int# w#))+{-# INLINE unsafeChr #-}++unsafeChr8 :: Word8 -> Char+unsafeChr8 (W8# w#) = C# (chr# (word2Int# w#))+{-# INLINE unsafeChr8 #-}++unsafeChr32 :: Word32 -> Char+unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))+{-# INLINE unsafeChr32 #-}++-- | Write a character into the array at the given offset. Returns+-- the number of 'Word16's written.+unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int+unsafeWrite marr i c+ | n < 0x10000 = do+#if defined(ASSERTS)+ assert (i >= 0) . assert (i < A.length marr) $ return ()+#endif+ A.unsafeWrite marr i (fromIntegral n)+ return 1+ | otherwise = do+#if defined(ASSERTS)+ assert (i >= 0) . assert (i < A.length marr - 1) $ return ()+#endif+ A.unsafeWrite marr i lo+ A.unsafeWrite marr (i+1) hi+ return 2+ where n = ord c+ m = n - 0x10000+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00+{-# INLINE unsafeWrite #-}++{-+unsafeWriteRev :: A.MArray s Word16 -> Int -> Char -> ST s Int+unsafeWriteRev marr i c+ | n < 0x10000 = do+ assert (i >= 0) . assert (i < A.length marr) $+ A.unsafeWrite marr i (fromIntegral n)+ return (i-1)+ | otherwise = do+ assert (i >= 1) . assert (i < A.length marr) $+ A.unsafeWrite marr (i-1) lo+ A.unsafeWrite marr i hi+ return (i-2)+ where n = ord c+ m = n - 0x10000+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00+{-# INLINE unsafeWriteRev #-}+-}
+ Data/Text/Internal/Unsafe/Shift.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE MagicHash #-}++-- |+-- Module : Data.Text.Internal.Unsafe.Shift+-- Copyright : (c) Bryan O'Sullivan 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Fast, unchecked bit shifting functions.++module Data.Text.Internal.Unsafe.Shift+ (+ UnsafeShift(..)+ ) where++-- import qualified Data.Bits as Bits+import GHC.Base+import GHC.Word++-- | This is a workaround for poor optimisation in GHC 6.8.2. It+-- fails to notice constant-width shifts, and adds a test and branch+-- to every shift. This imposes about a 10% performance hit.+--+-- These functions are undefined when the amount being shifted by is+-- greater than the size in bits of a machine Int#.+class UnsafeShift a where+ shiftL :: a -> Int -> a+ shiftR :: a -> Int -> a++instance UnsafeShift Word16 where+ {-# INLINE shiftL #-}+ shiftL (W16# x#) (I# i#) = W16# (narrow16Word# (x# `uncheckedShiftL#` i#))++ {-# INLINE shiftR #-}+ shiftR (W16# x#) (I# i#) = W16# (x# `uncheckedShiftRL#` i#)++instance UnsafeShift Word32 where+ {-# INLINE shiftL #-}+ shiftL (W32# x#) (I# i#) = W32# (narrow32Word# (x# `uncheckedShiftL#` i#))++ {-# INLINE shiftR #-}+ shiftR (W32# x#) (I# i#) = W32# (x# `uncheckedShiftRL#` i#)++instance UnsafeShift Word64 where+ {-# INLINE shiftL #-}+ shiftL (W64# x#) (I# i#) = W64# (x# `uncheckedShiftL64#` i#)++ {-# INLINE shiftR #-}+ shiftR (W64# x#) (I# i#) = W64# (x# `uncheckedShiftRL64#` i#)++instance UnsafeShift Int where+ {-# INLINE shiftL #-}+ shiftL (I# x#) (I# i#) = I# (x# `iShiftL#` i#)++ {-# INLINE shiftR #-}+ shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)++{-+instance UnsafeShift Integer where+ {-# INLINE shiftL #-}+ shiftL = Bits.shiftL++ {-# INLINE shiftR #-}+ shiftR = Bits.shiftR+-}
Data/Text/Lazy.hs view
@@ -8,8 +8,7 @@ -- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan -- -- License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org+-- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : GHC --@@ -208,15 +207,15 @@ import Data.String (IsString(..)) import qualified Data.Text as T import qualified Data.Text.Internal as T-import qualified Data.Text.Fusion.Common as S+import qualified Data.Text.Internal.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.Fusion (stream, unstream)-import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldlChunks, foldrChunks)+import qualified Data.Text.Internal.Lazy.Fusion as S+import Data.Text.Internal.Fusion.Types (PairS(..))+import Data.Text.Internal.Lazy.Fusion (stream, unstream)+import Data.Text.Internal.Lazy (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 qualified Data.Text.Internal.Functions as F+import Data.Text.Internal.Lazy.Search (indices) #if __GLASGOW_HASKELL__ >= 702 import qualified GHC.CString as GHC #else@@ -561,7 +560,7 @@ -- 'Text's and concatenates the list after interspersing the first -- argument between each element of the list. intercalate :: Text -> [Text] -> Text-intercalate t = concat . (U.intersperse t)+intercalate t = concat . (F.intersperse t) {-# INLINE intercalate #-} -- | /O(n)/ The 'intersperse' function takes a character and places it
Data/Text/Lazy/Builder.hs view
@@ -34,7 +34,7 @@ -- -- > singleton 'a' <> singleton 'b' <> singleton 'c' ----- since the '<>' from recent versions of 'Data.Monoid' associates +-- since the '<>' from recent versions of 'Data.Monoid' associates -- to the right. -----------------------------------------------------------------------------@@ -55,4 +55,4 @@ , flush ) where -import Data.Text.Lazy.Builder.Internal+import Data.Text.Internal.Builder
− Data/Text/Lazy/Builder/Functions.hs
@@ -1,35 +0,0 @@-{-# LANGUAGE MagicHash #-}---- |--- Module : Data.Text.Lazy.Builder.Functions--- Copyright : (c) 2011 MailRank, Inc.------ License : BSD-style--- Maintainer : bos@serpentine.com--- Stability : experimental--- Portability : GHC------ Useful functions and combinators.--module Data.Text.Lazy.Builder.Functions- (- (<>)- , i2d- ) where--import Data.Monoid (mappend)-import Data.Text.Lazy.Builder (Builder)-import GHC.Base---- | Unsafe conversion for decimal digits.-{-# INLINE i2d #-}-i2d :: Int -> Char-i2d (I# i#) = C# (chr# (ord# '0'# +# i#))---- | The normal 'mappend' function with right associativity instead of--- left.-(<>) :: Builder -> Builder -> Builder-(<>) = mappend-{-# INLINE (<>) #-}--infixr 4 <>
Data/Text/Lazy/Builder/Int.hs view
@@ -22,9 +22,9 @@ import Data.Int (Int8, Int16, Int32, Int64) import Data.Monoid (mempty) import qualified Data.ByteString.Unsafe as B-import Data.Text.Lazy.Builder.Functions ((<>), i2d)-import Data.Text.Lazy.Builder.Internal-import Data.Text.Lazy.Builder.Int.Digits (digits)+import Data.Text.Internal.Builder.Functions ((<>), i2d)+import Data.Text.Internal.Builder+import Data.Text.Internal.Builder.Int.Digits (digits) import Data.Text.Array import Data.Word (Word, Word8, Word16, Word32, Word64) import GHC.Base (quotInt, remInt)
− Data/Text/Lazy/Builder/Int/Digits.hs
@@ -1,22 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- Module: Data.Text.Lazy.Builder.Int.Digits--- Copyright: (c) 2013 Bryan O'Sullivan--- License: BSD3--- Maintainer: Bryan O'Sullivan <bos@serpentine.com>--- Stability: experimental--- Portability: portable------ This module exists because the C preprocessor does things that we--- shall not speak of when confronted with Haskell multiline strings.--module Data.Text.Lazy.Builder.Int.Digits (digits) where--import Data.ByteString.Char8 (ByteString)--digits :: ByteString-digits = "0001020304050607080910111213141516171819\- \2021222324252627282930313233343536373839\- \4041424344454647484950515253545556575859\- \6061626364656667686970717273747576777879\- \8081828384858687888990919293949596979899"
− Data/Text/Lazy/Builder/Internal.hs
@@ -1,321 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}---------------------------------------------------------------------------------- |--- Module : Data.Text.Lazy.Builder.Internal--- Copyright : (c) 2013 Bryan O'Sullivan--- (c) 2010 Johan Tibell--- License : BSD3-style (see LICENSE)------ Maintainer : Johan Tibell <johan.tibell@gmail.com>--- Stability : experimental--- Portability : portable to Hugs and GHC------ Efficient construction of lazy @Text@ values. The principal--- operations on a @Builder@ are @singleton@, @fromText@, and--- @fromLazyText@, which construct new builders, and 'mappend', which--- concatenates two builders.------ To get maximum performance when building lazy @Text@ values using a--- builder, associate @mappend@ calls to the right. For example,--- prefer------ > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')------ to------ > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'------ as the latter associates @mappend@ to the left.-----------------------------------------------------------------------------------module Data.Text.Lazy.Builder.Internal- ( -- * Public API- -- ** The Builder type- Builder- , toLazyText- , toLazyTextWith-- -- ** Constructing Builders- , singleton- , fromText- , fromLazyText- , fromString-- -- ** Flushing the buffer state- , flush-- -- * Internal functions- , append'- , ensureFree- , writeN- ) where--import Control.Monad.ST (ST, runST)-import Data.Bits ((.&.))-import Data.Monoid (Monoid(..))-import Data.Text.Internal (Text(..))-import Data.Text.Lazy.Internal (smallChunkSize)-import Data.Text.Unsafe (inlineInterleaveST)-import Data.Text.UnsafeChar (ord, unsafeWrite)-import Data.Text.UnsafeShift (shiftR)-import Prelude hiding (map, putChar)--import qualified Data.String as String-import qualified Data.Text as S-import qualified Data.Text.Array as A-import qualified Data.Text.Lazy as L------------------------------------------------------------------------------ | A @Builder@ is an efficient way to build lazy @Text@ values.--- There are several functions for constructing builders, but only one--- to inspect them: to extract any data, you have to turn them into--- lazy @Text@ values using @toLazyText@.------ Internally, a builder constructs a lazy @Text@ by filling arrays--- piece by piece. As each buffer is filled, it is \'popped\' off, to--- become a new chunk of the resulting lazy @Text@. All this is--- hidden from the user of the @Builder@.-newtype Builder = Builder {- -- Invariant (from Data.Text.Lazy):- -- The lists include no null Texts.- runBuilder :: forall s. (Buffer s -> ST s [S.Text])- -> Buffer s- -> ST s [S.Text]- }--instance Monoid Builder where- mempty = empty- {-# INLINE mempty #-}- mappend = append- {-# INLINE mappend #-}- mconcat = foldr mappend mempty- {-# INLINE mconcat #-}--instance String.IsString Builder where- fromString = fromString- {-# INLINE fromString #-}--instance Show Builder where- show = show . toLazyText--instance Eq Builder where- a == b = toLazyText a == toLazyText b--instance Ord Builder where- a <= b = toLazyText a <= toLazyText b------------------------------------------------------------------------------ | /O(1)./ The empty @Builder@, satisfying------ * @'toLazyText' 'empty' = 'L.empty'@----empty :: Builder-empty = Builder (\ k buf -> k buf)-{-# INLINE empty #-}---- | /O(1)./ A @Builder@ taking a single character, satisfying------ * @'toLazyText' ('singleton' c) = 'L.singleton' c@----singleton :: Char -> Builder-singleton c = writeAtMost 2 $ \ marr o ->- if n < 0x10000- then A.unsafeWrite marr o (fromIntegral n) >> return 1- else do- A.unsafeWrite marr o lo- A.unsafeWrite marr (o+1) hi- return 2- where n = ord c- m = n - 0x10000- lo = fromIntegral $ (m `shiftR` 10) + 0xD800- hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00-{-# INLINE singleton #-}------------------------------------------------------------------------------ | /O(1)./ The concatenation of two builders, an associative--- operation with identity 'empty', satisfying------ * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@----append :: Builder -> Builder -> Builder-append (Builder f) (Builder g) = Builder (f . g)-{-# INLINE [0] append #-}---- TODO: Experiment to find the right threshold.-copyLimit :: Int-copyLimit = 128---- This function attempts to merge small @Text@ values instead of--- treating each value as its own chunk. We may not always want this.---- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying------ * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@----fromText :: S.Text -> Builder-fromText t@(Text arr off l)- | S.null t = empty- | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)- | otherwise = flush `append` mapBuilder (t :)-{-# INLINE [1] fromText #-}--{-# RULES-"fromText/pack" forall s .- fromText (S.pack s) = fromString s- #-}---- | /O(1)./ A Builder taking a @String@, satisfying------ * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@----fromString :: String -> Builder-fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->- let loop !marr !o !u !l [] = k (Buffer marr o u l)- loop marr o u l s@(c:cs)- | l <= 1 = do- arr <- A.unsafeFreeze marr- let !t = Text arr o u- marr' <- A.new chunkSize- ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)- return $ t : ts- | otherwise = do- n <- unsafeWrite marr (o+u) c- loop marr o (u+n) (l-n) cs- in loop p0 o0 u0 l0 str- where- chunkSize = smallChunkSize-{-# INLINE fromString #-}---- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying------ * @'toLazyText' ('fromLazyText' t) = t@----fromLazyText :: L.Text -> Builder-fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)-{-# INLINE fromLazyText #-}------------------------------------------------------------------------------ Our internal buffer type-data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)- {-# UNPACK #-} !Int -- offset- {-# UNPACK #-} !Int -- used units- {-# UNPACK #-} !Int -- length left------------------------------------------------------------------------------ | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default--- buffer size. The construction work takes place if and when the--- relevant part of the lazy @Text@ is demanded.-toLazyText :: Builder -> L.Text-toLazyText = toLazyTextWith smallChunkSize---- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given--- size for the initial buffer. The construction work takes place if--- and when the relevant part of the lazy @Text@ is demanded.------ If the initial buffer is too small to hold all data, subsequent--- buffers will be the default buffer size.-toLazyTextWith :: Int -> Builder -> L.Text-toLazyTextWith chunkSize m = L.fromChunks (runST $- newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))---- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,--- yielding a new chunk in the result lazy @Text@.-flush :: Builder-flush = Builder $ \ k buf@(Buffer p o u l) ->- if u == 0- then k buf- else do arr <- A.unsafeFreeze p- let !b = Buffer p (o+u) 0 l- !t = Text arr o u- ts <- inlineInterleaveST (k b)- return $! t : ts------------------------------------------------------------------------------ | Sequence an ST operation on the buffer-withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder-withBuffer f = Builder $ \k buf -> f buf >>= k-{-# INLINE withBuffer #-}---- | Get the size of the buffer-withSize :: (Int -> Builder) -> Builder-withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->- runBuilder (f l) k buf-{-# INLINE withSize #-}---- | Map the resulting list of texts.-mapBuilder :: ([S.Text] -> [S.Text]) -> Builder-mapBuilder f = Builder (fmap f .)------------------------------------------------------------------------------ | Ensure that there are at least @n@ many elements available.-ensureFree :: Int -> Builder-ensureFree !n = withSize $ \ l ->- if n <= l- then empty- else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))-{-# INLINE [0] ensureFree #-}--writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder-writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)-{-# INLINE [0] writeAtMost #-}---- | Ensure that @n@ many elements are available, and then use @f@ to--- write some elements into the memory.-writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder-writeN n f = writeAtMost n (\ p o -> f p o >> return n)-{-# INLINE writeN #-}--writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)-writeBuffer f (Buffer p o u l) = do- n <- f p (o+u)- return $! Buffer p o (u+n) (l-n)-{-# INLINE writeBuffer #-}--newBuffer :: Int -> ST s (Buffer s)-newBuffer size = do- arr <- A.new size- return $! Buffer arr 0 0 size-{-# INLINE newBuffer #-}----------------------------------------------------------------------------- Some nice rules for Builder---- This function makes GHC understand that 'writeN' and 'ensureFree'--- are *not* recursive in the precense of the rewrite rules below.--- This is not needed with GHC 7+.-append' :: Builder -> Builder -> Builder-append' (Builder f) (Builder g) = Builder (f . g)-{-# INLINE append' #-}--{-# RULES--"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)- (g::forall s. A.MArray s -> Int -> ST s Int) ws.- append (writeAtMost a f) (append (writeAtMost b g) ws) =- append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->- g marr (o+n) >>= \ m ->- let s = n+m in s `seq` return s)) ws--"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)- (g::forall s. A.MArray s -> Int -> ST s Int).- append (writeAtMost a f) (writeAtMost b g) =- writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->- g marr (o+n) >>= \ m ->- let s = n+m in s `seq` return s)--"ensureFree/ensureFree" forall a b .- append (ensureFree a) (ensureFree b) = ensureFree (max a b)--"flush/flush"- append flush flush = flush-- #-}
Data/Text/Lazy/Builder/RealFloat.hs view
@@ -19,9 +19,9 @@ import Data.Array.Base (unsafeAt) import Data.Array.IArray-import Data.Text.Lazy.Builder.Functions ((<>), i2d)+import Data.Text.Internal.Builder.Functions ((<>), i2d) import Data.Text.Lazy.Builder.Int (decimal)-import Data.Text.Lazy.Builder.RealFloat.Functions (roundTo)+import Data.Text.Internal.Builder.RealFloat.Functions (roundTo) import Data.Text.Lazy.Builder import qualified Data.Text as T
− Data/Text/Lazy/Builder/RealFloat/Functions.hs
@@ -1,25 +0,0 @@--- |--- Module: Data.Text.Lazy.Builder.RealFloat.Functions--- Copyright: (c) The University of Glasgow 1994-2002--- License: see libraries/base/LICENSE--module Data.Text.Lazy.Builder.RealFloat.Functions- (- roundTo- ) where--roundTo :: Int -> [Int] -> (Int,[Int])-roundTo d is =- case f d is of- x@(0,_) -> x- (1,xs) -> (1, 1:xs)- _ -> error "roundTo: bad Value"- where- f n [] = (0, replicate n 0)- f 0 (x:_) = (if x >= 5 then 1 else 0, [])- f n (i:xs)- | i' == 10 = (1,0:ds)- | otherwise = (0,i':ds)- where- (c,ds) = f (n-1) xs- i' = c + i
Data/Text/Lazy/Encoding.hs view
@@ -7,8 +7,7 @@ -- Copyright : (c) 2009, 2010 Bryan O'Sullivan -- -- License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org+-- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable --@@ -46,19 +45,33 @@ , encodeUtf16BE , encodeUtf32LE , encodeUtf32BE++#if MIN_VERSION_bytestring(0,10,4)+ -- * Encoding Text using ByteString Builders+ , encodeUtf8Builder+ , encodeUtf8BuilderEscaped+#endif ) where import Control.Exception (evaluate, try) import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)-import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldrChunks)+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Internal as B import qualified Data.ByteString.Unsafe as B+#if MIN_VERSION_bytestring(0,10,4)+import Data.Word (Word8)+import Data.Monoid (mempty, (<>))+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)+import qualified Data.ByteString.Builder.Prim as BP+import qualified Data.Text as T+#endif import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as L-import qualified Data.Text.Lazy.Encoding.Fusion as E-import qualified Data.Text.Lazy.Fusion as F+import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E+import qualified Data.Text.Internal.Lazy.Fusion as F import Data.Text.Unsafe (unsafeDupablePerformIO) -- $strict@@ -136,8 +149,31 @@ {-# INLINE decodeUtf8' #-} encodeUtf8 :: Text -> B.ByteString+#if MIN_VERSION_bytestring(0,10,4)+encodeUtf8 Empty = B.empty+encodeUtf8 lt@(Chunk t _) =+ B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt+ where+ -- To improve our small string performance, we use a strategy that+ -- allocates a buffer that is guaranteed to be large enough for the+ -- encoding of the first chunk, but not larger than the default+ -- B.smallChunkSize. We clamp the firstChunkSize to ensure that we don't+ -- generate too large buffers which hamper streaming.+ firstChunkSize = min B.smallChunkSize (4 * (T.length t + 1))+ strategy = B.safeStrategy firstChunkSize B.defaultChunkSize++encodeUtf8Builder :: Text -> B.Builder+encodeUtf8Builder = foldrChunks (\c b -> TE.encodeUtf8Builder c <> b) mempty++{-# INLINE encodeUtf8BuilderEscaped #-}+encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder+encodeUtf8BuilderEscaped prim =+ foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c <> b) mempty++#else encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs) encodeUtf8 Empty = B.Empty+#endif -- | Decode text from little endian UTF-16 encoding. decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
− Data/Text/Lazy/Encoding/Fusion.hs
@@ -1,321 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}---- |--- Module : Data.Text.Lazy.Encoding.Fusion--- Copyright : (c) 2009, 2010 Bryan O'Sullivan------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : portable------ Fusible 'Stream'-oriented functions for converting between lazy--- 'Text' and several common encodings.--module Data.Text.Lazy.Encoding.Fusion- (- -- * Streaming- -- streamASCII- streamUtf8- , streamUtf16LE- , streamUtf16BE- , streamUtf32LE- , streamUtf32BE-- -- * Unstreaming- , unstream-- , module Data.Text.Encoding.Fusion.Common- ) where--import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)-import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as B-import Data.Text.Encoding.Fusion.Common-import Data.Text.Encoding.Error-import Data.Text.Fusion (Step(..), Stream(..))-import Data.Text.Fusion.Size-import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)-import Data.Text.UnsafeShift (shiftL)-import Data.Word (Word8, Word16, Word32)-import qualified Data.Text.Encoding.Utf8 as U8-import qualified Data.Text.Encoding.Utf16 as U16-import qualified Data.Text.Encoding.Utf32 as U32-import Data.Text.Unsafe (unsafeDupablePerformIO)-import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)-import Foreign.Storable (pokeByteOff)-import Data.ByteString.Internal (mallocByteString, memcpy)-#if defined(ASSERTS)-import Control.Exception (assert)-#endif-import qualified Data.ByteString.Internal as B--data S = S0- | S1 {-# UNPACK #-} !Word8- | S2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8- | S3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8- | S4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8--data T = T !ByteString !S {-# UNPACK #-} !Int---- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using--- UTF-8 encoding.-streamUtf8 :: OnDecodeError -> ByteString -> Stream Char-streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize- where- next (T bs@(Chunk ps _) S0 i)- | i < len && U8.validate1 a =- Yield (unsafeChr8 a) (T bs S0 (i+1))- | i + 1 < len && U8.validate2 a b =- Yield (U8.chr2 a b) (T bs S0 (i+2))- | i + 2 < len && U8.validate3 a b c =- Yield (U8.chr3 a b c) (T bs S0 (i+3))- | i + 3 < len && U8.validate4 a b c d =- Yield (U8.chr4 a b c d) (T bs S0 (i+4))- where len = B.length ps- a = B.unsafeIndex ps i- b = B.unsafeIndex ps (i+1)- c = B.unsafeIndex ps (i+2)- d = B.unsafeIndex ps (i+3)- next st@(T bs s i) =- case s of- S1 a | U8.validate1 a -> Yield (unsafeChr8 a) es- S2 a b | U8.validate2 a b -> Yield (U8.chr2 a b) es- S3 a b c | U8.validate3 a b c -> Yield (U8.chr3 a b c) es- S4 a b c d | U8.validate4 a b c d -> Yield (U8.chr4 a b c d) es- _ -> consume st- where es = T bs S0 i- consume (T bs@(Chunk ps rest) s i)- | i >= B.length ps = consume (T rest s 0)- | otherwise =- case s of- S0 -> next (T bs (S1 x) (i+1))- S1 a -> next (T bs (S2 a x) (i+1))- S2 a b -> next (T bs (S3 a b x) (i+1))- S3 a b c -> next (T bs (S4 a b c x) (i+1))- S4 a b c d -> decodeError "streamUtf8" "UTF-8" onErr (Just a)- (T bs (S3 b c d) (i+1))- where x = B.unsafeIndex ps i- consume (T Empty S0 _) = Done- consume st = decodeError "streamUtf8" "UTF-8" onErr Nothing st-{-# INLINE [0] streamUtf8 #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little--- endian UTF-16 encoding.-streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char-streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize- where- next (T bs@(Chunk ps _) S0 i)- | i + 1 < len && U16.validate1 x1 =- Yield (unsafeChr x1) (T bs S0 (i+2))- | i + 3 < len && U16.validate2 x1 x2 =- Yield (U16.chr2 x1 x2) (T bs S0 (i+4))- where len = B.length ps- x1 = c (idx i) (idx (i + 1))- x2 = c (idx (i + 2)) (idx (i + 3))- c w1 w2 = w1 + (w2 `shiftL` 8)- idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16- next st@(T bs s i) =- case s of- S2 w1 w2 | U16.validate1 (c w1 w2) ->- Yield (unsafeChr (c w1 w2)) es- S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->- Yield (U16.chr2 (c w1 w2) (c w3 w4)) es- _ -> consume st- where es = T bs S0 i- c :: Word8 -> Word8 -> Word16- c w1 w2 = fromIntegral w1 + (fromIntegral w2 `shiftL` 8)- consume (T bs@(Chunk ps rest) s i)- | i >= B.length ps = consume (T rest s 0)- | otherwise =- case s of- S0 -> next (T bs (S1 x) (i+1))- S1 w1 -> next (T bs (S2 w1 x) (i+1))- S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))- S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))- S4 w1 w2 w3 w4 -> decodeError "streamUtf16LE" "UTF-16LE" onErr (Just w1)- (T bs (S3 w2 w3 w4) (i+1))- where x = B.unsafeIndex ps i- consume (T Empty S0 _) = Done- consume st = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing st-{-# INLINE [0] streamUtf16LE #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big--- endian UTF-16 encoding.-streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char-streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize- where- next (T bs@(Chunk ps _) S0 i)- | i + 1 < len && U16.validate1 x1 =- Yield (unsafeChr x1) (T bs S0 (i+2))- | i + 3 < len && U16.validate2 x1 x2 =- Yield (U16.chr2 x1 x2) (T bs S0 (i+4))- where len = B.length ps- x1 = c (idx i) (idx (i + 1))- x2 = c (idx (i + 2)) (idx (i + 3))- c w1 w2 = (w1 `shiftL` 8) + w2- idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16- next st@(T bs s i) =- case s of- S2 w1 w2 | U16.validate1 (c w1 w2) ->- Yield (unsafeChr (c w1 w2)) es- S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->- Yield (U16.chr2 (c w1 w2) (c w3 w4)) es- _ -> consume st- where es = T bs S0 i- c :: Word8 -> Word8 -> Word16- c w1 w2 = (fromIntegral w1 `shiftL` 8) + fromIntegral w2- consume (T bs@(Chunk ps rest) s i)- | i >= B.length ps = consume (T rest s 0)- | otherwise =- case s of- S0 -> next (T bs (S1 x) (i+1))- S1 w1 -> next (T bs (S2 w1 x) (i+1))- S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))- S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))- S4 w1 w2 w3 w4 -> decodeError "streamUtf16BE" "UTF-16BE" onErr (Just w1)- (T bs (S3 w2 w3 w4) (i+1))- where x = B.unsafeIndex ps i- consume (T Empty S0 _) = Done- consume st = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing st-{-# INLINE [0] streamUtf16BE #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big--- endian UTF-32 encoding.-streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char-streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize- where- next (T bs@(Chunk ps _) S0 i)- | i + 3 < len && U32.validate x =- Yield (unsafeChr32 x) (T bs S0 (i+4))- where len = B.length ps- x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4- x1 = idx i- x2 = idx (i+1)- x3 = idx (i+2)- x4 = idx (i+3)- idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32- next st@(T bs s i) =- case s of- S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->- Yield (unsafeChr32 (c w1 w2 w3 w4)) es- _ -> consume st- where es = T bs S0 i- c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32- c w1 w2 w3 w4 = shifted- where- shifted = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4- x1 = fromIntegral w1- x2 = fromIntegral w2- x3 = fromIntegral w3- x4 = fromIntegral w4- consume (T bs@(Chunk ps rest) s i)- | i >= B.length ps = consume (T rest s 0)- | otherwise =- case s of- S0 -> next (T bs (S1 x) (i+1))- S1 w1 -> next (T bs (S2 w1 x) (i+1))- S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))- S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))- S4 w1 w2 w3 w4 -> decodeError "streamUtf32BE" "UTF-32BE" onErr (Just w1)- (T bs (S3 w2 w3 w4) (i+1))- where x = B.unsafeIndex ps i- consume (T Empty S0 _) = Done- consume st = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing st-{-# INLINE [0] streamUtf32BE #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little--- endian UTF-32 encoding.-streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char-streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize- where- next (T bs@(Chunk ps _) S0 i)- | i + 3 < len && U32.validate x =- Yield (unsafeChr32 x) (T bs S0 (i+4))- where len = B.length ps- x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1- x1 = idx i- x2 = idx (i+1)- x3 = idx (i+2)- x4 = idx (i+3)- idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32- next st@(T bs s i) =- case s of- S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->- Yield (unsafeChr32 (c w1 w2 w3 w4)) es- _ -> consume st- where es = T bs S0 i- c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32- c w1 w2 w3 w4 = shifted- where- shifted = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1- x1 = fromIntegral w1- x2 = fromIntegral w2- x3 = fromIntegral w3- x4 = fromIntegral w4- consume (T bs@(Chunk ps rest) s i)- | i >= B.length ps = consume (T rest s 0)- | otherwise =- case s of- S0 -> next (T bs (S1 x) (i+1))- S1 w1 -> next (T bs (S2 w1 x) (i+1))- S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))- S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))- S4 w1 w2 w3 w4 -> decodeError "streamUtf32LE" "UTF-32LE" onErr (Just w1)- (T bs (S3 w2 w3 w4) (i+1))- where x = B.unsafeIndex ps i- consume (T Empty S0 _) = Done- consume st = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing st-{-# INLINE [0] streamUtf32LE #-}---- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.-unstreamChunks :: Int -> Stream Word8 -> ByteString-unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)- where chunk s1 len1 = unsafeDupablePerformIO $ do- let len = max 4 (min len1 chunkSize)- mallocByteString len >>= loop len 0 s1- where- loop !n !off !s fp = case next s of- Done | off == 0 -> return Empty- | otherwise -> return $! Chunk (trimUp fp off) Empty- Skip s' -> loop n off s' fp- Yield x s'- | off == chunkSize -> do- let !newLen = n - off- return $! Chunk (trimUp fp off) (chunk s newLen)- | off == n -> realloc fp n off s' x- | otherwise -> do- withForeignPtr fp $ \p -> pokeByteOff p off x- loop n (off+1) s' fp- {-# NOINLINE realloc #-}- realloc fp n off s x = do- let n' = min (n+n) chunkSize- fp' <- copy0 fp n n'- withForeignPtr fp' $ \p -> pokeByteOff p off x- loop n' (off+1) s fp'- trimUp fp off = B.PS fp 0 off- copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)- copy0 !src !srcLen !destLen =-#if defined(ASSERTS)- assert (srcLen <= destLen) $-#endif- do- dest <- mallocByteString destLen- withForeignPtr src $ \src' ->- withForeignPtr dest $ \dest' ->- memcpy dest' src' (fromIntegral srcLen)- return dest---- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.-unstream :: Stream Word8 -> ByteString-unstream = unstreamChunks defaultChunkSize--decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8- -> s -> Step s Char-decodeError func kind onErr mb i =- case onErr desc mb of- Nothing -> Skip i- Just c -> Yield c i- where desc = "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Invalid " ++- kind ++ " stream"
− Data/Text/Lazy/Fusion.hs
@@ -1,117 +0,0 @@-{-# LANGUAGE BangPatterns #-}--- |--- Module : Data.Text.Lazy.Fusion--- Copyright : (c) 2009, 2010 Bryan O'Sullivan------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : GHC------ Core stream fusion functionality for text.--module Data.Text.Lazy.Fusion- (- stream- , unstream- , unstreamChunks- , length- , unfoldrN- , index- , countChar- ) where--import Prelude hiding (length)-import qualified Data.Text.Fusion.Common as S-import Control.Monad.ST (runST)-import Data.Text.Fusion.Internal-import Data.Text.Fusion.Size (isEmpty, unknownSize)-import Data.Text.Lazy.Internal-import qualified Data.Text.Internal as I-import qualified Data.Text.Array as A-import Data.Text.UnsafeChar (unsafeWrite)-import Data.Text.UnsafeShift (shiftL)-import Data.Text.Unsafe (Iter(..), iter)-import Data.Int (Int64)--default(Int64)---- | /O(n)/ Convert a 'Text' into a 'Stream Char'.-stream :: Text -> Stream Char-stream text = Stream next (text :*: 0) unknownSize- where- next (Empty :*: _) = Done- next (txt@(Chunk t@(I.Text _ _ len) ts) :*: i)- | i >= len = next (ts :*: 0)- | otherwise = Yield c (txt :*: i+d)- where Iter c d = iter t i-{-# INLINE [0] stream #-}---- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given--- chunk size.-unstreamChunks :: Int -> Stream Char -> Text-unstreamChunks !chunkSize (Stream next s0 len0)- | isEmpty len0 = Empty- | otherwise = outer s0- where- outer so = {-# SCC "unstreamChunks/outer" #-}- case next so of- Done -> Empty- Skip s' -> outer s'- Yield x s' -> runST $ do- a <- A.new unknownLength- unsafeWrite a 0 x >>= inner a unknownLength s'- where unknownLength = 4- where- inner marr !len s !i- | i + 1 >= chunkSize = finish marr i s- | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do- let newLen = min (len `shiftL` 1) chunkSize- marr' <- A.new newLen- A.copyM marr' 0 marr 0 len- inner marr' newLen s i- | otherwise =- {-# SCC "unstreamChunks/inner" #-}- case next s of- Done -> finish marr i s- Skip s' -> inner marr len s' i- Yield x s' -> do d <- unsafeWrite marr i x- inner marr len s' (i+d)- finish marr len s' = do- arr <- A.unsafeFreeze marr- return (I.Text arr 0 len `Chunk` outer s')-{-# INLINE [0] unstreamChunks #-}---- | /O(n)/ Convert a 'Stream Char' into a 'Text', using--- 'defaultChunkSize'.-unstream :: Stream Char -> Text-unstream = unstreamChunks defaultChunkSize-{-# INLINE [0] unstream #-}---- | /O(n)/ Returns the number of characters in a text.-length :: Stream Char -> Int64-length = S.lengthI-{-# INLINE[0] length #-}--{-# RULES "LAZY STREAM stream/unstream fusion" forall s.- stream (unstream s) = s #-}---- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed--- value. However, the length of the result is limited by the--- first argument to 'unfoldrN'. This function is more efficient than--- 'unfoldr' when the length of the result is known.-unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char-unfoldrN n = S.unfoldrNI n-{-# INLINE [0] unfoldrN #-}---- | /O(n)/ stream index (subscript) operator, starting from 0.-index :: Stream Char -> Int64 -> Char-index = S.indexI-{-# INLINE [0] index #-}---- | /O(n)/ The 'count' function returns the number of times the query--- element appears in the given stream.-countChar :: Char -> Stream Char -> Int64-countChar = S.countCharI-{-# INLINE [0] countChar #-}
Data/Text/Lazy/IO.hs view
@@ -50,8 +50,8 @@ import qualified Control.Exception as E import Control.Monad (when) import Data.IORef (readIORef)-import Data.Text.IO.Internal (hGetLineWith, readChunk)-import Data.Text.Lazy.Internal (chunk, empty)+import Data.Text.Internal.IO (hGetLineWith, readChunk)+import Data.Text.Internal.Lazy (chunk, empty) import GHC.IO.Buffer (isEmptyBuffer) import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException) import GHC.IO.Handle.Internals (augmentIOError, hClose_help,
Data/Text/Lazy/Internal.hs view
@@ -1,118 +1,20 @@ {-# LANGUAGE BangPatterns, DeriveDataTypeable #-} -- | -- Module : Data.Text.Lazy.Internal--- Copyright : (c) 2009, 2010 Bryan O'Sullivan+-- Copyright : (c) 2013 Bryan O'Sullivan -- -- License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org+-- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : GHC ----- A module containing private 'Text' internals. This exposes the--- 'Text' representation and low level construction functions.--- Modules which extend the 'Text' system may need to use this module.------ You should not use this module unless you are determined to monkey--- with the internals, as the functions here do just about nothing to--- preserve data invariants. You have been warned!+-- This module has been renamed to 'Data.Text.Internal.Lazy'. This+-- name for the module will be removed in the next major release. module Data.Text.Lazy.Internal+ {-# DEPRECATED "Use Data.Text.Internal.Lazy instead" #-} (- Text(..)- , chunk- , empty- , foldrChunks- , foldlChunks- -- * Data type invariant and abstraction functions-- -- $invariant- , strictInvariant- , lazyInvariant- , showStructure-- -- * Chunk allocation sizes- , defaultChunkSize- , smallChunkSize- , chunkOverhead+ module Data.Text.Internal.Lazy ) where -import Data.Text ()-import Data.Text.UnsafeShift (shiftL)-import Data.Typeable (Typeable)-import Foreign.Storable (sizeOf)-import qualified Data.Text.Internal as T--data Text = Empty- | Chunk {-# UNPACK #-} !T.Text Text- deriving (Typeable)---- $invariant------ The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or--- consists of non-null 'T.Text's. All functions must preserve this,--- and the QC properties must check this.---- | Check the invariant strictly.-strictInvariant :: Text -> Bool-strictInvariant Empty = True-strictInvariant x@(Chunk (T.Text _ _ len) cs)- | len > 0 = strictInvariant cs- | otherwise = error $ "Data.Text.Lazy: invariant violation: "- ++ showStructure x---- | Check the invariant lazily.-lazyInvariant :: Text -> Text-lazyInvariant Empty = Empty-lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)- | len > 0 = Chunk c (lazyInvariant cs)- | otherwise = error $ "Data.Text.Lazy: invariant violation: "- ++ showStructure x---- | Display the internal structure of a lazy 'Text'.-showStructure :: Text -> String-showStructure Empty = "Empty"-showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"-showStructure (Chunk t ts) =- "Chunk " ++ show t ++ " (" ++ showStructure 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---- | Smart constructor for 'Empty'.-empty :: Text-{-# INLINE [0] empty #-}-empty = Empty---- | Consume the chunks of a lazy 'Text' with a natural right fold.-foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a-foldrChunks f z = go- where go Empty = z- go (Chunk c cs) = f c (go cs)-{-# INLINE foldrChunks #-}---- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,--- accumulating left fold.-foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a-foldlChunks f z = go z- where go !a Empty = a- go !a (Chunk c cs) = go (f a c) cs-{-# INLINE foldlChunks #-}---- | Currently set to 16 KiB, less the memory management overhead.-defaultChunkSize :: Int-defaultChunkSize = 16384 - chunkOverhead-{-# INLINE defaultChunkSize #-}---- | Currently set to 128 bytes, less the memory management overhead.-smallChunkSize :: Int-smallChunkSize = 128 - chunkOverhead-{-# INLINE smallChunkSize #-}---- | The memory management overhead. Currently this is tuned for GHC only.-chunkOverhead :: Int-chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1-{-# INLINE chunkOverhead #-}+import Data.Text.Internal.Lazy
− Data/Text/Lazy/Search.hs
@@ -1,131 +0,0 @@-{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}---- |--- Module : Data.Text.Lazy.Search--- Copyright : (c) 2009, 2010 Bryan O'Sullivan------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : GHC------ Fast substring search for lazy 'Text', based on work by Boyer,--- Moore, Horspool, Sunday, and Lundh. Adapted from the strict--- implementation.--module Data.Text.Lazy.Search- (- indices- ) where--import qualified Data.Text.Array as A-import Data.Int (Int64)-import Data.Word (Word16, Word64)-import qualified Data.Text.Internal as T-import Data.Text.Fusion.Internal (PairS(..))-import Data.Text.Lazy.Internal (Text(..), foldlChunks)-import Data.Bits ((.|.), (.&.))-import Data.Text.UnsafeShift (shiftL)---- | /O(n+m)/ Find the offsets of all non-overlapping indices of--- @needle@ within @haystack@.------ This function is strict in @needle@, and lazy (as far as possible)--- in the chunks of @haystack@.------ In (unlikely) bad cases, this algorithm's complexity degrades--- towards /O(n*m)/.-indices :: Text -- ^ Substring to search for (@needle@)- -> Text -- ^ Text to search in (@haystack@)- -> [Int64]-indices needle@(Chunk n ns) _haystack@(Chunk k ks)- | nlen <= 0 = []- | nlen == 1 = indicesOne (nindex 0) 0 k ks- | otherwise = advance k ks 0 0- where- advance x@(T.Text _ _ l) xs = scan- where- scan !g !i- | i >= m = case xs of- Empty -> []- Chunk y ys -> advance y ys g (i-m)- | lackingHay (i + nlen) x xs = []- | c == z && candidateMatch 0 = g : scan (g+nlen) (i+nlen)- | otherwise = scan (g+delta) (i+delta)- where- m = fromIntegral l- c = hindex (i + nlast)- delta | nextInPattern = nlen + 1- | c == z = skip + 1- | otherwise = 1- nextInPattern = mask .&. swizzle (hindex (i+nlen)) == 0- candidateMatch !j- | j >= nlast = True- | hindex (i+j) /= nindex j = False- | otherwise = candidateMatch (j+1)- hindex = index x xs- nlen = wordLength needle- nlast = nlen - 1- nindex = index n ns- z = foldlChunks fin 0 needle- where fin _ (T.Text farr foff flen) = A.unsafeIndex farr (foff+flen-1)- (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)- swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)- buildTable (T.Text xarr xoff xlen) xs = go- where- go !(g::Int64) !i !msk !skp- | i >= xlast = case xs of- Empty -> (msk .|. swizzle z) :*: skp- Chunk y ys -> buildTable y ys g 0 msk' skp'- | otherwise = go (g+1) (i+1) msk' skp'- where c = A.unsafeIndex xarr (xoff+i)- msk' = msk .|. swizzle c- skp' | c == z = nlen - g - 2- | otherwise = skp- xlast = xlen - 1- -- | Check whether an attempt to index into the haystack at the- -- given offset would fail.- lackingHay q = go 0- where- go p (T.Text _ _ l) ps = p' < q && case ps of- Empty -> True- Chunk r rs -> go p' r rs- where p' = p + fromIntegral l-indices _ _ = []---- | Fast index into a partly unpacked 'Text'. We take into account--- the possibility that the caller might try to access one element--- past the end.-index :: T.Text -> Text -> Int64 -> Word16-index (T.Text arr off len) xs !i- | j < len = A.unsafeIndex arr (off+j)- | otherwise = case xs of- Empty- -- out of bounds, but legal- | j == len -> 0- -- should never happen, due to lackingHay above- | otherwise -> emptyError "index"- Chunk c cs -> index c cs (i-fromIntegral len)- where j = fromIntegral i---- | A variant of 'indices' that scans linearly for a single 'Word16'.-indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]-indicesOne c = chunk- where- chunk !i (T.Text oarr ooff olen) os = go 0- where- go h | h >= olen = case os of- Empty -> []- Chunk y ys -> chunk (i+fromIntegral olen) y ys- | on == c = i + fromIntegral h : go (h+1)- | otherwise = go (h+1)- where on = A.unsafeIndex oarr (ooff+h)---- | The number of 'Word16' values in a 'Text'.-wordLength :: Text -> Int64-wordLength = foldlChunks sumLength 0- where sumLength i (T.Text _ _ l) = i + fromIntegral l--emptyError :: String -> a-emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
− Data/Text/Private.hs
@@ -1,37 +0,0 @@-{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}---- |--- Module : Data.Text.Private--- Copyright : (c) 2011 Bryan O'Sullivan------ License : BSD-style--- Maintainer : bos@serpentine.com--- Stability : experimental--- Portability : GHC--module Data.Text.Private- (- runText- , span_- ) where--import Control.Monad.ST (ST, runST)-import Data.Text.Internal (Text(..), textP)-import Data.Text.Unsafe (Iter(..), iter)-import qualified Data.Text.Array as A--span_ :: (Char -> Bool) -> Text -> (# Text, Text #)-span_ p t@(Text arr off len) = (# hd,tl #)- where hd = textP arr off k- tl = textP arr (off+k) (len-k)- !k = loop 0- loop !i | i < len && p c = loop (i+d)- | otherwise = i- where Iter c d = iter t i-{-# INLINE span_ #-}--runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text-runText act = runST (act $ \ !marr !len -> do- arr <- A.unsafeFreeze marr- return $! textP arr 0 len)-{-# INLINE runText #-}
Data/Text/Read.hs view
@@ -28,7 +28,7 @@ import Data.Int (Int8, Int16, Int32, Int64) import Data.Ratio ((%)) import Data.Text as T-import Data.Text.Private (span_)+import Data.Text.Internal.Private (span_) import Data.Word (Word, Word8, Word16, Word32, Word64) -- | Read some text. If the read succeeds, return its value and the
− Data/Text/Search.hs
@@ -1,90 +0,0 @@-{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}---- |--- Module : Data.Text.Search--- Copyright : (c) Bryan O'Sullivan 2009------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : GHC------ Fast substring search for 'Text', based on work by Boyer, Moore,--- Horspool, Sunday, and Lundh.------ References:------ * R. S. Boyer, J. S. Moore: A Fast String Searching Algorithm.--- Communications of the ACM, 20, 10, 762-772 (1977)------ * R. N. Horspool: Practical Fast Searching in Strings. Software ---- Practice and Experience 10, 501-506 (1980)------ * D. M. Sunday: A Very Fast Substring Search Algorithm.--- Communications of the ACM, 33, 8, 132-142 (1990)------ * F. Lundh: The Fast Search Algorithm.--- <http://effbot.org/zone/stringlib.htm> (2006)--module Data.Text.Search- (- indices- ) where--import qualified Data.Text.Array as A-import Data.Word (Word64)-import Data.Text.Internal (Text(..))-import Data.Bits ((.|.), (.&.))-import Data.Text.UnsafeShift (shiftL)--data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int---- | /O(n+m)/ Find the offsets of all non-overlapping indices of--- @needle@ within @haystack@. The offsets returned represent--- uncorrected indices in the low-level \"needle\" array, to which its--- offset must be added.------ In (unlikely) bad cases, this algorithm's complexity degrades--- towards /O(n*m)/.-indices :: Text -- ^ Substring to search for (@needle@)- -> Text -- ^ Text to search in (@haystack@)- -> [Int]-indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)- | nlen == 1 = scanOne (nindex 0)- | nlen <= 0 || ldiff < 0 = []- | otherwise = scan 0- where- ldiff = hlen - nlen- nlast = nlen - 1- z = nindex nlast- nindex k = A.unsafeIndex narr (noff+k)- hindex k = A.unsafeIndex harr (hoff+k)- hindex' k | k == hlen = 0- | otherwise = A.unsafeIndex harr (hoff+k)- buildTable !i !msk !skp- | i >= nlast = (msk .|. swizzle z) :* skp- | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'- where c = nindex i- skp' | c == z = nlen - i - 2- | otherwise = skp- swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)- scan !i- | i > ldiff = []- | c == z && candidateMatch 0 = i : scan (i + nlen)- | otherwise = scan (i + delta)- where c = hindex (i + nlast)- candidateMatch !j- | j >= nlast = True- | hindex (i+j) /= nindex j = False- | otherwise = candidateMatch (j+1)- delta | nextInPattern = nlen + 1- | c == z = skip + 1- | otherwise = 1- where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0- !(mask :* skip) = buildTable 0 0 (nlen-2)- scanOne c = loop 0- where loop !i | i >= hlen = []- | hindex i == c = i : loop (i+1)- | otherwise = loop (i+1)-{-# INLINE indices #-}
Data/Text/Unsafe.hs view
@@ -3,8 +3,7 @@ -- Module : Data.Text.Unsafe -- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan -- License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org+-- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable --@@ -29,10 +28,10 @@ #if defined(ASSERTS) import Control.Exception (assert) #endif-import Data.Text.Encoding.Utf16 (chr2)+import Data.Text.Internal.Encoding.Utf16 (chr2) import Data.Text.Internal (Text(..))-import Data.Text.Unsafe.Base (inlineInterleaveST, inlinePerformIO)-import Data.Text.UnsafeChar (unsafeChr)+import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)+import Data.Text.Internal.Unsafe.Char (unsafeChr) import qualified Data.Text.Array as A import GHC.IO (unsafeDupablePerformIO)
− Data/Text/Unsafe/Base.hs
@@ -1,51 +0,0 @@-{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}--- |--- Module : Data.Text.Unsafe.Base--- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan--- License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : portable------ A module containing unsafe operations, for very very careful use in--- heavily tested code.-module Data.Text.Unsafe.Base- (- inlineInterleaveST- , inlinePerformIO- ) where--import GHC.ST (ST(..))-#if defined(__GLASGOW_HASKELL__)-import GHC.IO (IO(IO))-import GHC.Base (realWorld#)-#endif----- | Just like unsafePerformIO, but we inline it. Big performance gains as--- it exposes lots of things to further inlining. /Very unsafe/. In--- particular, you should do no memory allocation inside an--- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.----{-# INLINE inlinePerformIO #-}-inlinePerformIO :: IO a -> a-#if defined(__GLASGOW_HASKELL__)-inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r-#else-inlinePerformIO = unsafePerformIO-#endif---- | Allow an 'ST' computation to be deferred lazily. When passed an--- action of type 'ST' @s@ @a@, the action will only be performed when--- the value of @a@ is demanded.------ This function is identical to the normal unsafeInterleaveST, but is--- inlined and hence faster.------ /Note/: This operation is highly unsafe, as it can introduce--- externally visible non-determinism into an 'ST' action.-inlineInterleaveST :: ST s a -> ST s a-inlineInterleaveST (ST m) = ST $ \ s ->- let r = case m s of (# _, res #) -> res in (# s, r #)-{-# INLINE inlineInterleaveST #-}
− Data/Text/UnsafeChar.hs
@@ -1,92 +0,0 @@-{-# LANGUAGE CPP, MagicHash #-}---- |--- Module : Data.Text.UnsafeChar--- Copyright : (c) 2008, 2009 Tom Harper,--- (c) 2009, 2010 Bryan O'Sullivan,--- (c) 2009 Duncan Coutts------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : GHC------ Fast character manipulation functions.-module Data.Text.UnsafeChar- (- ord- , unsafeChr- , unsafeChr8- , unsafeChr32- , unsafeWrite- -- , unsafeWriteRev- ) where--#ifdef ASSERTS-import Control.Exception (assert)-#endif-import Control.Monad.ST (ST)-import Data.Bits ((.&.))-import Data.Text.UnsafeShift (shiftR)-import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)-import GHC.Word (Word8(..), Word16(..), Word32(..))-import qualified Data.Text.Array as A--ord :: Char -> Int-ord (C# c#) = I# (ord# c#)-{-# INLINE ord #-}--unsafeChr :: Word16 -> Char-unsafeChr (W16# w#) = C# (chr# (word2Int# w#))-{-# INLINE unsafeChr #-}--unsafeChr8 :: Word8 -> Char-unsafeChr8 (W8# w#) = C# (chr# (word2Int# w#))-{-# INLINE unsafeChr8 #-}--unsafeChr32 :: Word32 -> Char-unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))-{-# INLINE unsafeChr32 #-}---- | Write a character into the array at the given offset. Returns--- the number of 'Word16's written.-unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int-unsafeWrite marr i c- | n < 0x10000 = do-#if defined(ASSERTS)- assert (i >= 0) . assert (i < A.length marr) $ return ()-#endif- A.unsafeWrite marr i (fromIntegral n)- return 1- | otherwise = do-#if defined(ASSERTS)- assert (i >= 0) . assert (i < A.length marr - 1) $ return ()-#endif- A.unsafeWrite marr i lo- A.unsafeWrite marr (i+1) hi- return 2- where n = ord c- m = n - 0x10000- lo = fromIntegral $ (m `shiftR` 10) + 0xD800- hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00-{-# INLINE unsafeWrite #-}--{--unsafeWriteRev :: A.MArray s Word16 -> Int -> Char -> ST s Int-unsafeWriteRev marr i c- | n < 0x10000 = do- assert (i >= 0) . assert (i < A.length marr) $- A.unsafeWrite marr i (fromIntegral n)- return (i-1)- | otherwise = do- assert (i >= 1) . assert (i < A.length marr) $- A.unsafeWrite marr (i-1) lo- A.unsafeWrite marr i hi- return (i-2)- where n = ord c- m = n - 0x10000- lo = fromIntegral $ (m `shiftR` 10) + 0xD800- hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00-{-# INLINE unsafeWriteRev #-}--}
− Data/Text/UnsafeShift.hs
@@ -1,69 +0,0 @@-{-# LANGUAGE MagicHash #-}---- |--- Module : Data.Text.UnsafeShift--- Copyright : (c) Bryan O'Sullivan 2009------ License : BSD-style--- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,--- duncan@haskell.org--- Stability : experimental--- Portability : GHC------ Fast, unchecked bit shifting functions.--module Data.Text.UnsafeShift- (- UnsafeShift(..)- ) where---- import qualified Data.Bits as Bits-import GHC.Base-import GHC.Word---- | This is a workaround for poor optimisation in GHC 6.8.2. It--- fails to notice constant-width shifts, and adds a test and branch--- to every shift. This imposes about a 10% performance hit.------ These functions are undefined when the amount being shifted by is--- greater than the size in bits of a machine Int#.-class UnsafeShift a where- shiftL :: a -> Int -> a- shiftR :: a -> Int -> a--instance UnsafeShift Word16 where- {-# INLINE shiftL #-}- shiftL (W16# x#) (I# i#) = W16# (narrow16Word# (x# `uncheckedShiftL#` i#))-- {-# INLINE shiftR #-}- shiftR (W16# x#) (I# i#) = W16# (x# `uncheckedShiftRL#` i#)--instance UnsafeShift Word32 where- {-# INLINE shiftL #-}- shiftL (W32# x#) (I# i#) = W32# (narrow32Word# (x# `uncheckedShiftL#` i#))-- {-# INLINE shiftR #-}- shiftR (W32# x#) (I# i#) = W32# (x# `uncheckedShiftRL#` i#)--instance UnsafeShift Word64 where- {-# INLINE shiftL #-}- shiftL (W64# x#) (I# i#) = W64# (x# `uncheckedShiftL64#` i#)-- {-# INLINE shiftR #-}- shiftR (W64# x#) (I# i#) = W64# (x# `uncheckedShiftRL64#` i#)--instance UnsafeShift Int where- {-# INLINE shiftL #-}- shiftL (I# x#) (I# i#) = I# (x# `iShiftL#` i#)-- {-# INLINE shiftR #-}- shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)--{--instance UnsafeShift Integer where- {-# INLINE shiftL #-}- shiftL = Bits.shiftL-- {-# INLINE shiftR #-}- shiftR = Bits.shiftR--}
− Data/Text/Util.hs
@@ -1,27 +0,0 @@-{-# LANGUAGE CPP, DeriveDataTypeable #-}---- |--- Module : Data.Text.Util--- Copyright : 2010 Bryan O'Sullivan------ License : BSD-style--- Maintainer : bos@serpentine.com--- Stability : experimental--- Portability : GHC------ Useful functions.--module Data.Text.Util- (- intersperse- ) where---- | A lazier version of Data.List.intersperse. The other version--- causes space leaks!-intersperse :: a -> [a] -> [a]-intersperse _ [] = []-intersperse sep (x:xs) = x : go xs- where- go [] = []- go (y:ys) = sep : y: go ys-{-# INLINE intersperse #-}
benchmarks/haskell/Benchmarks.hs view
@@ -49,7 +49,10 @@ , Equality.benchmark (tf "japanese.txt") , FileRead.benchmark (tf "russian.txt") , FoldLines.benchmark (tf "russian.txt")- , Pure.benchmark "tiny "(tf "tiny.txt")+ , Pure.benchmark "tiny" (tf "tiny.txt")+ , Pure.benchmark "ascii" (tf "ascii-small.txt")+ , Pure.benchmark "france" (tf "france.html")+ , Pure.benchmark "russian" (tf "russian-small.txt") , Pure.benchmark "japanese" (tf "japanese.txt") , ReadNumbers.benchmark (tf "numbers.txt") , Replace.benchmark (tf "russian.txt") "принимая" "своем"
benchmarks/haskell/Benchmarks/Stream.hs view
@@ -13,16 +13,16 @@ import Control.DeepSeq (NFData (..)) import Criterion (Benchmark, bgroup, bench, nf)-import Data.Text.Fusion.Internal (Step (..), Stream (..))+import Data.Text.Internal.Fusion.Types (Step (..), Stream (..)) import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as E-import qualified Data.Text.Encoding.Fusion as T-import qualified Data.Text.Encoding.Fusion.Common as F-import qualified Data.Text.Fusion as T+import qualified Data.Text.Internal.Encoding.Fusion as T+import qualified Data.Text.Internal.Encoding.Fusion.Common as F+import qualified Data.Text.Internal.Fusion as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy.Encoding as TL-import qualified Data.Text.Lazy.Encoding.Fusion as TL-import qualified Data.Text.Lazy.Fusion as TL+import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL+import qualified Data.Text.Internal.Lazy.Fusion as TL import qualified Data.Text.Lazy.IO as TL instance NFData a => NFData (Stream a) where
cbits/cbits.c view
@@ -229,3 +229,70 @@ ret -= 1; return ret; }++void+_hs_text_encode_utf8(uint8_t **destp, const uint16_t *src, size_t srcoff,+ size_t srclen)+{+ const uint16_t *srcend;+ uint8_t *dest = *destp;++ src += srcoff;+ srcend = src + srclen;++ ascii:+#if defined(__x86_64__)+ while (srcend - src >= 4) {+ uint64_t w = *((uint64_t *) src);++ if (w & 0xFF80FF80FF80FF80ULL)+ break;+ *dest++ = w & 0xFFFF;+ *dest++ = (w >> 16) & 0xFFFF;+ *dest++ = (w >> 32) & 0xFFFF;+ *dest++ = w >> 48;+ src += 4;+ }+#endif++#if defined(__i386__)+ while (srcend - src >= 2) {+ uint32_t w = *((uint32_t *) src);++ if (w & 0xFF80FF80)+ break;+ *dest++ = w & 0xFFFF;+ *dest++ = w >> 16;+ src += 2;+ }+#endif++ while (src < srcend) {+ uint16_t w = *src++;++ if (w <= 0x7F) {+ *dest++ = w;+ /* An ASCII byte is likely to begin a run of ASCII bytes.+ Falling back into the fast path really helps performance. */+ goto ascii;+ }+ else if (w <= 0x7FF) {+ *dest++ = (w >> 6) | 0xC0;+ *dest++ = (w & 0x3f) | 0x80;+ }+ else if (w < 0xD800 || w > 0xDBFF) {+ *dest++ = (w >> 12) | 0xE0;+ *dest++ = ((w >> 6) & 0x3F) | 0x80;+ *dest++ = (w & 0x3F) | 0x80;+ } else {+ uint32_t c = ((((uint32_t) w) - 0xD800) << 10) ++ (((uint32_t) *src++) - 0xDC00) + 0x10000;+ *dest++ = (c >> 18) | 0xF0;+ *dest++ = ((c >> 12) & 0x3F) | 0x80;+ *dest++ = ((c >> 6) & 0x3F) | 0x80;+ *dest++ = (c & 0x3F) | 0x80;+ }+ }++ *destp = dest;+}
changelog view
@@ -1,3 +1,23 @@+1.1.0.0++ * encodeUtf8: Performance is improved by up to 4x.++ * encodeUtf8Builder, encodeUtf8BuilderEscaped: new functions,+ available only if bytestring >= 0.10.4.0 is installed, that+ allow very fast and flexible encoding of a Text value to a+ bytestring Builder.++ As an example of the performance gain to be had, the+ encodeUtf8BuilderEscaped function helps to double the speed+ of JSON encoding in the latest version of aeson! (Note: if+ all you need is a plain ByteString, encodeUtf8 is still the+ faster way to go.)++ * All of the internal module hierarchy is now publicly+ exposed. If a module is in the .Internal hierarchy, or is+ documented as internal, use at your own risk - there are no+ API stability guarantees for internal modules!+ 1.0.0.1 * decodeUtf8: Fixed a regression that caused us to incorrectly
scripts/CaseMapping.hs view
@@ -29,7 +29,7 @@ ["" ,"module Data.Text.Fusion.CaseMapping where" ,"import Data.Char"- ,"import Data.Text.Fusion.Internal"+ ,"import Data.Text.Internal.Fusion.Types" ,""] mapM_ (hPutStrLn h) (mapSC "upper" upper toUpper scs) mapM_ (hPutStrLn h) (mapSC "lower" lower toLower scs)
tests/Tests/Properties.hs view
@@ -22,12 +22,12 @@ import Data.Monoid (Monoid(..)) import Data.String (fromString) import Data.Text.Encoding.Error-import Data.Text.Encoding.Utf8 import Data.Text.Foreign-import Data.Text.Fusion.Size+import Data.Text.Internal.Encoding.Utf8+import Data.Text.Internal.Fusion.Size import Data.Text.Lazy.Read as TL import Data.Text.Read as T-import Data.Text.Search (indices)+import Data.Text.Internal.Search (indices) import Data.Word (Word, Word8, Word16, Word32, Word64) import Numeric (showHex) import Test.Framework (Test, testGroup)@@ -38,18 +38,18 @@ import qualified Data.List as L import qualified Data.Text as T import qualified Data.Text.Encoding as E-import qualified Data.Text.Fusion as S-import qualified Data.Text.Fusion.Common as S+import qualified Data.Text.Internal.Fusion as S+import qualified Data.Text.Internal.Fusion.Common as S import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import qualified Data.Text.Lazy.Builder.Int as TB import qualified Data.Text.Lazy.Builder.RealFloat as TB import qualified Data.Text.Lazy.Encoding as EL-import qualified Data.Text.Lazy.Fusion as SL+import qualified Data.Text.Internal.Lazy.Fusion as SL import qualified Data.Text.Lazy.IO as TL-import qualified Data.Text.Lazy.Search as S (indices)-import qualified Data.Text.UnsafeShift as U+import qualified Data.Text.Internal.Lazy.Search as S (indices)+import qualified Data.Text.Internal.Unsafe.Shift as U import qualified System.IO as IO import Tests.QuickCheckUtils@@ -148,7 +148,7 @@ -- invalid leading byte of a 4-byte sequence , (:) <$> choose (0xF5, 0xFF) <*> upTo 3 contByte -- 4-byte sequence greater than U+10FFFF- , do k <- choose (0x11, 0x1F)+ , do k <- choose (0x11, 0x13) let w0 = 0xF0 + (k `Bits.shiftR` 2) w1 = 0x80 + ((k .&. 3) `Bits.shiftL` 4) ([w0,w1]++) <$> vectorOf 2 contByte
tests/Tests/QuickCheckUtils.hs view
@@ -44,11 +44,11 @@ import qualified Data.ByteString as B import qualified Data.Text as T import qualified Data.Text.Encoding.Error as T-import qualified Data.Text.Fusion as TF-import qualified Data.Text.Fusion.Common as TF+import qualified Data.Text.Internal.Fusion as TF+import qualified Data.Text.Internal.Fusion.Common as TF import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Fusion as TLF-import qualified Data.Text.Lazy.Internal as TL+import qualified Data.Text.Internal.Lazy.Fusion as TLF+import qualified Data.Text.Internal.Lazy as TL import qualified System.IO as IO import Tests.Utils@@ -58,11 +58,19 @@ random = randomR (minBound,maxBound) instance Arbitrary I16 where- arbitrary = choose (minBound,maxBound)+ arbitrary = arbitrarySizedIntegral+ shrink = shrinkIntegral instance Arbitrary B.ByteString where arbitrary = B.pack `fmap` arbitrary+ shrink = map B.pack . shrink . B.unpack +#if !MIN_VERSION_base(4,4,0)+instance Random Word8 where+ randomR = integralRandomR+ random = randomR (minBound,maxBound)+#endif+ genUnicode :: IsString a => Gen a genUnicode = fmap fromString string where string = sized $ \n ->@@ -124,9 +132,11 @@ instance Arbitrary T.Text where arbitrary = T.pack `fmap` arbitrary+ shrink = map T.pack . shrink . T.unpack instance Arbitrary TL.Text where arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary+ shrink = map TL.pack . shrink . TL.unpack newtype NotEmpty a = NotEmpty { notEmpty :: a } deriving (Eq, Ord)@@ -139,16 +149,24 @@ instance Arbitrary a => Arbitrary (NotEmpty [a]) where arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))+ shrink = shrinkNotEmpty null instance Arbitrary (NotEmpty T.Text) where arbitrary = (fmap T.pack) `fmap` arbitrary+ shrink = shrinkNotEmpty T.null instance Arbitrary (NotEmpty TL.Text) where arbitrary = (fmap TL.pack) `fmap` arbitrary+ shrink = shrinkNotEmpty TL.null instance Arbitrary (NotEmpty B.ByteString) where arbitrary = (fmap B.pack) `fmap` arbitrary+ shrink = shrinkNotEmpty B.null +shrinkNotEmpty :: Arbitrary a => (a -> Bool) -> NotEmpty a -> [NotEmpty a]+shrinkNotEmpty isNull (NotEmpty xs) =+ [ NotEmpty xs' | xs' <- shrink xs, not (isNull xs') ]+ data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7 | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15 | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23@@ -188,7 +206,8 @@ random = randomR (minBound,maxBound) instance Arbitrary Small where- arbitrary = choose (minBound,maxBound)+ arbitrary = choose (minBound, maxBound)+ shrink = shrinkIntegral integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g) integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
tests/text-tests.cabal view
@@ -30,6 +30,7 @@ -fhpc cpp-options:+ -DTEST_SUITE -DASSERTS -DHAVE_DEEPSEQ @@ -70,49 +71,50 @@ Data.Text.Array Data.Text.Encoding Data.Text.Encoding.Error- Data.Text.Encoding.Fusion- Data.Text.Encoding.Fusion.Common- Data.Text.Encoding.Utf16- Data.Text.Encoding.Utf32- Data.Text.Encoding.Utf8+ Data.Text.Internal.Encoding.Fusion+ Data.Text.Internal.Encoding.Fusion.Common+ Data.Text.Internal.Encoding.Utf16+ Data.Text.Internal.Encoding.Utf32+ Data.Text.Internal.Encoding.Utf8 Data.Text.Foreign- Data.Text.Fusion- Data.Text.Fusion.CaseMapping- Data.Text.Fusion.Common- Data.Text.Fusion.Internal- Data.Text.Fusion.Size+ Data.Text.Internal.Fusion+ Data.Text.Internal.Fusion.CaseMapping+ Data.Text.Internal.Fusion.Common+ Data.Text.Internal.Fusion.Size+ Data.Text.Internal.Fusion.Types Data.Text.IO- Data.Text.IO.Internal+ Data.Text.Internal.IO Data.Text.Internal Data.Text.Lazy Data.Text.Lazy.Builder- Data.Text.Lazy.Builder.Functions+ Data.Text.Internal.Builder.Functions Data.Text.Lazy.Builder.Int- Data.Text.Lazy.Builder.Int.Digits- Data.Text.Lazy.Builder.Internal+ Data.Text.Internal.Builder.Int.Digits+ Data.Text.Internal.Builder Data.Text.Lazy.Builder.RealFloat- Data.Text.Lazy.Builder.RealFloat.Functions+ Data.Text.Internal.Builder.RealFloat.Functions Data.Text.Lazy.Encoding- Data.Text.Lazy.Encoding.Fusion- Data.Text.Lazy.Fusion+ Data.Text.Internal.Lazy.Encoding.Fusion+ Data.Text.Internal.Lazy.Fusion Data.Text.Lazy.IO- Data.Text.Lazy.Internal+ Data.Text.Internal.Lazy Data.Text.Lazy.Read- Data.Text.Lazy.Search- Data.Text.Private+ Data.Text.Internal.Lazy.Search+ Data.Text.Internal.Private Data.Text.Read- Data.Text.Search+ Data.Text.Internal.Search Data.Text.Unsafe- Data.Text.Unsafe.Base- Data.Text.UnsafeChar- Data.Text.UnsafeShift- Data.Text.Util+ Data.Text.Internal.Unsafe+ Data.Text.Internal.Unsafe.Char+ Data.Text.Internal.Unsafe.Shift+ Data.Text.Internal.Functions if flag(hpc) ghc-options: -fhpc cpp-options:+ -DTEST_SUITE -DHAVE_DEEPSEQ -DASSERTS -DINTEGER_GMP
text.cabal view
@@ -1,5 +1,5 @@ name: text-version: 1.0.0.1+version: 1.1.0.0 homepage: https://github.com/bos/text bug-reports: https://github.com/bos/text/issues synopsis: An efficient packed Unicode text type.@@ -82,6 +82,31 @@ Data.Text.Foreign Data.Text.IO Data.Text.Internal+ Data.Text.Internal.Builder+ Data.Text.Internal.Builder.Functions+ Data.Text.Internal.Builder.Int.Digits+ Data.Text.Internal.Builder.RealFloat.Functions+ Data.Text.Internal.Encoding.Fusion+ Data.Text.Internal.Encoding.Fusion.Common+ Data.Text.Internal.Encoding.Utf16+ Data.Text.Internal.Encoding.Utf32+ Data.Text.Internal.Encoding.Utf8+ Data.Text.Internal.Functions+ Data.Text.Internal.Fusion+ Data.Text.Internal.Fusion.CaseMapping+ Data.Text.Internal.Fusion.Common+ Data.Text.Internal.Fusion.Size+ Data.Text.Internal.Fusion.Types+ Data.Text.Internal.IO+ Data.Text.Internal.Lazy+ Data.Text.Internal.Lazy.Encoding.Fusion+ Data.Text.Internal.Lazy.Fusion+ Data.Text.Internal.Lazy.Search+ Data.Text.Internal.Private+ Data.Text.Internal.Search+ Data.Text.Internal.Unsafe+ Data.Text.Internal.Unsafe.Char+ Data.Text.Internal.Unsafe.Shift Data.Text.Lazy Data.Text.Lazy.Builder Data.Text.Lazy.Builder.Int@@ -92,39 +117,18 @@ Data.Text.Lazy.Read Data.Text.Read Data.Text.Unsafe- other-modules:- Data.Text.Encoding.Fusion- Data.Text.Encoding.Fusion.Common- Data.Text.Encoding.Utf16- Data.Text.Encoding.Utf32- Data.Text.Encoding.Utf8- Data.Text.Fusion- Data.Text.Fusion.CaseMapping- Data.Text.Fusion.Common- Data.Text.Fusion.Internal- Data.Text.Fusion.Size- Data.Text.IO.Internal- Data.Text.Lazy.Builder.Functions- Data.Text.Lazy.Builder.Int.Digits- Data.Text.Lazy.Builder.Internal- Data.Text.Lazy.Builder.RealFloat.Functions- Data.Text.Lazy.Encoding.Fusion- Data.Text.Lazy.Fusion- Data.Text.Lazy.Search- Data.Text.Private- Data.Text.Search- Data.Text.Unsafe.Base- Data.Text.UnsafeChar- Data.Text.UnsafeShift- Data.Text.Util build-depends: array >= 0.3, base >= 4.2 && < 5,- bytestring >= 0.9, deepseq >= 1.1.0.0, ghc-prim >= 0.2 + if impl(ghc >= 7.7)+ build-depends: bytestring >= 0.10.4.0+ else+ build-depends: bytestring >= 0.9+ cpp-options: -DHAVE_DEEPSEQ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 if flag(developer)@@ -150,7 +154,7 @@ -Wall -threaded -O0 -rtsopts cpp-options:- -DASSERTS -DHAVE_DEEPSEQ+ -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE build-depends: HUnit >= 1.2,