{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude
           , BangPatterns
           , NondecreasingIndentation
           , MagicHash
  #-}
{-# OPTIONS_GHC  -funbox-strict-fields #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.IO.Encoding.UTF16
-- Copyright   :  (c) The University of Glasgow, 2009
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  internal
-- Portability :  non-portable
--
-- UTF-16 Codecs for the IO library
--
-- Portions Copyright   : (c) Tom Harper 2008-2009,
--                        (c) Bryan O'Sullivan 2009,
--                        (c) Duncan Coutts 2009
--
-----------------------------------------------------------------------------

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
import GHC.IO.Buffer
import GHC.IO.Encoding.Failure
import GHC.IO.Encoding.Types
import GHC.Word
import Data.Bits
import GHC.IORef

-- -----------------------------------------------------------------------------
-- The UTF-16 codec: either UTF16BE or UTF16LE with a BOM

utf16  :: TextEncoding
utf16 :: TextEncoding
utf16 = CodingFailureMode -> TextEncoding
mkUTF16 CodingFailureMode
ErrorOnCodingFailure

-- | @since 4.4.0.0
mkUTF16 :: CodingFailureMode -> TextEncoding
mkUTF16 :: CodingFailureMode -> TextEncoding
mkUTF16 cfm :: CodingFailureMode
cfm =  TextEncoding :: forall dstate estate.
String
-> IO (TextDecoder dstate)
-> IO (TextEncoder estate)
-> TextEncoding
TextEncoding { textEncodingName :: String
textEncodingName = "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 cfm :: 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 (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
             encode :: DecodeBuffer
encode   = IORef (Maybe DecodeBuffer) -> DecodeBuffer
utf16_decode IORef (Maybe DecodeBuffer)
seen_bom,
             recover :: Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
recover  = CodingFailureMode
-> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
recoverDecode CodingFailureMode
cfm,
             close :: IO ()
close    = () -> IO ()
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 cfm :: 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 (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
             encode :: CodeBuffer Char Word8
encode   = IORef Bool -> CodeBuffer Char Word8
utf16_encode IORef Bool
done_bom,
             recover :: Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
recover  = CodingFailureMode
-> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
recoverEncode CodingFailureMode
cfm,
             close :: IO ()
close    = () -> IO ()
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 done_bom :: IORef Bool
done_bom input :: 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 }
 = do
  Bool
b <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
done_bom
  if Bool
b then CodeBuffer Char Word8
utf16_native_encode Buffer Char
input Buffer Word8
output
       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
< 2
               then (CodingProgress, Buffer Char, Buffer Word8)
-> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (CodingProgress
OutputUnderflow,Buffer Char
input,Buffer Word8
output)
               else do
                    IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
done_bom Bool
True
                    RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow     Word8
bom1
                    RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Word8
bom2
                    CodeBuffer Char Word8
utf16_native_encode Buffer Char
input Buffer Word8
output{ bufR :: Int
bufR = Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+2 }

utf16_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer
utf16_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer
utf16_decode seen_bom :: 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
_  }
  output :: Buffer Char
output
 = do
   Maybe DecodeBuffer
mb <- IORef (Maybe DecodeBuffer) -> IO (Maybe DecodeBuffer)
forall a. IORef a -> IO a
readIORef IORef (Maybe DecodeBuffer)
seen_bom
   case Maybe DecodeBuffer
mb of
     Just decode :: DecodeBuffer
decode -> DecodeBuffer
decode Buffer Word8
input Buffer Char
output
     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
< 2 then (CodingProgress, Buffer Word8, Buffer Char)
-> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (CodingProgress
InputUnderflow,Buffer Word8
input,Buffer Char
output) else do
       Word8
c0 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw Int
ir
       Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
       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 -> do
               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)
               DecodeBuffer
utf16be_decode Buffer Word8
input{ bufL :: Int
bufL= Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+2 } Buffer Char
output
          | 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 -> do
               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)
               DecodeBuffer
utf16le_decode Buffer Word8
input{ bufL :: Int
bufL= Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+2 } Buffer Char
output
          | Bool
otherwise -> do
               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)
               DecodeBuffer
utf16_native_decode Buffer Word8
input Buffer Char
output


bomB, bomL, bom1, bom2 :: Word8
bomB :: Word8
bomB = 0xfe
bomL :: Word8
bomL = 0xff

-- choose UTF-16BE by default for UTF-16 output
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

-- -----------------------------------------------------------------------------
-- UTF16LE and UTF16BE

utf16be :: TextEncoding
utf16be :: TextEncoding
utf16be = CodingFailureMode -> TextEncoding
mkUTF16be CodingFailureMode
ErrorOnCodingFailure

-- | @since 4.4.0.0
mkUTF16be :: CodingFailureMode -> TextEncoding
mkUTF16be :: CodingFailureMode -> TextEncoding
mkUTF16be cfm :: CodingFailureMode
cfm = TextEncoding :: forall dstate estate.
String
-> IO (TextDecoder dstate)
-> IO (TextEncoder estate)
-> TextEncoding
TextEncoding { textEncodingName :: String
textEncodingName = "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 cfm :: CodingFailureMode
cfm =
  TextDecoder () -> IO (TextDecoder ())
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
             encode :: DecodeBuffer
encode   = DecodeBuffer
utf16be_decode,
             recover :: Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
recover  = CodingFailureMode
-> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
recoverDecode CodingFailureMode
cfm,
             close :: IO ()
close    = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
             getState :: IO ()
getState = () -> IO ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()
          })

utf16be_EF :: CodingFailureMode -> IO (TextEncoder ())
utf16be_EF :: CodingFailureMode -> IO (TextEncoder ())
utf16be_EF cfm :: CodingFailureMode
cfm =
  TextEncoder () -> IO (TextEncoder ())
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
             encode :: CodeBuffer Char Word8
encode   = CodeBuffer Char Word8
utf16be_encode,
             recover :: Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
recover  = CodingFailureMode
-> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
recoverEncode CodingFailureMode
cfm,
             close :: IO ()
close    = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
             getState :: IO ()
getState = () -> IO ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()
          })

utf16le :: TextEncoding
utf16le :: TextEncoding
utf16le = CodingFailureMode -> TextEncoding
mkUTF16le CodingFailureMode
ErrorOnCodingFailure

-- | @since 4.4.0.0
mkUTF16le :: CodingFailureMode -> TextEncoding
mkUTF16le :: CodingFailureMode -> TextEncoding
mkUTF16le cfm :: CodingFailureMode
cfm = TextEncoding :: forall dstate estate.
String
-> IO (TextDecoder dstate)
-> IO (TextEncoder estate)
-> TextEncoding
TextEncoding { textEncodingName :: String
textEncodingName = "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 cfm :: CodingFailureMode
cfm =
  TextDecoder () -> IO (TextDecoder ())
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
             encode :: DecodeBuffer
encode   = DecodeBuffer
utf16le_decode,
             recover :: Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
recover  = CodingFailureMode
-> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
recoverDecode CodingFailureMode
cfm,
             close :: IO ()
close    = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
             getState :: IO ()
getState = () -> IO ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()
          })

utf16le_EF :: CodingFailureMode -> IO (TextEncoder ())
utf16le_EF :: CodingFailureMode -> IO (TextEncoder ())
utf16le_EF cfm :: CodingFailureMode
cfm =
  TextEncoder () -> IO (TextEncoder ())
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
             encode :: CodeBuffer Char Word8
encode   = CodeBuffer Char Word8
utf16le_encode,
             recover :: Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
recover  = CodingFailureMode
-> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
recoverEncode CodingFailureMode
cfm,
             close :: IO ()
close    = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
             getState :: IO ()
getState = () -> IO ()
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 (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 }
 = let
       loop :: Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop !Int
ir !Int
ow
         | Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
os     = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
OutputUnderflow Int
ir Int
ow
         | Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iw     = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
         | Int
ir Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
         | Bool
otherwise = do
              Word8
c0 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw Int
ir
              Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
              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` 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 do Int
ow' <- 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))
                         Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+2) Int
ow'
                 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
< 4 then CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow else do
                      Word8
c2 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+2)
                      Word8
c3 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+3)
                      let 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` 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 IO (CodingProgress, Buffer Word8, Buffer Char)
invalid else do
                      Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Word16 -> Word16 -> Char
chr2 Word16
x1 Word16
x2)
                      Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+4) Int
ow'
         where
           invalid :: IO (CodingProgress, Buffer Word8, Buffer Char)
invalid = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InvalidSequence Int
ir Int
ow

       -- lambda-lifted, to avoid thunks being built in the inner-loop:
       done :: a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done why :: a
why !Int
ir !Int
ow = (a, Buffer Word8, Buffer Char) -> m (a, Buffer Word8, Buffer Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
why,
                                  if Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw then Buffer Word8
input{ bufL :: Int
bufL=0, bufR :: Int
bufR=0 }
                                              else Buffer Word8
input{ bufL :: Int
bufL=Int
ir },
                                  Buffer Char
output{ bufR :: Int
bufR=Int
ow })
    in
    Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop Int
ir0 Int
ow0

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 }
 = let
       loop :: Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop !Int
ir !Int
ow
         | Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
os     = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
OutputUnderflow Int
ir Int
ow
         | Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iw     = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
         | Int
ir Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
         | Bool
otherwise = do
              Word8
c0 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw Int
ir
              Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
              let 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` 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 do Int
ow' <- 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))
                         Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+2) Int
ow'
                 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
< 4 then CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow else do
                      Word8
c2 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+2)
                      Word8
c3 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+3)
                      let 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` 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 IO (CodingProgress, Buffer Word8, Buffer Char)
invalid else do
                      Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Word16 -> Word16 -> Char
chr2 Word16
x1 Word16
x2)
                      Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+4) Int
ow'
         where
           invalid :: IO (CodingProgress, Buffer Word8, Buffer Char)
invalid = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InvalidSequence Int
ir Int
ow

       -- lambda-lifted, to avoid thunks being built in the inner-loop:
       done :: a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done why :: a
why !Int
ir !Int
ow = (a, Buffer Word8, Buffer Char) -> m (a, Buffer Word8, Buffer Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
why,
                                  if Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw then Buffer Word8
input{ bufL :: Int
bufL=0, bufR :: Int
bufR=0 }
                                              else Buffer Word8
input{ bufL :: Int
bufL=Int
ir },
                                  Buffer Char
output{ bufR :: Int
bufR=Int
ow })
    in
    Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop Int
ir0 Int
ow0

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 }
 = let
      done :: a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done why :: a
why !Int
ir !Int
ow = (a, Buffer Char, Buffer Word8) -> m (a, Buffer Char, Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
why,
                                 if Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw then Buffer Char
input{ bufL :: Int
bufL=0, bufR :: Int
bufR=0 }
                                             else Buffer Char
input{ bufL :: Int
bufL=Int
ir },
                                 Buffer Word8
output{ bufR :: Int
bufR=Int
ow })
      loop :: Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop !Int
ir !Int
ow
        | Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iw     =  CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
InputUnderflow Int
ir Int
ow
        | Int
os Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2  =  CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
OutputUnderflow Int
ir Int
ow
        | Bool
otherwise = do
           (c :: Char
c,ir' :: Int
ir') <- RawBuffer Char -> Int -> IO (Char, Int)
readCharBuf RawBuffer Char
iraw Int
ir
           case Char -> Int
ord Char
c of
             x :: Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0x10000 -> if Char -> Bool
isSurrogate Char
c then CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
InvalidSequence Int
ir Int
ow else do
                    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` 8))
                    RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
                    Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir' (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+2)
               | 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
< 4 then CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
OutputUnderflow Int
ir Int
ow else do
                    let
                         n1 :: Int
n1 = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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` 18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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` 10)
                         n2 :: Int
n2 = Int
n1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 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` 8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 0xDC)
                         c4 :: Word8
c4 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n2
                    --
                    RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow     Word8
c1
                    RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Word8
c2
                    RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+2) Word8
c3
                    RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+3) Word8
c4
                    Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir' (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+4)
    in
    Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir0 Int
ow0

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 }
 = let
      done :: a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done why :: a
why !Int
ir !Int
ow = (a, Buffer Char, Buffer Word8) -> m (a, Buffer Char, Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
why,
                                 if Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw then Buffer Char
input{ bufL :: Int
bufL=0, bufR :: Int
bufR=0 }
                                             else Buffer Char
input{ bufL :: Int
bufL=Int
ir },
                                 Buffer Word8
output{ bufR :: Int
bufR=Int
ow })
      loop :: Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop !Int
ir !Int
ow
        | Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iw     =  CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
InputUnderflow Int
ir Int
ow
        | Int
os Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2  =  CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
OutputUnderflow Int
ir Int
ow
        | Bool
otherwise = do
           (c :: Char
c,ir' :: Int
ir') <- RawBuffer Char -> Int -> IO (Char, Int)
readCharBuf RawBuffer Char
iraw Int
ir
           case Char -> Int
ord Char
c of
             x :: Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0x10000 -> if Char -> Bool
isSurrogate Char
c then CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
InvalidSequence Int
ir Int
ow else do
                    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)
                    RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+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` 8))
                    Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir' (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+2)
               | 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
< 4 then CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
OutputUnderflow Int
ir Int
ow else do
                    let
                         n1 :: Int
n1 = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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` 18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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` 10)
                         n2 :: Int
n2 = Int
n1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 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` 8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 0xDC)
                         c4 :: Word8
c4 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n2
                    --
                    RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow     Word8
c2
                    RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Word8
c1
                    RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+2) Word8
c4
                    RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+3) Word8
c3
                    Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir' (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+4)
    in
    Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir0 Int
ow0

chr2 :: Word16 -> Word16 -> Char
chr2 :: Word16 -> Word16 -> Char
chr2 (W16# a# :: Word#
a#) (W16# b# :: Word#
b#) = Char# -> Char
C# (Int# -> Char#
chr# (Int#
upper# Int# -> Int# -> Int#
+# Int#
lower# Int# -> Int# -> Int#
+# 0x10000#))
    where
      !x# :: Int#
x# = Word# -> Int#
word2Int# Word#
a#
      !y# :: Int#
y# = Word# -> Int#
word2Int# Word#
b#
      !upper# :: Int#
upper# = Int# -> Int# -> Int#
uncheckedIShiftL# (Int#
x# Int# -> Int# -> Int#
-# 0xD800#) 10#
      !lower# :: Int#
lower# = Int#
y# Int# -> Int# -> Int#
-# 0xDC00#
{-# INLINE chr2 #-}

validate1    :: Word16 -> Bool
validate1 :: Word16 -> Bool
validate1 x1 :: Word16
x1 = (Word16
x1 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Word16
x1 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< 0xD800) Bool -> Bool -> Bool
|| Word16
x1 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> 0xDFFF
{-# INLINE validate1 #-}

validate2       ::  Word16 -> Word16 -> Bool
validate2 :: Word16 -> Word16 -> Bool
validate2 x1 :: Word16
x1 x2 :: Word16
x2 = Word16
x1 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= 0xD800 Bool -> Bool -> Bool
&& Word16
x1 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xDBFF Bool -> Bool -> Bool
&&
                  Word16
x2 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= 0xDC00 Bool -> Bool -> Bool
&& Word16
x2 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xDFFF
{-# INLINE validate2 #-}