on master help sign in
pass the utf-8 lookup table instead of using it as global

The core gets simplified by 10x (2000 lines vs 200 lines). Stream benchmarks improve considerably readStream/utf8 changed from 12 sec to 7 sec.

commitef779032d9835860eabe2a9eeb6506a516f27fc5 authorHarendra Kumar <harendra.kumar@gmail.com> dateThu 19 Sep 2019, 01:14 (7 years ago) parent00e9793
1 file changed+32−16
src/Streamly/Streams/StreamD.hs+32−16
src/Streamly/Streams/StreamD.hs+32−16
@@ -3036,15 +3036,26 @@ utf8d = A.fromList [
30363036 12,36,12,12,12,12,12,12,12,12,12,12
30373037 ]
30383038
3039+-- | Return element at the specified index without checking the bounds.
3040+-- and without touching the foreign ptr.
3041+{-# INLINE_NORMAL unsafePeekElemOff #-}
3042+unsafePeekElemOff :: forall a. Storable a => Ptr a -> Int -> a
3043+unsafePeekElemOff p i = let !x = A.unsafeInlineIO $ peekElemOff p i in x
3044+
30393045{-# INLINE decode #-}
3040−decode :: DecoderState -> CodePoint -> Word8 -> Tuple' DecoderState CodePoint
3041−decode state codep byte =
3042− let t = utf8d `A.unsafeIndex` fromIntegral byte
3046+decode
3047+ :: Ptr Word8
3048+ -> DecoderState
3049+ -> CodePoint
3050+ -> Word8
3051+ -> Tuple' DecoderState CodePoint
3052+decode table state codep byte =
3053+ let !t = table `unsafePeekElemOff` fromIntegral byte
30433054 codep' =
30443055 if state /= 0
30453056 then (fromIntegral byte .&. 0x3f) .|. (codep `shiftL` 6)
30463057 else (0xff `shiftR` (fromIntegral t)) .&. fromIntegral byte
3047− state' = utf8d `A.unsafeIndex`
3058+ state' = table `unsafePeekElemOff`
30483059 (256 + fromIntegral state + fromIntegral t)
30493060 in (Tuple' state' codep')
30503061
@@ -3056,7 +3067,10 @@ data FreshPoint s
30563067-- XXX Add proper error messages
30573068{-# INLINE_NORMAL decodeUtf8With #-}
30583069decodeUtf8With :: Monad m => CodingFailureMode -> Stream m Word8 -> Stream m Char
3059−decodeUtf8With cfm (Stream step state) = Stream step' (FreshPoint 0 0 state)
3070+decodeUtf8With cfm (Stream step state) =
3071+ let Array p _ _ = utf8d
3072+ !ptr = (unsafeForeignPtrToPtr p)
3073+ in Stream (step' ptr) (FreshPoint 0 0 state)
30603074 where
30613075 {-# INLINE transliterateOrError #-}
30623076 transliterateOrError e s =
@@ -3070,7 +3084,7 @@ decodeUtf8With cfm (Stream step state) = Stream step' (FreshPoint 0 0 state)
30703084 error "Streamly.Streams.StreamD.decodeUtf8With: Input Underflow"
30713085 TransliterateCodingFailure -> YieldAndContinue replacementChar Done
30723086 {-# INLINE_LATE step' #-}
3073− step' gst (FreshPoint codepointPtr statePtr st) = do
3087+ step' table gst (FreshPoint codepointPtr statePtr st) = do
30743088 r <- step (adaptState gst) st
30753089 return $
30763090 case r of
@@ -3083,7 +3097,7 @@ decodeUtf8With cfm (Stream step state) = Stream step' (FreshPoint 0 0 state)
30833097 (FreshPoint 0 0 s)
30843098 else
30853099 let (Tuple' sv cp) =
3086− decode statePtr codepointPtr x
3100+ decode table statePtr codepointPtr x
30873101 in case sv of
30883102 12 ->
30893103 Skip $
@@ -3101,8 +3115,8 @@ decodeUtf8With cfm (Stream step state) = Stream step' (FreshPoint 0 0 state)
31013115 if statePtr /= 0
31023116 then Skip inputUnderflow
31033117 else Skip Done
3104− step' _ (YieldAndContinue c s) = return $ Yield c s
3105− step' _ Done = return Stop
3118+ step' _ _ (YieldAndContinue c s) = return $ Yield c s
3119+ step' _ _ Done = return Stop
31063120
31073121{-# INLINE decodeUtf8 #-}
31083122decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char
@@ -3134,7 +3148,9 @@ decodeUtf8ArraysWith ::
31343148 -> Stream m (A.Array Word8)
31353149 -> Stream m Char
31363150decodeUtf8ArraysWith cfm (Stream step state) =
3137− Stream step' (OuterLoop 0 0 state)
3151+ let Array p _ _ = utf8d
3152+ !ptr = (unsafeForeignPtrToPtr p)
3153+ in Stream (step' ptr) (OuterLoop 0 0 state)
31383154 where
31393155 {-# INLINE transliterateOrError #-}
31403156 transliterateOrError e s =
@@ -3149,7 +3165,7 @@ decodeUtf8ArraysWith cfm (Stream step state) =
31493165 "Streamly.Streams.StreamD.decodeUtf8ArraysWith: Input Underflow"
31503166 TransliterateCodingFailure -> YAndC replacementChar D
31513167 {-# INLINE_LATE step' #-}
3152− step' gst (OuterLoop cp ds st) = do
3168+ step' _ gst (OuterLoop cp ds st) = do
31533169 r <- step (adaptState gst) st
31543170 return $
31553171 case r of
@@ -3161,9 +3177,9 @@ decodeUtf8ArraysWith cfm (Stream step state) =
31613177 if ds /= 0
31623178 then Skip inputUnderflow
31633179 else Skip D
3164− step' _ (InnerLoop cp ds st _ p end)
3180+ step' _ _ (InnerLoop cp ds st _ p end)
31653181 | p == end = return $ Skip $ OuterLoop cp ds st
3166− step' _ (InnerLoop codepointPtr statePtr st startf p end) = do
3182+ step' table _ (InnerLoop codepointPtr statePtr st startf p end) = do
31673183 x <-
31683184 liftIO $ do
31693185 r <- peek p
@@ -3175,7 +3191,7 @@ decodeUtf8ArraysWith cfm (Stream step state) =
31753191 (unsafeChr (fromIntegral x))
31763192 (InnerLoop 0 0 st startf (p `plusPtr` 1) end)
31773193 else do
3178− let (Tuple' sv cp) = decode statePtr codepointPtr x
3194+ let (Tuple' sv cp) = decode table statePtr codepointPtr x
31793195 return $
31803196 case sv of
31813197 12 ->
@@ -3189,8 +3205,8 @@ decodeUtf8ArraysWith cfm (Stream step state) =
31893205 (unsafeChr (fromIntegral cp))
31903206 (InnerLoop cp sv st startf (p `plusPtr` 1) end)
31913207 _ -> Skip (InnerLoop cp sv st startf (p `plusPtr` 1) end)
3192− step' _ (YAndC c s) = return $ Yield c s
3193− step' _ D = return Stop
3208+ step' _ _ (YAndC c s) = return $ Yield c s
3209+ step' _ _ D = return Stop
31943210
31953211{-# INLINE decodeUtf8Arrays #-}
31963212decodeUtf8Arrays ::