@@ -266,6 +266,7 @@ module Streamly.Streams.StreamD
266266 , encodeUtf8
267267 , decodeUtf8Lenient
268268 , decodeUtf8Arrays
269+ , decodeUtf8ArraysLenient
269270 )
270271where
271272
@@ -282,8 +283,7 @@ import Data.Maybe (fromJust, isJust)
282283import Data.Word (Word32)
283284import Foreign.Ptr (Ptr)
284285import Foreign.Storable (Storable(..))
285−import GHC.Base (assert, Char(..), unsafeChr, (-#), (+#), uncheckedIShiftL#,
286− word2Int#, chr#, ord)
286+import GHC.Base (assert, Char(..), unsafeChr, ord)
287287import GHC.IO.Encoding.Failure (isSurrogate)
288288import GHC.Types (SPEC(..))
289289import GHC.Word (Word8(..))
@@ -301,6 +301,7 @@ import Streamly.Fold.Types (Fold(..))
301301import Streamly.Pipe.Types (Pipe(..), PipeState(..))
302302import Streamly.SVar (MonadAsync, defState, adaptState)
303303import Streamly.Unfold.Types (Unfold(..))
304+import Streamly.Strict (Tuple'(..))
304305
305306import Streamly.Streams.StreamD.Type
306307
@@ -312,7 +313,6 @@ import qualified Streamly.Streams.StreamK as K
312313import Foreign.Ptr (plusPtr)
313314import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
314315import Foreign.ForeignPtr (ForeignPtr, touchForeignPtr)
315−import Data.Array.Unboxed (UArray, listArray, (!))
316316
317317------------------------------------------------------------------------------
318318-- Construction
@@ -2973,16 +2973,16 @@ the (Stream step state) = go state
29732973-- UTF-8 primitives, Lifted from GHC.IO.Encoding.UTF8.
29742974
29752975{-# INLINE ord2 #-}
2976−ord2 :: Char -> [Word8]
2977−ord2 c = assert (n >= 0x80 && n <= 0x07ff) [x1, x2]
2976+ord2 :: Char -> WList
2977+ord2 c = assert (n >= 0x80 && n <= 0x07ff) (WCons x1 (WCons x2 WNil))
29782978 where
29792979 n = ord c
29802980 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
29812981 x2 = fromIntegral $ (n .&. 0x3F) + 0x80
29822982
29832983{-# INLINE ord3 #-}
2984−ord3 :: Char -> [Word8]
2985−ord3 c = assert (n >= 0x0800 && n <= 0xffff) [x1, x2, x3]
2984+ord3 :: Char -> WList
2985+ord3 c = assert (n >= 0x0800 && n <= 0xffff) (WCons x1 (WCons x2 (WCons x3 WNil)))
29862986 where
29872987 n = ord c
29882988 x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
@@ -2990,8 +2990,8 @@ ord3 c = assert (n >= 0x0800 && n <= 0xffff) [x1, x2, x3]
29902990 x3 = fromIntegral $ (n .&. 0x3F) + 0x80
29912991
29922992{-# INLINE ord4 #-}
2993−ord4 :: Char -> [Word8]
2994−ord4 c = assert (n >= 0x10000) [x1, x2, x3, x4]
2993+ord4 :: Char -> WList
2994+ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))
29952995 where
29962996 n = ord c
29972997 x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
@@ -2999,245 +2999,20 @@ ord4 c = assert (n >= 0x10000) [x1, x2, x3, x4]
29992999 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
30003000 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
30013001
3002−{-# INLINE chr2 #-}
3003−chr2 :: Word8 -> Word8 -> Char
3004−chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
3005− where
3006− !y1# = word2Int# x1#
3007− !y2# = word2Int# x2#
3008− !z1# = uncheckedIShiftL# (y1# -# 192#) 6#
3009− !z2# = y2# -# 128#
3010−
3011−{-# INLINE chr3 #-}
3012−chr3 :: Word8 -> Word8 -> Word8 -> Char
3013−chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))
3014− where
3015− !y1# = word2Int# x1#
3016− !y2# = word2Int# x2#
3017− !y3# = word2Int# x3#
3018− !z1# = uncheckedIShiftL# (y1# -# 224#) 12#
3019− !z2# = uncheckedIShiftL# (y2# -# 128#) 6#
3020− !z3# = y3# -# 128#
3021−
3022−{-# INLINE chr4 #-}
3023−chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
3024−chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =
3025− C# (chr# (z1# +# z2# +# z3# +# z4#))
3026− where
3027− !y1# = word2Int# x1#
3028− !y2# = word2Int# x2#
3029− !y3# = word2Int# x3#
3030− !y4# = word2Int# x4#
3031− !z1# = uncheckedIShiftL# (y1# -# 240#) 18#
3032− !z2# = uncheckedIShiftL# (y2# -# 128#) 12#
3033− !z3# = uncheckedIShiftL# (y3# -# 128#) 6#
3034− !z4# = y4# -# 128#
3035−
3036−{-# INLINE between #-}
3037−between ::
3038− Word8 -- ^ byte to check
3039− -> Word8 -- ^ lower bound
3040− -> Word8 -- ^ upper bound
3041− -> Bool
3042−between x y z = x >= y && x <= z
3043−
3044−{-# INLINE validate3 #-}
3045−validate3 :: Word8 -> Word8 -> Word8 -> Bool
3046−validate3 x1 x2 x3 = validate3_1 ||
3047− validate3_2 ||
3048− validate3_3 ||
3049− validate3_4
3050− where
3051− validate3_1 = (x1 == 0xE0) &&
3052− between x2 0xA0 0xBF &&
3053− between x3 0x80 0xBF
3054− validate3_2 = between x1 0xE1 0xEC &&
3055− between x2 0x80 0xBF &&
3056− between x3 0x80 0xBF
3057− validate3_3 = x1 == 0xED &&
3058− between x2 0x80 0x9F &&
3059− between x3 0x80 0xBF
3060− validate3_4 = between x1 0xEE 0xEF &&
3061− between x2 0x80 0xBF &&
3062− between x3 0x80 0xBF
3063−
3064−{-# INLINE validate4 #-}
3065−validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
3066−validate4 x1 x2 x3 x4 = validate4_1 ||
3067− validate4_2 ||
3068− validate4_3
3069− where
3070− validate4_1 = x1 == 0xF0 &&
3071− between x2 0x90 0xBF &&
3072− between x3 0x80 0xBF &&
3073− between x4 0x80 0xBF
3074− validate4_2 = between x1 0xF1 0xF3 &&
3075− between x2 0x80 0xBF &&
3076− between x3 0x80 0xBF &&
3077− between x4 0x80 0xBF
3078− validate4_3 = x1 == 0xF4 &&
3079− between x2 0x80 0x8F &&
3080− between x3 0x80 0xBF &&
3081− between x4 0x80 0xBF
3082−
3083−data CPoint s
3084− = FreshPoint s
3085− | Two !Word8 s
3086− | GoThree !Word8 s
3087− | Three !Word8 !Word8 s
3088− | GoFour !Word8 s
3089− | Four1 !Word8 !Word8 s
3090− | Four !Word8 !Word8 !Word8 s
3091− | YieldAndContinue !Char (CPoint s)
3092− | Done
3093−
30943002data CodingFailureMode
30953003 = TransliterateCodingFailure
30963004 | ErrorOnCodingFailure
30973005 deriving (Show)
30983006
3099−{-# INLINE_NORMAL decodeUtf8With #-}
3100−decodeUtf8With :: Monad m => CodingFailureMode -> Stream m Word8 -> Stream m Char
3101−decodeUtf8With cfm (Stream step state) = Stream step' (FreshPoint state)
3102− where
3103− {-# INLINE transliterateOrError #-}
3104− transliterateOrError e s =
3105− case cfm of
3106− ErrorOnCodingFailure -> error e
3107− TransliterateCodingFailure -> Skip $ YieldAndContinue '\xFFFD' (FreshPoint s)
3108− {-# INLINE inputUnderflow #-}
3109− inputUnderflow = case cfm of
3110− ErrorOnCodingFailure -> error "Input Underflow"
3111− TransliterateCodingFailure -> Skip $ YieldAndContinue '\xFFFD' Done
3112−
3113− {-# INLINE_LATE step' #-}
3114− step' gst (FreshPoint st) = do
3115− r <- step (adaptState gst) st
3116− return $
3117− case r of
3118− Yield c0 s
3119− | c0 <= 0x7f ->
3120− Skip $ YieldAndContinue (unsafeChr (fromIntegral c0)) (FreshPoint s)
3121− | c0 >= 0xc0 && c0 <= 0xc1 ->
3122− transliterateOrError "Invalid Overlong forms" s
3123− | c0 >= 0xc2 && c0 <= 0xdf -> Skip (Two c0 s)
3124− | c0 >= 0xe0 && c0 <= 0xef -> Skip (GoThree c0 s)
3125− | c0 >= 0xf0 -> Skip (GoFour c0 s)
3126− | otherwise -> transliterateOrError "Invalid Sequence" s
3127− Skip s -> Skip (FreshPoint s)
3128− Stop -> Stop
3129−
3130− -- Decoding of a UTF8 character that spans two bytes with one byte (c0)
3131− -- known.
3132− step' gst (Two c0 st) = do
3133− r <- step (adaptState gst) st
3134− return $
3135− case r of
3136− Yield c1 s
3137− | c1 < 0x80 || c1 >= 0xc0 ->
3138− transliterateOrError "Invalid Sequence" s
3139− | otherwise -> Skip $ YieldAndContinue (chr2 c0 c1) (FreshPoint s)
3140− Skip s -> Skip $ Two c0 s
3141− Stop -> inputUnderflow
3142−
3143− -- Decoding of a UTF8 character that spans three bytes with first byte (c0)
3144− -- known.
3145− step' gst (GoThree c0 st) = do
3146− r <- step (adaptState gst) st
3147− return $
3148− case r of
3149− Yield c1 s
3150− | not (validate3 c0 c1 0x80) ->
3151− transliterateOrError "Invalid Sequence" s
3152− -- See #3341@ghc
3153− | otherwise -> Skip $ Three c0 c1 s
3154− Skip s -> Skip $ GoThree c0 s
3155− Stop -> inputUnderflow
3156−
3157− -- Two bytes known of a 3 byte UTF8 encoded unicode character.
3158− step' gst (Three c0 c1 st) = do
3159− r <- step (adaptState gst) st
3160− return $
3161− case r of
3162− Yield c2 s
3163− | not (validate3 c0 c1 c2) ->
3164− transliterateOrError "Invalid Sequence" s
3165− | otherwise -> Skip $ YieldAndContinue (chr3 c0 c1 c2) (FreshPoint s)
3166− Skip s -> Skip $ Three c0 c1 s
3167− Stop -> inputUnderflow
3168−
3169− -- One byte known of a four byte UTF8 unicode character.
3170− step' gst (GoFour c0 st) = do
3171− r <- step (adaptState gst) st
3172− return $
3173− case r of
3174− Yield c1 s
3175− | not (validate4 c0 c1 0x80 0x80) ->
3176− transliterateOrError "Invalid Sequence" s
3177− | otherwise -> Skip $ Four1 c0 c1 s
3178− Skip s -> Skip $ GoFour c0 s
3179− Stop -> inputUnderflow
3180−
3181− -- Two bytes known of a four byte UTF8 unicode character.
3182− step' gst (Four1 c0 c1 st) = do
3183− r <- step (adaptState gst) st
3184− return $
3185− case r of
3186− Yield c2 s
3187− | not (validate4 c0 c1 c2 0x80) ->
3188− transliterateOrError "Invalid Sequence" s
3189− | otherwise -> Skip $ Four c0 c1 c2 s
3190− Skip s -> Skip $ Four1 c0 c1 s
3191− Stop -> inputUnderflow
3192−
3193− -- Three bytes known of a three byte UTF8 unicode character.
3194− step' gst (Four c0 c1 c2 st) = do
3195− r <- step (adaptState gst) st
3196− return $
3197− case r of
3198− Yield c3 s
3199− | not (validate4 c0 c1 c2 c3) ->
3200− transliterateOrError "Invalid Sequence" s
3201− | otherwise -> Skip $ YieldAndContinue (chr4 c0 c1 c2 c3) (FreshPoint s)
3202− Skip s -> Skip $ Four c0 c1 c2 s
3203− Stop -> inputUnderflow
3204−
3205− -- This way so that we only need one Yield.
3206− --step' _ (YieldAndStop c) = return $ Yield c Done
3207− step' _ (YieldAndContinue c s) = return $ Yield c s
3208− step' _ Done = return Stop
3209−
3210−{-# INLINE decodeUtf8Lenient #-}
3211−decodeUtf8Lenient :: Monad m => Stream m Word8 -> Stream m Char
3212−decodeUtf8Lenient = decodeUtf8With TransliterateCodingFailure
3213−
3214−{-# INLINE_NORMAL encodeUtf8 #-}
3215−encodeUtf8 :: Monad m => Stream m Char -> Stream m Word8
3216−encodeUtf8 (Stream step state) = Stream step' (state, [])
3217− where
3218− {-# INLINE_LATE step' #-}
3219− step' gst (st, []) = do
3220− r <- step (adaptState gst) st
3221− return $
3222− case r of
3223− Yield c s ->
3224− case ord c of
3225− x | x <= 0x7F -> Skip (s, [fromIntegral x])
3226− | x <= 0x7FF -> Skip (s, (ord2 c))
3227− | x <= 0xFFFF ->
3228− if isSurrogate c
3229− then error "Encountered a surrogate"
3230− else Skip (s, (ord3 c))
3231− | otherwise -> Skip (s, (ord4 c))
3232− Skip s -> Skip (s, [])
3233− Stop -> Stop
3234− step' _ (s, (x:xs)) = return $ Yield x (s, xs)
3007+{-# INLINE replacementChar #-}
3008+replacementChar :: Char
3009+replacementChar = '\xFFFD'
32353010
32363011type CodePoint = Word32
32373012type DecoderState = Word32
32383013
3239−utf8d :: UArray Word32 Word32
3240−utf8d = listArray (0,363) [
3014+utf8d :: A.Array Word32
3015+utf8d = A.fromList [
32413016 -- The first part of the table maps bytes to character classes that
32423017 -- to reduce the size of the transition table and create bitmasks.
32433018 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
@@ -3259,50 +3034,109 @@ utf8d = listArray (0,363) [
32593034 ]
32603035
32613036{-# INLINE decode #-}
3262−decode :: (DecoderState, CodePoint) -> Word32 -> (DecoderState, CodePoint)
3263−decode (state, codep) byte =
3264− let t = utf8d ! byte
3037+decode :: DecoderState -> CodePoint -> Word32 -> Tuple' DecoderState CodePoint
3038+decode state codep byte =
3039+ let t = utf8d `A.unsafeIndex` (fromIntegral byte)
32653040 codep' =
32663041 if state /= 0
32673042 then (byte .&. 0x3f) .|. (codep `shiftL` 6)
32683043 else (0xff `shiftR` (fromIntegral t)) .&. byte
3269− state' = utf8d ! (256 + state + t)
3270− in (state', codep')
3044+ state' = utf8d `A.unsafeIndex` (fromIntegral $ 256 + state + t)
3045+ in (Tuple' state' codep')
3046+
3047+data FreshPoint s
3048+ = FreshPoint !CodePoint !DecoderState s
3049+ | YieldAndContinue !Char (FreshPoint s)
3050+ | Done
32713051
32723052-- XXX Add proper error messages
3273−{-# INLINE_NORMAL decodeUtf8 #-}
3274−decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char
3275−decodeUtf8 (Stream step state) = Stream step' (0, 0, state)
3053+{-# INLINE_NORMAL decodeUtf8With #-}
3054+decodeUtf8With :: Monad m => CodingFailureMode -> Stream m Word8 -> Stream m Char
3055+decodeUtf8With cfm (Stream step state) = Stream step' (FreshPoint 0 0 state)
32763056 where
3277−
3057+ {-# INLINE transliterateOrError #-}
3058+ transliterateOrError e s =
3059+ case cfm of
3060+ ErrorOnCodingFailure -> error e
3061+ TransliterateCodingFailure -> YieldAndContinue replacementChar s
3062+ {-# INLINE inputUnderflow #-}
3063+ inputUnderflow =
3064+ case cfm of
3065+ ErrorOnCodingFailure ->
3066+ error "Streamly.Streams.StreamD.decodeUtf8With: Input Underflow"
3067+ TransliterateCodingFailure -> YieldAndContinue replacementChar Done
32783068 {-# INLINE_LATE step' #-}
3279− step' gst (codepointPtr, statePtr, st) = do
3069+ step' gst (FreshPoint codepointPtr statePtr st) = do
32803070 r <- step (adaptState gst) st
3281− case r of
3282− Yield x s -> do
3283− let (sv, cp) = decode (statePtr, codepointPtr) (fromIntegral x)
3284− return $
3285− case sv of
3286− 12 -> error "UTF8: REJECT"
3287− 0 ->
3288− Yield (unsafeChr (fromIntegral cp)) (cp, sv, s)
3289− _ -> Skip (cp, sv, s)
3290− Skip s -> return $ Skip (codepointPtr, statePtr, s)
3291− Stop -> return Stop -- XXX check whether statePtr is in Accept state or not.
3071+ return $
3072+ case r of
3073+ Yield x s ->
3074+ let (Tuple' sv cp) =
3075+ decode statePtr codepointPtr (fromIntegral x)
3076+ in case sv of
3077+ 12 ->
3078+ Skip $
3079+ transliterateOrError
3080+ "Streamly.Streams.StreamD.decodeUtf8With: Invalid UTF8 codepoint encountered"
3081+ (FreshPoint 0 0 st)
3082+ 0 ->
3083+ Skip $
3084+ YieldAndContinue
3085+ (unsafeChr (fromIntegral cp))
3086+ (FreshPoint cp sv s)
3087+ _ -> Skip (FreshPoint cp sv s)
3088+ Skip s -> Skip (FreshPoint codepointPtr statePtr s)
3089+ Stop ->
3090+ if statePtr /= 0
3091+ then Skip inputUnderflow
3092+ else Skip Done
3093+ step' _ (YieldAndContinue c s) = return $ Yield c s
3094+ step' _ Done = return Stop
3095+
3096+{-# INLINE decodeUtf8 #-}
3097+decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char
3098+decodeUtf8 = decodeUtf8With ErrorOnCodingFailure
3099+
3100+{-# INLINE decodeUtf8Lenient #-}
3101+decodeUtf8Lenient :: Monad m => Stream m Word8 -> Stream m Char
3102+decodeUtf8Lenient = decodeUtf8With TransliterateCodingFailure
32923103
32933104data FlattenState s a
32943105 = OuterLoop !CodePoint !DecoderState s
32953106 | InnerLoop !CodePoint !DecoderState s (ForeignPtr a) (Ptr a) (Ptr a)
3107+ | YAndC !Char (FlattenState s a) -- These constructors can be
3108+ -- encoded in the FreshPoint
3109+ -- type, I prefer to keep these
3110+ -- flat even though that means
3111+ -- coming up with new names
3112+ | D
32963113
32973114-- The normal decodeUtf8 above should fuse with flattenArrays
32983115-- to create this exact code but it doesn't for some reason, as of now this
32993116-- remains the fastest way I could figure out to decodeUtf8.
33003117--
33013118-- XXX Add Proper error messages
3302−{-# INLINE_NORMAL decodeUtf8Arrays #-}
3303−decodeUtf8Arrays :: MonadIO m => Stream m (A.Array Word8) -> Stream m Char
3304−decodeUtf8Arrays (Stream step state) = Stream step' (OuterLoop 0 0 state)
3119+{-# INLINE_NORMAL decodeUtf8ArraysWith #-}
3120+decodeUtf8ArraysWith ::
3121+ MonadIO m
3122+ => CodingFailureMode
3123+ -> Stream m (A.Array Word8)
3124+ -> Stream m Char
3125+decodeUtf8ArraysWith cfm (Stream step state) =
3126+ Stream step' (OuterLoop 0 0 state)
33053127 where
3128+ {-# INLINE transliterateOrError #-}
3129+ transliterateOrError e s =
3130+ case cfm of
3131+ ErrorOnCodingFailure -> error e
3132+ TransliterateCodingFailure -> YAndC replacementChar s
3133+ {-# INLINE inputUnderflow #-}
3134+ inputUnderflow =
3135+ case cfm of
3136+ ErrorOnCodingFailure ->
3137+ error
3138+ "Streamly.Streams.StreamD.decodeUtf8ArraysWith: Input Underflow"
3139+ TransliterateCodingFailure -> YAndC replacementChar D
33063140 {-# INLINE_LATE step' #-}
33073141 step' gst (OuterLoop cp ds st) = do
33083142 r <- step (adaptState gst) st
@@ -3312,7 +3146,10 @@ decodeUtf8Arrays (Stream step state) = Stream step' (OuterLoop 0 0 state)
33123146 let p = unsafeForeignPtrToPtr aStart
33133147 in Skip (InnerLoop cp ds s aStart p aEnd)
33143148 Skip s -> Skip (OuterLoop cp ds s)
3315− Stop -> Stop
3149+ Stop ->
3150+ if ds /= 0
3151+ then Skip inputUnderflow
3152+ else Skip D
33163153 step' _ (InnerLoop cp ds st _ p end)
33173154 | p == end = return $ Skip $ OuterLoop cp ds st
33183155 step' _ (InnerLoop codepointPtr statePtr st startf p end) = do
@@ -3321,26 +3158,63 @@ decodeUtf8Arrays (Stream step state) = Stream step' (OuterLoop 0 0 state)
33213158 r <- peek p
33223159 touchForeignPtr startf
33233160 return r
3324− let (sv, cp) = decode (statePtr, codepointPtr) (fromIntegral x)
3161+ let (Tuple' sv cp) = decode statePtr codepointPtr (fromIntegral x)
33253162 return $
33263163 case sv of
3327− 12 -> error "UTF8: REJECT"
3164+ 12 ->
3165+ Skip $
3166+ transliterateOrError
3167+ "Streamly.Streams.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"
3168+ (InnerLoop 0 0 st startf (p `plusPtr` 1) end)
33283169 0 ->
3329− Yield
3170+ Skip $
3171+ YAndC
33303172 (unsafeChr (fromIntegral cp))
3331− (InnerLoop
3332− cp
3333− sv
3334− st
3335− startf
3336− (p `plusPtr` 1)
3337− end)
3338− _ ->
3339− Skip
3340− (InnerLoop
3341− cp
3342− sv
3343− st
3344− startf
3345− (p `plusPtr` 1)
3346− end)
3173+ (InnerLoop cp sv st startf (p `plusPtr` 1) end)
3174+ _ -> Skip (InnerLoop cp sv st startf (p `plusPtr` 1) end)
3175+ step' _ (YAndC c s) = return $ Yield c s
3176+ step' _ D = return Stop
3177+
3178+{-# INLINE decodeUtf8Arrays #-}
3179+decodeUtf8Arrays ::
3180+ MonadIO m
3181+ => Stream m (A.Array Word8)
3182+ -> Stream m Char
3183+decodeUtf8Arrays = decodeUtf8ArraysWith ErrorOnCodingFailure
3184+
3185+{-# INLINE decodeUtf8ArraysLenient #-}
3186+decodeUtf8ArraysLenient ::
3187+ MonadIO m
3188+ => Stream m (A.Array Word8)
3189+ -> Stream m Char
3190+decodeUtf8ArraysLenient = decodeUtf8ArraysWith TransliterateCodingFailure
3191+
3192+data WList = WCons !Word8 !WList | WNil
3193+
3194+data EncodeState s = EncodeState s !WList
3195+
3196+{-# INLINE_NORMAL encodeUtf8 #-}
3197+encodeUtf8 :: Monad m => Stream m Char -> Stream m Word8
3198+encodeUtf8 (Stream step state) = Stream step' (EncodeState state WNil)
3199+ where
3200+ {-# INLINE_LATE step' #-}
3201+ step' gst (EncodeState st WNil) = do
3202+ r <- step (adaptState gst) st
3203+ return $
3204+ case r of
3205+ Yield c s ->
3206+ case ord c of
3207+ x
3208+ | x <= 0x7F ->
3209+ Skip
3210+ (EncodeState s (WCons (fromIntegral x) WNil))
3211+ | x <= 0x7FF -> Skip (EncodeState s (ord2 c))
3212+ | x <= 0xFFFF ->
3213+ if isSurrogate c
3214+ then error
3215+ "Streamly.Streams.StreamD.encodeUtf8: Encountered a surrogate"
3216+ else Skip (EncodeState s (ord3 c))
3217+ | otherwise -> Skip (EncodeState s (ord4 c))
3218+ Skip s -> Skip (EncodeState s WNil)
3219+ Stop -> Stop
3220+ step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)