28cfe5b · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Use unfold to implement utf8 encode

28cfe5bHarendra Kumar6 years ago

src/Streamly/Internal/Unicode/Stream.hs+32−70

compare with master

unifiedsplit

@@ -38,6 +38,7 @@ module Streamly.Internal.Unicode.Stream

38 , encodeLatin1_

40 -- ** UTF-8 Encoding

41+ , readCharUtf8'

41 , encodeUtf8

42 , encodeUtf8

42 , encodeUtf8'

43 , encodeUtf8'

43 , encodeUtf8_

44 , encodeUtf8_

@@ -96,7 +97,7 @@ import Streamly.Internal.Data.Stream.Serial (SerialT)

96import Streamly.Internal.Data.Stream.StreamD (Stream(..), Step (..))

97import Streamly.Internal.Data.Stream.StreamD (Stream(..), Step (..))

97import Streamly.Internal.Data.SVar (adaptState)

98import Streamly.Internal.Data.SVar (adaptState)

98import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))

99import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))

99−import Streamly.Internal.Data.Unfold (Unfold)

100+import Streamly.Internal.Data.Unfold.Type (Unfold(..))

100import Streamly.Internal.System.IO (unsafeInlineIO)

101import Streamly.Internal.System.IO (unsafeInlineIO)

101

102

102import qualified Streamly.Internal.Data.Unfold as Unfold

103import qualified Streamly.Internal.Data.Unfold as Unfold

@@ -775,75 +776,28 @@ ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))

775 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80

776 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80

776 x4 = fromIntegral $ (n .&. 0x3F) + 0x80

777 x4 = fromIntegral $ (n .&. 0x3F) + 0x80

777

778

778−#ifndef __GHCJS__

779−{-# ANN type EncodeState Fuse #-}

780−#endif

781−data EncodeState s = EncodeState s !WList

782−

783−#ifndef __GHCJS__

784−{-# ANN type InvalidAction Fuse #-}

785−#endif

786−data InvalidAction =

787− DropInvalid | ErrorInvalid | IgnoreInvalid | ReplaceInvalid

788−

789−replaceInvalid :: s -> Step (EncodeState s) a

790−replaceInvalid s =

791− Skip $ EncodeState s (WCons 239 (WCons 191 (WCons 189 WNil)))

792−

793−dropInvalid :: s -> Step (EncodeState s) a

794−dropInvalid s = Skip (EncodeState s WNil)

795−

796−errorOnInvalid :: s -> Step (EncodeState s) a

797−errorOnInvalid _ =

798− error $

799− show "Streamly.Internal.Data.Stream.StreamD.encodeUtf8:"

800− ++ "Encountered a surrogate"

801−

802−{-# INLINE_NORMAL encodeUtf8DGeneric #-}

779+{-# INLINE_NORMAL readCharUtf8With #-}

803−encodeUtf8DGeneric ::

780+readCharUtf8With :: Monad m => WList -> Unfold m Char Word8

804− Monad m

781+readCharUtf8With surr = Unfold step inject

805− => InvalidAction

806− -> Stream m Char

807− -> Stream m Word8

808−encodeUtf8DGeneric act (Stream step state) =

809− Stream step' (EncodeState state WNil)

810

782

811 where

783 where

812

784

813− {-# INLINE_LATE step' #-}

785+ inject c =

814− step' gst (EncodeState st WNil) = do

815− r <- step (adaptState gst) st

816− return $

817− case r of

818− Yield c s ->

819− case ord c of

786+ return $ case ord c of

820− x | x <= 0x7F ->

821− Yield (fromIntegral x) (EncodeState s WNil)

787+ x | x <= 0x7F -> fromIntegral x `WCons` WNil

822− | x <= 0x7FF -> Skip (EncodeState s (ord2 c))

788+ | x <= 0x7FF -> ord2 c

823− | x <= 0xFFFF ->

824− case act of

825− DropInvalid ->

826− if isSurrogate c

789+ | x <= 0xFFFF -> if isSurrogate c then surr else ord3 c

827− then dropInvalid s

828− else Skip (EncodeState s (ord3 c))

829−

830− ErrorInvalid ->

831− if isSurrogate c

832− then errorOnInvalid s

833− else Skip (EncodeState s (ord3 c))

834−

835− IgnoreInvalid ->

836− Skip (EncodeState s (ord3 c))

837−

838− ReplaceInvalid ->

839− if isSurrogate c

840− then replaceInvalid s

841− else Skip (EncodeState s (ord3 c))

842−

843− | otherwise -> Skip (EncodeState s (ord4 c))

790+ | otherwise -> ord4 c

844− Skip s -> Skip (EncodeState s WNil)

791+

845− Stop -> Stop

792+ {-# INLINE_LATE step #-}

793+ step WNil = return Stop

846− step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)

794+ step (WCons x xs) = return $ Yield x xs

795+

796+{-# INLINE_NORMAL readCharUtf8' #-}

797+readCharUtf8' :: Monad m => Unfold m Char Word8

798+readCharUtf8' =

799+ readCharUtf8With $

800+ error "Streamly.Internal.Unicode.readCharUtf8': Encountered a surrogate"

847

801

848-- More yield points improve performance, but I am not sure if they can cause

802-- More yield points improve performance, but I am not sure if they can cause

849-- too much code bloat or some trouble with fusion. So keeping only two yield

803-- too much code bloat or some trouble with fusion. So keeping only two yield

@@ -851,7 +805,7 @@ encodeUtf8DGeneric act (Stream step state) =

851-- paths (slow path).

805-- paths (slow path).

852{-# INLINE_NORMAL encodeUtf8D' #-}

806{-# INLINE_NORMAL encodeUtf8D' #-}

853encodeUtf8D' :: Monad m => Stream m Char -> Stream m Word8

807encodeUtf8D' :: Monad m => Stream m Char -> Stream m Word8

854−encodeUtf8D' = encodeUtf8DGeneric ErrorInvalid

808+encodeUtf8D' = D.unfoldMany readCharUtf8'

855

809

856-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. When

810-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. When

857-- any invalid character (U+D800-U+D8FF) is encountered in the input stream the

811-- any invalid character (U+D800-U+D8FF) is encountered in the input stream the

@@ -862,12 +816,16 @@ encodeUtf8D' = encodeUtf8DGeneric ErrorInvalid

862encodeUtf8' :: (Monad m, IsStream t) => t m Char -> t m Word8

816encodeUtf8' :: (Monad m, IsStream t) => t m Char -> t m Word8

863encodeUtf8' = fromStreamD . encodeUtf8D' . toStreamD

817encodeUtf8' = fromStreamD . encodeUtf8D' . toStreamD

864

818

819+{-# INLINE_NORMAL readCharUtf8 #-}

820+readCharUtf8 :: Monad m => Unfold m Char Word8

821+readCharUtf8 = readCharUtf8With $ WCons 239 (WCons 191 (WCons 189 WNil))

822+

865-- | See section "3.9 Unicode Encoding Forms" in

823-- | See section "3.9 Unicode Encoding Forms" in

866-- https://www.unicode.org/versions/Unicode13.0.0/UnicodeStandard-13.0.pdf

824-- https://www.unicode.org/versions/Unicode13.0.0/UnicodeStandard-13.0.pdf

867--

825--

868{-# INLINE_NORMAL encodeUtf8D #-}

826{-# INLINE_NORMAL encodeUtf8D #-}

869encodeUtf8D :: Monad m => Stream m Char -> Stream m Word8

827encodeUtf8D :: Monad m => Stream m Char -> Stream m Word8

870−encodeUtf8D = encodeUtf8DGeneric ReplaceInvalid

828+encodeUtf8D = D.unfoldMany readCharUtf8

871

829

872-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any

830-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any

873-- Invalid characters (U+D800-U+D8FF) in the input stream are replaced by the

831-- Invalid characters (U+D800-U+D8FF) in the input stream are replaced by the

@@ -880,9 +838,13 @@ encodeUtf8D = encodeUtf8DGeneric ReplaceInvalid

880encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8

838encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8

881encodeUtf8 = fromStreamD . encodeUtf8D . toStreamD

839encodeUtf8 = fromStreamD . encodeUtf8D . toStreamD

882

840

841+{-# INLINE_NORMAL readCharUtf8_ #-}

842+readCharUtf8_ :: Monad m => Unfold m Char Word8

843+readCharUtf8_ = readCharUtf8With WNil

844+

883{-# INLINE_NORMAL encodeUtf8D_ #-}

845{-# INLINE_NORMAL encodeUtf8D_ #-}

884encodeUtf8D_ :: Monad m => Stream m Char -> Stream m Word8

846encodeUtf8D_ :: Monad m => Stream m Char -> Stream m Word8

885−encodeUtf8D_ = encodeUtf8DGeneric DropInvalid

847+encodeUtf8D_ = D.unfoldMany readCharUtf8_

886

848

887-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any

849-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any

888-- Invalid characters (U+D800-U+D8FF) in the input stream are dropped.

850-- Invalid characters (U+D800-U+D8FF) in the input stream are dropped.