@@ -437,74 +437,80 @@ encodeUtf8_1 (Text arr off len)
437437 | len == 0 = B.empty
438438 | otherwise = unsafeDupablePerformIO $ do
439439 fp0 <- mallocByteString len
440− withForeignPtr fp0 $ go1 off 0 fp0
440+ withForeignPtr fp0 $ go1 off fp0
441441 where
442442 offLen = off + len
443− poke8 p k v = poke (p `plusPtr` k) (fromIntegral v :: Word8)
444− resize :: Int -> Int -> ForeignPtr Word8 -> IO (ForeignPtr Word8)
445− resize k m fp = {-# SCC "encodeUtf8_1/resize" #-} do
443+ poke8 p v = poke p (fromIntegral v :: Word8)
444+ resize k fp ptr = {-# SCC "encodeUtf8_1/resize" #-} do
446445 fp' <- mallocByteString (len*k)
447− withForeignPtr fp $ \ptr ->
448− memcpy (unsafeForeignPtrToPtr fp') ptr (fromIntegral m)
446+ withForeignPtr fp $ \ptr0 -> do
447+ let m = ptr `minusPtr` ptr0
448+ memcpy (unsafeForeignPtrToPtr fp') ptr0 (fromIntegral m)
449449 return fp'
450450 {-# NOINLINE resize #-}
451− ensure k n m fp go = {-# SCC "encodeUtf8_1/ensure" #-} do
452− fp' <- resize k m fp
453− go n m fp' (unsafeForeignPtrToPtr fp')
454− do1 ptr n m w k = poke8 ptr m w >> k (n+1) (m+1)
455− loop :: (Word16 -> Int -> Int -> ForeignPtr Word8 -> Ptr Word8
456− -> (Int -> Int -> IO ByteString)
457− -> IO ByteString) -> Int -> Int -> ForeignPtr Word8 -> Ptr Word8
451+ ensure k n fp ptr go = {-# SCC "encodeUtf8_1/ensure" #-} do
452+ fp' <- resize k fp ptr
453+ go n fp' (unsafeForeignPtrToPtr fp')
454+ do1 ptr n w k = poke8 ptr w >> k (n+1) (ptr `plusPtr` 1)
455+ loop :: (Word16 -> Int -> ForeignPtr Word8 -> Ptr Word8
456+ -> (Int -> Ptr Word8 -> IO ByteString)
457+ -> IO ByteString) -> Int -> ForeignPtr Word8 -> Ptr Word8
458458 -> IO ByteString
459− loop act !n0 !m0 fp ptr = hot n0 m0
460− where hot !n !m
461− | n == offLen = touchForeignPtr fp >> return (PS fp 0 m)
462− | otherwise = act (A.unsafeIndex arr n) n m fp ptr hot
459+ loop act !n0 fp !ptr0 = hot n0 ptr0
460+ where hot !n !ptr
461+ | n == offLen = do
462+ let !l = ptr `minusPtr` unsafeForeignPtrToPtr fp
463+ touchForeignPtr fp
464+ return (PS fp 0 l)
465+ | otherwise = act (A.unsafeIndex arr n) n fp ptr hot
463466 {-# INLINE loop #-}
464− go1 = loop $ \ w !n !m fp ptr cont ->
467+ go1 = loop $ \ w !n fp ptr cont ->
465468 case w of
466− _| w <= 0x7F -> do1 ptr n m w cont
467− | w <= 0x7FF -> ensure 2 n m fp go2
468− | w < 0xD800 || w > 0xDBFF -> ensure 3 n m fp go3
469− | otherwise -> ensure 4 n m fp go4
470− do2 ptr n m w k = do
471− poke8 ptr m $ (w `shiftR` 6) + 0xC0
472− poke8 ptr (m+1) $ (w .&. 0x3f) + 0x80
473− k (n+1) (m+2)
474− go2 = loop $ \ w !n !m fp ptr cont ->
469+ _| w <= 0x7F -> do1 ptr n w cont
470+ | w <= 0x7FF -> ensure 2 n fp ptr go2
471+ | w < 0xD800 || w > 0xDBFF -> ensure 3 n fp ptr go3
472+ | otherwise -> ensure 4 n fp ptr go4
473+ do2 ptr n w k = do
474+ poke8 ptr $ (w `shiftR` 6) + 0xC0
475+ poke8 (ptr `plusPtr` 1) $ (w .&. 0x3f) + 0x80
476+ k (n+1) (ptr `plusPtr` 2)
477+ go2 = loop $ \ w !n fp !ptr cont ->
475478 case w of
476− _| w <= 0x7F -> do1 ptr n m w cont
477− | w <= 0x7FF -> do2 ptr n m w cont
478− | w < 0xD800 || w > 0xDBFF -> ensure 3 n m fp go3
479− | otherwise -> ensure 4 n m fp go4
480− do3 ptr !n m w k = do
481− poke8 ptr m $ (w `shiftR` 12) + 0xE0
482− poke8 ptr (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
483− poke8 ptr (m+2) $ (w .&. 0x3F) + 0x80
484− k (n+1) (m+3)
485− go3 = loop body where body w !n !m fp ptr cont =
479+ _| w <= 0x7F -> do1 ptr n w cont
480+ | w <= 0x7FF -> do2 ptr n w cont
481+ | w < 0xD800 || w > 0xDBFF -> ensure 3 n fp ptr go3
482+ | otherwise -> ensure 4 n fp ptr go4
483+ do3 ptr !n w k = do
484+ poke8 ptr $ (w `shiftR` 12) + 0xE0
485+ poke8 (ptr `plusPtr` 1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
486+ poke8 (ptr `plusPtr` 2) $ (w .&. 0x3F) + 0x80
487+ k (n+1) (ptr `plusPtr` 3)
488+ go3 = loop body where body w !n fp !ptr cont =
486489 case w of
487− _| w <= 0x7F -> do1 ptr n m w cont
488− | w <= 0x7FF -> do2 ptr n m w cont
489− | w < 0xD800 || w > 0xDBFF -> do3 ptr n m w cont
490− | otherwise -> ensure 4 n m fp go4
490+ _| w <= 0x7F -> do1 ptr n w cont
491+ | w <= 0x7FF -> do2 ptr n w cont
492+ | w < 0xD800 || w > 0xDBFF -> do3 ptr n w cont
493+ | otherwise -> ensure 4 n fp ptr go4
491494 {-# INLINE body #-}
492− go4 !n0 !m0 fp ptr = do
493− let hot !n !m
494− | n == offLen = touchForeignPtr fp >> return (PS fp 0 m)
495+ go4 !n0 fp ptr0 = do
496+ let hot !n !ptr
497+ | n == offLen = do
498+ let !l = ptr `minusPtr` unsafeForeignPtrToPtr fp
499+ touchForeignPtr fp
500+ return (PS fp 0 l)
495501 | otherwise = do
496502 case A.unsafeIndex arr n of
497− w| w <= 0x7F -> do1 ptr n m w hot
498− | w <= 0x7FF -> do2 ptr n m w hot
499− | w < 0xD800 || w > 0xDBFF -> do3 ptr n m w hot
503+ w| w <= 0x7F -> do1 ptr n w hot
504+ | w <= 0x7FF -> do2 ptr n w hot
505+ | w < 0xD800 || w > 0xDBFF -> do3 ptr n w hot
500506 | otherwise -> do
501507 let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
502− poke8 ptr m $ (c `shiftR` 18) + 0xF0
503− poke8 ptr (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
504− poke8 ptr (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
505− poke8 ptr (m+3) $ (c .&. 0x3F) + 0x80
506− go4 (n+2) (m+4) fp ptr
507− hot n0 m0
508+ poke8 ptr $ (c `shiftR` 18) + 0xF0
509+ poke8 (ptr `plusPtr` 1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
510+ poke8 (ptr `plusPtr` 2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
511+ poke8 (ptr `plusPtr` 3) $ (c .&. 0x3F) + 0x80
512+ hot (n+2) (ptr `plusPtr` 4)
513+ hot n0 ptr0
508514
509515-- | Decode text from little endian UTF-16 encoding.
510516decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text