{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude
, BangPatterns
, NondecreasingIndentation
, MagicHash
, UnboxedTuples
#-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module GHC.IO.Encoding.UTF16 (
utf16, mkUTF16,
utf16_decode,
utf16_encode,
utf16be, mkUTF16be,
utf16be_decode,
utf16be_encode,
utf16le, mkUTF16le,
utf16le_decode,
utf16le_encode,
) where
import GHC.Base
import GHC.Real
import GHC.Num
import GHC.IO.Buffer
import GHC.IO.Encoding.Failure
import GHC.IO.Encoding.Types
import GHC.Word
import Data.Bits
import GHC.IORef
utf16 :: TextEncoding
utf16 :: TextEncoding
utf16 = CodingFailureMode -> TextEncoding
mkUTF16 CodingFailureMode
ErrorOnCodingFailure
mkUTF16 :: CodingFailureMode -> TextEncoding
mkUTF16 :: CodingFailureMode -> TextEncoding
mkUTF16 CodingFailureMode
cfm = TextEncoding { textEncodingName :: String
textEncodingName = String
"UTF-16",
mkTextDecoder :: IO (TextDecoder (Maybe DecodeBuffer#))
mkTextDecoder = CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#))
utf16_DF CodingFailureMode
cfm,
mkTextEncoder :: IO (TextEncoder Bool)
mkTextEncoder = CodingFailureMode -> IO (TextEncoder Bool)
utf16_EF CodingFailureMode
cfm }
utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#))
utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#))
utf16_DF CodingFailureMode
cfm = do
IORef (Maybe DecodeBuffer#)
seen_bom <- Maybe DecodeBuffer# -> IO (IORef (Maybe DecodeBuffer#))
forall a. a -> IO (IORef a)
newIORef Maybe DecodeBuffer#
forall a. Maybe a
Nothing
TextDecoder (Maybe DecodeBuffer#)
-> IO (TextDecoder (Maybe DecodeBuffer#))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec# {
encode# :: DecodeBuffer#
encode# = IORef (Maybe DecodeBuffer#) -> DecodeBuffer#
utf16_decode IORef (Maybe DecodeBuffer#)
seen_bom,
recover# :: Buffer Word8
-> Buffer Char
-> State# RealWorld
-> (# State# RealWorld, Buffer Word8, Buffer Char #)
recover# = CodingFailureMode
-> Buffer Word8
-> Buffer Char
-> State# RealWorld
-> (# State# RealWorld, Buffer Word8, Buffer Char #)
recoverDecode# CodingFailureMode
cfm,
close# :: IO ()
close# = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState# :: IO (Maybe DecodeBuffer#)
getState# = IORef (Maybe DecodeBuffer#) -> IO (Maybe DecodeBuffer#)
forall a. IORef a -> IO a
readIORef IORef (Maybe DecodeBuffer#)
seen_bom,
setState# :: Maybe DecodeBuffer# -> IO ()
setState# = IORef (Maybe DecodeBuffer#) -> Maybe DecodeBuffer# -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DecodeBuffer#)
seen_bom
})
utf16_EF :: CodingFailureMode -> IO (TextEncoder Bool)
utf16_EF :: CodingFailureMode -> IO (TextEncoder Bool)
utf16_EF CodingFailureMode
cfm = do
IORef Bool
done_bom <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
TextEncoder Bool -> IO (TextEncoder Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec# {
encode# :: CodeBuffer# Char Word8
encode# = IORef Bool -> CodeBuffer# Char Word8
utf16_encode IORef Bool
done_bom,
recover# :: Buffer Char
-> Buffer Word8
-> State# RealWorld
-> (# State# RealWorld, Buffer Char, Buffer Word8 #)
recover# = CodingFailureMode
-> Buffer Char
-> Buffer Word8
-> State# RealWorld
-> (# State# RealWorld, Buffer Char, Buffer Word8 #)
recoverEncode# CodingFailureMode
cfm,
close# :: IO ()
close# = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState# :: IO Bool
getState# = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
done_bom,
setState# :: Bool -> IO ()
setState# = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
done_bom
})
utf16_encode :: IORef Bool -> EncodeBuffer#
utf16_encode :: IORef Bool -> CodeBuffer# Char Word8
utf16_encode IORef Bool
done_bom Buffer Char
input
output :: Buffer Word8
output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
oraw, bufL :: forall e. Buffer e -> Int
bufL=Int
_, bufR :: forall e. Buffer e -> Int
bufR=Int
ow, bufSize :: forall e. Buffer e -> Int
bufSize=Int
os }
State# RealWorld
st0
= do
let !(# State# RealWorld
st1, Bool
b #) = IO Bool -> State# RealWorld -> (# State# RealWorld, Bool #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
done_bom) State# RealWorld
st0
if Bool
b then CodeBuffer# Char Word8
utf16_native_encode Buffer Char
input Buffer Word8
output State# RealWorld
st1
else if Int
os Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
then (# State# RealWorld
st1,CodingProgress
OutputUnderflow,Buffer Char
input,Buffer Word8
output #)
else do
let !(# State# RealWorld
st2, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
done_bom Bool
True) State# RealWorld
st1
!(# State# RealWorld
st3, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow Word8
bom1) State# RealWorld
st2
!(# State# RealWorld
st4, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8
bom2) State# RealWorld
st3
CodeBuffer# Char Word8
utf16_native_encode Buffer Char
input Buffer Word8
output{ bufR = ow+2 } State# RealWorld
st4
utf16_decode :: IORef (Maybe DecodeBuffer#) -> DecodeBuffer#
utf16_decode :: IORef (Maybe DecodeBuffer#) -> DecodeBuffer#
utf16_decode IORef (Maybe DecodeBuffer#)
seen_bom
input :: Buffer Word8
input@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
iraw, bufL :: forall e. Buffer e -> Int
bufL=Int
ir, bufR :: forall e. Buffer e -> Int
bufR=Int
iw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
_ }
Buffer Char
output
State# RealWorld
st0
= do
let !(# State# RealWorld
st1, Maybe DecodeBuffer#
mb #) = IO (Maybe DecodeBuffer#)
-> State# RealWorld -> (# State# RealWorld, Maybe DecodeBuffer# #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (IORef (Maybe DecodeBuffer#) -> IO (Maybe DecodeBuffer#)
forall a. IORef a -> IO a
readIORef IORef (Maybe DecodeBuffer#)
seen_bom) State# RealWorld
st0
case Maybe DecodeBuffer#
mb of
Just DecodeBuffer#
decode -> DecodeBuffer#
decode Buffer Word8
input Buffer Char
output State# RealWorld
st1
Maybe DecodeBuffer#
Nothing ->
if Int
iw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 then (# State# RealWorld
st1,CodingProgress
InputUnderflow,Buffer Word8
input,Buffer Char
output #) else do
let !(# State# RealWorld
st2, Word8
c0 #) = IO Word8 -> State# RealWorld -> (# State# RealWorld, Word8 #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw Int
ir ) State# RealWorld
st1
!(# State# RealWorld
st3, Word8
c1 #) = IO Word8 -> State# RealWorld -> (# State# RealWorld, Word8 #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) State# RealWorld
st2
case () of
()
_ | Word8
c0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bomB Bool -> Bool -> Bool
&& Word8
c1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bomL ->
let !(# State# RealWorld
st4, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (IORef (Maybe DecodeBuffer#) -> Maybe DecodeBuffer# -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DecodeBuffer#)
seen_bom (DecodeBuffer# -> Maybe DecodeBuffer#
forall a. a -> Maybe a
Just DecodeBuffer#
utf16be_decode)) State# RealWorld
st3
in DecodeBuffer#
utf16be_decode Buffer Word8
input{ bufL= ir+2 } Buffer Char
output State# RealWorld
st4
| Word8
c0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bomL Bool -> Bool -> Bool
&& Word8
c1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bomB ->
let !(# State# RealWorld
st4, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (IORef (Maybe DecodeBuffer#) -> Maybe DecodeBuffer# -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DecodeBuffer#)
seen_bom (DecodeBuffer# -> Maybe DecodeBuffer#
forall a. a -> Maybe a
Just DecodeBuffer#
utf16le_decode)) State# RealWorld
st3
in DecodeBuffer#
utf16le_decode Buffer Word8
input{ bufL= ir+2 } Buffer Char
output State# RealWorld
st4
| Bool
otherwise ->
let !(# State# RealWorld
st4, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (IORef (Maybe DecodeBuffer#) -> Maybe DecodeBuffer# -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DecodeBuffer#)
seen_bom (DecodeBuffer# -> Maybe DecodeBuffer#
forall a. a -> Maybe a
Just DecodeBuffer#
utf16_native_decode)) State# RealWorld
st3
in DecodeBuffer#
utf16_native_decode Buffer Word8
input Buffer Char
output State# RealWorld
st4
bomB, bomL, bom1, bom2 :: Word8
bomB :: Word8
bomB = Word8
0xfe
bomL :: Word8
bomL = Word8
0xff
utf16_native_decode :: DecodeBuffer#
utf16_native_decode :: DecodeBuffer#
utf16_native_decode = DecodeBuffer#
utf16be_decode
utf16_native_encode :: EncodeBuffer#
utf16_native_encode :: CodeBuffer# Char Word8
utf16_native_encode = CodeBuffer# Char Word8
utf16be_encode
bom1 :: Word8
bom1 = Word8
bomB
bom2 :: Word8
bom2 = Word8
bomL
utf16be :: TextEncoding
utf16be :: TextEncoding
utf16be = CodingFailureMode -> TextEncoding
mkUTF16be CodingFailureMode
ErrorOnCodingFailure
mkUTF16be :: CodingFailureMode -> TextEncoding
mkUTF16be :: CodingFailureMode -> TextEncoding
mkUTF16be CodingFailureMode
cfm = TextEncoding { textEncodingName :: String
textEncodingName = String
"UTF-16BE",
mkTextDecoder :: IO (TextDecoder ())
mkTextDecoder = CodingFailureMode -> IO (TextDecoder ())
utf16be_DF CodingFailureMode
cfm,
mkTextEncoder :: IO (TextEncoder ())
mkTextEncoder = CodingFailureMode -> IO (TextEncoder ())
utf16be_EF CodingFailureMode
cfm }
utf16be_DF :: CodingFailureMode -> IO (TextDecoder ())
utf16be_DF :: CodingFailureMode -> IO (TextDecoder ())
utf16be_DF CodingFailureMode
cfm =
TextDecoder () -> IO (TextDecoder ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec# {
encode# :: DecodeBuffer#
encode# = DecodeBuffer#
utf16be_decode,
recover# :: Buffer Word8
-> Buffer Char
-> State# RealWorld
-> (# State# RealWorld, Buffer Word8, Buffer Char #)
recover# = CodingFailureMode
-> Buffer Word8
-> Buffer Char
-> State# RealWorld
-> (# State# RealWorld, Buffer Word8, Buffer Char #)
recoverDecode# CodingFailureMode
cfm,
close# :: IO ()
close# = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState# :: IO ()
getState# = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
setState# :: () -> IO ()
setState# = IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
})
utf16be_EF :: CodingFailureMode -> IO (TextEncoder ())
utf16be_EF :: CodingFailureMode -> IO (TextEncoder ())
utf16be_EF CodingFailureMode
cfm =
TextEncoder () -> IO (TextEncoder ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec# {
encode# :: CodeBuffer# Char Word8
encode# = CodeBuffer# Char Word8
utf16be_encode,
recover# :: Buffer Char
-> Buffer Word8
-> State# RealWorld
-> (# State# RealWorld, Buffer Char, Buffer Word8 #)
recover# = CodingFailureMode
-> Buffer Char
-> Buffer Word8
-> State# RealWorld
-> (# State# RealWorld, Buffer Char, Buffer Word8 #)
recoverEncode# CodingFailureMode
cfm,
close# :: IO ()
close# = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState# :: IO ()
getState# = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
setState# :: () -> IO ()
setState# = IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
})
utf16le :: TextEncoding
utf16le :: TextEncoding
utf16le = CodingFailureMode -> TextEncoding
mkUTF16le CodingFailureMode
ErrorOnCodingFailure
mkUTF16le :: CodingFailureMode -> TextEncoding
mkUTF16le :: CodingFailureMode -> TextEncoding
mkUTF16le CodingFailureMode
cfm = TextEncoding { textEncodingName :: String
textEncodingName = String
"UTF16-LE",
mkTextDecoder :: IO (TextDecoder ())
mkTextDecoder = CodingFailureMode -> IO (TextDecoder ())
utf16le_DF CodingFailureMode
cfm,
mkTextEncoder :: IO (TextEncoder ())
mkTextEncoder = CodingFailureMode -> IO (TextEncoder ())
utf16le_EF CodingFailureMode
cfm }
utf16le_DF :: CodingFailureMode -> IO (TextDecoder ())
utf16le_DF :: CodingFailureMode -> IO (TextDecoder ())
utf16le_DF CodingFailureMode
cfm =
TextDecoder () -> IO (TextDecoder ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec# {
encode# :: DecodeBuffer#
encode# = DecodeBuffer#
utf16le_decode,
recover# :: Buffer Word8
-> Buffer Char
-> State# RealWorld
-> (# State# RealWorld, Buffer Word8, Buffer Char #)
recover# = CodingFailureMode
-> Buffer Word8
-> Buffer Char
-> State# RealWorld
-> (# State# RealWorld, Buffer Word8, Buffer Char #)
recoverDecode# CodingFailureMode
cfm,
close# :: IO ()
close# = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState# :: IO ()
getState# = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
setState# :: () -> IO ()
setState# = IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
})
utf16le_EF :: CodingFailureMode -> IO (TextEncoder ())
utf16le_EF :: CodingFailureMode -> IO (TextEncoder ())
utf16le_EF CodingFailureMode
cfm =
TextEncoder () -> IO (TextEncoder ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec# {
encode# :: CodeBuffer# Char Word8
encode# = CodeBuffer# Char Word8
utf16le_encode,
recover# :: Buffer Char
-> Buffer Word8
-> State# RealWorld
-> (# State# RealWorld, Buffer Char, Buffer Word8 #)
recover# = CodingFailureMode
-> Buffer Char
-> Buffer Word8
-> State# RealWorld
-> (# State# RealWorld, Buffer Char, Buffer Word8 #)
recoverEncode# CodingFailureMode
cfm,
close# :: IO ()
close# = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState# :: IO ()
getState# = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
setState# :: () -> IO ()
setState# = IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
})
utf16be_decode :: DecodeBuffer#
utf16be_decode :: DecodeBuffer#
utf16be_decode
input :: Buffer Word8
input@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
iraw, bufL :: forall e. Buffer e -> Int
bufL=Int
ir0, bufR :: forall e. Buffer e -> Int
bufR=Int
iw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
_ }
output :: Buffer Char
output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Char
oraw, bufL :: forall e. Buffer e -> Int
bufL=Int
_, bufR :: forall e. Buffer e -> Int
bufR=Int
ow0, bufSize :: forall e. Buffer e -> Int
bufSize=Int
os }
State# RealWorld
st
= let
loop :: Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
loop !Int
ir !Int
ow State# RealWorld
st0
| Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
os = CodingProgress
-> Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
done CodingProgress
OutputUnderflow Int
ir Int
ow State# RealWorld
st0
| Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iw = CodingProgress
-> Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
done CodingProgress
InputUnderflow Int
ir Int
ow State# RealWorld
st0
| Int
ir Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw = CodingProgress
-> Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
done CodingProgress
InputUnderflow Int
ir Int
ow State# RealWorld
st0
| Bool
otherwise = do
let !(# State# RealWorld
st1, Word8
c0 #) = IO Word8 -> State# RealWorld -> (# State# RealWorld, Word8 #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw Int
ir ) State# RealWorld
st0
!(# State# RealWorld
st2, Word8
c1 #) = IO Word8 -> State# RealWorld -> (# State# RealWorld, Word8 #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) State# RealWorld
st1
let x1 :: Word16
x1 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c0 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c1
if Word16 -> Bool
validate1 Word16
x1
then let !(# State# RealWorld
st3, Int
ow' #) = IO Int -> State# RealWorld -> (# State# RealWorld, Int #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Int -> Char
unsafeChr (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x1))) State# RealWorld
st2
in Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Int
ow' State# RealWorld
st3
else if Int
iw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then CodingProgress
-> Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
done CodingProgress
InputUnderflow Int
ir Int
ow State# RealWorld
st2 else do
let !(# State# RealWorld
st3, Word8
c2 #) = IO Word8 -> State# RealWorld -> (# State# RealWorld, Word8 #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)) State# RealWorld
st2
!(# State# RealWorld
st4, Word8
c3 #) = IO Word8 -> State# RealWorld -> (# State# RealWorld, Word8 #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)) State# RealWorld
st3
x2 :: Word16
x2 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c2 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c3
if Bool -> Bool
not (Word16 -> Word16 -> Bool
validate2 Word16
x1 Word16
x2) then State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
invalid State# RealWorld
st4 else do
let !(# State# RealWorld
st5, Int
ow' #) = IO Int -> State# RealWorld -> (# State# RealWorld, Int #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Word16 -> Word16 -> Char
chr2 Word16
x1 Word16
x2)) State# RealWorld
st4
Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) Int
ow' State# RealWorld
st5
where
invalid :: DecodingBuffer#
invalid :: State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
invalid State# RealWorld
st' = CodingProgress
-> Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
done CodingProgress
InvalidSequence Int
ir Int
ow State# RealWorld
st'
{-# NOINLINE done #-}
done :: CodingProgress -> Int -> Int -> DecodingBuffer#
done :: CodingProgress
-> Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
done CodingProgress
why !Int
ir !Int
ow State# RealWorld
st' =
let !ri :: Buffer Word8
ri = if Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw then Buffer Word8
input { bufL = 0, bufR = 0 } else Buffer Word8
input { bufL = ir }
!ro :: Buffer Char
ro = Buffer Char
output{ bufR = ow }
in (# State# RealWorld
st', CodingProgress
why, Buffer Word8
ri, Buffer Char
ro #)
in
Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
loop Int
ir0 Int
ow0 State# RealWorld
st
utf16le_decode :: DecodeBuffer#
utf16le_decode :: DecodeBuffer#
utf16le_decode
input :: Buffer Word8
input@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
iraw, bufL :: forall e. Buffer e -> Int
bufL=Int
ir0, bufR :: forall e. Buffer e -> Int
bufR=Int
iw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
_ }
output :: Buffer Char
output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Char
oraw, bufL :: forall e. Buffer e -> Int
bufL=Int
_, bufR :: forall e. Buffer e -> Int
bufR=Int
ow0, bufSize :: forall e. Buffer e -> Int
bufSize=Int
os }
State# RealWorld
st
= let
loop :: Int -> Int -> DecodingBuffer#
loop :: Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
loop !Int
ir !Int
ow State# RealWorld
st0
| Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
os = CodingProgress
-> Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
done CodingProgress
OutputUnderflow Int
ir Int
ow State# RealWorld
st0
| Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iw = CodingProgress
-> Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
done CodingProgress
InputUnderflow Int
ir Int
ow State# RealWorld
st0
| Int
ir Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw = CodingProgress
-> Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
done CodingProgress
InputUnderflow Int
ir Int
ow State# RealWorld
st0
| Bool
otherwise = do
let !(# State# RealWorld
st1, Word8
c0 #) = IO Word8 -> State# RealWorld -> (# State# RealWorld, Word8 #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw Int
ir ) State# RealWorld
st0
!(# State# RealWorld
st2, Word8
c1 #) = IO Word8 -> State# RealWorld -> (# State# RealWorld, Word8 #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) State# RealWorld
st1
x1 :: Word16
x1 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c1 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c0
if Word16 -> Bool
validate1 Word16
x1
then let !(# State# RealWorld
st3, Int
ow' #) = IO Int -> State# RealWorld -> (# State# RealWorld, Int #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Int -> Char
unsafeChr (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x1))) State# RealWorld
st2
in Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Int
ow' State# RealWorld
st3
else if Int
iw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then CodingProgress
-> Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
done CodingProgress
InputUnderflow Int
ir Int
ow State# RealWorld
st2 else do
let !(# State# RealWorld
st3, Word8
c2 #) = IO Word8 -> State# RealWorld -> (# State# RealWorld, Word8 #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)) State# RealWorld
st2
!(# State# RealWorld
st4, Word8
c3 #) = IO Word8 -> State# RealWorld -> (# State# RealWorld, Word8 #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)) State# RealWorld
st3
x2 :: Word16
x2 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c3 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c2
if Bool -> Bool
not (Word16 -> Word16 -> Bool
validate2 Word16
x1 Word16
x2) then State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
invalid State# RealWorld
st4 else do
let !(# State# RealWorld
st5, Int
ow' #) = IO Int -> State# RealWorld -> (# State# RealWorld, Int #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Word16 -> Word16 -> Char
chr2 Word16
x1 Word16
x2)) State# RealWorld
st4
Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) Int
ow' State# RealWorld
st5
where
invalid :: DecodingBuffer#
invalid :: State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
invalid State# RealWorld
st' = CodingProgress
-> Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
done CodingProgress
InvalidSequence Int
ir Int
ow State# RealWorld
st'
{-# NOINLINE done #-}
done :: CodingProgress -> Int -> Int -> DecodingBuffer#
done :: CodingProgress
-> Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
done CodingProgress
why !Int
ir !Int
ow State# RealWorld
st' =
let !ri :: Buffer Word8
ri = if Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw then Buffer Word8
input{ bufL = 0, bufR = 0 } else Buffer Word8
input{ bufL = ir }
!ro :: Buffer Char
ro = Buffer Char
output{ bufR = ow }
in (# State# RealWorld
st', CodingProgress
why, Buffer Word8
ri, Buffer Char
ro #)
in
Int
-> Int
-> State# RealWorld
-> (# State# RealWorld, CodingProgress, Buffer Word8,
Buffer Char #)
loop Int
ir0 Int
ow0 State# RealWorld
st
utf16be_encode :: EncodeBuffer#
utf16be_encode :: CodeBuffer# Char Word8
utf16be_encode
input :: Buffer Char
input@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Char
iraw, bufL :: forall e. Buffer e -> Int
bufL=Int
ir0, bufR :: forall e. Buffer e -> Int
bufR=Int
iw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
_ }
output :: Buffer Word8
output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
oraw, bufL :: forall e. Buffer e -> Int
bufL=Int
_, bufR :: forall e. Buffer e -> Int
bufR=Int
ow0, bufSize :: forall e. Buffer e -> Int
bufSize=Int
os }
State# RealWorld
st
= let
{-# NOINLINE done #-}
done :: CodingProgress -> Int -> Int -> EncodingBuffer#
done :: CodingProgress -> Int -> Int -> EncodingBuffer#
done CodingProgress
why !Int
ir !Int
ow State# RealWorld
st' =
let !ri :: Buffer Char
ri = if Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw then Buffer Char
input{ bufL = 0, bufR = 0 } else Buffer Char
input{ bufL=ir }
!ro :: Buffer Word8
ro = Buffer Word8
output{ bufR=ow }
in (# State# RealWorld
st', CodingProgress
why, Buffer Char
ri, Buffer Word8
ro #)
loop :: Int -> Int -> EncodingBuffer#
loop :: Int -> Int -> EncodingBuffer#
loop !Int
ir !Int
ow State# RealWorld
st0
| Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iw = CodingProgress -> Int -> Int -> EncodingBuffer#
done CodingProgress
InputUnderflow Int
ir Int
ow State# RealWorld
st0
| Int
os Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = CodingProgress -> Int -> Int -> EncodingBuffer#
done CodingProgress
OutputUnderflow Int
ir Int
ow State# RealWorld
st0
| Bool
otherwise = do
let !(# State# RealWorld
st1, (Char
c,Int
ir') #) = IO (Char, Int)
-> State# RealWorld -> (# State# RealWorld, (Char, Int) #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Char -> Int -> IO (Char, Int)
readCharBuf RawBuffer Char
iraw Int
ir) State# RealWorld
st0
case Char -> Int
ord Char
c of
Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000 -> if Char -> Bool
isSurrogate Char
c then CodingProgress -> Int -> Int -> EncodingBuffer#
done CodingProgress
InvalidSequence Int
ir Int
ow State# RealWorld
st1 else do
let !(# State# RealWorld
st2, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))) State# RealWorld
st1
!(# State# RealWorld
st3, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)) State# RealWorld
st2
Int -> Int -> EncodingBuffer#
loop Int
ir' (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) State# RealWorld
st3
| Bool
otherwise -> do
if Int
os Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then CodingProgress -> Int -> Int -> EncodingBuffer#
done CodingProgress
OutputUnderflow Int
ir Int
ow State# RealWorld
st1 else do
let
n1 :: Int
n1 = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
c1 :: Word8
c1 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xD8)
c2 :: Word8
c2 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
10)
n2 :: Int
n2 = Int
n1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3FF
c3 :: Word8
c3 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xDC)
c4 :: Word8
c4 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n2
!(# State# RealWorld
st2, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow Word8
c1) State# RealWorld
st1
!(# State# RealWorld
st3, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8
c2) State# RealWorld
st2
!(# State# RealWorld
st4, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Word8
c3) State# RealWorld
st3
!(# State# RealWorld
st5, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) Word8
c4) State# RealWorld
st4
Int -> Int -> EncodingBuffer#
loop Int
ir' (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) State# RealWorld
st5
in
Int -> Int -> EncodingBuffer#
loop Int
ir0 Int
ow0 State# RealWorld
st
utf16le_encode :: EncodeBuffer#
utf16le_encode :: CodeBuffer# Char Word8
utf16le_encode
input :: Buffer Char
input@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Char
iraw, bufL :: forall e. Buffer e -> Int
bufL=Int
ir0, bufR :: forall e. Buffer e -> Int
bufR=Int
iw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
_ }
output :: Buffer Word8
output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
oraw, bufL :: forall e. Buffer e -> Int
bufL=Int
_, bufR :: forall e. Buffer e -> Int
bufR=Int
ow0, bufSize :: forall e. Buffer e -> Int
bufSize=Int
os }
State# RealWorld
st
= let
{-# NOINLINE done #-}
done :: CodingProgress -> Int -> Int -> EncodingBuffer#
done :: CodingProgress -> Int -> Int -> EncodingBuffer#
done CodingProgress
why !Int
ir !Int
ow State# RealWorld
st' =
let !ri :: Buffer Char
ri = if Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw then Buffer Char
input{ bufL = 0, bufR = 0 } else Buffer Char
input{ bufL = ir }
!ro :: Buffer Word8
ro = Buffer Word8
output{ bufR = ow }
in (# State# RealWorld
st', CodingProgress
why, Buffer Char
ri, Buffer Word8
ro #)
loop :: Int -> Int -> EncodingBuffer#
loop :: Int -> Int -> EncodingBuffer#
loop !Int
ir !Int
ow State# RealWorld
st0
| Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iw = CodingProgress -> Int -> Int -> EncodingBuffer#
done CodingProgress
InputUnderflow Int
ir Int
ow State# RealWorld
st0
| Int
os Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = CodingProgress -> Int -> Int -> EncodingBuffer#
done CodingProgress
OutputUnderflow Int
ir Int
ow State# RealWorld
st0
| Bool
otherwise = do
let !(# State# RealWorld
st1, (Char
c,Int
ir') #) = IO (Char, Int)
-> State# RealWorld -> (# State# RealWorld, (Char, Int) #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Char -> Int -> IO (Char, Int)
readCharBuf RawBuffer Char
iraw Int
ir) State# RealWorld
st0
case Char -> Int
ord Char
c of
Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000 -> if Char -> Bool
isSurrogate Char
c then CodingProgress -> Int -> Int -> EncodingBuffer#
done CodingProgress
InvalidSequence Int
ir Int
ow State# RealWorld
st1 else do
let !(# State# RealWorld
st2, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)) State# RealWorld
st1
!(# State# RealWorld
st3, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))) State# RealWorld
st2
Int -> Int -> EncodingBuffer#
loop Int
ir' (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) State# RealWorld
st3
| Bool
otherwise ->
if Int
os Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then CodingProgress -> Int -> Int -> EncodingBuffer#
done CodingProgress
OutputUnderflow Int
ir Int
ow State# RealWorld
st1 else do
let
n1 :: Int
n1 = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
c1 :: Word8
c1 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xD8)
c2 :: Word8
c2 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
10)
n2 :: Int
n2 = Int
n1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3FF
c3 :: Word8
c3 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xDC)
c4 :: Word8
c4 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n2
!(# State# RealWorld
st2, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow Word8
c2) State# RealWorld
st1
!(# State# RealWorld
st3, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8
c1) State# RealWorld
st2
!(# State# RealWorld
st4, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Word8
c4) State# RealWorld
st3
!(# State# RealWorld
st5, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) Word8
c3) State# RealWorld
st4
Int -> Int -> EncodingBuffer#
loop Int
ir' (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) State# RealWorld
st5
in
Int -> Int -> EncodingBuffer#
loop Int
ir0 Int
ow0 State# RealWorld
st
chr2 :: Word16 -> Word16 -> Char
chr2 :: Word16 -> Word16 -> Char
chr2 (W16# Word16#
a#) (W16# Word16#
b#) = Char# -> Char
C# (Int# -> Char#
chr# (Int#
upper# Int# -> Int# -> Int#
+# Int#
lower# Int# -> Int# -> Int#
+# Int#
0x10000#))
where
!x# :: Int#
x# = Word# -> Int#
word2Int# (Word16# -> Word#
word16ToWord# Word16#
a#)
!y# :: Int#
y# = Word# -> Int#
word2Int# (Word16# -> Word#
word16ToWord# Word16#
b#)
!upper# :: Int#
upper# = Int# -> Int# -> Int#
uncheckedIShiftL# (Int#
x# Int# -> Int# -> Int#
-# Int#
0xD800#) Int#
10#
!lower# :: Int#
lower# = Int#
y# Int# -> Int# -> Int#
-# Int#
0xDC00#
{-# INLINE chr2 #-}
validate1 :: Word16 -> Bool
validate1 :: Word16 -> Bool
validate1 Word16
x1 = (Word16
x1 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
0 Bool -> Bool -> Bool
&& Word16
x1 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
0xD800) Bool -> Bool -> Bool
|| Word16
x1 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
0xDFFF
{-# INLINE validate1 #-}
validate2 :: Word16 -> Word16 -> Bool
validate2 :: Word16 -> Word16 -> Bool
validate2 Word16
x1 Word16
x2 = Word16
x1 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
0xD800 Bool -> Bool -> Bool
&& Word16
x1 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0xDBFF Bool -> Bool -> Bool
&&
Word16
x2 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
0xDC00 Bool -> Bool -> Bool
&& Word16
x2 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0xDFFF
{-# INLINE validate2 #-}