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

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.IO.Encoding.UTF32
-- Copyright   :  (c) The University of Glasgow, 2009
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  internal
-- Portability :  non-portable
--
-- UTF-32 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.UTF32 (
  utf32, mkUTF32,
  utf32_decode,
  utf32_encode,

  utf32be, mkUTF32be,
  utf32be_decode,
  utf32be_encode,

  utf32le, mkUTF32le,
  utf32le_decode,
  utf32le_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-32 codec: either UTF-32BE or UTF-32LE with a BOM

utf32  :: TextEncoding
utf32 :: TextEncoding
utf32 = CodingFailureMode -> TextEncoding
mkUTF32 CodingFailureMode
ErrorOnCodingFailure

-- | @since 4.4.0.0
mkUTF32 :: CodingFailureMode -> TextEncoding
mkUTF32 :: CodingFailureMode -> TextEncoding
mkUTF32 CodingFailureMode
cfm = TextEncoding { textEncodingName :: String
textEncodingName = String
"UTF-32",
                             mkTextDecoder :: IO (TextDecoder (Maybe DecodeBuffer#))
mkTextDecoder = CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#))
utf32_DF CodingFailureMode
cfm,
                             mkTextEncoder :: IO (TextEncoder Bool)
mkTextEncoder = CodingFailureMode -> IO (TextEncoder Bool)
utf32_EF CodingFailureMode
cfm }

utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#))
utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#))
utf32_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#
utf32_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
          })

utf32_EF :: CodingFailureMode -> IO (TextEncoder Bool)
utf32_EF :: CodingFailureMode -> IO (TextEncoder Bool)
utf32_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
utf32_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
          })

utf32_encode :: IORef Bool -> EncodeBuffer#
utf32_encode :: IORef Bool -> CodeBuffer# Char Word8
utf32_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
utf32_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
4
               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
bom0) 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
bom1) 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
2) Word8
bom2) State# RealWorld
st4
                   !(# State# RealWorld
st6, () #) = 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
bom3) State# RealWorld
st5
               CodeBuffer# Char Word8
utf32_native_encode Buffer Char
input Buffer Word8
output{ bufR = ow+4 } State# RealWorld
st6

utf32_decode :: IORef (Maybe DecodeBuffer#) -> DecodeBuffer#
utf32_decode :: IORef (Maybe DecodeBuffer#) -> DecodeBuffer#
utf32_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
4 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
           !(# State# RealWorld
st4, 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
st3
           !(# State# RealWorld
st5, 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
st4
       case () of
        ()
_ | Word8
c0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom0 Bool -> Bool -> Bool
&& Word8
c1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom1 Bool -> Bool -> Bool
&& Word8
c2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom2 Bool -> Bool -> Bool
&& Word8
c3 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom3 ->
               let !(# State# RealWorld
st6, () #) = 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#
utf32be_decode)) State# RealWorld
st5
               in DecodeBuffer#
utf32be_decode Buffer Word8
input{ bufL= ir+4 } Buffer Char
output State# RealWorld
st6
        ()
_ | Word8
c0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom3 Bool -> Bool -> Bool
&& Word8
c1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom2 Bool -> Bool -> Bool
&& Word8
c2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom1 Bool -> Bool -> Bool
&& Word8
c3 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom0 ->
               let !(# State# RealWorld
st6, () #) = 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#
utf32le_decode)) State# RealWorld
st5
               in DecodeBuffer#
utf32le_decode Buffer Word8
input{ bufL= ir+4 } Buffer Char
output State# RealWorld
st6
          | Bool
otherwise ->
               let !(# State# RealWorld
st6, () #) = 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#
utf32_native_decode)) State# RealWorld
st5
               in DecodeBuffer#
utf32_native_decode Buffer Word8
input Buffer Char
output State# RealWorld
st6


bom0, bom1, bom2, bom3 :: Word8
bom0 :: Word8
bom0 = Word8
0
bom1 :: Word8
bom1 = Word8
0
bom2 :: Word8
bom2 = Word8
0xfe
bom3 :: Word8
bom3 = Word8
0xff

-- choose UTF-32BE by default for UTF-32 output
utf32_native_decode :: DecodeBuffer#
utf32_native_decode :: DecodeBuffer#
utf32_native_decode = DecodeBuffer#
utf32be_decode

utf32_native_encode :: EncodeBuffer#
utf32_native_encode :: CodeBuffer# Char Word8
utf32_native_encode = CodeBuffer# Char Word8
utf32be_encode

-- -----------------------------------------------------------------------------
-- UTF32LE and UTF32BE

utf32be :: TextEncoding
utf32be :: TextEncoding
utf32be = CodingFailureMode -> TextEncoding
mkUTF32be CodingFailureMode
ErrorOnCodingFailure

-- | @since 4.4.0.0
mkUTF32be :: CodingFailureMode -> TextEncoding
mkUTF32be :: CodingFailureMode -> TextEncoding
mkUTF32be CodingFailureMode
cfm = TextEncoding { textEncodingName :: String
textEncodingName = String
"UTF-32BE",
                               mkTextDecoder :: IO (TextDecoder ())
mkTextDecoder = CodingFailureMode -> IO (TextDecoder ())
utf32be_DF CodingFailureMode
cfm,
                               mkTextEncoder :: IO (TextEncoder ())
mkTextEncoder = CodingFailureMode -> IO (TextEncoder ())
utf32be_EF CodingFailureMode
cfm }

utf32be_DF :: CodingFailureMode -> IO (TextDecoder ())
utf32be_DF :: CodingFailureMode -> IO (TextDecoder ())
utf32be_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#
utf32be_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 ()
          })

utf32be_EF :: CodingFailureMode -> IO (TextEncoder ())
utf32be_EF :: CodingFailureMode -> IO (TextEncoder ())
utf32be_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
utf32be_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 ()
          })


utf32le :: TextEncoding
utf32le :: TextEncoding
utf32le = CodingFailureMode -> TextEncoding
mkUTF32le CodingFailureMode
ErrorOnCodingFailure

-- | @since 4.4.0.0
mkUTF32le :: CodingFailureMode -> TextEncoding
mkUTF32le :: CodingFailureMode -> TextEncoding
mkUTF32le CodingFailureMode
cfm = TextEncoding { textEncodingName :: String
textEncodingName = String
"UTF-32LE",
                               mkTextDecoder :: IO (TextDecoder ())
mkTextDecoder = CodingFailureMode -> IO (TextDecoder ())
utf32le_DF CodingFailureMode
cfm,
                               mkTextEncoder :: IO (TextEncoder ())
mkTextEncoder = CodingFailureMode -> IO (TextEncoder ())
utf32le_EF CodingFailureMode
cfm }

utf32le_DF :: CodingFailureMode -> IO (TextDecoder ())
utf32le_DF :: CodingFailureMode -> IO (TextDecoder ())
utf32le_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#
utf32le_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 ()
          })

utf32le_EF :: CodingFailureMode -> IO (TextEncoder ())
utf32le_EF :: CodingFailureMode -> IO (TextEncoder ())
utf32le_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
utf32le_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 ()
          })


utf32be_decode :: DecodeBuffer#
utf32be_decode :: DecodeBuffer#
utf32be_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 -> DecodingBuffer#
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 -> DecodingBuffer#
done CodingProgress
OutputUnderflow Int
ir Int
ow State# RealWorld
st0
         | 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 = CodingProgress -> Int -> Int -> DecodingBuffer#
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
                  !(# 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
              let x1 :: Char
x1 = Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 Word8
c0 Word8
c1 Word8
c2 Word8
c3
              if Bool -> Bool
not (Char -> Bool
validate Char
x1) then DecodingBuffer#
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 Char
x1) State# RealWorld
st4
              Int -> Int -> DecodingBuffer#
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) Int
ow' State# RealWorld
st5
         where
           invalid :: DecodingBuffer#
           invalid :: DecodingBuffer#
invalid State# RealWorld
st' = CodingProgress -> Int -> Int -> DecodingBuffer#
done CodingProgress
InvalidSequence Int
ir Int
ow State# RealWorld
st'

       -- lambda-lifted, to avoid thunks being built in the inner-loop:
       {-# NOINLINE done #-}
       done :: CodingProgress -> Int -> Int -> DecodingBuffer#
       done :: CodingProgress -> Int -> Int -> DecodingBuffer#
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 -> DecodingBuffer#
loop Int
ir0 Int
ow0 State# RealWorld
st

utf32le_decode :: DecodeBuffer#
utf32le_decode :: DecodeBuffer#
utf32le_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 -> DecodingBuffer#
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 -> DecodingBuffer#
done CodingProgress
OutputUnderflow Int
ir Int
ow State# RealWorld
st0
         | 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 = CodingProgress -> Int -> Int -> DecodingBuffer#
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
                  !(# 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
              let x1 :: Char
x1 = Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 Word8
c3 Word8
c2 Word8
c1 Word8
c0
              if Bool -> Bool
not (Char -> Bool
validate Char
x1) then DecodingBuffer#
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 Char
x1) State# RealWorld
st4
              Int -> Int -> DecodingBuffer#
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) Int
ow' State# RealWorld
st5
         where
           invalid :: DecodingBuffer#
           invalid :: DecodingBuffer#
invalid State# RealWorld
st' = CodingProgress -> Int -> Int -> DecodingBuffer#
done CodingProgress
InvalidSequence Int
ir Int
ow State# RealWorld
st'

       -- lambda-lifted, to avoid thunks being built in the inner-loop:
       {-# NOINLINE done #-}
       done :: CodingProgress -> Int -> Int -> DecodingBuffer#
       done :: CodingProgress -> Int -> Int -> DecodingBuffer#
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 -> DecodingBuffer#
loop Int
ir0 Int
ow0 State# RealWorld
st

utf32be_encode :: EncodeBuffer#
utf32be_encode :: CodeBuffer# Char Word8
utf32be_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
4 = 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
           if Char -> Bool
isSurrogate Char
c then CodingProgress -> Int -> Int -> EncodingBuffer#
done CodingProgress
InvalidSequence Int
ir Int
ow State# RealWorld
st1 else do
             let (Word8
c0,Word8
c1,Word8
c2,Word8
c3) = Char -> (Word8, Word8, Word8, Word8)
ord4 Char
c
                 !(# 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
c0) 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
c2) 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

utf32le_encode :: EncodeBuffer#
utf32le_encode :: CodeBuffer# Char Word8
utf32le_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
      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
4 = 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
           if Char -> Bool
isSurrogate Char
c then CodingProgress -> Int -> Int -> EncodingBuffer#
done CodingProgress
InvalidSequence Int
ir Int
ow State# RealWorld
st1 else do
             let (Word8
c0,Word8
c1,Word8
c2,Word8
c3) = Char -> (Word8, Word8, Word8, Word8)
ord4 Char
c
                 !(# 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
c3) 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
c1) 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
c0) 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

chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 (W8# Word8#
x1#) (W8# Word8#
x2#) (W8# Word8#
x3#) (W8# Word8#
x4#) =
    Char# -> Char
C# (Int# -> Char#
chr# (Int#
z1# Int# -> Int# -> Int#
+# Int#
z2# Int# -> Int# -> Int#
+# Int#
z3# Int# -> Int# -> Int#
+# Int#
z4#))
    where
      !y1# :: Int#
y1# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
x1#)
      !y2# :: Int#
y2# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
x2#)
      !y3# :: Int#
y3# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
x3#)
      !y4# :: Int#
y4# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
x4#)
      !z1# :: Int#
z1# = Int# -> Int# -> Int#
uncheckedIShiftL# Int#
y1# Int#
24#
      !z2# :: Int#
z2# = Int# -> Int# -> Int#
uncheckedIShiftL# Int#
y2# Int#
16#
      !z3# :: Int#
z3# = Int# -> Int# -> Int#
uncheckedIShiftL# Int#
y3# Int#
8#
      !z4# :: Int#
z4# = Int#
y4#
{-# INLINE chr4 #-}

ord4 :: Char -> (Word8,Word8,Word8,Word8)
ord4 :: Char -> (Word8, Word8, Word8, Word8)
ord4 Char
c = (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
24),
          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
16),
          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),
          Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
  where
    x :: Int
x = Char -> Int
ord Char
c
{-# INLINE ord4 #-}


validate    :: Char -> Bool
validate :: Char -> Bool
validate Char
c = (Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x0 Bool -> Bool -> Bool
&& Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xD800) Bool -> Bool -> Bool
|| (Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xDFFF Bool -> Bool -> Bool
&& Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFF)
   where x1 :: Int
x1 = Char -> Int
ord Char
c
{-# INLINE validate #-}