Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE NoImplicitPrelude           , BangPatterns           , NondecreasingIndentation           , MagicHash  #-}{-# 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-------------------------------------------------------------------------------moduleGHC.IO.Encoding.UTF32(utf32,mkUTF32,utf32_decode,utf32_encode,utf32be,mkUTF32be,utf32be_decode,utf32be_encode,utf32le,mkUTF32le,utf32le_decode,utf32le_encode,)whereimportGHC.BaseimportGHC.RealimportGHC.Num-- import GHC.IOimportGHC.IO.BufferimportGHC.IO.Encoding.FailureimportGHC.IO.Encoding.TypesimportGHC.WordimportData.BitsimportGHC.IORef-- ------------------------------------------------------------------------------- The UTF-32 codec: either UTF-32BE or UTF-32LE with a BOMutf32::TextEncodingutf32 :: TextEncodingutf32=CodingFailureMode -> TextEncodingmkUTF32CodingFailureModeErrorOnCodingFailure-- | @since 4.4.0.0mkUTF32::CodingFailureMode->TextEncodingmkUTF32 :: CodingFailureMode -> TextEncodingmkUTF32CodingFailureModecfm=TextEncoding :: forall dstate estate.String-> IO (TextDecoder dstate)-> IO (TextEncoder estate)-> TextEncodingTextEncoding{textEncodingName :: StringtextEncodingName=String"UTF-32",mkTextDecoder :: IO (TextDecoder (Maybe DecodeBuffer))mkTextDecoder=CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer))utf32_DFCodingFailureModecfm,mkTextEncoder :: IO (TextEncoder Bool)mkTextEncoder=CodingFailureMode -> IO (TextEncoder Bool)utf32_EFCodingFailureModecfm}utf32_DF::CodingFailureMode->IO(TextDecoder(MaybeDecodeBuffer))utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer))utf32_DFCodingFailureModecfm=doIORef (Maybe DecodeBuffer)seen_bom<-Maybe DecodeBuffer -> IO (IORef (Maybe DecodeBuffer))forall a. a -> IO (IORef a)newIORefMaybe DecodeBufferforall a. Maybe aNothingTextDecoder (Maybe DecodeBuffer)-> IO (TextDecoder (Maybe DecodeBuffer))forall (m :: * -> *) a. Monad m => a -> m areturn(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 stateBufferCodec{encode :: DecodeBufferencode=IORef (Maybe DecodeBuffer) -> DecodeBufferutf32_decodeIORef (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)recoverDecodeCodingFailureModecfm,close :: IO ()close=() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn(),getState :: IO (Maybe DecodeBuffer)getState=IORef (Maybe DecodeBuffer) -> IO (Maybe DecodeBuffer)forall a. IORef a -> IO areadIORefIORef (Maybe DecodeBuffer)seen_bom,setState :: Maybe DecodeBuffer -> IO ()setState=IORef (Maybe DecodeBuffer) -> Maybe DecodeBuffer -> IO ()forall a. IORef a -> a -> IO ()writeIORefIORef (Maybe DecodeBuffer)seen_bom})utf32_EF::CodingFailureMode->IO(TextEncoderBool)utf32_EF :: CodingFailureMode -> IO (TextEncoder Bool)utf32_EFCodingFailureModecfm=doIORef Booldone_bom<-Bool -> IO (IORef Bool)forall a. a -> IO (IORef a)newIORefBoolFalseTextEncoder Bool -> IO (TextEncoder Bool)forall (m :: * -> *) a. Monad m => a -> m areturn(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 stateBufferCodec{encode :: CodeBuffer Char Word8encode=IORef Bool -> CodeBuffer Char Word8utf32_encodeIORef Booldone_bom,recover :: Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)recover=CodingFailureMode-> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)recoverEncodeCodingFailureModecfm,close :: IO ()close=() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn(),getState :: IO BoolgetState=IORef Bool -> IO Boolforall a. IORef a -> IO areadIORefIORef Booldone_bom,setState :: Bool -> IO ()setState=IORef Bool -> Bool -> IO ()forall a. IORef a -> a -> IO ()writeIORefIORef Booldone_bom})utf32_encode::IORefBool->EncodeBufferutf32_encode :: IORef Bool -> CodeBuffer Char Word8utf32_encodeIORef Booldone_bomBuffer Charinputoutput :: Buffer Word8output@Buffer{bufRaw :: forall e. Buffer e -> RawBuffer ebufRaw=RawBuffer Word8oraw,bufL :: forall e. Buffer e -> IntbufL=Int_,bufR :: forall e. Buffer e -> IntbufR=Intow,bufSize :: forall e. Buffer e -> IntbufSize=Intos}=doBoolb<-IORef Bool -> IO Boolforall a. IORef a -> IO areadIORefIORef Booldone_bomifBoolbthenCodeBuffer Char Word8utf32_native_encodeBuffer CharinputBuffer Word8outputelseifIntosInt -> Int -> Intforall a. Num a => a -> a -> a-IntowInt -> Int -> Boolforall a. Ord a => a -> a -> Bool<Int4then(CodingProgress, Buffer Char, Buffer Word8)-> IO (CodingProgress, Buffer Char, Buffer Word8)forall (m :: * -> *) a. Monad m => a -> m areturn(CodingProgressOutputUnderflow,Buffer Charinput,Buffer Word8output)elsedoIORef Bool -> Bool -> IO ()forall a. IORef a -> a -> IO ()writeIORefIORef Booldone_bomBoolTrueRawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8BufRawBuffer Word8orawIntowWord8bom0RawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8BufRawBuffer Word8oraw(IntowInt -> Int -> Intforall a. Num a => a -> a -> a+Int1)Word8bom1RawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8BufRawBuffer Word8oraw(IntowInt -> Int -> Intforall a. Num a => a -> a -> a+Int2)Word8bom2RawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8BufRawBuffer Word8oraw(IntowInt -> Int -> Intforall a. Num a => a -> a -> a+Int3)Word8bom3CodeBuffer Char Word8utf32_native_encodeBuffer CharinputBuffer Word8output{bufR :: IntbufR=IntowInt -> Int -> Intforall a. Num a => a -> a -> a+Int4}utf32_decode::IORef(MaybeDecodeBuffer)->DecodeBufferutf32_decode :: IORef (Maybe DecodeBuffer) -> DecodeBufferutf32_decodeIORef (Maybe DecodeBuffer)seen_bominput :: Buffer Word8input@Buffer{bufRaw :: forall e. Buffer e -> RawBuffer ebufRaw=RawBuffer Word8iraw,bufL :: forall e. Buffer e -> IntbufL=Intir,bufR :: forall e. Buffer e -> IntbufR=Intiw,bufSize :: forall e. Buffer e -> IntbufSize=Int_}Buffer Charoutput=doMaybe DecodeBuffermb<-IORef (Maybe DecodeBuffer) -> IO (Maybe DecodeBuffer)forall a. IORef a -> IO areadIORefIORef (Maybe DecodeBuffer)seen_bomcaseMaybe DecodeBuffermbofJustDecodeBufferdecode->DecodeBufferdecodeBuffer Word8inputBuffer CharoutputMaybe DecodeBufferNothing->ifIntiwInt -> Int -> Intforall a. Num a => a -> a -> a-IntirInt -> Int -> Boolforall a. Ord a => a -> a -> Bool<Int4then(CodingProgress, Buffer Word8, Buffer Char)-> IO (CodingProgress, Buffer Word8, Buffer Char)forall (m :: * -> *) a. Monad m => a -> m areturn(CodingProgressInputUnderflow,Buffer Word8input,Buffer Charoutput)elsedoWord8c0<-RawBuffer Word8 -> Int -> IO Word8readWord8BufRawBuffer Word8irawIntirWord8c1<-RawBuffer Word8 -> Int -> IO Word8readWord8BufRawBuffer Word8iraw(IntirInt -> Int -> Intforall a. Num a => a -> a -> a+Int1)Word8c2<-RawBuffer Word8 -> Int -> IO Word8readWord8BufRawBuffer Word8iraw(IntirInt -> Int -> Intforall a. Num a => a -> a -> a+Int2)Word8c3<-RawBuffer Word8 -> Int -> IO Word8readWord8BufRawBuffer Word8iraw(IntirInt -> Int -> Intforall a. Num a => a -> a -> a+Int3)case()of()_|Word8c0Word8 -> Word8 -> Boolforall a. Eq a => a -> a -> Bool==Word8bom0Bool -> Bool -> Bool&&Word8c1Word8 -> Word8 -> Boolforall a. Eq a => a -> a -> Bool==Word8bom1Bool -> Bool -> Bool&&Word8c2Word8 -> Word8 -> Boolforall a. Eq a => a -> a -> Bool==Word8bom2Bool -> Bool -> Bool&&Word8c3Word8 -> Word8 -> Boolforall a. Eq a => a -> a -> Bool==Word8bom3->doIORef (Maybe DecodeBuffer) -> Maybe DecodeBuffer -> IO ()forall a. IORef a -> a -> IO ()writeIORefIORef (Maybe DecodeBuffer)seen_bom(DecodeBuffer -> Maybe DecodeBufferforall a. a -> Maybe aJustDecodeBufferutf32be_decode)DecodeBufferutf32be_decodeBuffer Word8input{bufL :: IntbufL=IntirInt -> Int -> Intforall a. Num a => a -> a -> a+Int4}Buffer Charoutput()_|Word8c0Word8 -> Word8 -> Boolforall a. Eq a => a -> a -> Bool==Word8bom3Bool -> Bool -> Bool&&Word8c1Word8 -> Word8 -> Boolforall a. Eq a => a -> a -> Bool==Word8bom2Bool -> Bool -> Bool&&Word8c2Word8 -> Word8 -> Boolforall a. Eq a => a -> a -> Bool==Word8bom1Bool -> Bool -> Bool&&Word8c3Word8 -> Word8 -> Boolforall a. Eq a => a -> a -> Bool==Word8bom0->doIORef (Maybe DecodeBuffer) -> Maybe DecodeBuffer -> IO ()forall a. IORef a -> a -> IO ()writeIORefIORef (Maybe DecodeBuffer)seen_bom(DecodeBuffer -> Maybe DecodeBufferforall a. a -> Maybe aJustDecodeBufferutf32le_decode)DecodeBufferutf32le_decodeBuffer Word8input{bufL :: IntbufL=IntirInt -> Int -> Intforall a. Num a => a -> a -> a+Int4}Buffer Charoutput|Boolotherwise->doIORef (Maybe DecodeBuffer) -> Maybe DecodeBuffer -> IO ()forall a. IORef a -> a -> IO ()writeIORefIORef (Maybe DecodeBuffer)seen_bom(DecodeBuffer -> Maybe DecodeBufferforall a. a -> Maybe aJustDecodeBufferutf32_native_decode)DecodeBufferutf32_native_decodeBuffer Word8inputBuffer Charoutputbom0,bom1,bom2,bom3::Word8bom0 :: Word8bom0=Word80bom1 :: Word8bom1=Word80bom2 :: Word8bom2=Word80xfebom3 :: Word8bom3=Word80xff-- choose UTF-32BE by default for UTF-32 outpututf32_native_decode::DecodeBufferutf32_native_decode :: DecodeBufferutf32_native_decode=DecodeBufferutf32be_decodeutf32_native_encode::EncodeBufferutf32_native_encode :: CodeBuffer Char Word8utf32_native_encode=CodeBuffer Char Word8utf32be_encode-- ------------------------------------------------------------------------------- UTF32LE and UTF32BEutf32be::TextEncodingutf32be :: TextEncodingutf32be=CodingFailureMode -> TextEncodingmkUTF32beCodingFailureModeErrorOnCodingFailure-- | @since 4.4.0.0mkUTF32be::CodingFailureMode->TextEncodingmkUTF32be :: CodingFailureMode -> TextEncodingmkUTF32beCodingFailureModecfm=TextEncoding :: forall dstate estate.String-> IO (TextDecoder dstate)-> IO (TextEncoder estate)-> TextEncodingTextEncoding{textEncodingName :: StringtextEncodingName=String"UTF-32BE",mkTextDecoder :: IO (TextDecoder ())mkTextDecoder=CodingFailureMode -> IO (TextDecoder ())utf32be_DFCodingFailureModecfm,mkTextEncoder :: IO (TextEncoder ())mkTextEncoder=CodingFailureMode -> IO (TextEncoder ())utf32be_EFCodingFailureModecfm}utf32be_DF::CodingFailureMode->IO(TextDecoder())utf32be_DF :: CodingFailureMode -> IO (TextDecoder ())utf32be_DFCodingFailureModecfm=TextDecoder () -> IO (TextDecoder ())forall (m :: * -> *) a. Monad m => a -> m areturn(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 stateBufferCodec{encode :: DecodeBufferencode=DecodeBufferutf32be_decode,recover :: Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)recover=CodingFailureMode-> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)recoverDecodeCodingFailureModecfm,close :: IO ()close=() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn(),getState :: IO ()getState=() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn(),setState :: () -> IO ()setState=IO () -> () -> IO ()forall a b. a -> b -> aconst(IO () -> () -> IO ()) -> IO () -> () -> IO ()forall a b. (a -> b) -> a -> b$() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn()})utf32be_EF::CodingFailureMode->IO(TextEncoder())utf32be_EF :: CodingFailureMode -> IO (TextEncoder ())utf32be_EFCodingFailureModecfm=TextEncoder () -> IO (TextEncoder ())forall (m :: * -> *) a. Monad m => a -> m areturn(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 stateBufferCodec{encode :: CodeBuffer Char Word8encode=CodeBuffer Char Word8utf32be_encode,recover :: Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)recover=CodingFailureMode-> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)recoverEncodeCodingFailureModecfm,close :: IO ()close=() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn(),getState :: IO ()getState=() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn(),setState :: () -> IO ()setState=IO () -> () -> IO ()forall a b. a -> b -> aconst(IO () -> () -> IO ()) -> IO () -> () -> IO ()forall a b. (a -> b) -> a -> b$() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn()})utf32le::TextEncodingutf32le :: TextEncodingutf32le=CodingFailureMode -> TextEncodingmkUTF32leCodingFailureModeErrorOnCodingFailure-- | @since 4.4.0.0mkUTF32le::CodingFailureMode->TextEncodingmkUTF32le :: CodingFailureMode -> TextEncodingmkUTF32leCodingFailureModecfm=TextEncoding :: forall dstate estate.String-> IO (TextDecoder dstate)-> IO (TextEncoder estate)-> TextEncodingTextEncoding{textEncodingName :: StringtextEncodingName=String"UTF-32LE",mkTextDecoder :: IO (TextDecoder ())mkTextDecoder=CodingFailureMode -> IO (TextDecoder ())utf32le_DFCodingFailureModecfm,mkTextEncoder :: IO (TextEncoder ())mkTextEncoder=CodingFailureMode -> IO (TextEncoder ())utf32le_EFCodingFailureModecfm}utf32le_DF::CodingFailureMode->IO(TextDecoder())utf32le_DF :: CodingFailureMode -> IO (TextDecoder ())utf32le_DFCodingFailureModecfm=TextDecoder () -> IO (TextDecoder ())forall (m :: * -> *) a. Monad m => a -> m areturn(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 stateBufferCodec{encode :: DecodeBufferencode=DecodeBufferutf32le_decode,recover :: Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)recover=CodingFailureMode-> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)recoverDecodeCodingFailureModecfm,close :: IO ()close=() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn(),getState :: IO ()getState=() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn(),setState :: () -> IO ()setState=IO () -> () -> IO ()forall a b. a -> b -> aconst(IO () -> () -> IO ()) -> IO () -> () -> IO ()forall a b. (a -> b) -> a -> b$() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn()})utf32le_EF::CodingFailureMode->IO(TextEncoder())utf32le_EF :: CodingFailureMode -> IO (TextEncoder ())utf32le_EFCodingFailureModecfm=TextEncoder () -> IO (TextEncoder ())forall (m :: * -> *) a. Monad m => a -> m areturn(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 stateBufferCodec{encode :: CodeBuffer Char Word8encode=CodeBuffer Char Word8utf32le_encode,recover :: Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)recover=CodingFailureMode-> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)recoverEncodeCodingFailureModecfm,close :: IO ()close=() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn(),getState :: IO ()getState=() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn(),setState :: () -> IO ()setState=IO () -> () -> IO ()forall a b. a -> b -> aconst(IO () -> () -> IO ()) -> IO () -> () -> IO ()forall a b. (a -> b) -> a -> b$() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn()})utf32be_decode::DecodeBufferutf32be_decode :: DecodeBufferutf32be_decodeinput :: Buffer Word8input@Buffer{bufRaw :: forall e. Buffer e -> RawBuffer ebufRaw=RawBuffer Word8iraw,bufL :: forall e. Buffer e -> IntbufL=Intir0,bufR :: forall e. Buffer e -> IntbufR=Intiw,bufSize :: forall e. Buffer e -> IntbufSize=Int_}output :: Buffer Charoutput@Buffer{bufRaw :: forall e. Buffer e -> RawBuffer ebufRaw=RawBuffer Charoraw,bufL :: forall e. Buffer e -> IntbufL=Int_,bufR :: forall e. Buffer e -> IntbufR=Intow0,bufSize :: forall e. Buffer e -> IntbufSize=Intos}=letloop :: Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)loop!Intir!Intow|IntowInt -> Int -> Boolforall a. Ord a => a -> a -> Bool>=Intos=CodingProgress-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)forall (m :: * -> *) a.Monad m =>a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)doneCodingProgressOutputUnderflowIntirIntow|IntiwInt -> Int -> Intforall a. Num a => a -> a -> a-IntirInt -> Int -> Boolforall a. Ord a => a -> a -> Bool<Int4=CodingProgress-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)forall (m :: * -> *) a.Monad m =>a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)doneCodingProgressInputUnderflowIntirIntow|Boolotherwise=doWord8c0<-RawBuffer Word8 -> Int -> IO Word8readWord8BufRawBuffer Word8irawIntirWord8c1<-RawBuffer Word8 -> Int -> IO Word8readWord8BufRawBuffer Word8iraw(IntirInt -> Int -> Intforall a. Num a => a -> a -> a+Int1)Word8c2<-RawBuffer Word8 -> Int -> IO Word8readWord8BufRawBuffer Word8iraw(IntirInt -> Int -> Intforall a. Num a => a -> a -> a+Int2)Word8c3<-RawBuffer Word8 -> Int -> IO Word8readWord8BufRawBuffer Word8iraw(IntirInt -> Int -> Intforall a. Num a => a -> a -> a+Int3)letx1 :: Charx1=Word8 -> Word8 -> Word8 -> Word8 -> Charchr4Word8c0Word8c1Word8c2Word8c3ifBool -> Boolnot(Char -> BoolvalidateCharx1)thenIO (CodingProgress, Buffer Word8, Buffer Char)invalidelsedoIntow'<-RawBuffer Char -> Int -> Char -> IO IntwriteCharBufRawBuffer CharorawIntowCharx1Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)loop(IntirInt -> Int -> Intforall a. Num a => a -> a -> a+Int4)Intow'whereinvalid :: 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)doneCodingProgressInvalidSequenceIntirIntow-- lambda-lifted, to avoid thunks being built in the inner-loop:done :: a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)doneawhy!Intir!Intow=(a, Buffer Word8, Buffer Char) -> m (a, Buffer Word8, Buffer Char)forall (m :: * -> *) a. Monad m => a -> m areturn(awhy,ifIntirInt -> Int -> Boolforall a. Eq a => a -> a -> Bool==IntiwthenBuffer Word8input{bufL :: IntbufL=Int0,bufR :: IntbufR=Int0}elseBuffer Word8input{bufL :: IntbufL=Intir},Buffer Charoutput{bufR :: IntbufR=Intow})inInt -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)loopIntir0Intow0utf32le_decode::DecodeBufferutf32le_decode :: DecodeBufferutf32le_decodeinput :: Buffer Word8input@Buffer{bufRaw :: forall e. Buffer e -> RawBuffer ebufRaw=RawBuffer Word8iraw,bufL :: forall e. Buffer e -> IntbufL=Intir0,bufR :: forall e. Buffer e -> IntbufR=Intiw,bufSize :: forall e. Buffer e -> IntbufSize=Int_}output :: Buffer Charoutput@Buffer{bufRaw :: forall e. Buffer e -> RawBuffer ebufRaw=RawBuffer Charoraw,bufL :: forall e. Buffer e -> IntbufL=Int_,bufR :: forall e. Buffer e -> IntbufR=Intow0,bufSize :: forall e. Buffer e -> IntbufSize=Intos}=letloop :: Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)loop!Intir!Intow|IntowInt -> Int -> Boolforall a. Ord a => a -> a -> Bool>=Intos=CodingProgress-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)forall (m :: * -> *) a.Monad m =>a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)doneCodingProgressOutputUnderflowIntirIntow|IntiwInt -> Int -> Intforall a. Num a => a -> a -> a-IntirInt -> Int -> Boolforall a. Ord a => a -> a -> Bool<Int4=CodingProgress-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)forall (m :: * -> *) a.Monad m =>a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)doneCodingProgressInputUnderflowIntirIntow|Boolotherwise=doWord8c0<-RawBuffer Word8 -> Int -> IO Word8readWord8BufRawBuffer Word8irawIntirWord8c1<-RawBuffer Word8 -> Int -> IO Word8readWord8BufRawBuffer Word8iraw(IntirInt -> Int -> Intforall a. Num a => a -> a -> a+Int1)Word8c2<-RawBuffer Word8 -> Int -> IO Word8readWord8BufRawBuffer Word8iraw(IntirInt -> Int -> Intforall a. Num a => a -> a -> a+Int2)Word8c3<-RawBuffer Word8 -> Int -> IO Word8readWord8BufRawBuffer Word8iraw(IntirInt -> Int -> Intforall a. Num a => a -> a -> a+Int3)letx1 :: Charx1=Word8 -> Word8 -> Word8 -> Word8 -> Charchr4Word8c3Word8c2Word8c1Word8c0ifBool -> Boolnot(Char -> BoolvalidateCharx1)thenIO (CodingProgress, Buffer Word8, Buffer Char)invalidelsedoIntow'<-RawBuffer Char -> Int -> Char -> IO IntwriteCharBufRawBuffer CharorawIntowCharx1Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)loop(IntirInt -> Int -> Intforall a. Num a => a -> a -> a+Int4)Intow'whereinvalid :: 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)doneCodingProgressInvalidSequenceIntirIntow-- lambda-lifted, to avoid thunks being built in the inner-loop:done :: a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)doneawhy!Intir!Intow=(a, Buffer Word8, Buffer Char) -> m (a, Buffer Word8, Buffer Char)forall (m :: * -> *) a. Monad m => a -> m areturn(awhy,ifIntirInt -> Int -> Boolforall a. Eq a => a -> a -> Bool==IntiwthenBuffer Word8input{bufL :: IntbufL=Int0,bufR :: IntbufR=Int0}elseBuffer Word8input{bufL :: IntbufL=Intir},Buffer Charoutput{bufR :: IntbufR=Intow})inInt -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)loopIntir0Intow0utf32be_encode::EncodeBufferutf32be_encode :: CodeBuffer Char Word8utf32be_encodeinput :: Buffer Charinput@Buffer{bufRaw :: forall e. Buffer e -> RawBuffer ebufRaw=RawBuffer Chariraw,bufL :: forall e. Buffer e -> IntbufL=Intir0,bufR :: forall e. Buffer e -> IntbufR=Intiw,bufSize :: forall e. Buffer e -> IntbufSize=Int_}output :: Buffer Word8output@Buffer{bufRaw :: forall e. Buffer e -> RawBuffer ebufRaw=RawBuffer Word8oraw,bufL :: forall e. Buffer e -> IntbufL=Int_,bufR :: forall e. Buffer e -> IntbufR=Intow0,bufSize :: forall e. Buffer e -> IntbufSize=Intos}=letdone :: a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)doneawhy!Intir!Intow=(a, Buffer Char, Buffer Word8) -> m (a, Buffer Char, Buffer Word8)forall (m :: * -> *) a. Monad m => a -> m areturn(awhy,ifIntirInt -> Int -> Boolforall a. Eq a => a -> a -> Bool==IntiwthenBuffer Charinput{bufL :: IntbufL=Int0,bufR :: IntbufR=Int0}elseBuffer Charinput{bufL :: IntbufL=Intir},Buffer Word8output{bufR :: IntbufR=Intow})loop :: Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)loop!Intir!Intow|IntirInt -> Int -> Boolforall a. Ord a => a -> a -> Bool>=Intiw=CodingProgress-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)forall (m :: * -> *) a.Monad m =>a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)doneCodingProgressInputUnderflowIntirIntow|IntosInt -> Int -> Intforall a. Num a => a -> a -> a-IntowInt -> Int -> Boolforall a. Ord a => a -> a -> Bool<Int4=CodingProgress-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)forall (m :: * -> *) a.Monad m =>a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)doneCodingProgressOutputUnderflowIntirIntow|Boolotherwise=do(Charc,Intir')<-RawBuffer Char -> Int -> IO (Char, Int)readCharBufRawBuffer CharirawIntirifChar -> BoolisSurrogateCharcthenCodingProgress-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)forall (m :: * -> *) a.Monad m =>a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)doneCodingProgressInvalidSequenceIntirIntowelsedolet(Word8c0,Word8c1,Word8c2,Word8c3)=Char -> (Word8, Word8, Word8, Word8)ord4CharcRawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8BufRawBuffer Word8orawIntowWord8c0RawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8BufRawBuffer Word8oraw(IntowInt -> Int -> Intforall a. Num a => a -> a -> a+Int1)Word8c1RawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8BufRawBuffer Word8oraw(IntowInt -> Int -> Intforall a. Num a => a -> a -> a+Int2)Word8c2RawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8BufRawBuffer Word8oraw(IntowInt -> Int -> Intforall a. Num a => a -> a -> a+Int3)Word8c3Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)loopIntir'(IntowInt -> Int -> Intforall a. Num a => a -> a -> a+Int4)inInt -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)loopIntir0Intow0utf32le_encode::EncodeBufferutf32le_encode :: CodeBuffer Char Word8utf32le_encodeinput :: Buffer Charinput@Buffer{bufRaw :: forall e. Buffer e -> RawBuffer ebufRaw=RawBuffer Chariraw,bufL :: forall e. Buffer e -> IntbufL=Intir0,bufR :: forall e. Buffer e -> IntbufR=Intiw,bufSize :: forall e. Buffer e -> IntbufSize=Int_}output :: Buffer Word8output@Buffer{bufRaw :: forall e. Buffer e -> RawBuffer ebufRaw=RawBuffer Word8oraw,bufL :: forall e. Buffer e -> IntbufL=Int_,bufR :: forall e. Buffer e -> IntbufR=Intow0,bufSize :: forall e. Buffer e -> IntbufSize=Intos}=letdone :: a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)doneawhy!Intir!Intow=(a, Buffer Char, Buffer Word8) -> m (a, Buffer Char, Buffer Word8)forall (m :: * -> *) a. Monad m => a -> m areturn(awhy,ifIntirInt -> Int -> Boolforall a. Eq a => a -> a -> Bool==IntiwthenBuffer Charinput{bufL :: IntbufL=Int0,bufR :: IntbufR=Int0}elseBuffer Charinput{bufL :: IntbufL=Intir},Buffer Word8output{bufR :: IntbufR=Intow})loop :: Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)loop!Intir!Intow|IntirInt -> Int -> Boolforall a. Ord a => a -> a -> Bool>=Intiw=CodingProgress-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)forall (m :: * -> *) a.Monad m =>a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)doneCodingProgressInputUnderflowIntirIntow|IntosInt -> Int -> Intforall a. Num a => a -> a -> a-IntowInt -> Int -> Boolforall a. Ord a => a -> a -> Bool<Int4=CodingProgress-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)forall (m :: * -> *) a.Monad m =>a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)doneCodingProgressOutputUnderflowIntirIntow|Boolotherwise=do(Charc,Intir')<-RawBuffer Char -> Int -> IO (Char, Int)readCharBufRawBuffer CharirawIntirifChar -> BoolisSurrogateCharcthenCodingProgress-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)forall (m :: * -> *) a.Monad m =>a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)doneCodingProgressInvalidSequenceIntirIntowelsedolet(Word8c0,Word8c1,Word8c2,Word8c3)=Char -> (Word8, Word8, Word8, Word8)ord4CharcRawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8BufRawBuffer Word8orawIntowWord8c3RawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8BufRawBuffer Word8oraw(IntowInt -> Int -> Intforall a. Num a => a -> a -> a+Int1)Word8c2RawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8BufRawBuffer Word8oraw(IntowInt -> Int -> Intforall a. Num a => a -> a -> a+Int2)Word8c1RawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8BufRawBuffer Word8oraw(IntowInt -> Int -> Intforall a. Num a => a -> a -> a+Int3)Word8c0Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)loopIntir'(IntowInt -> Int -> Intforall a. Num a => a -> a -> a+Int4)inInt -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)loopIntir0Intow0chr4::Word8->Word8->Word8->Word8->Charchr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Charchr4(W8#Word#x1#)(W8#Word#x2#)(W8#Word#x3#)(W8#Word#x4#)=Char# -> CharC#(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#Word#x1#!y2# :: Int#y2#=Word# -> Int#word2Int#Word#x2#!y3# :: Int#y3#=Word# -> Int#word2Int#Word#x3#!y4# :: Int#y4#=Word# -> Int#word2Int#Word#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#{-# INLINEchr4#-}ord4::Char->(Word8,Word8,Word8,Word8)ord4 :: Char -> (Word8, Word8, Word8, Word8)ord4Charc=(Int -> Word8forall a b. (Integral a, Num b) => a -> bfromIntegral(IntxInt -> Int -> Intforall a. Bits a => a -> Int -> a`shiftR`Int24),Int -> Word8forall a b. (Integral a, Num b) => a -> bfromIntegral(IntxInt -> Int -> Intforall a. Bits a => a -> Int -> a`shiftR`Int16),Int -> Word8forall a b. (Integral a, Num b) => a -> bfromIntegral(IntxInt -> Int -> Intforall a. Bits a => a -> Int -> a`shiftR`Int8),Int -> Word8forall a b. (Integral a, Num b) => a -> bfromIntegralIntx)wherex :: Intx=Char -> IntordCharc{-# INLINEord4#-}validate::Char->Boolvalidate :: Char -> BoolvalidateCharc=(Intx1Int -> Int -> Boolforall a. Ord a => a -> a -> Bool>=Int0x0Bool -> Bool -> Bool&&Intx1Int -> Int -> Boolforall a. Ord a => a -> a -> Bool<Int0xD800)Bool -> Bool -> Bool||(Intx1Int -> Int -> Boolforall a. Ord a => a -> a -> Bool>Int0xDFFFBool -> Bool -> Bool&&Intx1Int -> Int -> Boolforall a. Ord a => a -> a -> Bool<=Int0x10FFFF)wherex1 :: Intx1=Char -> IntordCharc{-# INLINEvalidate#-}