f68d334 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Refactor encodeUtf8 and encodeUtf8'

f68d334Ranjeet Kumar Ranjan5 years ago

src/Streamly/Internal/Unicode/Stream.hs+73−64

compare with master

unifiedsplit

@@ -602,8 +602,9 @@ decodeUtf8ArraysWithD cfm (Stream step state) =

602 inputUnderflow =

603 case cfm of

604 ErrorOnCodingFailure ->

605− error

605+ error $

606+ show "Streamly.Internal.Data.Stream.StreamD."

606− "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Input Underflow"

607+ ++ "decodeUtf8ArraysWith: Input Underflow"

607 TransliterateCodingFailure -> YAndC replacementChar D

608 TransliterateCodingFailure -> YAndC replacementChar D

608 DropOnCodingFailure -> D

609 DropOnCodingFailure -> D

609 {-# INLINE_LATE step' #-}

610 {-# INLINE_LATE step' #-}

@@ -653,7 +654,11 @@ decodeUtf8ArraysWithD cfm (Stream step state) =

653 12 ->

654 12 ->

654 Skip $

655 Skip $

655 transliterateOrError

656 transliterateOrError

657+ (

656− "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"

658+ "Streamly.Internal.Data.Stream.StreamD."

659+ ++ "decodeUtf8ArraysWith: Invalid UTF8"

660+ ++ " codepoint encountered"

661+ )

657 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)

662 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)

658 0 -> error "unreachable state"

663 0 -> error "unreachable state"

659 _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)

664 _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)

@@ -674,9 +679,15 @@ decodeUtf8ArraysWithD cfm (Stream step state) =

674 12 ->

679 12 ->

675 Skip $

680 Skip $

676 transliterateOrError

681 transliterateOrError

682+ (

677− "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"

683+ "Streamly.Internal.Data.Stream.StreamD."

684+ ++ "decodeUtf8ArraysWith: Invalid UTF8"

685+ ++ " codepoint encountered"

686+ )

678 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)

687 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)

688+ _ ->

689+ Skip

679− _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)

690+ (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)

680 step' _ _ (YAndC c s) = return $ Yield c s

691 step' _ _ (YAndC c s) = return $ Yield c s

681 step' _ _ D = return Stop

692 step' _ _ D = return Stop

682

693

@@ -764,14 +775,34 @@ ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))

764{-# ANN type EncodeState Fuse #-}

775{-# ANN type EncodeState Fuse #-}

765data EncodeState s = EncodeState s !WList

776data EncodeState s = EncodeState s !WList

766

777

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

778+{-# ANN type InvalidAction Fuse #-}

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

779+data InvalidAction =

769−-- points for now, one for the ascii chars (fast path) and one for all other

780+ DropInvalid | ErrorInvalid | IgnoreInvalid | ReplaceInvalid

770−-- paths (slow path).

781+

782+replaceInvalid :: s -> Step (EncodeState s) a

783+replaceInvalid s =

784+ Skip $ EncodeState s (WCons 239 (WCons 191 (WCons 189 WNil)))

785+

786+dropInvalid :: s -> Step (EncodeState s) a

787+dropInvalid s = Skip (EncodeState s WNil)

788+

789+errorOnInvalid :: s -> Step (EncodeState s) a

790+errorOnInvalid _ =

791+ error $

792+ show "Streamly.Internal.Data.Stream.StreamD.encodeUtf8:"

793+ ++ "Encountered a surrogate"

794+

771−{-# INLINE_NORMAL encodeUtf8D' #-}

795+{-# INLINE_NORMAL encodeUtf8DGeneric #-}

796+encodeUtf8DGeneric ::

797+ Monad m

798+ => InvalidAction

799+ -> Stream m Char

772−encodeUtf8D' :: Monad m => Stream m Char -> Stream m Word8

800+ -> Stream m Word8

801+encodeUtf8DGeneric act (Stream step state) =

773−encodeUtf8D' (Stream step state) = Stream step' (EncodeState state WNil)

802+ Stream step' (EncodeState state WNil)

803+

774− where

804+ where

805+

775 {-# INLINE_LATE step' #-}

806 {-# INLINE_LATE step' #-}

776 step' gst (EncodeState st WNil) = do

807 step' gst (EncodeState st WNil) = do

777 r <- step (adaptState gst) st

808 r <- step (adaptState gst) st

@@ -779,20 +810,41 @@ encodeUtf8D' (Stream step state) = Stream step' (EncodeState state WNil)

779 case r of

810 case r of

780 Yield c s ->

811 Yield c s ->

781 case ord c of

812 case ord c of

782− x

783− | x <= 0x7F ->

813+ x | x <= 0x7F ->

784 Yield (fromIntegral x) (EncodeState s WNil)

814 Yield (fromIntegral x) (EncodeState s WNil)

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

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

786 | x <= 0xFFFF ->

816 | x <= 0xFFFF ->

817+ case act of

818+ DropInvalid ->

787− if isSurrogate c

819+ if isSurrogate c

788− then error

820+ then dropInvalid s

789− "Streamly.Internal.Data.Stream.StreamD.encodeUtf8: Encountered a surrogate"

821+ else Skip (EncodeState s (ord3 c))

822+

823+ ErrorInvalid ->

824+ if isSurrogate c

825+ then errorOnInvalid s

826+ else Skip (EncodeState s (ord3 c))

827+

828+ IgnoreInvalid ->

829+ Skip (EncodeState s (ord3 c))

830+

831+ ReplaceInvalid ->

832+ if isSurrogate c

833+ then replaceInvalid s

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

834+ else Skip (EncodeState s (ord3 c))

835+

791 | otherwise -> Skip (EncodeState s (ord4 c))

836 | otherwise -> Skip (EncodeState s (ord4 c))

792 Skip s -> Skip (EncodeState s WNil)

837 Skip s -> Skip (EncodeState s WNil)

793 Stop -> Stop

838 Stop -> Stop

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

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

795

840

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

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

843+-- points for now, one for the ascii chars (fast path) and one for all other

844+-- paths (slow path).

845+{-# INLINE_NORMAL encodeUtf8D' #-}

846+encodeUtf8D' :: Monad m => Stream m Char -> Stream m Word8

847+encodeUtf8D' = encodeUtf8DGeneric ErrorInvalid

796

848

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

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

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

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

@@ -808,30 +860,7 @@ encodeUtf8' = D.fromStreamD . encodeUtf8D' . D.toStreamD

808--

860--

809{-# INLINE_NORMAL encodeUtf8D #-}

861{-# INLINE_NORMAL encodeUtf8D #-}

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

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

811−encodeUtf8D (Stream step state) = Stream step' (EncodeState state WNil)

863+encodeUtf8D = encodeUtf8DGeneric ReplaceInvalid

812− where

813− {-# INLINE_LATE step' #-}

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

820− x | x <= 0x7F ->

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

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

823− | x <= 0xFFFF ->

824− if isSurrogate c

825− then Skip $

826− EncodeState

827− s

828− (WCons 239 (WCons 191 (WCons 189 WNil)))

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

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

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

832− Stop -> Stop

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

834−

835

864

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

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

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

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

@@ -846,27 +875,7 @@ encodeUtf8 = D.fromStreamD . encodeUtf8D . D.toStreamD

846

875

847{-# INLINE_NORMAL encodeUtf8D_ #-}

876{-# INLINE_NORMAL encodeUtf8D_ #-}

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

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

849−encodeUtf8D_ (Stream step state) = Stream step' (EncodeState state WNil)

878+encodeUtf8D_ = encodeUtf8DGeneric DropInvalid

850− where

851− {-# INLINE_LATE step' #-}

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

853− r <- step (adaptState gst) st

854− return $

855− case r of

856− Yield c s ->

857− case ord c of

858− x | x <= 0x7F ->

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

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

861− | x <= 0xFFFF ->

862− if isSurrogate c

863− then Skip $

864− EncodeState s WNil

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

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

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

868− Stop -> Stop

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

870

879

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

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

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

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