ced5579 · text · git.iko.soy

git.iko.soy/text

on master help sign in

Add decodeLatin and faster decodeUtf8

ced5579Luigy Leon10 years ago

Data/Text/Encoding.hs+49−48

compare with master

unifiedsplit

@@ -74,7 +74,7 @@ import Data.ByteString as B

74import Data.ByteString.Internal as B hiding (c2w)

75import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)

76import Data.Text.Internal (Text(..), safe, text)

77−-- import Data.Text.Internal.Private (runText)

77+import Data.Text.Internal.Private (runText)

78import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)

79import Data.Text.Internal.Unsafe.Shift (shiftR)

80-- import Data.Text.Show ()

@@ -95,7 +95,7 @@ import qualified Data.Text.Internal.Encoding.Fusion as E

95import qualified Data.Text.Internal.Encoding.Utf16 as U16

96import qualified Data.Text.Internal.Fusion as F

98−import GHC.Exts (ByteArray#, Int(..), Int#, Any)

98+import GHC.Exts (ByteArray#, Int(..), Int#, Any, Addr#, Ptr(..))

99{-

100#include "text_cbits.h"

101-}

@@ -105,6 +105,7 @@ import Data.ByteString (ByteString)

105import Data.Text.Internal (Text)

106

107-------------------------------------

108+import GHC.ForeignPtr

108import GHCJS.Types

109import GHCJS.Types

109import GHCJS.Buffer

110import GHCJS.Buffer

110import Data.JSString (JSString)

111import Data.JSString (JSString)

@@ -137,55 +138,55 @@ decodeASCII = decodeUtf8

137-- 'decodeLatin1' is semantically equivalent to

138-- 'decodeLatin1' is semantically equivalent to

138-- @Data.Text.pack . Data.ByteString.Char8.unpack@

139-- @Data.Text.pack . Data.ByteString.Char8.unpack@

139decodeLatin1 :: ByteString -> Text

140decodeLatin1 :: ByteString -> Text

140−decodeLatin1 = error "decodeLatin1"

141−-- decodeLatin1 (PS fp off len) = text a 0 len

141+decodeLatin1 (PS fp off len) = text a 0 len

142−-- where

142+ where

143−-- a = A.run (A.new len >>= unsafeIOToST . go)

143+ a = A.run (A.new len >>= unsafeIOToST . go)

144−-- go dest = withForeignPtr fp $ \ptr -> do

144+ go dest = withForeignPtr fp $ \ptr -> do

145−-- c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))

145+ c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))

146−-- return dest

146+ return dest

147

148-- foreign import javascript unsafe "h$textToString" js_toString :: JSVal -> Text

149

150foreign import javascript unsafe "h$textFromString" js_fromString :: JSString -> (# ByteArray#, Int# #)

151foreign import javascript unsafe "String['fromCharCode']['apply'](null, $1['u8'])" js_decodeBytes :: JSVal -> JSString

152foreign import javascript unsafe "h$decodeUtf8z($1, $2)" js_fromByteStringBuffer :: Buffer -> Int -> JSString

153+foreign import javascript unsafe "h$decodeUtf8z($1, $2)" js_fromByteStringBufferz :: Addr# -> Int -> JSString

153foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8 :: JSString -> Buffer

154foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8 :: JSString -> Buffer

155+

156+foreign import javascript unsafe "String['fromCharCode']['apply'](null, $1['u8'])" js_decodeUtf8Hack :: Addr# -> JSString

157+

154foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8Mut :: JSString -> MutableBuffer

158foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8Mut :: JSString -> MutableBuffer

155foreign import javascript unsafe "h$encodeUtf16($1)" js_encodeUtf16 :: JSString -> Buffer

159foreign import javascript unsafe "h$encodeUtf16($1)" js_encodeUtf16 :: JSString -> Buffer

156foreign import javascript unsafe "$1['length']" js_length :: JSString -> Int

160foreign import javascript unsafe "$1['length']" js_length :: JSString -> Int

157foreign import javascript unsafe "h$jsstringTake" js_take :: Int -> JSString -> JSString

161foreign import javascript unsafe "h$jsstringTake" js_take :: Int -> JSString -> JSString

162+foreign import javascript unsafe "$3.substring($1,$2)" js_substring :: Int# -> Int# -> JSString -> JSString

158

163

159-- | Decode a 'ByteString' containing UTF-8 encoded text.

164-- | Decode a 'ByteString' containing UTF-8 encoded text.

160decodeUtf8With :: OnDecodeError -> ByteString -> Text

165decodeUtf8With :: OnDecodeError -> ByteString -> Text

161−-- decodeUtf8With _ bs@(PS fp off len) = Text $ js_decodeBytes $ unsafeCoerce bs

162− -- decodeUtf8With _ bs = Text $ js_fromByteStringBuffer buf off

163−decodeUtf8With _ bs = Text $ js_take (len) $ js_fromByteStringBuffer buf off

164− where (buf, off, len) = fromByteString bs

165−-- decodeUtf8With onErr (PS fp off len) = runText $ \done -> do

166+decodeUtf8With onErr (PS fp off len) = runText $ \done -> do

166− -- let go dest = withForeignPtr fp $ \ptr ->

167+ let go dest = withForeignPtr fp $ \ptr ->

167− -- with (0::CSize) $ \destOffPtr -> do

168+ with (0::CSize) $ \destOffPtr -> do

168− -- let end = ptr `plusPtr` (off + len)

169+ let end = ptr `plusPtr` (off + len)

169− -- loop curPtr = do

170+ loop curPtr = do

170− -- curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end

171+ curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end

171− -- if curPtr' == end

172+ if curPtr' == end

172− -- then do

173+ then do

173− -- n <- peek destOffPtr

174+ n <- peek destOffPtr

174− -- unsafeSTToIO (done dest (fromIntegral n))

175+ unsafeSTToIO (done dest (fromIntegral n))

175− -- else do

176+ else do

176− -- x <- peek curPtr'

177+ x <- peek curPtr'

177− -- case onErr desc (Just x) of

178+ case onErr desc (Just x) of

178− -- Nothing -> loop $ curPtr' `plusPtr` 1

179+ Nothing -> loop $ curPtr' `plusPtr` 1

179− -- Just c -> do

180+ Just c -> do

180− -- destOff <- peek destOffPtr

181+ destOff <- peek destOffPtr

181− -- w <- unsafeSTToIO $

182+ w <- unsafeSTToIO $

182− -- unsafeWrite dest (fromIntegral destOff) (safe c)

183+ unsafeWrite dest (fromIntegral destOff) (safe c)

183− -- poke destOffPtr (destOff + fromIntegral w)

184+ poke destOffPtr (destOff + fromIntegral w)

184− -- loop $ curPtr' `plusPtr` 1

185+ loop $ curPtr' `plusPtr` 1

185− -- loop (ptr `plusPtr` off)

186+ loop (ptr `plusPtr` off)

186− -- (unsafeIOToST . go) =<< A.new len

187+ (unsafeIOToST . go) =<< A.new len

187− -- where

188+ where

188− -- desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"

189+ desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"

189{- INLINE[0] decodeUtf8With #-}

190{- INLINE[0] decodeUtf8With #-}

190

191

191-- $stream

192-- $stream

@@ -504,17 +505,17 @@ encodeUtf32BE :: Text -> ByteString

504encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))

505encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))

505{-# INLINE encodeUtf32BE #-}

506{-# INLINE encodeUtf32BE #-}

506

507

507−-- foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8

508+foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8

508−-- :: MutableByteArray# s -> Ptr CSize

509+ :: MutableByteArray# s -> Ptr CSize

509−-- -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)

510+ -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)

510

511

511−-- foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state

512+foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state

512−-- :: MutableByteArray# s -> Ptr CSize

513+ :: MutableByteArray# s -> Ptr CSize

513−-- -> Ptr (Ptr Word8) -> Ptr Word8

514+ -> Ptr (Ptr Word8) -> Ptr Word8

514−-- -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)

515+ -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)

515

516

516−-- foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1

517+foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1

517−-- :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()

518+ :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()

518

519

519−-- foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8

520+foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8

520−-- :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()

521+ :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()

Data/Text/Internal.hs+8−3

@@ -26,10 +26,11 @@ import Data.Bits

26import Data.Int (Int32, Int64)

27-- import Data.Text.Internal.Unsafe.Char (ord)

28import Data.Typeable (Typeable)

29−import GHC.Exts (ByteArray#, Char(..), ord#, andI#, (/=#), isTrue#)

29+import GHC.Exts (ByteArray#, Char(..), ord#, andI#, (/=#), isTrue#, (==#), Int(..), Int#, isTrue#)

30-- import qualified Data.Text.Array as A

31import GHCJS.Marshal.Pure

32import GHCJS.Marshal

33+import qualified GHC.CString as GHC

35newtype Text = Text JSString

36newtype Text = Text JSString

@@ -49,13 +50,17 @@ foreign import javascript unsafe

49 "String.fromCharCode.apply(null, $1['u8'])"

50 "String.fromCharCode.apply(null, $1['u8'])"

50 js_decodeBytes :: ByteArray# -> JSString

51 js_decodeBytes :: ByteArray# -> JSString

53+foreign import javascript unsafe

54+ "h$textToString"

55+ js_textToString :: ByteArray# -> Int# -> Int# -> JSString

56+

52-- | Construct a 'Text' without invisibly pinning its byte array in

57-- | Construct a 'Text' without invisibly pinning its byte array in

53-- memory if its length has dwindled to zero.

58-- memory if its length has dwindled to zero.

54text :: A.Array -> Int -> Int -> Text

59text :: A.Array -> Int -> Int -> Text

55-- text arr off len | len == 0 = empty

60-- text arr off len | len == 0 = empty

56-- | otherwise = text_ arr off len

61-- | otherwise = text_ arr off len

57−text (A.Array ba) off len | len == 0 = empty

62+text (A.Array ba) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty

58− | otherwise = Text (js_decodeBytes ba)

63+ | otherwise = Text $ js_textToString ba off# len#

60-- | Checked multiplication. Calls 'error' if the result would

65-- | Checked multiplication. Calls 'error' if the result would

61-- overflow.

66-- overflow.

text.cabal+1−1

@@ -111,7 +111,7 @@ library

111 -- Data.Text.Internal.Lazy.Encoding.Fusion

112 Data.Text.Internal.Lazy.Fusion

113 Data.Text.Internal.Lazy.Search

114− -- Data.Text.Internal.Private

114+ Data.Text.Internal.Private

115 Data.Text.Internal.Read

116 -- Data.Text.Internal.Search

117 Data.Text.Internal.Unsafe