@@ -3009,7 +3009,8 @@ data CodingFailureMode
3009replacementChar :: Char
3009replacementChar :: Char
3010replacementChar = '\xFFFD'
3010replacementChar = '\xFFFD'
3012+-- Int helps in cheaper conversion from Int to Char
3012−type CodePoint = Word32
3013+type CodePoint = Int
3013type DecoderState = Word8
3014type DecoderState = Word8
3015-- See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.
3016-- See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.
@@ -3050,12 +3051,14 @@ decode
3050 -> Word8
3051 -> Word8
3051 -> Tuple' DecoderState CodePoint
3052 -> Tuple' DecoderState CodePoint
3052decode table state codep byte =
3053decode table state codep byte =
3054+ -- Remember codep is Int type!
3055+ -- Can it be unsafe to convert the resulting to Char?
3053 let !t = table `unsafePeekElemOff` fromIntegral byte
3056 let !t = table `unsafePeekElemOff` fromIntegral byte
3054− codep' =
3057+ !codep' =
3055 if state /= 0
3058 if state /= 0
3056 then (fromIntegral byte .&. 0x3f) .|. (codep `shiftL` 6)
3059 then (fromIntegral byte .&. 0x3f) .|. (codep `shiftL` 6)
3057 else (0xff `shiftR` (fromIntegral t)) .&. fromIntegral byte
3060 else (0xff `shiftR` (fromIntegral t)) .&. fromIntegral byte
3058− state' = table `unsafePeekElemOff`
3061+ !state' = table `unsafePeekElemOff`
3059 (256 + fromIntegral state + fromIntegral t)
3062 (256 + fromIntegral state + fromIntegral t)
3060 in (Tuple' state' codep')
3063 in (Tuple' state' codep')
@@ -3107,7 +3110,7 @@ decodeUtf8With cfm (Stream step state) =
3109 YieldAndContinue
3112 YieldAndContinue
3110− (unsafeChr (fromIntegral cp))
3113+ (unsafeChr cp)
3111 (FreshPoint cp sv s)
3114 (FreshPoint cp sv s)
3112 _ -> Skip (FreshPoint cp sv s)
3115 _ -> Skip (FreshPoint cp sv s)
3113 Skip s -> Skip (FreshPoint codepointPtr statePtr s)
3116 Skip s -> Skip (FreshPoint codepointPtr statePtr s)
@@ -3127,8 +3130,8 @@ decodeUtf8Lenient :: Monad m => Stream m Word8 -> Stream m Char
3127decodeUtf8Lenient = decodeUtf8With TransliterateCodingFailure
3130decodeUtf8Lenient = decodeUtf8With TransliterateCodingFailure
3129data FlattenState s a
3132data FlattenState s a
3130− = OuterLoop !CodePoint !DecoderState s
3133+ = OuterLoop s !CodePoint !DecoderState
3131− | InnerLoop !CodePoint !DecoderState s (ForeignPtr a) (Ptr a) (Ptr a)
3134+ | InnerLoop s (ForeignPtr a) !CodePoint !DecoderState !(Ptr a) !(Ptr a)
3132 | YAndC !Char (FlattenState s a) -- These constructors can be
3135 | YAndC !Char (FlattenState s a) -- These constructors can be
3133 -- encoded in the FreshPoint
3136 -- encoded in the FreshPoint
3134 -- type, I prefer to keep these
3137 -- type, I prefer to keep these
@@ -3150,7 +3153,7 @@ decodeUtf8ArraysWith ::
3150decodeUtf8ArraysWith cfm (Stream step state) =
3153decodeUtf8ArraysWith cfm (Stream step state) =
3151 let Array p _ _ = utf8d
3154 let Array p _ _ = utf8d
3152 !ptr = (unsafeForeignPtrToPtr p)
3155 !ptr = (unsafeForeignPtrToPtr p)
3153− in Stream (step' ptr) (OuterLoop 0 0 state)
3156+ in Stream (step' ptr) (OuterLoop state 0 0)
3155 {-# INLINE transliterateOrError #-}
3158 {-# INLINE transliterateOrError #-}
3156 transliterateOrError e s =
3159 transliterateOrError e s =
@@ -3165,31 +3168,29 @@ decodeUtf8ArraysWith cfm (Stream step state) =
3165 "Streamly.Streams.StreamD.decodeUtf8ArraysWith: Input Underflow"
3168 "Streamly.Streams.StreamD.decodeUtf8ArraysWith: Input Underflow"
3166 TransliterateCodingFailure -> YAndC replacementChar D
3169 TransliterateCodingFailure -> YAndC replacementChar D
3167 {-# INLINE_LATE step' #-}
3170 {-# INLINE_LATE step' #-}
3168− step' _ gst (OuterLoop cp ds st) = do
3171+ step' _ gst (OuterLoop st cp ds) = do
3169 r <- step (adaptState gst) st
3172 r <- step (adaptState gst) st
3170 return $
3173 return $
3171 case r of
3174 case r of
3172 Yield A.Array {..} s ->
3175 Yield A.Array {..} s ->
3173 let p = unsafeForeignPtrToPtr aStart
3176 let p = unsafeForeignPtrToPtr aStart
3174− in Skip (InnerLoop cp ds s aStart p aEnd)
3177+ in Skip (InnerLoop s aStart cp ds p aEnd)
3175− Skip s -> Skip (OuterLoop cp ds s)
3178+ Skip s -> Skip (OuterLoop s cp ds)
3177 if ds /= 0
3180 if ds /= 0
3178 then Skip inputUnderflow
3181 then Skip inputUnderflow
3179 else Skip D
3182 else Skip D
3180− step' _ _ (InnerLoop cp ds st _ p end)
3183+ step' _ _ (InnerLoop st startf cp ds p end)
3185+ liftIO $ touchForeignPtr startf
3181− | p == end = return $ Skip $ OuterLoop cp ds st
3186+ return $ Skip $ OuterLoop st cp ds
3182− step' table _ (InnerLoop codepointPtr statePtr st startf p end) = do
3187+ step' table _ (InnerLoop st startf codepointPtr statePtr p end) = do
3184− liftIO $ do
3188+ x <- liftIO $ peek p
3186− touchForeignPtr startf
3188 if statePtr == 0 && x <= 0x7f
3189 if statePtr == 0 && x <= 0x7f
3190 return $ Skip $ YAndC
3191 return $ Skip $ YAndC
3191 (unsafeChr (fromIntegral x))
3192 (unsafeChr (fromIntegral x))
3192− (InnerLoop 0 0 st startf (p `plusPtr` 1) end)
3193+ (InnerLoop st startf 0 0 (p `plusPtr` 1) end)
3194 let (Tuple' sv cp) = decode table statePtr codepointPtr x
3195 let (Tuple' sv cp) = decode table statePtr codepointPtr x
3195 return $
3196 return $
@@ -3198,13 +3199,13 @@ decodeUtf8ArraysWith cfm (Stream step state) =
3199 transliterateOrError
3200 transliterateOrError
3200 "Streamly.Streams.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"
3201 "Streamly.Streams.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"
3201− (InnerLoop 0 0 st startf (p `plusPtr` 1) end)
3202+ (InnerLoop st startf 0 0 (p `plusPtr` 1) end)
3205− (unsafeChr (fromIntegral cp))
3206+ (unsafeChr cp)
3206− (InnerLoop cp sv st startf (p `plusPtr` 1) end)
3207+ (InnerLoop st startf 0 0 (p `plusPtr` 1) end)
3207− _ -> Skip (InnerLoop cp sv st startf (p `plusPtr` 1) end)
3208+ _ -> Skip (InnerLoop st startf cp sv (p `plusPtr` 1) end)
3208 step' _ _ (YAndC c s) = return $ Yield c s
3209 step' _ _ (YAndC c s) = return $ Yield c s
3209 step' _ _ D = return Stop
3210 step' _ _ D = return Stop